From c8045e8dbd43ac5f346346a1a8ce6f619e2629bc Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Mon, 17 Apr 2000 16:25:11 +0000 Subject: [PATCH] * struct.c, struct.h: Struct data regions (and thus also vtable data regions) are now C arrays of scm_bits_t elements. * gc.c: Made the mixup of glocs and structs explicit. --- libguile/ChangeLog | 15 ++++++ libguile/gc.c | 124 +++++++++++++++++++++++++-------------------- libguile/struct.c | 46 ++++++++--------- libguile/struct.h | 17 +++---- 4 files changed, 114 insertions(+), 88 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index b99cd7f1a..d4e757a37 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +2000-04-17 Dirk Herrmann + + * struct.c (scm_alloc_struct, scm_struct_free_0, + scm_struct_free_light, scm_struct_free_standard, + scm_struct_free_entity, scm_make_struct, scm_make_vtable_vtable), + struct.h (scm_struct_free_t, scm_alloc_struct, scm_struct_free_0, + scm_struct_free_light, scm_struct_free_standard, + scm_struct_free_entity): Struct data regions (and thus also + vtable data regions) are now C arrays of scm_bits_t elements. + + * gc.c (scm_gc_mark, scm_gc_sweep, scm_unhash_name): Made the + mixup of glocs and structs explicit. + + * gc.c (scm_unprotect_object): Compare SCM's with SCM_EQ_P. + 2000-04-17 Dirk Herrmann * eval.c (scm_unmemocar): Use macros to test for gloc cell. diff --git a/libguile/gc.c b/libguile/gc.c index 9ff841aab..d2dc4adcb 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1128,55 +1128,61 @@ gc_mark_nimp: break; SCM_SETGCMARK (ptr); { - SCM vcell; - vcell = (SCM) SCM_STRUCT_VTABLE_DATA (ptr); - switch (SCM_UNPACK (SCM_CDR (vcell))) + /* Dirk:FIXME:: The following code is super ugly: ptr may be a struct + * or a gloc. If it is a gloc, the cell word #0 of ptr is a pointer + * to a heap cell. If it is a struct, the cell word #0 of ptr is a + * pointer to a struct vtable data region. The fact that these are + * accessed in the same way restricts the possibilites to change the + * data layout of structs or heap cells. + */ + scm_bits_t word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_cons_gloc; + scm_bits_t * vtable_data = (scm_bits_t *) word0; /* access as struct */ + switch (vtable_data [scm_vtable_index_vcell]) { default: - scm_gc_mark (vcell); - ptr = SCM_GCCDR (ptr); - goto gc_mark_loop; + { + /* ptr is a gloc */ + SCM gloc_car = SCM_PACK (word0); + scm_gc_mark (gloc_car); + ptr = SCM_GCCDR (ptr); + goto gc_mark_loop; + } case 1: /* ! */ case 0: /* ! */ { - SCM layout; - SCM * vtable_data; - int len; - char * fields_desc; - register SCM * mem; - register int x; - - vtable_data = (SCM *) vcell; - layout = vtable_data[scm_vtable_index_layout]; - len = SCM_LENGTH (layout); - fields_desc = SCM_CHARS (layout); + /* ptr is a struct */ + SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); + int len = SCM_LENGTH (layout); + char * fields_desc = SCM_CHARS (layout); /* We're using SCM_GCCDR here like STRUCT_DATA, except that it removes the mark */ - mem = (SCM *) SCM_GCCDR (ptr); + scm_bits_t * struct_data = (scm_bits_t *) SCM_UNPACK (SCM_GCCDR (ptr)); - if (SCM_UNPACK (vtable_data[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) + if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) { - scm_gc_mark (mem[scm_struct_i_procedure]); - scm_gc_mark (mem[scm_struct_i_setter]); + scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_procedure])); + scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_setter])); } if (len) { - for (x = 0; x < len - 2; x += 2, ++mem) + int x; + + for (x = 0; x < len - 2; x += 2, ++struct_data) if (fields_desc[x] == 'p') - scm_gc_mark (*mem); + scm_gc_mark (SCM_PACK (*struct_data)); if (fields_desc[x] == 'p') { if (SCM_LAYOUT_TAILP (fields_desc[x + 1])) - for (x = (long int) *mem; x; --x) - scm_gc_mark (*++mem); + for (x = *struct_data; x; --x) + scm_gc_mark (SCM_PACK (*++struct_data)); else - scm_gc_mark (*mem); + scm_gc_mark (SCM_PACK (*struct_data)); } } - if (!SCM_CDR (vcell)) + if (vtable_data [scm_vtable_index_vcell] == 0) { - SCM_SETGCMARK (vcell); - ptr = vtable_data[scm_vtable_index_vtable]; + vtable_data [scm_vtable_index_vcell] = 1; + ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]); goto gc_mark_loop; } } @@ -1637,24 +1643,28 @@ scm_gc_sweep () switch SCM_TYP7 (scmptr) { case scm_tcs_cons_gloc: - if (SCM_GCMARKP (scmptr)) - { - if (SCM_CELL_WORD_1 ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr)) - == 1) - SCM_SET_CELL_WORD_1 ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr), - 0); - goto cmrkcontinue; - } { - SCM vcell; - vcell = (SCM) SCM_STRUCT_VTABLE_DATA (scmptr); - - if ((SCM_CELL_WORD_1 (vcell) == 0) - || (SCM_CELL_WORD_1 (vcell) == 1)) + /* Dirk:FIXME:: Again, super ugly code: scmptr may be a + * struct or a gloc. See the corresponding comment in + * scm_gc_mark. + */ + scm_bits_t word0 = SCM_CELL_WORD_0 (scmptr) - scm_tc3_cons_gloc; + scm_bits_t * vtable_data = (scm_bits_t *) word0; /* access as struct */ + if (SCM_GCMARKP (scmptr)) { - scm_struct_free_t free - = (scm_struct_free_t) ((SCM*) vcell)[scm_struct_i_free]; - m += free ((SCM *) vcell, (SCM *) SCM_GCCDR (scmptr)); + if (vtable_data [scm_vtable_index_vcell] == 1) + vtable_data [scm_vtable_index_vcell] = 0; + goto cmrkcontinue; + } + else + { + if (vtable_data [scm_vtable_index_vcell] == 0 + || vtable_data [scm_vtable_index_vcell] == 1) + { + scm_struct_free_t free + = (scm_struct_free_t) vtable_data[scm_struct_i_free]; + m += free (vtable_data, (scm_bits_t *) SCM_UNPACK (SCM_GCCDR (scmptr))); + } } } break; @@ -1813,7 +1823,7 @@ scm_gc_sweep () k = SCM_SMOBNUM (scmptr); if (!(k < scm_numsmob)) goto sweeperr; - m += (scm_smobs[k].free) ((SCM) scmptr); + m += (scm_smobs[k].free) (scmptr); break; } } @@ -2401,7 +2411,6 @@ alloc_some_heap (scm_freelist_t *freelist) } - SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0, (SCM name), "") @@ -2420,16 +2429,19 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0, pbound = (SCM_CELLPTR)scm_heap_table[x].bounds[1]; while (p < pbound) { - SCM incar; - incar = p->car; - if (1 == (7 & (int)incar)) + SCM cell = PTR2SCM (p); + if (SCM_TYP3 (cell) == scm_tc3_cons_gloc) { - --incar; - if ( ((name == SCM_BOOL_T) || (SCM_CAR (incar) == name)) - && (SCM_CDR (incar) != 0) - && (SCM_UNPACK (SCM_CDR (incar)) != 1)) + /* Dirk:FIXME:: Again, super ugly code: cell may be a gloc or a + * struct cell. See the corresponding comment in scm_gc_mark. + */ + scm_bits_t word0 = SCM_CELL_WORD_0 (cell) - scm_tc3_cons_gloc; + SCM gloc_car = SCM_PACK (word0); /* access as gloc */ + SCM vcell = SCM_CELL_OBJECT_1 (gloc_car); + if ((SCM_TRUE_P (name) || SCM_EQ_P (SCM_CAR (gloc_car), name)) + && (SCM_UNPACK (vcell) != 0) && (SCM_UNPACK (vcell) != 1)) { - p->car = name; + SCM_SET_CELL_OBJECT_0 (cell, name); } } ++p; @@ -2517,7 +2529,7 @@ scm_unprotect_object (SCM obj) SCM *tail_ptr = &scm_protects; while (SCM_CONSP (*tail_ptr)) - if (SCM_CAR (*tail_ptr) == obj) + if (SCM_EQ_P (SCM_CAR (*tail_ptr), obj)) { *tail_ptr = SCM_CDR (*tail_ptr); break; diff --git a/libguile/struct.c b/libguile/struct.c index b4482719b..6e55635ac 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -305,54 +305,54 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, Ugh. */ -SCM * +scm_bits_t * scm_alloc_struct (int n_words, int n_extra, char *who) { - int size = sizeof (SCM) * (n_words + n_extra) + 7; - SCM *block = (SCM *) scm_must_malloc (size, who); + int size = sizeof (scm_bits_t) * (n_words + n_extra) + 7; + void * block = scm_must_malloc (size, who); /* Adjust the pointer to hide the extra words. */ - SCM *p = block + n_extra; + scm_bits_t * p = (scm_bits_t *) block + n_extra; /* Adjust it even further so it's aligned on an eight-byte boundary. */ - p = (SCM *) (((scm_bits_t) SCM_UNPACK (p) + 7) & ~7); + p = (scm_bits_t *) (((scm_bits_t) p + 7) & ~7); /* Initialize a few fields as described above. */ - p[scm_struct_i_free] = (SCM) scm_struct_free_standard; - p[scm_struct_i_ptr] = (SCM) block; - p[scm_struct_i_n_words] = (SCM) n_words; + p[scm_struct_i_free] = (scm_bits_t) scm_struct_free_standard; + p[scm_struct_i_ptr] = (scm_bits_t) block; + p[scm_struct_i_n_words] = n_words; p[scm_struct_i_flags] = 0; return p; } scm_sizet -scm_struct_free_0 (SCM *vtable, SCM *data) +scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data) { return 0; } scm_sizet -scm_struct_free_light (SCM *vtable, SCM *data) +scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data) { free (data); - return SCM_UNPACK (vtable[scm_struct_i_size]) & ~SCM_STRUCTF_MASK; + return vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK; } scm_sizet -scm_struct_free_standard (SCM *vtable, SCM *data) +scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data) { - size_t n = ((SCM_UNPACK (data[scm_struct_i_n_words]) + scm_struct_n_extra_words) - * sizeof (SCM) + 7); + size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words) + * sizeof (scm_bits_t) + 7; free ((void *) data[scm_struct_i_ptr]); return n; } scm_sizet -scm_struct_free_entity (SCM *vtable, SCM *data) +scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data) { - size_t n = (SCM_UNPACK(data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) - * sizeof (SCM) + 7); + size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) + * sizeof (scm_bits_t) + 7; free ((void *) data[scm_struct_i_ptr]); return n; } @@ -374,7 +374,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, SCM layout; int basic_size; int tail_elts; - SCM * data; + scm_bits_t * data; SCM handle; SCM_VALIDATE_VTABLE (1,vtable); @@ -390,15 +390,15 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, data = scm_alloc_struct (basic_size + tail_elts, scm_struct_entity_n_extra_words, "make-struct"); - data[scm_struct_i_procedure] = SCM_BOOL_F; - data[scm_struct_i_setter] = SCM_BOOL_F; + data[scm_struct_i_procedure] = SCM_UNPACK (SCM_BOOL_F); + data[scm_struct_i_setter] = SCM_UNPACK (SCM_BOOL_F); } else data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, "make-struct"); SCM_SET_CELL_WORD_1 (handle, data); - SCM_SETCAR (handle, ((SCM)SCM_STRUCT_DATA (vtable)) + scm_tc3_cons_gloc); + SCM_SET_CELL_WORD_0 (handle, (scm_bits_t) SCM_STRUCT_DATA (vtable) + scm_tc3_cons_gloc); scm_struct_init (handle, tail_elts, init); SCM_ALLOW_INTS; return handle; @@ -469,7 +469,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, SCM layout; int basic_size; int tail_elts; - SCM * data; + scm_bits_t * data; SCM handle; SCM_VALIDATE_ROSTRING (1,extra_fields); @@ -487,7 +487,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, scm_struct_n_extra_words, "make-vtable-vtable"); SCM_SET_CELL_WORD_1 (handle, data); - SCM_SETCAR (handle, ((SCM)data) + scm_tc3_cons_gloc); + SCM_SET_CELL_WORD_0 (handle, (scm_bits_t) data + scm_tc3_cons_gloc); SCM_SET_STRUCT_LAYOUT (handle, layout); scm_struct_init (handle, tail_elts, scm_cons (layout, init)); SCM_ALLOW_INTS; diff --git a/libguile/struct.h b/libguile/struct.h index 1e81acd29..a2c3edbfb 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -70,16 +70,17 @@ #define scm_vtable_index_printer 3 /* A printer for this struct type. */ #define scm_vtable_offset_user 4 /* Where do user fields start? */ -typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data); +typedef scm_sizet (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data); #define SCM_STRUCTF_MASK (0xFFF << 20) #define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */ #define SCM_STRUCTF_LIGHT (1L << 31) /* Light representation (no hidden words) */ +/* Dirk:FIXME:: the SCM_STRUCTP predicate is also fulfilled for glocs */ #define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc)) #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_VTABLE_DATA(X) ((scm_bits_t *) (SCM_CELL_WORD_0 (X) - scm_tc3_cons_gloc)) #define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout])) #define SCM_SET_STRUCT_LAYOUT(X, v) (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout] = SCM_UNPACK (v)) @@ -98,13 +99,11 @@ extern SCM scm_struct_table; -extern SCM *scm_alloc_struct (int n_words, - int n_extra, - char *who); -extern scm_sizet scm_struct_free_0 (SCM *vtable, SCM *data); -extern scm_sizet scm_struct_free_light (SCM *vtable, SCM *data); -extern scm_sizet scm_struct_free_standard (SCM *vtable, SCM *data); -extern scm_sizet scm_struct_free_entity (SCM *vtable, SCM *data); +extern scm_bits_t * scm_alloc_struct (int n_words, int n_extra, char * who); +extern scm_sizet scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data); +extern scm_sizet scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data); +extern scm_sizet scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data); +extern scm_sizet scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data); extern void scm_struct_init (SCM handle, int tail_elts, SCM inits); extern SCM scm_make_struct_layout (SCM fields); extern SCM scm_struct_p (SCM x);