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

SCM_GENERIC_METHOD_CACHE macro splits from SCM_ENTITY_PROCEDURE

Browse source 
* libguile/goops.h (SCM_GENERIC_METHOD_CACHE)
  (SCM_SET_GENERIC_METHOD_CACHE): Two new macros; the same as
  SCM_[SET_]ENTITY_PROCEDURE, but more reflecting the reality of the
  generic hack.

* libguile/eval.i.c:
* libguile/goops.c:
* libguile/objects.c:
* libguile/vm-i-system.c: Use the new macros when it is appropriate to
  do so.
This commit is contained in:
Andy Wingo 2009-10-31 12:04:53 +01:00
parent 48c7c44e70
commit 521ac49bde
5 changed files with 13 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/eval.i.c
View file

@ -1027,7 +1027,7 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
x = SCM_GENERIC_METHOD_CACHE (proc);
arg1 = SCM_EOL;
goto type_dispatch;
}
@ -1154,7 +1154,7 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
@ -1233,7 +1233,7 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
@ -1464,7 +1464,7 @@ dispatch:
#else
arg1 = scm_cons2 (arg1, arg2, scm_ceval_args (x, env, proc));
#endif
x = SCM_ENTITY_PROCEDURE (proc);
x = SCM_GENERIC_METHOD_CACHE (proc);
goto type_dispatch;
}
else if (SCM_I_ENTITYP (proc))

4
libguile/goops.c
View file

@ -1797,7 +1797,7 @@ static void
clear_method_cache (SCM gf)
{
SCM cache = scm_make_method_cache (gf);
SCM_SET_ENTITY_PROCEDURE (gf, cache);
SCM_SET_GENERIC_METHOD_CACHE (gf, cache);
SCM_SET_SLOT (gf, scm_si_used_by, SCM_BOOL_F);
}
@ -1821,7 +1821,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0
{
SCM n = SCM_SLOT (gf, scm_si_n_specialized);
/* The sign of n is a flag indicating rest args. */
SCM_SET_MCACHE_N_SPECIALIZED (SCM_ENTITY_PROCEDURE (gf), n);
SCM_SET_MCACHE_N_SPECIALIZED (SCM_GENERIC_METHOD_CACHE (gf), n);
}
return SCM_UNSPECIFIED;
}

2
libguile/goops.h
View file

@ -133,6 +133,8 @@ typedef struct scm_t_method {
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_method))
#define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP, "method")
#define SCM_GENERIC_METHOD_CACHE(G) (SCM_PACK (SCM_STRUCT_DATA (G) [scm_struct_i_procedure]))
#define SCM_SET_GENERIC_METHOD_CACHE(G,C) (SCM_STRUCT_DATA (G) [scm_struct_i_procedure] = 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)

3
libguile/objects.c
View file

@ -163,7 +163,7 @@ scm_mcache_compute_cmethod (SCM cache, SCM args)
SCM
scm_apply_generic (SCM gf, SCM args)
{
SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args);
SCM cmethod = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (gf), args);
if (SCM_PROGRAM_P (cmethod))
return scm_vm_apply (scm_the_vm (), cmethod, args);
else if (scm_is_pair (cmethod))
@ -247,7 +247,6 @@ SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
obj,
SCM_ARG1,
FUNC_NAME);
SCM_ASSERT (scm_valid_object_procedure_p (proc), proc, SCM_ARG2, FUNC_NAME);
SCM_SET_ENTITY_PROCEDURE (obj, proc);
return SCM_UNSPECIFIED;
}

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

@ -757,7 +757,7 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (x), args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_call;
}
/*
@ -841,7 +841,7 @@ VM_DEFINE_INSTRUCTION (54, goto_args, "goto/args", 1, -1, 1)
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (x), args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_goto_args;
}
@ -933,7 +933,7 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1)
SYNC_REGISTER ();
while (n--)
args = scm_cons (*walk--, args);
*walk = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (x), args);
*walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
goto vm_mv_call;
}
/*