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

remove code that manages the method cache

Browse source 
* libguile/goops.h (SCM_MCACHE_N_SPECIALIZED)
  (SCM_SET_MCACHE_N_SPECIALIZED, SCM_INITIAL_MCACHE_SIZE)
  (scm_make_method_cache, scm_memoize_method, scm_mcache_lookup_cmethod)
  (scm_mcache_compute_cmethod):
* libguile/goops.c: Remove these procedures which managed the method
  cache. There's still a slot there but it's not initialized. The method
  cache is no longer necessary.

* module/oop/goops/dispatch.scm (memoize-method!): Change to not take a
  "cache" argument.

* libguile/eval.i.c:
* libguile/vm-i-system.c: Remove dispatch via the method cache.
This commit is contained in:
Andy Wingo 2009-11-20 13:31:07 +01:00
parent 5bdea5bd3d
commit 9022ff183c
5 changed files with 2 additions and 231 deletions
Download patch file Download diff file Expand all files Collapse all files

53
libguile/eval.i.c
View file

@ -733,23 +733,6 @@ dispatch:
case (ISYMNUM (SCM_IM_DELAY)):
RETURN (scm_make_promise (scm_closure (SCM_CDR (x), env)));
/* PLACEHOLDER for case (ISYMNUM (SCM_IM_DISPATCH)): The following
code (type_dispatch) is intended to be the tail of the case
clause for the internal macro SCM_IM_DISPATCH. Please don't
remove it from this location without discussing it with Mikael
<djurfeldt@nada.kth.se> */
/* The type dispatch code is duplicated below
* (c.f. objects.c:scm_mcache_compute_cmethod) since that
* cuts down execution time for type dispatch to 50%. */
type_dispatch: /* inputs: x, arg1 */
{
proc = scm_mcache_compute_cmethod (x, arg1);
PREP_APPLY (proc, arg1);
goto apply_proc;
}
case (ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);
{
@ -1034,12 +1017,6 @@ dispatch:
#endif
goto evap0;
}
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_GENERIC_METHOD_CACHE (proc);
arg1 = SCM_EOL;
goto type_dispatch;
}
else
goto badfun;
case scm_tc7_subr_1:
@ -1159,16 +1136,6 @@ dispatch:
#endif
goto evap1;
}
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
arg1 = scm_list_1 (arg1);
#endif
goto type_dispatch;
}
else
goto badfun;
case scm_tc7_subr_2:
@ -1244,16 +1211,6 @@ dispatch:
SCM_EOL));
#endif
}
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
arg1 = scm_list_2 (arg1, arg2);
#endif
goto type_dispatch;
}
else
goto badfun;
case scm_tc7_subr_0:
@ -1455,16 +1412,6 @@ dispatch:
case scm_tcs_struct:
if (SCM_STRUCT_APPLICABLE_P (proc))
goto operatorn;
else if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
arg1 = scm_cons2 (arg1, arg2, scm_ceval_args (x, env, proc));
#endif
x = SCM_GENERIC_METHOD_CACHE (proc);
goto type_dispatch;
}
else
goto badfun;
case scm_tc7_subr_2:

135
libguile/goops.c
View file

