From e050d4f8240ff1b123ccd5687633d5be241c445c Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Wed, 20 Mar 2002 23:53:13 +0000 Subject: [PATCH] * eval.c (SIDEVAL): Removed. (SCM_CEVAL): Minimized scope of variable orig_sym. Eliminated goto-labels cdrxnoap, cdrxbegin and nontoplevel_cdrxnoap. Changed argument checking order for set! to locals, variables and symbols. Improvements to control structure. Removed some uses of arg1 and arg2 as temporary variables. --- libguile/ChangeLog | 10 +++++ libguile/eval.c | 93 ++++++++++++++++++++++------------------------ 2 files changed, 55 insertions(+), 48 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f0ac8b320..3ee6ff728 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2002-03-20 Dirk Herrmann + + * eval.c (SIDEVAL): Removed. + + (SCM_CEVAL): Minimized scope of variable orig_sym. Eliminated + goto-labels cdrxnoap, cdrxbegin and nontoplevel_cdrxnoap. Changed + argument checking order for set! to locals, variables and symbols. + Improvements to control structure. Removed some uses of arg1 and + arg2 as temporary variables. + 2002-03-15 Thien-Thi Nguyen * guile-snarf.in: Remove "--compat=1.4" support. diff --git a/libguile/eval.c b/libguile/eval.c index 523f7adb5..f8a52afd0 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -123,10 +123,6 @@ char *alloca (); * Originally, it is defined to scm_ceval, but is redefined to * scm_deval during the second pass. * - * SIDEVAL corresponds to SCM_CEVAL, but is used in situations where - * only side effects of expressions matter. All immediates are - * ignored. - * * SCM_EVALIM is used when it is known that the expression is an * immediate. (This macro never calls an evaluator.) * @@ -150,8 +146,6 @@ char *alloca (); */ #define SCM_CEVAL scm_ceval -#define SIDEVAL(x, env) if (SCM_NIMP (x)) SCM_CEVAL((x), (env)) - #define EVALCELLCAR(x, env) (SCM_SYMBOLP (SCM_CAR (x)) \ ? *scm_lookupcar (x, env, 1) \ : SCM_CEVAL (SCM_CAR (x), env)) @@ -1890,7 +1884,7 @@ scm_deval (SCM x, SCM env) SCM SCM_CEVAL (SCM x, SCM env) { - SCM proc, arg1, arg2, orig_sym; + SCM proc, arg1, arg2; #ifdef DEVAL scm_t_debug_frame debug; scm_t_debug_info *debug_info_end; @@ -2009,15 +2003,11 @@ dispatch: goto carloop; case SCM_BIT8 (SCM_IM_BEGIN): - if (SCM_NULLP (SCM_CDR (x))) + x = SCM_CDR (x); + if (SCM_NULLP (x)) RETURN (SCM_UNSPECIFIED); - /* (currently unused) - cdrxnoap: */ PREP_APPLY (SCM_UNDEFINED, SCM_EOL); - /* (currently unused) - cdrxbegin: */ - x = SCM_CDR (x); begin: /* If we are on toplevel with a lookup closure, we need to sync @@ -2036,9 +2026,6 @@ dispatch: else goto nontoplevel_begin; - nontoplevel_cdrxnoap: - PREP_APPLY (SCM_UNDEFINED, SCM_EOL); - x = SCM_CDR (x); nontoplevel_begin: while (!SCM_NULLP (SCM_CDR (x))) { @@ -2254,8 +2241,9 @@ dispatch: while (!SCM_NULLP (init_forms)); env = EXTEND_ENV (SCM_CAR (x), init_values, env); } - x = SCM_CDR (x); - goto nontoplevel_cdrxnoap; + x = SCM_CDDR (x); + PREP_APPLY (SCM_UNDEFINED, SCM_EOL); + goto nontoplevel_begin; case SCM_BIT8 (SCM_IM_LETREC): @@ -2273,7 +2261,9 @@ dispatch: while (!SCM_NULLP (init_forms)); SCM_SETCDR (SCM_CAR (env), init_values); } - goto nontoplevel_cdrxnoap; + x = SCM_CDR (x); + PREP_APPLY (SCM_UNDEFINED, SCM_EOL); + goto nontoplevel_begin; case SCM_BIT8 (SCM_IM_LETSTAR): @@ -2294,7 +2284,9 @@ dispatch: while (!SCM_NULLP (bindings)); } } - goto nontoplevel_cdrxnoap; + x = SCM_CDR (x); + PREP_APPLY (SCM_UNDEFINED, SCM_EOL); + goto nontoplevel_begin; case SCM_BIT8 (SCM_IM_OR): @@ -2324,12 +2316,13 @@ dispatch: { SCM *location; SCM variable = SCM_CAR (x); +#ifdef MEMOIZE_LOCALS + if (SCM_ILOCP (variable)) + location = scm_ilookup (variable, env); + else +#endif if (SCM_VARIABLEP (variable)) location = SCM_VARIABLE_LOC (variable); -#ifdef MEMOIZE_LOCALS - else if (SCM_ILOCP (variable)) - location = scm_ilookup (variable, env); -#endif else /* (SCM_SYMBOLP (variable)) is known to be true */ location = scm_lookupcar (x, env, 1); x = SCM_CDR (x); @@ -2407,23 +2400,27 @@ dispatch: int first; SCM val = scm_make_continuation (&first); - if (first) - arg1 = val; - else + if (!first) RETURN (val); + else + { + arg1 = val; + proc = SCM_CDR (x); + proc = scm_eval_car (proc, env); + SCM_ASRTGO (SCM_NIMP (proc), badfun); + PREP_APPLY (proc, scm_list_1 (arg1)); + ENTER_APPLY; + if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) + goto umwrongnumargs; + goto evap1; + } } - proc = SCM_CDR (x); - proc = scm_eval_car (proc, env); - SCM_ASRTGO (SCM_NIMP (proc), badfun); - PREP_APPLY (proc, scm_list_1 (arg1)); - ENTER_APPLY; - if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) - goto umwrongnumargs; - goto evap1; + case (SCM_ISYMNUM (SCM_IM_DELAY)): RETURN (scm_makprom (scm_closure (SCM_CDR (x), env))); + case (SCM_ISYMNUM (SCM_IM_DISPATCH)): { /* If not done yet, evaluate the operand forms. The result is a @@ -2732,9 +2729,9 @@ dispatch: #endif /* ifdef MEMOIZE_LOCALS */ case scm_tcs_cons_nimcar: - orig_sym = SCM_CAR (x); - if (SCM_SYMBOLP (orig_sym)) + if (SCM_SYMBOLP (SCM_CAR (x))) { + SCM orig_sym = SCM_CAR (x); #ifdef USE_THREADS { SCM *location = scm_lookupcar1 (x, env, 1); @@ -2759,7 +2756,7 @@ dispatch: { SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */ - handle_a_macro: + 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. */ @@ -2812,18 +2809,18 @@ dispatch: #endif if (SCM_CLOSUREP (proc)) { - arg2 = SCM_CLOSURE_FORMALS (proc); - arg1 = SCM_CDR (x); - while (!SCM_NULLP (arg2)) + SCM formals = SCM_CLOSURE_FORMALS (proc); + SCM args = SCM_CDR (x); + while (!SCM_NULLP (formals)) { - if (!SCM_CONSP (arg2)) + if (!SCM_CONSP (formals)) goto evapply; - if (SCM_IMP (arg1)) + if (SCM_IMP (args)) goto umwrongnumargs; - arg2 = SCM_CDR (arg2); - arg1 = SCM_CDR (arg1); + formals = SCM_CDR (formals); + args = SCM_CDR (args); } - if (!SCM_NULLP (arg1)) + if (!SCM_NULLP (args)) goto umwrongnumargs; } else if (SCM_MACROP (proc)) @@ -2832,7 +2829,7 @@ dispatch: } -evapply: +evapply: /* inputs: x, proc */ PREP_APPLY (proc, SCM_EOL); if (SCM_NULLP (SCM_CDR (x))) { ENTER_APPLY; @@ -3358,7 +3355,7 @@ exit: { int first; SCM val = scm_make_continuation (&first); - + if (first) arg1 = val; else