diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 24416dac7..4fb5e43b6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,66 @@ +2001-06-30 Dirk Herrmann + + * list.c (SCM_I_CONS): Make sure the cell type is initialized + last. + + * gc.c (s_scm_map_free_list, scm_igc, scm_gc_sweep, + init_heap_seg): Fixed signedness. + + (init_heap_seg): Replaced strange for-loop with a while loop. + + * weaks.h (WEAKSH, SCM_WEAKS_H): Rename H to SCM__H. + + (SCM_WVECTP): Prefer !SCM_ over SCM_N. + + The following patch adds conservative marking for the elements of + free or allocated cells. + + * gc.c (allocated_mark, heap_segment): New static functions. + + (which_seg): Deleted, since the functionality is now provided by + function heap_segment. + + (map_free_list): Use heap_segment instead of which_seg. + + (MARK): If cell debugging is disabled, mark free cells + conservatively. + + (scm_mark_locations, scm_cellp): Extracted the search for the + heap segment of a SCM value into function heap_segment. + + (scm_init_storage): Allocated cells must be marked + conservatively. + + * gc.[ch] (scm_gc_mark_cell_conservatively): New function. + + The following patch changes the representation of weak vectors to + double cells instead of using an extension of the vector's + allocated memory. + + * gc.c (MARK): Use SCM_SET_WVECT_GC_CHAIN instead of assigning to + the result of SCM_WVECT_GC_CHAIN. + + (scm_gc_sweep): Weak vectors don't have extra fields any more. + + * weaks.c (allocate_weak_vector): New static function. It does + not patch any previously created vector object during the + construction of a weak vector, and thus doesn't need to switch + off interrupts during vector creation. + + (scm_make_weak_vector, scm_make_weak_key_hash_table, + scm_make_weak_value_hash_table, scm_make_doubly_weak_hash_table): + Use allocate_weak_vector to provide the new weak vector object. + + * weaks.h (SCM_WVECT_TYPE, SCM_SET_WVECT_TYPE, + SCM_SET_WVECT_GC_CHAIN): New macros. The weak vector subtype is + now stored in the double cell. + + (SCM_IS_WHVEC, SCM_IS_WHVEC_V, SCM_IS_WHVEC_B, SCM_IS_WHVEC_ANY): + Use SCM_WVECT_TYPE. + + (SCM_WVECT_GC_CHAIN): The weak objects are now chained together + using an entry of the double cell. + 2001-06-30 Thien-Thi Nguyen * stamp-h.in: bye bye diff --git a/libguile/gc.c b/libguile/gc.c index ac7f8fe85..0d5177912 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -114,6 +114,19 @@ unsigned int scm_debug_cell_accesses_p = 1; static unsigned int debug_cells_gc_interval = 0; +/* If an allocated cell is detected during garbage collection, this means that + * some code has just obtained the object but was preempted before the + * initialization of the object was completed. This meanst that some entries + * of the allocated cell may already contain SCM objects. Therefore, + * allocated cells are scanned conservatively. */ +static SCM +allocated_mark (SCM allocated) +{ + scm_gc_mark_cell_conservatively (allocated); + return SCM_BOOL_F; +} + + /* Assert that the given object is a valid reference to a valid cell. This * test involves to determine whether the object is a cell pointer, whether * this pointer actually points into a heap segment and whether the cell @@ -517,22 +530,6 @@ clear_mark_space () #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) -/* Return the number of the heap segment containing CELL. */ -static long -which_seg (SCM cell) -{ - long i; - - for (i = 0; i < scm_n_heap_segs; i++) - if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell)) - && SCM_PTR_GT (scm_heap_table[i].bounds[1], SCM2PTR (cell))) - return i; - fprintf (stderr, "which_seg: can't find segment containing cell %lux\n", - (unsigned long) SCM_UNPACK (cell)); - abort (); -} - - static void map_free_list (scm_t_freelist *master, SCM freelist) { @@ -541,9 +538,16 @@ map_free_list (scm_t_freelist *master, SCM freelist) for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f)) { - long this_seg = which_seg (f); + long int this_seg = heap_segment (f); - if (this_seg != last_seg) + if (this_seg == -1) + { + fprintf (stderr, + "map_free_list: can't find segment containing cell %lux\n", + (unsigned long int) SCM_UNPACK (cell)); + abort (); + } + else if (this_seg != last_seg) { if (last_seg != -1) fprintf (stderr, " %5ld %d-cells in segment %ld\n", @@ -565,12 +569,14 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0, "@code{--enable-guile-debug} builds of Guile.") #define FUNC_NAME s_scm_map_free_list { - long i; + size_t i; + fprintf (stderr, "%ld segments total (%d:%ld", (long) scm_n_heap_segs, scm_heap_table[0].span, (long) (scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0])); - for (i = 1; i < scm_n_heap_segs; i++) + + for (i = 1; i != scm_n_heap_segs; i++) fprintf (stderr, ", %d:%ld", scm_heap_table[i].span, (long) (scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0])); @@ -1120,10 +1126,10 @@ scm_igc (const char *what) /* mark the registered roots */ { - long i; + size_t i; for (i = 0; i < SCM_VECTOR_LENGTH (scm_gc_registered_roots); ++i) { SCM l = SCM_VELTS (scm_gc_registered_roots)[i]; - for (; ! SCM_NULLP (l); l = SCM_CDR (l)) { + for (; !SCM_NULLP (l); l = SCM_CDR (l)) { SCM *p = (SCM *) (scm_num2long (SCM_CAAR (l), 0, NULL)); scm_gc_mark (*p); } @@ -1366,7 +1372,7 @@ gc_mark_loop_first_time: goto_gc_mark_loop; case scm_tc7_wvect: - SCM_WVECT_GC_CHAIN (ptr) = scm_weak_vectors; + SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors); scm_weak_vectors = ptr; if (SCM_IS_WHVEC_ANY (ptr)) { @@ -1449,7 +1455,27 @@ gc_mark_loop_first_time: switch (SCM_TYP16 (ptr)) { /* should be faster than going through scm_smobs */ case scm_tc_free_cell: - /* printf("found free_cell %X ", ptr); fflush(stdout); */ + /* We have detected a free cell. This can happen if non-object data + * on the C stack points into guile's heap and is scanned during + * conservative marking. */ +#if (SCM_DEBUG_CELL_ACCESSES == 0) + /* If cell debugging is disabled, there is a second situation in + * which a free cell can be encountered, namely if with preemptive + * threading one thread has just obtained a fresh cell and was + * preempted before the cell initialization was completed. In this + * case, some entries of the cell may already contain objects. + * Thus, if cell debugging is disabled, free cells are scanned + * conservatively. */ + scm_gc_mark_cell_conservatively (ptr); +#else /* SCM_DEBUG_CELL_ACCESSES == 1 */ + /* With cell debugging enabled, a freshly obtained but not fully + * initialized cell is guaranteed to be of type scm_tc16_allocated. + * Thus, no conservative scanning for free cells is necessary, but + * instead cells of type scm_tc16_allocated have to be scanned + * conservatively. This is done in the mark function of the + * scm_tc16_allocated smob type. */ +#endif + break; case scm_tc16_big: case scm_tc16_real: case scm_tc16_complex: @@ -1493,9 +1519,97 @@ gc_mark_loop_first_time: #undef FNAME -/* Mark a Region Conservatively - */ +/* Determine whether the given value does actually represent a cell in some + * heap segment. If this is the case, the number of the heap segment is + * returned. Otherwise, -1 is returned. Binary search is used in order to + * determine the heap segment that contains the cell.*/ +/* FIXME: To be used within scm_gc_mark_cell_conservatively, + * scm_mark_locations and scm_cellp this function should be an inline + * function. */ +static long int +heap_segment (SCM obj) +{ + if (!SCM_CELLP (obj)) + return -1; + else + { + SCM_CELLPTR ptr = SCM2PTR (obj); + unsigned long int i = 0; + unsigned long int j = scm_n_heap_segs - 1; + if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0])) + return -1; + else if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr)) + return -1; + else + { + while (i < j) + { + if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[1])) + { + break; + } + else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr)) + { + i = j; + break; + } + else + { + unsigned long int k = (i + j) / 2; + + if (k == i) + return -1; + else if (SCM_PTR_LT (ptr, scm_heap_table[k].bounds[1])) + { + j = k; + ++i; + if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0])) + return -1; + } + else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) + { + i = k; + --j; + if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr)) + return -1; + } + } + } + + if (!DOUBLECELL_ALIGNED_P (obj) && scm_heap_table[i].span == 2) + return -1; + else if (SCM_GC_IN_CARD_HEADERP (ptr)) + return -1; + else + return i; + } + } +} + + +/* Mark the entries of a cell conservatively. The given cell is known to be + * on the heap. Still we have to determine its heap segment in order to + * figure out whether it is a single or a double cell. Then, each of the cell + * elements itself is checked and potentially marked. */ +void +scm_gc_mark_cell_conservatively (SCM cell) +{ + unsigned long int cell_segment = heap_segment (cell); + unsigned int span = scm_heap_table[cell_segment].span; + unsigned int i; + + for (i = 1; i != span * 2; ++i) + { + SCM obj = SCM_CELL_OBJECT (cell, i); + long int obj_segment = heap_segment (obj); + if (obj_segment >= 0) + scm_gc_mark (obj); + } +} + + +/* Mark a region conservatively */ void scm_mark_locations (SCM_STACKITEM x[], unsigned long n) { @@ -1504,98 +1618,21 @@ scm_mark_locations (SCM_STACKITEM x[], unsigned long n) for (m = 0; m < n; ++m) { SCM obj = * (SCM *) &x[m]; - if (SCM_CELLP (obj)) - { - SCM_CELLPTR ptr = SCM2PTR (obj); - long i = 0; - long j = scm_n_heap_segs - 1; - if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) - && SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr)) - { - while (i <= j) - { - long seg_id; - seg_id = -1; - if ((i == j) - || SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr)) - seg_id = i; - else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr)) - seg_id = j; - else - { - long k; - k = (i + j) / 2; - if (k == i) - break; - if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) - { - j = k; - ++i; - if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)) - continue; - else - break; - } - else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) - { - i = k; - --j; - if (SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr)) - continue; - else - break; - } - } - - if (SCM_GC_IN_CARD_HEADERP (ptr)) - break; - - if (scm_heap_table[seg_id].span == 1 - || DOUBLECELL_ALIGNED_P (obj)) - scm_gc_mark (obj); - - break; - } - } - } + long int segment = heap_segment (obj); + if (segment >= 0) + scm_gc_mark (obj); } } /* The function scm_cellp determines whether an SCM value can be regarded as a - * pointer to a cell on the heap. Binary search is used in order to determine - * the heap segment that contains the cell. + * pointer to a cell on the heap. */ int scm_cellp (SCM value) { - if (SCM_CELLP (value)) { - scm_cell * ptr = SCM2PTR (value); - unsigned long i = 0; - unsigned long j = scm_n_heap_segs - 1; - - if (SCM_GC_IN_CARD_HEADERP (ptr)) - return 0; - - while (i < j) { - long k = (i + j) / 2; - if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) { - j = k; - } else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) { - i = k + 1; - } - } - - if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) - && SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr) - && (scm_heap_table[i].span == 1 || DOUBLECELL_ALIGNED_P (value)) - && !SCM_GC_IN_CARD_HEADERP (ptr) - ) - return 1; - else - return 0; - } else - return 0; + long int segment = heap_segment (value); + return (segment >= 0); } @@ -1654,7 +1691,7 @@ scm_gc_sweep () register scm_t_freelist *freelist; register unsigned long m; register int span; - long i; + size_t i; size_t seg_size; m = 0; @@ -1738,9 +1775,6 @@ scm_gc_sweep () case scm_tc7_pws: break; case scm_tc7_wvect: - m += (2 + SCM_VECTOR_LENGTH (scmptr)) * sizeof (SCM); - scm_must_free (SCM_VECTOR_BASE (scmptr) - 2); - break; case scm_tc7_vector: { unsigned long int length = SCM_VECTOR_LENGTH (scmptr); @@ -2222,7 +2256,7 @@ init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_t_freelist *freelist) { register SCM_CELLPTR ptr; SCM_CELLPTR seg_end; - long new_seg_index; + size_t new_seg_index; ptrdiff_t n_new_cells; int span = freelist->span; @@ -2238,13 +2272,11 @@ init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_t_freelist *freelist) seg_end = SCM_GC_CARD_DOWN ((char *)seg_org + size); /* Find the right place and insert the segment record. - * */ - for (new_seg_index = 0; - ( (new_seg_index < scm_n_heap_segs) - && SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org)); - new_seg_index++) - ; + new_seg_index = 0; + while (new_seg_index < scm_n_heap_segs + && SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org)) + new_seg_index++; { int i; @@ -2468,7 +2500,7 @@ alloc_some_heap (scm_t_freelist *freelist, policy_on_error error_policy) * parameters. Therefore, you can be sure that the compiler will keep those * scheme values alive (on the stack or in a register) up to the point where * scm_remember_upto_here* is called. In other words, place the call to - * scm_remember_upt_here* _behind_ the last code in your function, that + * scm_remember_upto_here* _behind_ the last code in your function, that * depends on the scheme object to exist. * * Example: We want to make sure, that the string object str does not get @@ -2778,6 +2810,7 @@ scm_init_storage () #if (SCM_DEBUG_CELL_ACCESSES == 1) scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0); + scm_set_smob_mark (scm_tc16_allocated, allocated_mark); #endif /* SCM_DEBUG_CELL_ACCESSES == 1 */ j = SCM_NUM_PROTECTS; diff --git a/libguile/gc.h b/libguile/gc.h index 07d2fe724..0f0b5a8a3 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -363,6 +363,7 @@ extern void scm_alloc_cluster (struct scm_t_freelist *master); extern void scm_igc (const char *what); extern void scm_gc_mark (SCM p); extern void scm_gc_mark_dependencies (SCM p); +extern void scm_gc_mark_cell_conservatively (SCM cell); extern void scm_mark_locations (SCM_STACKITEM x[], unsigned long n); extern int scm_cellp (SCM value); extern void scm_gc_sweep (void); diff --git a/libguile/list.c b/libguile/list.c index f39c99c91..0da225596 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -63,8 +63,8 @@ #define SCM_I_CONS(cell,x,y) \ do { \ SCM_NEWCELL (cell); \ - SCM_SET_CELL_OBJECT_0 (cell, x); \ SCM_SET_CELL_OBJECT_1 (cell, y); \ + SCM_SET_CELL_OBJECT_0 (cell, x); \ } while (0) SCM diff --git a/libguile/weaks.c b/libguile/weaks.c index 6180f1bc5..4debbb499 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -43,18 +43,72 @@ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ + #include "libguile/_scm.h" #include "libguile/vectors.h" #include "libguile/validate.h" #include "libguile/weaks.h" - + /* {Weak Vectors} */ +/* Allocate memory for a weak vector on behalf of the caller. The allocated + * vector will be of the given weak vector subtype. It will contain size + * elements which are initialized with the 'fill' object, or, if 'fill' is + * undefined, with an unspecified object. + */ +static SCM +allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller) +#define FUNC_NAME caller +{ + if (SCM_INUMP (size)) + { + size_t c_size; + SCM v; + + SCM_ASSERT_RANGE (1, size, SCM_INUM (size) >= 0); + c_size = SCM_INUM (size); + + SCM_NEWCELL2 (v); + SCM_SET_WVECT_GC_CHAIN (v, SCM_EOL); + SCM_SET_WVECT_TYPE (v, type); + + if (c_size > 0) + { + scm_t_bits *base; + size_t j; + + if (SCM_UNBNDP (fill)) + fill = SCM_UNSPECIFIED; + + SCM_ASSERT_RANGE (1, size, c_size <= SCM_VECTOR_MAX_LENGTH); + base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME); + for (j = 0; j != c_size; ++j) + base[j] = SCM_UNPACK (fill); + SCM_SET_VECTOR_BASE (v, base); + SCM_SET_VECTOR_LENGTH (v, c_size, scm_tc7_wvect); + scm_remember_upto_here_1 (fill); + } + else + { + SCM_SET_VECTOR_BASE (v, NULL); + SCM_SET_VECTOR_LENGTH (v, 0, scm_tc7_wvect); + } + + return v; + } + else if (SCM_BIGP (size)) + SCM_OUT_OF_RANGE (1, size); + else + SCM_WRONG_TYPE_ARG (1, size); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0, (SCM size, SCM fill), "Return a weak vector with @var{size} elements. If the optional\n" @@ -63,16 +117,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0, "empty list.") #define FUNC_NAME s_scm_make_weak_vector { - /* Dirk:FIXME:: We should probably rather use a double cell for weak vectors. */ - SCM v; - v = scm_make_vector (scm_sum (size, SCM_MAKINUM (2)), fill); - SCM_DEFER_INTS; - SCM_SET_VECTOR_LENGTH (v, SCM_INUM (size), scm_tc7_wvect); - SCM_SETVELTS(v, SCM_VELTS(v) + 2); - SCM_VELTS(v)[-2] = SCM_EOL; - SCM_VECTOR_BASE (v) [-1] = 0; - SCM_ALLOW_INTS; - return v; + return allocate_weak_vector (0, size, fill, FUNC_NAME); } #undef FUNC_NAME @@ -116,16 +161,12 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, "weak hashes are also weak vectors.") #define FUNC_NAME s_scm_weak_vector_p { - return SCM_BOOL(SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); + return SCM_BOOL (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj)); } #undef FUNC_NAME - - - - SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0, (SCM size), "@deffnx primitive make-weak-value-hash-table size\n" @@ -138,13 +179,7 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0, "would modify regular hash tables. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_key_hash_table { - SCM v; - SCM_VALIDATE_INUM (1, size); - v = scm_make_weak_vector (size, SCM_EOL); - SCM_DEFER_INTS; - SCM_VECTOR_BASE (v) [-1] = 1; - SCM_ALLOW_INTS; - return v; + return allocate_weak_vector (1, size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME @@ -155,34 +190,22 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0, "(@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_value_hash_table { - SCM v; - SCM_VALIDATE_INUM (1, size); - v = scm_make_weak_vector (size, SCM_EOL); - SCM_DEFER_INTS; - SCM_VECTOR_BASE (v) [-1] = 2; - SCM_ALLOW_INTS; - return v; + return allocate_weak_vector (2, size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME - SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0, (SCM size), "Return a hash table with weak keys and values with @var{size}\n" "buckets. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_doubly_weak_hash_table { - SCM v; - SCM_VALIDATE_INUM (1, size); - v = scm_make_weak_vector (size, SCM_EOL); - SCM_DEFER_INTS; - SCM_VECTOR_BASE (v) [-1] = 3; - SCM_ALLOW_INTS; - return v; + return allocate_weak_vector (3, size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME + SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, (SCM obj), "@deffnx primitive weak-value-hash-table? obj\n" @@ -192,7 +215,7 @@ SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, "nor a weak value hash table.") #define FUNC_NAME s_scm_weak_key_hash_table_p { - return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC(obj)); + return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj)); } #undef FUNC_NAME @@ -202,7 +225,7 @@ SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a weak value hash table.") #define FUNC_NAME s_scm_weak_value_hash_table_p { - return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC_V(obj)); + return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); } #undef FUNC_NAME @@ -212,10 +235,11 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, "Return @code{#t} if @var{obj} is a doubly weak hash table.") #define FUNC_NAME s_scm_doubly_weak_hash_table_p { - return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); + return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); } #undef FUNC_NAME + static void * scm_weak_vector_gc_init (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, @@ -226,6 +250,7 @@ scm_weak_vector_gc_init (void *dummy1 SCM_UNUSED, return 0; } + static void * scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, @@ -265,6 +290,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, return 0; } + static void * scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, @@ -325,10 +351,8 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, return 0; } - - void scm_weaks_prehistory () { @@ -337,6 +361,7 @@ scm_weaks_prehistory () scm_c_hook_add (&scm_after_sweep_c_hook, scm_scan_weak_vectors, 0, 0); } + void scm_init_weaks () { diff --git a/libguile/weaks.h b/libguile/weaks.h index 9f662d2c6..da86bfd1c 100644 --- a/libguile/weaks.h +++ b/libguile/weaks.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef WEAKSH -#define WEAKSH -/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc. +#ifndef SCM_WEAKS_H +#define SCM_WEAKS_H +/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -51,13 +51,15 @@ - -#define SCM_WVECTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_wvect)) -#define SCM_IS_WHVEC(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 1) -#define SCM_IS_WHVEC_V(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 2) -#define SCM_IS_WHVEC_B(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 3) -#define SCM_IS_WHVEC_ANY(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) != 0) -#define SCM_WVECT_GC_CHAIN(X) (SCM_VELTS(X)[-2]) +#define SCM_WVECTP(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_wvect) +#define SCM_WVECT_TYPE(x) (SCM_CELL_WORD_2 (x)) +#define SCM_SET_WVECT_TYPE(x, t) (SCM_SET_CELL_WORD_2 ((x), (t))) +#define SCM_IS_WHVEC(X) (SCM_WVECT_TYPE (X) == 1) +#define SCM_IS_WHVEC_V(X) (SCM_WVECT_TYPE (X) == 2) +#define SCM_IS_WHVEC_B(X) (SCM_WVECT_TYPE (X) == 3) +#define SCM_IS_WHVEC_ANY(X) (SCM_WVECT_TYPE (X) != 0) +#define SCM_WVECT_GC_CHAIN(X) (SCM_CELL_OBJECT_3 (X)) +#define SCM_SET_WVECT_GC_CHAIN(X, o) (SCM_SET_CELL_OBJECT_3 ((X), (o))) extern SCM scm_weak_vectors; @@ -75,7 +77,7 @@ extern SCM scm_doubly_weak_hash_table_p (SCM x); extern void scm_weaks_prehistory (void); extern void scm_init_weaks (void); -#endif /* WEAKSH */ +#endif /* SCM_WEAKS_H */ /* Local Variables: