diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1997-03-07 21:43:03 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1997-03-07 21:43:03 +0000 |
commit | 399dedcca7437a47f9b63c23b9535ac17e3cc51d (patch) | |
tree | 02df2cffb392046b7c922897c357033e23be504f | |
parent | a8485f4d34ed17d9578c379b53787446c2b66ece (diff) | |
download | guile-399dedcca7437a47f9b63c23b9535ac17e3cc51d.tar.gz |
* eval.c (SCM_CEVAL): Added code sections for handling of asubrs
with 3 or more args internally to the evaluator. This is mainly
because we don't want to pass entry and exit points of the
debug support twice, but it also seems to increase the speed of
the evaluator for such calls (e. g. (+ 1 2 3)).
-rw-r--r-- | libguile/eval.c | 38 |
1 files changed, 22 insertions, 16 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 564e49edf..cc2f70d30 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1327,6 +1327,7 @@ scm_deval_args (l, env, lloc) #endif #endif /* DEVAL */ +#define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */ /* SECTION: This is the evaluator. Like any real monster, it has * three heads. This code is compiled twice. @@ -2119,18 +2120,21 @@ evapply: SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CAR (SCM_CDR (SCM_CDR (debug.info->a.args))))); case scm_tc7_asubr: - /* t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2); - while SCM_NIMP(x) { - t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env)); - x = SCM_CDR(x); - } - RETURN (t.arg1) */ +#ifdef BUILTIN_RPASUBR + t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2); + arg2 = SCM_CDR (SCM_CDR (debug.info->a.args)); + do { + t.arg1 = SCM_SUBRF(proc)(t.arg1, SCM_CAR (arg2)); + arg2 = SCM_CDR (arg2); + } while (SCM_NIMP (arg2)); + RETURN (t.arg1) +#endif /* BUILTIN_RPASUBR */ case scm_tc7_rpsubr: RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, SCM_CDR (SCM_CDR (debug.info->a.args)), SCM_EOL))) - case scm_tc7_lsubr_2: - RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CDR (SCM_CDR (debug.info->a.args)))) - case scm_tc7_lsubr: - RETURN (SCM_SUBRF (proc) (debug.info->a.args)) + case scm_tc7_lsubr_2: + RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CDR (SCM_CDR (debug.info->a.args)))) + case scm_tc7_lsubr: + RETURN (SCM_SUBRF (proc) (debug.info->a.args)) #ifdef CCLO case scm_tc7_cclo: goto cclon; @@ -2147,12 +2151,14 @@ evapply: SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); RETURN (SCM_SUBRF (proc) (t.arg1, arg2, EVALCAR (x, env))); case scm_tc7_asubr: - /* t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2); - while SCM_NIMP(x) { - t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env)); - x = SCM_CDR(x); - } - RETURN (t.arg1) */ +#ifdef BUILTIN_RPASUBR + t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2); + do { + t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env)); + x = SCM_CDR(x); + } while (SCM_NIMP (x)); + RETURN (t.arg1) +#endif /* BUILTIN_RPASUBR */ case scm_tc7_rpsubr: RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, scm_eval_args (x, env), SCM_EOL))); case scm_tc7_lsubr_2: |