From d8c40b9f49836a0d8c28b49ff5346033c50e113d Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Wed, 12 Apr 2000 01:19:49 +0000 Subject: [PATCH] The struct data is now an array of scm_bits_t variables. --- libguile/ChangeLog | 17 +++++++++++++ libguile/eval.c | 10 ++++---- libguile/objects.c | 8 +++---- libguile/objects.h | 12 +++++----- libguile/struct.c | 60 +++++++++++++++++++--------------------------- libguile/struct.h | 2 +- 6 files changed, 57 insertions(+), 52 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 1cd729fdb..57869d819 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,20 @@ +2000-04-11 Dirk Herrmann + + * eval.c (SCM_CEVAL), objects.c (scm_mcache_lookup_cmethod, + scm_make_subclass_object), objects.h (SCM_CLASS_FLAGS, + SCM_ENTITY_PROCEDURE, SCM_ENTITY_SETTER), struct.c + (scm_struct_init, scm_struct_vtable_p, scm_make_struct, + scm_struct_ref, scm_struct_set_x), struct.h (SCM_STRUCT_DATA): + The struct data is now an array of scm_bits_t variables. + + * objects.h (SCM_SET_ENTITY_PROCEDURE): New macro. + + * objects.c (scm_set_object_procedure_x): Use it. + + * struct.c (scm_struct_init): Unused variable 'data' removed. + + (scm_struct_vtable_p): Redundant SCM_IMP tests removed. + 2000-04-11 Dirk Herrmann * objects.h (SCM_OBJ_CLASS_FLAGS, SCM_OBJ_CLASS_REDEF), struct.h diff --git a/libguile/eval.c b/libguile/eval.c index 68e30b4a1..c17e4787d 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2299,8 +2299,8 @@ dispatch: if (SCM_NIMP (t.arg1)) do { - i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))) - [scm_si_hashsets + hashset]); + i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1))) + [scm_si_hashsets + hashset]; t.arg1 = SCM_CDR (t.arg1); } while (--j && SCM_NIMP (t.arg1)); @@ -2344,15 +2344,15 @@ dispatch: case (SCM_ISYMNUM (SCM_IM_SLOT_REF)): x = SCM_CDR (x); t.arg1 = EVALCAR (x, env); - RETURN (SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CADR (x))]) + RETURN (SCM_PACK (SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CADR (x))])) case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)): x = SCM_CDR (x); t.arg1 = EVALCAR (x, env); x = SCM_CDR (x); proc = SCM_CDR (x); - SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))] - = EVALCAR (proc, env); + SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))] + = SCM_UNPACK (EVALCAR (proc, env)); RETURN (SCM_UNSPECIFIED) case (SCM_ISYMNUM (SCM_IM_NIL_COND)): diff --git a/libguile/objects.c b/libguile/objects.c index d1473d3bb..03330eb4f 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -276,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) if (SCM_NIMP (ls)) do { - i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) - [scm_si_hashsets + hashset]); + i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) + [scm_si_hashsets + hashset]; ls = SCM_CDR (ls); } while (--j && SCM_NIMP (ls)); @@ -390,7 +390,7 @@ SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0, FUNC_NAME); SCM_VALIDATE_PROC (2,proc); if (SCM_I_ENTITYP (obj)) - SCM_ENTITY_PROCEDURE (obj) = proc; + SCM_SET_ENTITY_PROCEDURE (obj, proc); else SCM_OPERATOR_CLASS (obj)->procedure = proc; return SCM_UNSPECIFIED; @@ -455,7 +455,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, SCM pl; SCM_VALIDATE_STRUCT (1,class); SCM_VALIDATE_STRING (2,layout); - pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout]; + pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]); /* Convert symbol->string */ pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0); return scm_i_make_class_object (SCM_STRUCT_VTABLE (class), diff --git a/libguile/objects.h b/libguile/objects.h index 03aa52b22..389552c2b 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -67,10 +67,8 @@ * certain class or its subclasses when traversal of the inheritance * graph would be too costly. */ -#define SCM_CLASS_FLAGS(class)\ - SCM_UNPACK (SCM_STRUCT_DATA (class)[scm_struct_i_flags]) -#define SCM_OBJ_CLASS_FLAGS(obj)\ - (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags]) +#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags]) +#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags]) #define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f)) #define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f)) #define SCM_CLASSF_MASK SCM_STRUCTF_MASK @@ -92,8 +90,10 @@ #define SCM_I_ENTITYP(obj)\ ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0) #define SCM_ENTITY_PROCEDURE(obj) \ - (SCM_STRUCT_DATA (obj)[scm_struct_i_procedure]) -#define SCM_ENTITY_SETTER(obj) (SCM_STRUCT_DATA (obj)[scm_struct_i_setter]) + (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure])) +#define SCM_SET_ENTITY_PROCEDURE(obj,v) \ + (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v)) +#define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter])) #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d) #define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \ diff --git a/libguile/struct.c b/libguile/struct.c index bbae48bb9..b4482719b 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -151,19 +151,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, void scm_struct_init (SCM handle, int tail_elts, SCM inits) { - SCM layout; - SCM * data; - unsigned char * fields_desc; + SCM layout = SCM_STRUCT_LAYOUT (handle); + unsigned char * fields_desc = (unsigned char *) SCM_CHARS (layout) - 2; unsigned char prot = 0; - int n_fields; - SCM * mem; + int n_fields = SCM_LENGTH (layout) / 2; + scm_bits_t * mem = SCM_STRUCT_DATA (handle); int tailp = 0; - - layout = SCM_STRUCT_LAYOUT (handle); - data = SCM_STRUCT_DATA (handle); - fields_desc = (unsigned char *) SCM_CHARS (layout) - 2; - n_fields = SCM_LENGTH (layout) / 2; - mem = SCM_STRUCT_DATA (handle); + while (n_fields) { if (!tailp) @@ -174,7 +168,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits) { tailp = 1; prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o'; - *mem++ = SCM_PACK (tail_elts); + *mem++ = tail_elts; n_fields += tail_elts - 1; if (n_fields == 0) break; @@ -200,19 +194,19 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits) *mem = 0; else { - *mem = SCM_PACK (scm_num2ulong (SCM_CAR (inits), - SCM_ARGn, - "scm_struct_init")); + *mem = scm_num2ulong (SCM_CAR (inits), + SCM_ARGn, + "scm_struct_init"); inits = SCM_CDR (inits); } break; case 'p': if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits)) - *mem = SCM_BOOL_F; + *mem = SCM_UNPACK (SCM_BOOL_F); else { - *mem = SCM_CAR (inits); + *mem = SCM_UNPACK (SCM_CAR (inits)); inits = SCM_CDR (inits); } @@ -232,7 +226,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits) #endif case 's': - *mem = handle; + *mem = SCM_UNPACK (handle); break; } @@ -257,10 +251,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, #define FUNC_NAME s_scm_struct_vtable_p { SCM layout; - SCM * mem; - - if (SCM_IMP (x)) - return SCM_BOOL_F; + scm_bits_t * mem; if (!SCM_STRUCTP (x)) return SCM_BOOL_F; @@ -279,10 +270,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, if (mem[1] != 0) return SCM_BOOL_F; - if (SCM_IMP (mem[0])) - return SCM_BOOL_F; - - return SCM_BOOL(SCM_SYMBOLP (mem[0])); + return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[0]))); } #undef FUNC_NAME @@ -392,12 +380,12 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, SCM_VALIDATE_VTABLE (1,vtable); SCM_VALIDATE_INUM (2,tail_array_size); - layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout]; + layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); basic_size = SCM_LENGTH (layout) / 2; tail_elts = SCM_INUM (tail_array_size); SCM_NEWCELL (handle); SCM_DEFER_INTS; - if (SCM_UNPACK (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) + if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) { data = scm_alloc_struct (basic_size + tail_elts, scm_struct_entity_n_extra_words, @@ -520,7 +508,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, #define FUNC_NAME s_scm_struct_ref { SCM answer = SCM_UNDEFINED; - SCM * data; + scm_bits_t * data; SCM layout; int p; scm_bits_t n_fields; @@ -536,7 +524,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, p = SCM_INUM (pos); fields_desc = (unsigned char *) SCM_CHARS (layout); - n_fields = SCM_UNPACK (data[scm_struct_i_n_words]); + n_fields = data[scm_struct_i_n_words]; SCM_ASSERT_RANGE(1,pos, p < n_fields); @@ -564,7 +552,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, switch (field_type) { case 'u': - answer = scm_ulong2num (SCM_UNPACK (data[p])); + answer = scm_ulong2num (data[p]); break; #if 0 @@ -579,7 +567,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, case 's': case 'p': - answer = data[p]; + answer = SCM_PACK (data[p]); break; @@ -598,7 +586,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, "") #define FUNC_NAME s_scm_struct_set_x { - SCM * data; + scm_bits_t * data; SCM layout; int p; int n_fields; @@ -613,7 +601,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, p = SCM_INUM (pos); fields_desc = (unsigned char *)SCM_CHARS (layout); - n_fields = SCM_UNPACK (data[scm_struct_i_n_words]); + n_fields = data[scm_struct_i_n_words]; SCM_ASSERT_RANGE (1,pos, p < n_fields); @@ -636,7 +624,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, switch (field_type) { case 'u': - data[p] = SCM_PACK (SCM_NUM2ULONG (3, val)); + data[p] = SCM_NUM2ULONG (3, val); break; #if 0 @@ -650,7 +638,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, #endif case 'p': - data[p] = val; + data[p] = SCM_UNPACK (val); break; case 's': diff --git a/libguile/struct.h b/libguile/struct.h index d76b0f968..1e81acd29 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -78,7 +78,7 @@ typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data); (no hidden words) */ #define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc)) -#define SCM_STRUCT_DATA(X) ((SCM *) SCM_UNPACK (SCM_CDR (X))) +#define SCM_STRUCT_DATA(X) ((scm_bits_t *) SCM_CELL_WORD_1 (X)) #define SCM_STRUCT_VTABLE_DATA(X) ((scm_bits_t *) (SCM_CELL_WORD_0 (X) - 1)) #define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))