summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1999-08-30 02:18:00 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1999-08-30 02:18:00 +0000
commit61364ba686e12aa6ffc7d5e02f6cc94a9ef0e165 (patch)
treed6d396f978550713c478488ab881007da9b82b83
parenta709833577ae819754cc7c424ad7f71e51cb301c (diff)
downloadguile-61364ba686e12aa6ffc7d5e02f6cc94a9ef0e165.tar.gz
* eval.c (SCM_CEVAL): Duplicated the method dispatch code at the
SCM_IM_DISPATCH form instead of calling scm_mcache_lookup_cmethod since that cuts down the time for type dispatch by 50%.
-rw-r--r--libguile/eval.c78
1 files changed, 72 insertions, 6 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index d117563c3..ce5bae35b 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -94,6 +94,8 @@ char *alloca ();
#include "eval.h"
+SCM (*scm_memoize_method) (SCM, SCM);
+
/* The evaluator contains a plethora of EVAL symbols.
@@ -2332,12 +2334,76 @@ dispatch:
}
type_dispatch:
- proc = scm_mcache_compute_cmethod (x, arg2);
- env = EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (proc)),
- arg2,
- SCM_CMETHOD_ENV (proc));
- x = SCM_CMETHOD_CODE (proc);
- goto cdrxbegin;
+ /* The type dispatch code is duplicated here
+ * (c.f. objects.c:scm_mcache_compute_cmethod) since that
+ * cuts down execution time for type dispatch to 50%.
+ */
+ {
+ int i, n, end, mask;
+ SCM z = SCM_CDDR (x);
+ n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
+ proc = SCM_CADR (z);
+
+ if (SCM_NIMP (proc))
+ {
+ /* Prepare for linear search */
+ mask = -1;
+ i = 0;
+ end = SCM_LENGTH (proc);
+ }
+ else
+ {
+ /* Compute a hash value */
+ int hashset = SCM_INUM (proc);
+ int j = n;
+ mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
+ proc = SCM_CADR (z);
+ i = 0;
+ t.arg1 = arg2;
+ if (SCM_NIMP (t.arg1))
+ do
+ {
+ i += (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))
+ [scm_si_hashsets + hashset]);
+ t.arg1 = SCM_CDR (t.arg1);
+ }
+ while (--j && SCM_NIMP (t.arg1));
+ i &= mask;
+ end = i;
+ }
+
+ /* Search for match */
+ do
+ {
+ int j = n;
+ z = SCM_VELTS (proc)[i];
+ t.arg1 = arg2; /* list of arguments */
+ if (SCM_NIMP (t.arg1))
+ do
+ {
+ /* More arguments than specifiers => CLASS != ENV */
+ if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (z))
+ goto next_method;
+ t.arg1 = SCM_CDR (t.arg1);
+ z = SCM_CDR (z);
+ }
+ while (--j && SCM_NIMP (t.arg1));
+ /* Fewer arguments than specifiers => CAR != ENV */
+ if (!(SCM_IMP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z))))
+ goto next_method;
+ apply_cmethod:
+ env = EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (z)),
+ arg2,
+ SCM_CMETHOD_ENV (z));
+ x = SCM_CMETHOD_CODE (z);
+ goto cdrxbegin;
+ next_method:
+ i = (i + 1) & mask;
+ } while (i != end);
+
+ z = scm_memoize_method (x, arg2);
+ goto apply_cmethod;
+ }
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);