@ -78,7 +78,6 @@ static SCM var_slot_unbound = SCM_BOOL_F;
static SCM var_slot_missing = SCM_BOOL_F;
static SCM var_compute_cpl = SCM_BOOL_F;
static SCM var_no_applicable_method = SCM_BOOL_F;
static SCM var_memoize_method_x = SCM_BOOL_F;
static SCM var_change_class = SCM_BOOL_F;
SCM_SYMBOL (sym_slot_unbound, "slot-unbound");
@ -1692,111 +1691,6 @@ static SCM list_of_no_method;
SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
* formats:
*
* Format #1:
* (SCM_IM_DISPATCH ARGS N-SPECIALIZED
* #((TYPE1 ... . CMETHOD) ...)
* GF)
*
* Format #2:
* (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
* #((TYPE1 ... CMETHOD) ...)
* GF)
*
* ARGS is either a list of expressions, in which case they
* are interpreted as the arguments of an application, or
* a non-pair, which is interpreted as a single expression
* yielding all arguments.
*
* SCM_IM_DISPATCH expressions in generic functions always
* have ARGS = the symbol `args' or the iloc #@0-0.
*
* 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.
*/
SCM
scm_mcache_lookup_cmethod (SCM cache, SCM args)
{
unsigned long i, mask, n, end;
SCM ls, methods, z = SCM_CDDR (cache);
n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
if (scm_is_simple_vector (methods))
{
/* cache format #1: prepare for linear search */
mask = -1;
i = 0;
end = SCM_SIMPLE_VECTOR_LENGTH (methods);
}
else
{
/* cache format #2: compute a hash value */
unsigned long hashset = scm_to_ulong (methods);
long j = n;
z = SCM_CDDR (z);
mask = scm_to_ulong (SCM_CAR (z));
methods = SCM_CADR (z);
i = 0;
ls = args;
if (!scm_is_null (ls))
do
{
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
[scm_si_hashsets + hashset];
ls = SCM_CDR (ls);
}
while (j-- && !scm_is_null (ls));
i &= mask;
end = i;
}
/* Search for match */
do
{
long j = n;
z = SCM_SIMPLE_VECTOR_REF (methods, i);
ls = args; /* list of arguments */
/* More arguments than specifiers => z = CMETHOD, not a pair.
* Fewer arguments than specifiers => CAR != CLASS or `no-method'. */
if (!scm_is_null (ls) && scm_is_pair (z))
do
{
if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
goto next_method;
ls = SCM_CDR (ls);
z = SCM_CDR (z);
}
while (j-- && !scm_is_null (ls) && scm_is_pair (z));
if (!scm_is_pair (z))
return z;
next_method:
i = (i + 1) & mask;
} while (i != end);
return SCM_BOOL_F;
}
SCM
scm_mcache_compute_cmethod (SCM cache, SCM args)
{
SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
if (scm_is_false (cmethod))
/* No match - memoize */
return scm_memoize_method (cache, args);
return cmethod;
}
SCM
scm_apply_generic (SCM gf, SCM args)
{
@ -1827,17 +1721,6 @@ scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
}
SCM
scm_make_method_cache (SCM gf)
{
return scm_list_5 (SCM_IM_DISPATCH,
scm_sym_args,
scm_from_int (1),
scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
list_of_no_method),
gf);
}
SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
static SCM
make_dispatch_procedure (SCM gf)
@ -1852,8 +1735,6 @@ make_dispatch_procedure (SCM gf)
static void
clear_method_cache (SCM gf)
{
SCM cache = scm_make_method_cache (gf);
SCM_SET_GENERIC_METHOD_CACHE (gf, cache);
SCM_SET_GENERIC_DISPATCH_PROCEDURE (gf, make_dispatch_procedure (gf));
SCM_CLEAR_GENERIC_EFFECTIVE_METHODS (gf);
}
@ -1865,9 +1746,6 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0
{
SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME);
clear_method_cache (gf);
/* The sign of n-specialized is a flag indicating rest args. */
SCM_SET_MCACHE_N_SPECIALIZED (SCM_GENERIC_METHOD_CACHE (gf),
SCM_SLOT (gf, scm_si_n_specialized));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -2224,19 +2102,6 @@ scm_sys_compute_applicable_methods (SCM gf, SCM args)
SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
SCM_VARIABLE_INIT (var_compute_applicable_methods, "compute-applicable-methods", scm_c_define_gsubr (s_sys_compute_applicable_methods, 2, 0, 0, scm_sys_compute_applicable_methods));
SCM
scm_memoize_method (SCM cache, SCM args)
{
SCM gf = SCM_CAR (scm_last_pair (cache));
if (SCM_UNLIKELY (scm_is_false (var_memoize_method_x)))
var_memoize_method_x =
scm_permanent_object
(scm_module_variable (scm_module_goops, sym_memoize_method_x));
return scm_call_3 (SCM_VARIABLE_REF (var_memoize_method_x), gf, args, cache);
}
/******************************************************************************
*
* A simple make (which will be redefined later in Scheme)

8
libguile/goops.h
View file

@ -154,8 +154,6 @@ typedef struct scm_t_method {
#define SCM_GENERIC_METHOD_CACHE(G) (SCM_PACK (SCM_STRUCT_DATA (G) [scm_si_generic_cache]))
#define SCM_SET_GENERIC_METHOD_CACHE(G,C) (SCM_STRUCT_DATA (G) [scm_si_generic_cache] = SCM_UNPACK (C))
#define SCM_MCACHE_N_SPECIALIZED(C) SCM_CADDR (C)
#define SCM_SET_MCACHE_N_SPECIALIZED(C, X) SCM_SETCAR (SCM_CDDR (C), X)
#define SCM_SET_GENERIC_DISPATCH_PROCEDURE(G,C) (SCM_STRUCT_SLOT_SET (G, scm_si_dispatch_procedure, (C)))
#define SCM_CLEAR_GENERIC_EFFECTIVE_METHODS(G) (SCM_STRUCT_SLOT_SET (G, scm_si_effective_methods, SCM_EOL));
@ -163,8 +161,6 @@ typedef struct scm_t_method {
#define SCM_GENERIC_SETTER(G) (SCM_PACK (SCM_STRUCT_DATA (G) [scm_si_generic_setter]))
#define SCM_SET_GENERIC_SETTER(G,C) (SCM_STRUCT_DATA (G) [scm_si_generic_setter] = SCM_UNPACK (C))
#define SCM_INITIAL_MCACHE_SIZE 1
#define scm_si_dispatch_procedure scm_applicable_struct_index_procedure /* 0 */
#define scm_si_methods 1
#define scm_si_n_specialized 2
@ -301,7 +297,6 @@ SCM_API SCM scm_slot_exists_p (SCM obj, SCM slot_name);
SCM_API SCM scm_sys_modify_instance (SCM old, SCM newinst);
SCM_API SCM scm_sys_modify_class (SCM old, SCM newcls);
SCM_API SCM scm_sys_invalidate_class (SCM cls);
SCM_API SCM scm_make_method_cache (SCM gf);
SCM_API SCM scm_sys_invalidate_method_cache_x (SCM gf);
SCM_API SCM scm_generic_capability_p (SCM proc);
SCM_API SCM scm_enable_primitive_generic_x (SCM subrs);
@ -313,9 +308,6 @@ SCM_API SCM scm_make (SCM args);
SCM_API SCM scm_find_method (SCM args);
SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
SCM_API void scm_change_object_class (SCM, SCM, SCM);
SCM_API SCM scm_memoize_method (SCM x, SCM args);
SCM_API SCM scm_mcache_lookup_cmethod (SCM cache, SCM args);
SCM_API SCM scm_mcache_compute_cmethod (SCM cache, SCM args);
/* The following are declared in __scm.h
SCM_API SCM scm_call_generic_0 (SCM gf);
SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);

33
libguile/vm-i-system.c
View file

@ -766,17 +766,6 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_call;
}
if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
{
SCM args = SCM_EOL;
int n = nargs;
SCM* walk = sp;
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_call;
}
/*
* Other interpreted or compiled call
*/
@ -855,17 +844,6 @@ VM_DEFINE_INSTRUCTION (54, goto_args, "goto/args", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_goto_args;
}
if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
{
SCM args = SCM_EOL;
int n = nargs;
SCM* walk = sp;
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_goto_args;
}
/*
* Other interpreted or compiled call
@ -952,17 +930,6 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_mv_call;
}
if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
{
SCM args = SCM_EOL;
int n = nargs;
SCM* walk = sp;
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_mv_call;
}
/*
* Other interpreted or compiled call
*/

4
module/oop/goops/dispatch.scm
View file

@ -228,7 +228,7 @@
(cache-miss gf args)))
(define (cache-miss gf args)
(apply (memoize-method! gf args (slot-ref gf '%cache)) args))
(apply (memoize-method! gf args) args))
(define (memoize-effective-method! gf args applicable)
(define (first-n ls n)
@ -256,7 +256,7 @@
;;; Memoization
;;;
(define (memoize-method! gf args exp)
(define (memoize-method! gf args)
(let ((applicable ((if (eq? gf compute-applicable-methods)
%compute-applicable-methods
compute-applicable-methods)