summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1997-03-07 21:43:03 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1997-03-07 21:43:03 +0000
commit399dedcca7437a47f9b63c23b9535ac17e3cc51d (patch)
tree02df2cffb392046b7c922897c357033e23be504f
parenta8485f4d34ed17d9578c379b53787446c2b66ece (diff)
downloadguile-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.c38
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: