diff options
Diffstat (limited to 'libguile/struct.c')
-rw-r--r-- | libguile/struct.c | 142 |
1 files changed, 57 insertions, 85 deletions
diff --git a/libguile/struct.c b/libguile/struct.c index c8d34a4db..a263f9667 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -39,6 +39,8 @@ #include <string.h> #endif +#include "libguile/boehm-gc.h" + static SCM required_vtable_fields = SCM_BOOL_F; @@ -304,97 +306,53 @@ scm_alloc_struct (int n_words, int n_extra, const char *what) p = (scm_t_bits *) (((scm_t_bits) p + 7) & ~7); /* Initialize a few fields as described above. */ - p[scm_struct_i_free] = (scm_t_bits) scm_struct_free_standard; + p[scm_struct_i_free] = (scm_t_bits) 0; p[scm_struct_i_ptr] = (scm_t_bits) block; p[scm_struct_i_n_words] = n_words; p[scm_struct_i_flags] = 0; + /* Since `SCM' objects will record either P or P + SCM_TC3_STRUCT, we need + to register them as valid displacements. Fortunately, only a handful of + N_EXTRA values are used in core Guile. */ + GC_REGISTER_DISPLACEMENT ((char *)p - (char *)block); + GC_REGISTER_DISPLACEMENT ((char *)p - (char *)block + scm_tc3_struct); + return p; } -void -scm_struct_free_0 (scm_t_bits * vtable SCM_UNUSED, - scm_t_bits * data SCM_UNUSED) -{ -} + +/* Finalization. */ -void -scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data) -{ - size_t n = vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK; - scm_gc_free (data, n, "struct"); -} -void -scm_struct_free_standard (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data) +/* Invoke the finalizer of the struct pointed to by PTR. */ +static void +struct_finalizer_trampoline (GC_PTR ptr, GC_PTR unused_data) { - size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words) - * sizeof (scm_t_bits) + 7; - scm_gc_free ((void *) data[scm_struct_i_ptr], n, "heavy struct"); -} + SCM obj = PTR2SCM (ptr); -void -scm_struct_free_entity (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data) -{ - size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) - * sizeof (scm_t_bits) + 7; - scm_gc_free ((void *) data[scm_struct_i_ptr], n, "entity struct"); -} + /* XXX - use less explicit code. */ + scm_t_bits word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_struct; + scm_t_bits *vtable_data = (scm_t_bits *) word0; + scm_t_bits *data = SCM_STRUCT_DATA (obj); + scm_t_struct_free free_struct_data + = ((scm_t_struct_free) vtable_data[scm_struct_i_free]); -static void * -scm_struct_gc_init (void *dummy1 SCM_UNUSED, - void *dummy2 SCM_UNUSED, - void *dummy3 SCM_UNUSED) -{ - scm_i_structs_to_free = SCM_EOL; - return 0; -} + SCM_SET_CELL_TYPE (obj, scm_tc_free_cell); -static void * -scm_free_structs (void *dummy1 SCM_UNUSED, - void *dummy2 SCM_UNUSED, - void *dummy3 SCM_UNUSED) -{ - SCM newchain = scm_i_structs_to_free; - do - { - /* Mark vtables in GC chain. GC mark set means delay freeing. */ - SCM chain = newchain; - while (!scm_is_null (chain)) - { - SCM vtable = SCM_STRUCT_VTABLE (chain); - if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain) - SCM_SET_GC_MARK (vtable); - chain = SCM_STRUCT_GC_CHAIN (chain); - } - /* Free unmarked structs. */ - chain = newchain; - newchain = SCM_EOL; - while (!scm_is_null (chain)) - { - SCM obj = chain; - chain = SCM_STRUCT_GC_CHAIN (chain); - if (SCM_GC_MARK_P (obj)) - { - SCM_CLEAR_GC_MARK (obj); - SCM_SET_STRUCT_GC_CHAIN (obj, newchain); - newchain = obj; - } - else - { - scm_t_bits * vtable_data = SCM_STRUCT_VTABLE_DATA (obj); - scm_t_bits * data = SCM_STRUCT_DATA (obj); - scm_t_struct_free free_struct_data - = ((scm_t_struct_free) vtable_data[scm_struct_i_free]); - SCM_SET_CELL_TYPE (obj, scm_tc_free_cell); - free_struct_data (vtable_data, data); - } - } - } - while (!scm_is_null (newchain)); - return 0; +#if 0 + /* A sanity check. However, this check can fail if the free function + changed between the `make-struct' time and now. */ + if (free_struct_data != (scm_t_struct_free)unused_data) + abort (); +#endif + + if (free_struct_data) + free_struct_data (vtable_data, data); } + + + SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, (SCM vtable, SCM tail_array_size, SCM init), "Create a new structure.\n\n" @@ -421,13 +379,15 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, SCM layout; size_t basic_size; size_t tail_elts; - scm_t_bits * data; + scm_t_bits *data, *c_vtable; SCM handle; SCM_VALIDATE_VTABLE (1, vtable); SCM_VALIDATE_REST_ARGUMENT (init); - layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); + c_vtable = SCM_STRUCT_DATA (vtable); + + layout = SCM_PACK (c_vtable [scm_vtable_index_layout]); basic_size = scm_i_symbol_length (layout) / 2; tail_elts = scm_to_size_t (tail_array_size); @@ -451,7 +411,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, } SCM_CRITICAL_SECTION_START; - if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) + if (c_vtable[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) { data = scm_alloc_struct (basic_size + tail_elts, scm_struct_entity_n_extra_words, @@ -463,9 +423,25 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, "struct"); - handle = scm_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable)) + handle = scm_double_cell ((((scm_t_bits) c_vtable) + scm_tc3_struct), (scm_t_bits) data, 0, 0); + + if (c_vtable[scm_struct_i_free]) + { + /* Register a finalizer for the newly created instance. */ + GC_finalization_proc prev_finalizer; + GC_PTR prev_finalizer_data; + scm_t_struct_free free_struct = + (scm_t_struct_free)c_vtable[scm_struct_i_free]; + + GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (handle), + struct_finalizer_trampoline, + free_struct, + &prev_finalizer, + &prev_finalizer_data); + } + SCM_CRITICAL_SECTION_END; /* In guile 1.8.1 and earlier, the SCM_CRITICAL_SECTION_END above covered @@ -887,11 +863,7 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate) void scm_struct_prehistory () { - scm_i_structs_to_free = SCM_EOL; - scm_c_hook_add (&scm_before_sweep_c_hook, scm_struct_gc_init, 0, 0); - /* With the new lazy sweep GC, the point at which the entire heap is - swept is just before the mark phase. */ - scm_c_hook_add (&scm_before_mark_c_hook, scm_free_structs, 0, 0); + /* Empty. */ } void |