mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00
Code Activity

* eval.c (SCM_CEVAL): Improvements to SCM_IM_DISPATCH and

Browse source 
SCM_IM_HASH_DISPATCH.
This commit is contained in:
Mikael Djurfeldt 1999-08-04 11:27:44 +00:00
parent 31703ab8c6
commit ef67c5eac1
1 changed files with 40 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/eval.c
View file

@ -2266,27 +2266,53 @@ dispatch:
goto evap1; goto evap1;
case (SCM_ISYMNUM (SCM_IM_DISPATCH)): case (SCM_ISYMNUM (SCM_IM_DISPATCH)):
/* (SCM_IM_DISPATCH N-SPECIALIZED
* #((TYPE1 ... ENV FORMALS FORM ...) ...))
*
* Need FORMALS in order to support varying arity. This
* also avoids the need for renaming of bindings.
*
* We should probably not complicate this mechanism by
* introducing "optimizations" for getters and setters or
* primitive methods. Getters and setter will normally be
* compiled into @slot-[ref|set!] or a procedure call.
* They rely on the dispatch performed before executing
* the code which contains them.
*
* We might want to use a more efficient representation of
* this form in the future, perhaps after we have introduced
* low-level support for syntax-case macros.
*/
{ {
int i, end, mask; int i, n, end, mask;
mask = -1; mask = -1;
proc = SCM_CADR (x); n = SCM_INUM (SCM_CADR (x)); /* maximum number of specializers */
proc = SCM_CADDR (x); /* cache entries */
i = 0; i = 0;
end = SCM_LENGTH (proc); end = SCM_LENGTH (proc);
find_method: find_method:
do do
{ {
t.arg1 = SCM_CDDAR (env); int j = n;
t.arg1 = SCM_CDDAR (env); /* list of arguments */
arg2 = SCM_VELTS (proc)[i]; arg2 = SCM_VELTS (proc)[i];
do do
{ {
/* More arguments than specifiers => CLASS != ENV */
if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (arg2)) if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (arg2))
goto next_method; goto next_method;
t.arg1 = SCM_CDR (t.arg1); t.arg1 = SCM_CDR (t.arg1);
arg2 = SCM_CDR (arg2); arg2 = SCM_CDR (arg2);
} }
while (SCM_NIMP (t.arg1)); while (--j && SCM_NIMP (t.arg1));
x = arg2; /* Fewer arguments than specifiers => CAR != ENV */
env = scm_cons (SCM_CAR (env), SCM_CDR (arg2)); if (!SCM_CONSP (SCM_CAR (arg2)))
goto next_method;
/* Copy the environment frame so that the dispatch form can
be used also in normal code. */
env = EXTEND_ENV (SCM_CADR (arg2), SCM_CDDAR (env),
SCM_CAR (arg2));
x = SCM_CDDR (arg2);
goto begin; goto begin;
next_method: next_method:
i = (i + 1) & mask; i = (i + 1) & mask;
@ -2295,10 +2321,14 @@ dispatch:
goto loop; goto loop;
case (SCM_ISYMNUM (SCM_IM_HASH_DISPATCH)): case (SCM_ISYMNUM (SCM_IM_HASH_DISPATCH)):
/* (SCM_IM_HASH_DISPATCH N-SPECIALIZED HASHSET MASK
#((TYPE1 ... ENV FORMALS FORM ...) ...)) */
n = SCM_INUM (SCM_CADR (x)); /* maximum number of specializers */
{ {
int hashset = SCM_INUM (SCM_CADR (x)); int hashset = SCM_INUM (SCM_CADDR (x));
mask = SCM_INUM (SCM_CADDR (x)); int j = n;
proc = SCM_CADDDR (x); mask = SCM_INUM (SCM_CADDDR (x));
proc = SCM_CAR (SCM_CDDDDR (x));
i = 0; i = 0;
t.arg1 = SCM_CDDAR (env); t.arg1 = SCM_CDDAR (env);
do do
@ -2306,7 +2336,7 @@ dispatch:
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))[scm_si_hashsets + hashset]; i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))[scm_si_hashsets + hashset];
t.arg1 = SCM_CDR (t.arg1); t.arg1 = SCM_CDR (t.arg1);
} }
while (SCM_NIMP (t.arg1)); while (--j && SCM_NIMP (t.arg1));
i &= mask; i &= mask;
end = i; end = i;
} }