diff options
author | Marius Vollmer <mvo@zagadka.de> | 2001-05-15 14:57:22 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2001-05-15 14:57:22 +0000 |
commit | 86d31dfe7d0754b863863f6544c75097ef68fe8c (patch) | |
tree | 0f78f9d3ace802b80422dcedea25098cf901d05a /libguile/gc.c | |
parent | 7c33806ae676601f902dbdc0f39c1f0828d68951 (diff) | |
download | guile-86d31dfe7d0754b863863f6544c75097ef68fe8c.tar.gz |
Merge from mvo-vcell-cleanup-1-branch.
Diffstat (limited to 'libguile/gc.c')
-rw-r--r-- | libguile/gc.c | 102 |
1 files changed, 35 insertions, 67 deletions
diff --git a/libguile/gc.c b/libguile/gc.c index ddfbbec41..d93bf1ae8 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1145,6 +1145,17 @@ MARK (SCM p) goto gc_mark_loop_first_time; #endif +/* A simple hack for debugging. Chose the second branch to get a + meaningful backtrace for crashes inside the GC. +*/ +#if 1 +#define goto_gc_mark_loop goto gc_mark_loop +#define goto_gc_mark_nimp goto gc_mark_nimp +#else +#define goto_gc_mark_loop RECURSE(ptr); return +#define goto_gc_mark_nimp RECURSE(ptr); return +#endif + gc_mark_loop: if (SCM_IMP (ptr)) return; @@ -1187,26 +1198,31 @@ gc_mark_loop_first_time: if (SCM_IMP (SCM_CDR (ptr))) { ptr = SCM_CAR (ptr); - goto gc_mark_nimp; + goto_gc_mark_nimp; } RECURSE (SCM_CAR (ptr)); ptr = SCM_CDR (ptr); - goto gc_mark_nimp; + goto_gc_mark_nimp; case scm_tcs_cons_imcar: ptr = SCM_CDR (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; case scm_tc7_pws: RECURSE (SCM_SETTER (ptr)); ptr = SCM_PROCEDURE (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; case scm_tcs_cons_gloc: { - /* 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. + /* 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 the address of a scm_tc16_variable smob. 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.) To discriminate between + * the two, it is guaranteed that the scm_vtable_index_vcell + * element of the prospective vtable is always zero. For a + * gloc, this location has the CDR of the variable smob, which + * is guaranteed to be non-zero. */ 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 */ @@ -1249,7 +1265,7 @@ gc_mark_loop_first_time: } /* mark vtable */ ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]); - goto gc_mark_loop; + goto_gc_mark_loop; } } break; @@ -1257,11 +1273,11 @@ gc_mark_loop_first_time: if (SCM_IMP (SCM_ENV (ptr))) { ptr = SCM_CLOSCAR (ptr); - goto gc_mark_nimp; + goto_gc_mark_nimp; } RECURSE (SCM_CLOSCAR (ptr)); ptr = SCM_ENV (ptr); - goto gc_mark_nimp; + goto_gc_mark_nimp; case scm_tc7_vector: i = SCM_VECTOR_LENGTH (ptr); if (i == 0) @@ -1270,7 +1286,7 @@ gc_mark_loop_first_time: if (SCM_NIMP (SCM_VELTS (ptr)[i])) RECURSE (SCM_VELTS (ptr)[i]); ptr = SCM_VELTS (ptr)[0]; - goto gc_mark_loop; + goto_gc_mark_loop; #ifdef CCLO case scm_tc7_cclo: { @@ -1283,7 +1299,7 @@ gc_mark_loop_first_time: RECURSE (obj); } ptr = SCM_CCLO_REF (ptr, 0); - goto gc_mark_loop; + goto_gc_mark_loop; } #endif #ifdef HAVE_ARRAYS @@ -1304,7 +1320,7 @@ gc_mark_loop_first_time: case scm_tc7_substring: ptr = SCM_CDR (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; case scm_tc7_wvect: SCM_WVECT_GC_CHAIN (ptr) = scm_weak_vectors; @@ -1367,7 +1383,7 @@ gc_mark_loop_first_time: case scm_tc7_symbol: ptr = SCM_PROP_SLOTS (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; case scm_tcs_subrs: break; case scm_tc7_port: @@ -1381,7 +1397,7 @@ gc_mark_loop_first_time: if (scm_ptobs[i].mark) { ptr = (scm_ptobs[i].mark) (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; } else return; @@ -1404,7 +1420,7 @@ gc_mark_loop_first_time: if (scm_smobs[i].mark) { ptr = (scm_smobs[i].mark) (ptr); - goto gc_mark_loop; + goto_gc_mark_loop; } else return; @@ -2307,50 +2323,6 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy) } #undef FUNC_NAME - -SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0, - (SCM name), - "Flushes the glocs for @var{name}, or all glocs if @var{name}\n" - "is @code{#t}.") -#define FUNC_NAME s_scm_unhash_name -{ - int x; - int bound; - SCM_VALIDATE_SYMBOL (1,name); - SCM_DEFER_INTS; - bound = scm_n_heap_segs; - for (x = 0; x < bound; ++x) - { - SCM_CELLPTR p; - SCM_CELLPTR pbound; - p = scm_heap_table[x].bounds[0]; - pbound = scm_heap_table[x].bounds[1]; - while (p < pbound) - { - SCM cell = PTR2SCM (p); - if (SCM_TYP3 (cell) == scm_tc3_cons_gloc) - { - /* 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_EQ_P (name, SCM_BOOL_T) || SCM_EQ_P (SCM_CAR (gloc_car), name)) - && (SCM_UNPACK (vcell) != 0) && (SCM_UNPACK (vcell) != 1)) - { - SCM_SET_CELL_OBJECT_0 (cell, name); - } - } - ++p; - } - } - SCM_ALLOW_INTS; - return name; -} -#undef FUNC_NAME - - /* {GC Protection Helper Functions} */ @@ -2653,10 +2625,6 @@ scm_init_storage () #endif #endif -#define DEFAULT_SYMHASH_SIZE 277 - scm_symhash = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE); - scm_symhash_vars = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE); - scm_stand_in_procs = SCM_EOL; scm_permobjs = SCM_EOL; scm_protects = scm_c_make_hash_table (31); |