summaryrefslogtreecommitdiff
path: root/libguile/eval.c
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 /libguile/eval.c
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)).
Diffstat (limited to 'libguile/eval.c')
-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: