diff options
-rw-r--r-- | libguile/eval.c | 52 | ||||
-rw-r--r-- | libguile/gc.c | 16 | ||||
-rw-r--r-- | libguile/objects.c | 120 | ||||
-rw-r--r-- | libguile/objects.h | 18 | ||||
-rw-r--r-- | libguile/struct.h | 2 | ||||
-rw-r--r-- | libguile/tags.h | 2 |
6 files changed, 3 insertions, 207 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 33062ee25..02811b1d5 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -93,9 +93,6 @@ char *alloca (); #include "feature.h" #include "eval.h" - -void (*scm_memoize_method) (SCM, SCM); - /* The evaluator contains a plethora of EVAL symbols. @@ -1978,55 +1975,6 @@ dispatch: ENTER_APPLY; goto evap1; - case (SCM_ISYMNUM (SCM_IM_DISPATCH)): - { - int i, end, mask; - mask = -1; - proc = SCM_CDR (x); - i = 0; - end = SCM_LENGTH (proc); - find_method: - do - { - t.arg1 = SCM_CDDAR (env); - arg2 = SCM_VELTS (proc)[i]; - do - { - if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (arg2)) - goto next_method; - t.arg1 = SCM_CDR (t.arg1); - arg2 = SCM_CDR (arg2); - } - while (SCM_NIMP (t.arg1)); - x = SCM_CAR (arg2); - env = scm_cons (SCM_CAR (env), SCM_CDR (arg2)); - goto begin; - next_method: - i = (i + 1) & mask; - } while (i != end); - memoize_method: - scm_memoize_method (x, SCM_CDAR (env)); - goto loop; - - case (SCM_ISYMNUM (SCM_IM_HASH_DISPATCH)): - { - int hashset = SCM_INUM (SCM_CADR (x)); - mask = SCM_INUM (SCM_CADDR (x)); - proc = SCM_CDDDR (x); - i = 0; - t.arg1 = SCM_CDDAR (env); - do - { - i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))[scm_si_hashsets + hashset]; - t.arg1 = SCM_CDR (t.arg1); - } - while (SCM_NIMP (t.arg1)); - i &= mask; - end = i; - } - goto find_method; - } - default: goto badfun; } diff --git a/libguile/gc.c b/libguile/gc.c index 823c3ce4c..46b4507ed 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1113,19 +1113,9 @@ scm_gc_sweep () if ((SCM_CDR (vcell) == 0) || (SCM_CDR (vcell) == 1)) { SCM *p = (SCM *) SCM_GCCDR (scmptr); - if (((SCM*) vcell)[scm_vtable_index_layout] - & SCM_STRUCTF_LIGHT) - { - SCM layout = ((SCM*)vcell)[scm_vtable_index_layout]; - m += SCM_LENGTH (layout) / 2; - free ((char *) p); - } - else - { - m += p[scm_struct_i_n_words] * sizeof (SCM); - /* I feel like I'm programming in BCPL here... */ - free ((char *) p[scm_struct_i_ptr]); - } + m += p[scm_struct_i_n_words] * sizeof (SCM); + /* I feel like I'm programming in BCPL here... */ + free ((char *) p[scm_struct_i_ptr]); } } break; diff --git a/libguile/objects.c b/libguile/objects.c index a55209b13..cbb6b4ca9 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -49,8 +49,6 @@ #include "struct.h" #include "procprop.h" -#include "chars.h" -#include "kw.h" #include "objects.h" @@ -58,124 +56,6 @@ SCM scm_metaclass_standard; SCM scm_metaclass_operator; -/* These variables are filled in by the object system when loaded. */ -SCM scm_class_boolean, scm_class_char, scm_class_pair; -SCM scm_class_procedure, scm_class_string, scm_class_symbol; -SCM scm_class_vector, scm_class_null; -SCM scm_class_real, scm_class_complex, scm_class_integer; -SCM scm_class_keyword, scm_class_unknown; - -void (*scm_change_object_class) (SCM, SCM, SCM); - -/* This function is used for efficient type dispatch. */ -SCM -scm_class_of (SCM x) -{ - switch (SCM_ITAG3 (x)) - { - case scm_tc3_int_1: - case scm_tc3_int_2: - return scm_class_integer; - - case scm_tc3_imm24: - if (SCM_ICHRP (x)) - return scm_class_char; - else - { - switch (SCM_ISYMNUM (x)) - { - case SCM_ISYMNUM (SCM_BOOL_F): - case SCM_ISYMNUM (SCM_BOOL_T): - return scm_class_boolean; - case SCM_ISYMNUM (SCM_EOL): - return scm_class_null; - default: - return scm_class_unknown; - } - } - - case scm_tc3_cons: - switch (SCM_TYP7 (x)) - { - case scm_tcs_cons_nimcar: - return scm_class_pair; - case scm_tcs_closures: - return scm_class_procedure; - case scm_tcs_symbols: - return scm_class_symbol; - case scm_tc7_vector: - case scm_tc7_wvect: - case scm_tc7_bvect: - case scm_tc7_byvect: - case scm_tc7_svect: - case scm_tc7_ivect: - case scm_tc7_uvect: - case scm_tc7_fvect: - case scm_tc7_dvect: - case scm_tc7_cvect: - return scm_class_vector; - case scm_tc7_string: - case scm_tc7_substring: - return scm_class_string; - case scm_tc7_asubr: - case scm_tc7_subr_0: - case scm_tc7_subr_1: - case scm_tc7_cxr: - case scm_tc7_subr_3: - case scm_tc7_subr_2: - case scm_tc7_rpsubr: - case scm_tc7_subr_1o: - case scm_tc7_subr_2o: - case scm_tc7_lsubr_2: - case scm_tc7_lsubr: - return scm_class_procedure; - - case scm_tc7_port: - return scm_class_unknown; - case scm_tc7_smob: - { - SCM type = SCM_TYP16 (x); - if (type == scm_tc16_flo) - { - if (SCM_CAR (x) & SCM_IMAG_PART) - return scm_class_complex; - else - return scm_class_real; - } - else if (type == scm_tc16_bigpos || type == scm_tc16_bigneg) - return scm_class_integer; - else if (type == scm_tc16_kw) - return scm_class_keyword; - else - return scm_class_unknown; - } - case scm_tcs_cons_gloc: - /* must be a struct */ - if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS) - { - if (CLASS_REDEF (SCM_CLASS_OF (x)) != SCM_BOOL_F) - scm_change_object_class (x, - SCM_CLASS_OF (x), - CLASS_REDEF (SCM_CLASS_OF (x))); - return SCM_CLASS_OF (x); - } - default: - if (SCM_CONSP (x)) - return scm_class_pair; - else - return scm_class_unknown; - } - - case scm_tc3_cons_gloc: - case scm_tc3_tc7_1: - case scm_tc3_tc7_2: - case scm_tc3_closure: - /* Never reached */ - break; - } - return scm_class_unknown; -} - SCM_PROC (s_entity_p, "entity?", 1, 0, 0, scm_entity_p); SCM diff --git a/libguile/objects.h b/libguile/objects.h index e70c1a4a4..8f778838c 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -159,27 +159,9 @@ struct scm_metaclass_operator { */ #define SCM_ENTITY_LAYOUT "" -/* The following three definitions are Goops dependencies needed by - scm_class_of. */ -#define SCM_CLASSF_GOOPS (0x10 << 24) -#define scm_si_redefined 17 -#define scm_si_hashsets 19 -#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x) - -#define CLASS_REDEF(c) (SCM_STRUCT_DATA(c)[scm_si_redefined]) - extern SCM scm_metaclass_standard; extern SCM scm_metaclass_operator; -extern SCM scm_class_boolean, scm_class_char, scm_class_pair; -extern SCM scm_class_procedure, scm_class_string, scm_class_symbol; -extern SCM scm_class_vector, scm_class_null; -extern SCM scm_class_real, scm_class_complex, scm_class_integer; -extern SCM scm_class_keyword, scm_class_unknown; - -extern void (*scm_change_object_class) (SCM, SCM, SCM); -extern void (*scm_memoize_method) (SCM x, SCM args); -extern SCM scm_class_of (SCM obj); extern SCM scm_entity_p (SCM obj); extern SCM scm_set_object_procedure_x (SCM obj, SCM procs); extern SCM scm_make_class_object (SCM metaclass, SCM layout); diff --git a/libguile/struct.h b/libguile/struct.h index 3e3708b5f..ea2221880 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -65,8 +65,6 @@ #define scm_vtable_offset_user 4 /* Where do user fields start? */ #define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */ -#define SCM_STRUCTF_LIGHT (1L << 31) /* Light representation - (no hidden words) */ #define SCM_STRUCTP(X) (SCM_TYP3(X) == scm_tc3_cons_gloc) #define SCM_STRUCT_DATA(X) ((SCM*)(SCM_CDR(X))) diff --git a/libguile/tags.h b/libguile/tags.h index 715d7b131..2c97f4f78 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -472,8 +472,6 @@ enum scm_tags #define SCM_EOF_VAL SCM_MAKIFLAG(19) #define SCM_EOL SCM_MAKIFLAG(20) #define SCM_UNSPECIFIED SCM_MAKIFLAG(21) -#define SCM_IM_DISPATCH SCM_MAKISYM(22) -#define SCM_IM_HASH_DISPATCH SCM_MAKISYM(23) #define SCM_UNBNDP(x) (SCM_UNDEFINED==(x)) |