summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/eval.c52
-rw-r--r--libguile/gc.c16
-rw-r--r--libguile/objects.c120
-rw-r--r--libguile/objects.h18
-rw-r--r--libguile/struct.h2
-rw-r--r--libguile/tags.h2
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))