diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-20 13:31:07 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:25:07 +0100 |
commit | 9022ff183c44976b7f28503f9f78c523b578846a (patch) | |
tree | 2fd53c6909ec5dd91eafd48013a2e1ce4a06a7c8 | |
parent | 5bdea5bd3de9a592e91c194d73bfd0681894a2ca (diff) | |
download | guile-9022ff183c44976b7f28503f9f78c523b578846a.tar.gz |
remove code that manages the method cache
* 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.
-rw-r--r-- | libguile/eval.i.c | 53 | ||||
-rw-r--r-- | libguile/goops.c | 135 | ||||
-rw-r--r-- | libguile/goops.h | 8 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 33 | ||||
-rw-r--r-- | module/oop/goops/dispatch.scm | 4 |
5 files changed, 2 insertions, 231 deletions
diff --git a/libguile/eval.i.c b/libguile/eval.i.c index d78f498d7..681169878 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -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: diff --git a/libguile/goops.c b/libguile/goops.c index 4a38f397c..aee8ee280 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -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) diff --git a/libguile/goops.h b/libguile/goops.h index 57604a035..312304025 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -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); diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 59a5520f7..1f376ab70 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -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 */ diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm index 9e97b5b71..df7680028 100644 --- a/module/oop/goops/dispatch.scm +++ b/module/oop/goops/dispatch.scm @@ -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) |