summaryrefslogtreecommitdiff
path: root/libguile/eval.i.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-08-21 01:00:28 +0200
committerAndy Wingo <wingo@pobox.com>2009-12-01 21:00:25 +0100
commit25e8a4721e20e116646a55313a3c8b92ccfa4e71 (patch)
tree045867fb5359416200e8808867173212c2221785 /libguile/eval.i.c
parenta4ac184963d503b9b9cd6a5ead7d8720ee4cad66 (diff)
downloadguile-25e8a4721e20e116646a55313a3c8b92ccfa4e71.tar.gz
remove code from eval.i.c that was only for CEVAL.
* libguile/eval.i.c: Remove CEVAL-only code.
Diffstat (limited to 'libguile/eval.i.c')
-rw-r--r--libguile/eval.i.c241
1 files changed, 0 insertions, 241 deletions
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 616f95e65..7d06fb352 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -27,8 +27,6 @@
#undef EVAL_DEBUGGING_P
-#ifdef DEVAL
-
/*
This code is specific for the debugging support.
*/
@@ -83,58 +81,6 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
}
-#else /* DEVAL */
-
-/*
- Code is specific to debugging-less support.
- */
-
-
-#define CEVAL ceval
-#define SCM_APPLY scm_apply
-#define PREP_APPLY(proc, args)
-#define ENTER_APPLY
-#define RETURN(x) do { return x; } while (0)
-#define EVAL_DEBUGGING_P 0
-
-#ifdef STACK_CHECKING
-# ifndef NO_CEVAL_STACK_CHECKING
-# define EVAL_STACK_CHECKING
-# endif
-#endif
-
-
-
-
-static SCM
-scm_ceval_args (SCM l, SCM env, SCM proc)
-{
- SCM results = SCM_EOL, *lloc = &results, res;
- while (scm_is_pair (l))
- {
- res = EVALCAR (l, env);
-
- *lloc = scm_list_1 (res);
- lloc = SCM_CDRLOC (*lloc);
- l = SCM_CDR (l);
- }
- if (!scm_is_null (l))
- scm_wrong_num_args (proc);
- return results;
-}
-
-
-SCM
-scm_eval_args (SCM l, SCM env, SCM proc)
-{
- return scm_ceval_args (l, env, proc);
-}
-
-
-
-#endif
-
-
#define EVAL(x, env) SCM_I_XEVAL(x, env)
@@ -186,7 +132,6 @@ static SCM
CEVAL (SCM x, SCM env)
{
SCM proc, arg1;
-#ifdef DEVAL
scm_t_debug_frame debug;
scm_t_debug_info *debug_info_end;
debug.prev = scm_i_last_debug_frame ();
@@ -201,24 +146,18 @@ CEVAL (SCM x, SCM env)
debug.info = debug.vect;
debug_info_end = debug.vect + scm_debug_eframe_size;
scm_i_set_last_debug_frame (&debug);
-#endif
#ifdef EVAL_STACK_CHECKING
if (scm_stack_checking_enabled_p && SCM_STACK_OVERFLOW_P (&proc))
{
-#ifdef DEVAL
debug.info->e.exp = x;
debug.info->e.env = env;
-#endif
scm_report_stack_overflow ();
}
#endif
-#ifdef DEVAL
goto start;
-#endif
loop:
-#ifdef DEVAL
SCM_CLEAR_ARGSREADY (debug);
if (SCM_OVERFLOWP (debug))
--debug.info;
@@ -267,7 +206,6 @@ start:
}
}
}
-#endif
dispatch:
SCM_TICK;
if (SCM_ISYMP (SCM_CAR (x)))
@@ -653,9 +591,7 @@ dispatch:
if (SCM_CLOSUREP (proc))
{
SCM formals = SCM_CLOSURE_FORMALS (proc);
-#ifdef DEVAL
debug.info->a.args = arg1;
-#endif
if (SCM_UNLIKELY (scm_badargsp (formals, arg1)))
scm_wrong_num_args (proc);
ENTER_APPLY;
@@ -838,7 +774,6 @@ dispatch:
goto dispatch;
}
proc = *location;
-#ifdef DEVAL
if (scm_check_memoize_p && SCM_TRAPS_P)
{
SCM arg1, retval;
@@ -856,7 +791,6 @@ dispatch:
*/
SCM_TRAPS_P = 1;
}
-#endif
}
if (SCM_MACROP (proc))
@@ -864,16 +798,12 @@ dispatch:
SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of
lookupcar */
handle_a_macro: /* inputs: x, env, proc */
-#ifdef DEVAL
/* Set a flag during macro expansion so that macro
application frames can be deleted from the backtrace. */
SCM_SET_MACROEXP (debug);
-#endif
arg1 = SCM_APPLY (SCM_MACRO_CODE (proc), x,
scm_cons (env, scm_listofnull));
-#ifdef DEVAL
SCM_CLEAR_MACROEXP (debug);
-#endif
switch (SCM_MACRO_TYPE (proc))
{
case 3:
@@ -884,7 +814,6 @@ dispatch:
assert (!scm_is_eq (x, SCM_CAR (arg1))
&& !scm_is_eq (x, SCM_CDR (arg1)));
-#ifdef DEVAL
if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc)))
{
SCM_CRITICAL_SECTION_START;
@@ -897,7 +826,6 @@ dispatch:
debug.info->e.exp = scm_cons_source (debug.info->e.exp,
SCM_CAR (x),
SCM_CDR (x));
-#endif
SCM_CRITICAL_SECTION_START;
SCM_SETCAR (x, SCM_CAR (arg1));
SCM_SETCDR (x, SCM_CDR (arg1));
@@ -962,16 +890,12 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_0 (proc));
case scm_tc7_gsubr:
-#ifdef DEVAL
debug.info->a.proc = proc;
debug.info->a.args = SCM_EOL;
-#endif
RETURN (scm_i_gsubr_apply (proc, SCM_UNDEFINED));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
-#ifdef DEVAL
debug.info->a.proc = proc;
-#endif
if (!SCM_CLOSUREP (proc))
goto evap0;
/* fallthrough */
@@ -988,9 +912,7 @@ dispatch:
if (SCM_STRUCT_APPLICABLE_P (proc))
{
proc = SCM_STRUCT_PROCEDURE (proc);
-#ifdef DEVAL
debug.info->a.proc = proc;
-#endif
goto evap0;
}
else
@@ -1016,9 +938,7 @@ dispatch:
arg1 = EVALCAR (x, env);
else
scm_wrong_num_args (proc);
-#ifdef DEVAL
debug.info->a.args = scm_list_1 (arg1);
-#endif
x = SCM_CDR (x);
{
SCM arg2;
@@ -1061,26 +981,18 @@ dispatch:
case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
case scm_tc7_lsubr:
-#ifdef DEVAL
RETURN (SCM_SUBRF (proc) (debug.info->a.args));
-#else
- RETURN (SCM_SUBRF (proc) (scm_list_1 (arg1)));
-#endif
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
RETURN (SCM_SMOB_APPLY_1 (proc, arg1));
case scm_tc7_gsubr:
-#ifdef DEVAL
debug.info->a.args = debug.info->a.args;
debug.info->a.proc = proc;
-#endif
RETURN (scm_i_gsubr_apply (proc, arg1, SCM_UNDEFINED));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
-#ifdef DEVAL
debug.info->a.proc = proc;
-#endif
if (!SCM_CLOSUREP (proc))
goto evap1;
/* fallthrough */
@@ -1092,24 +1004,16 @@ dispatch:
|| (scm_is_pair (formals) && scm_is_pair (SCM_CDR (formals))))
goto wrongnumargs;
x = SCM_CLOSURE_BODY (proc);
-#ifdef DEVAL
env = SCM_EXTEND_ENV (formals,
debug.info->a.args,
SCM_ENV (proc));
-#else
- env = SCM_EXTEND_ENV (formals,
- scm_list_1 (arg1),
- SCM_ENV (proc));
-#endif
goto nontoplevel_begin;
}
case scm_tcs_struct:
if (SCM_STRUCT_APPLICABLE_P (proc))
{
proc = SCM_STRUCT_PROCEDURE (proc);
-#ifdef DEVAL
debug.info->a.proc = proc;
-#endif
goto evap1;
}
else
@@ -1129,9 +1033,7 @@ dispatch:
scm_wrong_num_args (proc);
{ /* have two or more arguments */
-#ifdef DEVAL
debug.info->a.args = scm_list_2 (arg1, arg2);
-#endif
x = SCM_CDR (x);
if (scm_is_null (x)) {
ENTER_APPLY;
@@ -1143,11 +1045,7 @@ dispatch:
case scm_tc7_subr_2o:
RETURN (SCM_SUBRF (proc) (arg1, arg2));
case scm_tc7_lsubr:
-#ifdef DEVAL
RETURN (SCM_SUBRF (proc) (debug.info->a.args));
-#else
- RETURN (SCM_SUBRF (proc) (scm_list_2 (arg1, arg2)));
-#endif
case scm_tc7_lsubr_2:
RETURN (SCM_SUBRF (proc) (arg1, arg2, SCM_EOL));
case scm_tc7_rpsubr:
@@ -1164,28 +1062,14 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2));
case scm_tc7_gsubr:
-#ifdef DEVAL
RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args));
-#else
- RETURN (scm_i_gsubr_apply (proc, arg1, arg2, SCM_UNDEFINED));
-#endif
case scm_tcs_struct:
if (SCM_STRUCT_APPLICABLE_P (proc))
{
operatorn:
-#ifdef DEVAL
RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
debug.info->a.args,
SCM_EOL));
-#else
- RETURN (SCM_APPLY (SCM_STRUCT_PROCEDURE (proc),
- scm_cons (arg1,
- scm_cons (arg2,
- scm_ceval_args (x,
- env,
- proc))),
- SCM_EOL));
-#endif
}
else
goto badfun;
@@ -1200,9 +1084,7 @@ dispatch:
goto badfun;
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
-#ifdef DEVAL
debug.info->a.proc = proc;
-#endif
if (!SCM_CLOSUREP (proc))
goto evap2;
/* fallthrough */
@@ -1216,15 +1098,9 @@ dispatch:
|| (scm_is_pair (SCM_CDR (formals))
&& scm_is_pair (SCM_CDDR (formals))))))
goto wrongnumargs;
-#ifdef DEVAL
env = SCM_EXTEND_ENV (formals,
debug.info->a.args,
SCM_ENV (proc));
-#else
- env = SCM_EXTEND_ENV (formals,
- scm_list_2 (arg1, arg2),
- SCM_ENV (proc));
-#endif
x = SCM_CLOSURE_BODY (proc);
goto nontoplevel_begin;
}
@@ -1232,17 +1108,14 @@ dispatch:
}
if (SCM_UNLIKELY (!scm_is_pair (x)))
scm_wrong_num_args (proc);
-#ifdef DEVAL
debug.info->a.args = scm_cons2 (arg1, arg2,
deval_args (x, env, proc,
SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
-#endif
ENTER_APPLY;
evap3:
SCM_ASRTGO (!SCM_IMP (proc), badfun);
switch (SCM_TYP7 (proc))
{ /* have 3 or more arguments */
-#ifdef DEVAL
case scm_tc7_subr_3:
if (!scm_is_null (SCM_CDR (x)))
scm_wrong_num_args (proc);
@@ -1308,83 +1181,6 @@ dispatch:
x = SCM_CLOSURE_BODY (proc);
goto nontoplevel_begin;
}
-#else /* DEVAL */
- case scm_tc7_subr_3:
- if (SCM_UNLIKELY (!scm_is_null (SCM_CDR (x))))
- scm_wrong_num_args (proc);
- else
- RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env)));
- case scm_tc7_asubr:
- arg1 = SCM_SUBRF (proc) (arg1, arg2);
- do
- {
- arg1 = SCM_SUBRF(proc)(arg1, EVALCAR(x, env));
- x = SCM_CDR(x);
- }
- while (!scm_is_null (x));
- RETURN (arg1);
- case scm_tc7_rpsubr:
- if (scm_is_false (SCM_SUBRF (proc) (arg1, arg2)))
- RETURN (SCM_BOOL_F);
- do
- {
- arg1 = EVALCAR (x, env);
- if (scm_is_false (SCM_SUBRF (proc) (arg2, arg1)))
- RETURN (SCM_BOOL_F);
- arg2 = arg1;
- x = SCM_CDR (x);
- }
- while (!scm_is_null (x));
- RETURN (SCM_BOOL_T);
- case scm_tc7_lsubr_2:
- RETURN (SCM_SUBRF (proc) (arg1, arg2, scm_ceval_args (x, env, proc)));
- case scm_tc7_lsubr:
- RETURN (SCM_SUBRF (proc) (scm_cons2 (arg1,
- arg2,
- scm_ceval_args (x, env, proc))));
- case scm_tc7_smob:
- if (!SCM_SMOB_APPLICABLE_P (proc))
- goto badfun;
- RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2,
- scm_ceval_args (x, env, proc)));
- case scm_tc7_gsubr:
- if (scm_is_null (SCM_CDR (x)))
- /* 3 arguments */
- RETURN (scm_i_gsubr_apply (proc, arg1, arg2, EVALCAR (x, env),
- SCM_UNDEFINED));
- else
- RETURN (scm_i_gsubr_apply_list (proc,
- scm_cons2 (arg1, arg2,
- scm_ceval_args (x, env,
- proc))));
- case scm_tc7_program:
- RETURN (scm_vm_apply
- (scm_the_vm (), proc,
- scm_cons (arg1, scm_cons (arg2,
- scm_ceval_args (x, env, proc)))));
- case scm_tc7_pws:
- proc = SCM_PROCEDURE (proc);
- if (!SCM_CLOSUREP (proc))
- goto evap3;
- /* fallthrough */
- case scm_tcs_closures:
- {
- const SCM formals = SCM_CLOSURE_FORMALS (proc);
- if (scm_is_null (formals)
- || (scm_is_pair (formals)
- && (scm_is_null (SCM_CDR (formals))
- || (scm_is_pair (SCM_CDR (formals))
- && scm_badargsp (SCM_CDDR (formals), x)))))
- goto wrongnumargs;
- env = SCM_EXTEND_ENV (formals,
- scm_cons2 (arg1,
- arg2,
- scm_ceval_args (x, env, proc)),
- SCM_ENV (proc));
- x = SCM_CLOSURE_BODY (proc);
- goto nontoplevel_begin;
- }
-#endif /* DEVAL */
case scm_tcs_struct:
if (SCM_STRUCT_APPLICABLE_P (proc))
goto operatorn;
@@ -1403,7 +1199,6 @@ dispatch:
}
}
}
-#ifdef DEVAL
exit:
if (scm_check_exit_p && SCM_TRAPS_P)
if (SCM_EXIT_FRAME_P || (SCM_TRACE_P && SCM_TRACED_FRAME_P (debug)))
@@ -1418,7 +1213,6 @@ exit:
}
scm_i_set_last_debug_frame (debug.prev);
return proc;
-#endif
}
@@ -1437,7 +1231,6 @@ exit:
SCM
SCM_APPLY (SCM proc, SCM arg1, SCM args)
{
-#ifdef DEVAL
scm_t_debug_frame debug;
scm_t_debug_info debug_vect_body;
debug.prev = scm_i_last_debug_frame ();
@@ -1446,10 +1239,6 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = SCM_EOL;
scm_i_set_last_debug_frame (&debug);
-#else
- if (scm_debug_mode_p)
- return scm_dapply (proc, arg1, args);
-#endif
SCM_ASRTGO (SCM_NIMP (proc), badproc);
@@ -1470,15 +1259,11 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
if (scm_is_null (arg1))
{
arg1 = SCM_UNDEFINED;
-#ifdef DEVAL
debug.vect[0].a.args = SCM_EOL;
-#endif
}
else
{
-#ifdef DEVAL
debug.vect[0].a.args = arg1;
-#endif
args = SCM_CDR (arg1);
arg1 = SCM_CAR (arg1);
}
@@ -1486,11 +1271,8 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
else
{
args = scm_nconc2last (args);
-#ifdef DEVAL
debug.vect[0].a.args = scm_cons (arg1, args);
-#endif
}
-#ifdef DEVAL
if (SCM_ENTER_FRAME_P && SCM_TRAPS_P)
{
SCM tmp = scm_make_debugobj (&debug);
@@ -1499,7 +1281,6 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
SCM_TRAPS_P = 1;
}
ENTER_APPLY;
-#endif
tail:
switch (SCM_TYP7 (proc))
{
@@ -1566,11 +1347,7 @@ tail:
else
RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CADR (args)));
case scm_tc7_lsubr:
-#ifdef DEVAL
RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : debug.vect[0].a.args));
-#else
- RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)));
-#endif
case scm_tc7_lsubr_2:
if (SCM_UNLIKELY (!scm_is_pair (args)))
scm_wrong_num_args (proc);
@@ -1604,11 +1381,7 @@ tail:
}
RETURN (SCM_BOOL_T);
case scm_tcs_closures:
-#ifdef DEVAL
arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : debug.vect[0].a.args);
-#else
- arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args));
-#endif
if (SCM_UNLIKELY (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1)))
scm_wrong_num_args (proc);
@@ -1667,27 +1440,19 @@ tail:
else
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
case scm_tc7_gsubr:
-#ifdef DEVAL
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = args;
-#else
- args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
-#endif
RETURN (scm_i_gsubr_apply_list (proc, args));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
-#ifdef DEVAL
debug.vect[0].a.proc = proc;
-#endif
goto tail;
case scm_tcs_struct:
if (SCM_STRUCT_APPLICABLE_P (proc))
{
proc = SCM_STRUCT_PROCEDURE (proc);
-#ifdef DEVAL
debug.vect[0].a.proc = proc;
-#endif
if (SCM_NIMP (proc))
goto tail;
else
@@ -1695,11 +1460,7 @@ tail:
}
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
-#ifdef DEVAL
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
-#else
- args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
-#endif
RETURN (scm_apply_generic (proc, args));
}
else
@@ -1708,7 +1469,6 @@ tail:
badproc:
scm_wrong_type_arg ("apply", SCM_ARG1, proc);
}
-#ifdef DEVAL
exit:
if (scm_check_exit_p && SCM_TRAPS_P)
if (SCM_EXIT_FRAME_P || (SCM_TRACE_P && SCM_TRACED_FRAME_P (debug)))
@@ -1723,6 +1483,5 @@ exit:
}
scm_i_set_last_debug_frame (debug.prev);
return proc;
-#endif
}