diff options
| -rw-r--r-- | libguile.h | 2 | ||||
| -rw-r--r-- | libguile/Makefile.am | 8 | ||||
| -rw-r--r-- | libguile/gc-malloc.c | 1 | ||||
| -rw-r--r-- | libguile/gc.c | 1 | ||||
| -rw-r--r-- | libguile/goops.c | 1 | ||||
| -rw-r--r-- | libguile/guardians.c | 16 | ||||
| -rw-r--r-- | libguile/init.c | 6 | ||||
| -rw-r--r-- | libguile/modules.c | 12 | ||||
| -rw-r--r-- | libguile/objprop.c | 1 | ||||
| -rw-r--r-- | libguile/print.c | 31 | ||||
| -rw-r--r-- | libguile/snarf.h | 9 | ||||
| -rw-r--r-- | libguile/srcprop.c | 1 | ||||
| -rw-r--r-- | libguile/struct.c | 1 | ||||
| -rw-r--r-- | libguile/threads.c | 33 | ||||
| -rw-r--r-- | libguile/vectors.c | 179 | ||||
| -rw-r--r-- | libguile/vectors.h | 21 | ||||
| -rw-r--r-- | libguile/weak-vector.c | 207 | ||||
| -rw-r--r-- | libguile/weak-vector.h | 48 | ||||
| -rw-r--r-- | libguile/weaks.c | 294 | ||||
| -rw-r--r-- | libguile/weaks.h | 101 | ||||
| -rw-r--r-- | module/ice-9/weak-vector.scm | 15 | ||||
| -rw-r--r-- | test-suite/tests/weaks.test | 24 |
22 files changed, 367 insertions, 645 deletions
diff --git a/libguile.h b/libguile.h index 2c6840250..7ac98a507 100644 --- a/libguile.h +++ b/libguile.h @@ -117,7 +117,7 @@ extern "C" { #include "libguile/vports.h" #include "libguile/weak-set.h" #include "libguile/weak-table.h" -#include "libguile/weaks.h" +#include "libguile/weak-vector.h" #include "libguile/backtrace.h" #include "libguile/debug.h" #include "libguile/stacks.h" diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 25547da4e..502ae56fa 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -220,7 +220,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ vports.c \ weak-set.c \ weak-table.c \ - weaks.c + weak-vector.c DOT_X_FILES = \ alist.x \ @@ -318,7 +318,7 @@ DOT_X_FILES = \ vports.x \ weak-set.x \ weak-table.x \ - weaks.x + weak-vector.x # vm-related snarfs DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x @@ -421,7 +421,7 @@ DOT_DOC_FILES = \ vports.doc \ weak-set.doc \ weak-table.doc \ - weaks.doc + weak-vector.doc EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@ @@ -625,7 +625,7 @@ modinclude_HEADERS = \ vports.h \ weak-set.h \ weak-table.h \ - weaks.h + weak-vector.h nodist_modinclude_HEADERS = version.h scmconfig.h diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 839154a46..d02d8470e 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -43,7 +43,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/root.h" #include "libguile/strings.h" #include "libguile/vectors.h" -#include "libguile/weaks.h" #include "libguile/hashtab.h" #include "libguile/tags.h" diff --git a/libguile/gc.c b/libguile/gc.c index 40b158abd..696e32148 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -45,7 +45,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/root.h" #include "libguile/strings.h" #include "libguile/vectors.h" -#include "libguile/weaks.h" #include "libguile/hashtab.h" #include "libguile/tags.h" diff --git a/libguile/goops.c b/libguile/goops.c index ded989567..4b09f3311 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -53,7 +53,6 @@ #include "libguile/strings.h" #include "libguile/strports.h" #include "libguile/vectors.h" -#include "libguile/weaks.h" #include "libguile/vm.h" #include "libguile/validate.h" diff --git a/libguile/guardians.c b/libguile/guardians.c index 81313df31..076df00df 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -57,7 +57,6 @@ #include "libguile/validate.h" #include "libguile/root.h" #include "libguile/hashtab.h" -#include "libguile/weaks.h" #include "libguile/deprecation.h" #include "libguile/eval.h" @@ -131,9 +130,12 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) guardian_list = SCM_CDR (guardian_list)) { SCM zombies; + SCM guardian; t_guardian *g; - if (SCM_WEAK_PAIR_CAR_DELETED_P (guardian_list)) + guardian = scm_c_weak_vector_ref (scm_car (guardian_list), 0); + + if (scm_is_false (guardian)) { /* The guardian itself vanished in the meantime. */ #ifdef DEBUG_GUARDIANS @@ -142,7 +144,7 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) continue; } - g = GUARDIAN_DATA (SCM_CAR (guardian_list)); + g = GUARDIAN_DATA (guardian); if (g->live == 0) abort (); @@ -209,9 +211,11 @@ scm_i_guard (SCM guardian, SCM obj) g->live++; - /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be - collected before the objects it guards (see `guardians.test'). */ - guardians_for_obj = scm_weak_car_pair (guardian, SCM_EOL); + /* Note: GUARDIANS_FOR_OBJ holds weak references to guardians so + that a guardian can be collected before the objects it guards + (see `guardians.test'). */ + guardians_for_obj = scm_cons (scm_make_weak_vector (SCM_INUM1, guardian), + SCM_EOL); finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj); GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded, diff --git a/libguile/init.c b/libguile/init.c index 056ad33f3..130725c8f 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -133,7 +133,6 @@ #include "libguile/version.h" #include "libguile/vm.h" #include "libguile/vports.h" -#include "libguile/weaks.h" #include "libguile/guardians.h" #include "libguile/extensions.h" #include "libguile/uniform.h" @@ -383,12 +382,11 @@ scm_i_init_guile (void *base) scm_storage_prehistory (); scm_threads_prehistory (base); /* requires storage_prehistory */ - scm_weaks_prehistory (); /* requires storage_prehistory */ scm_weak_table_prehistory (); /* requires storage_prehistory */ #ifdef GUILE_DEBUG_MALLOC scm_debug_malloc_prehistory (); #endif - scm_symbols_prehistory (); /* requires weaks_prehistory */ + scm_symbols_prehistory (); /* requires weak_table_prehistory */ scm_modules_prehistory (); scm_init_array_handle (); scm_bootstrap_bytevectors (); /* Requires array-handle */ @@ -489,9 +487,9 @@ scm_i_init_guile (void *base) scm_init_throw (); /* Requires smob_prehistory */ scm_init_trees (); scm_init_version (); - scm_init_weaks (); scm_init_weak_set (); scm_init_weak_table (); + scm_init_weak_vectors (); scm_init_guardians (); /* requires smob_prehistory */ scm_init_vports (); scm_init_standard_ports (); /* Requires fports */ diff --git a/libguile/modules.c b/libguile/modules.c index 6c3f2629e..971676c28 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -960,16 +960,8 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, { handle = SCM_CAR (ls); - if (SCM_UNPACK (SCM_CAR (handle)) == 0) - { - /* FIXME: We hit a weak pair whose car has become unreachable. - We should remove the pair in question or something. */ - } - else - { - if (scm_is_eq (SCM_CDR (handle), variable)) - return SCM_CAR (handle); - } + if (scm_is_eq (SCM_CDR (handle), variable)) + return SCM_CAR (handle); ls = SCM_CDR (ls); } diff --git a/libguile/objprop.c b/libguile/objprop.c index eda089d4c..3a57d2866 100644 --- a/libguile/objprop.c +++ b/libguile/objprop.c @@ -27,7 +27,6 @@ #include "libguile/hashtab.h" #include "libguile/alist.h" #include "libguile/root.h" -#include "libguile/weaks.h" #include "libguile/objprop.h" diff --git a/libguile/print.c b/libguile/print.c index 095e48899..e462d1267 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -40,7 +40,6 @@ #include "libguile/macros.h" #include "libguile/procprop.h" #include "libguile/read.h" -#include "libguile/weaks.h" #include "libguile/programs.h" #include "libguile/alist.h" #include "libguile/struct.h" @@ -653,10 +652,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) break; case scm_tc7_wvect: ENTER_NESTED_DATA (pstate, exp, circref); - if (SCM_IS_WHVEC (exp)) - scm_puts ("#wh(", port); - else - scm_puts ("#w(", port); + scm_puts ("#w(", port); goto common_vector_printer; case scm_tc7_bytevector: @@ -676,26 +672,11 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) last = pstate->length - 1; cutp = 1; } - if (SCM_I_WVECTP (exp)) - { - /* Elements of weak vectors may not be accessed via the - `SIMPLE_VECTOR_REF ()' macro. */ - for (i = 0; i < last; ++i) - { - scm_iprin1 (scm_c_vector_ref (exp, i), - port, pstate); - scm_putc (' ', port); - } - } - else - { - for (i = 0; i < last; ++i) - { - scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate); - scm_putc (' ', port); - } - } - + for (i = 0; i < last; ++i) + { + scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate); + scm_putc (' ', port); + } if (i == last) { /* CHECK_INTS; */ diff --git a/libguile/snarf.h b/libguile/snarf.h index 1c072babb..4aaff7c34 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -119,9 +119,9 @@ SCM_SNARF_HERE( \ ) \ SCM_SNARF_INIT( \ /* Initialize the foreign. */ \ - scm_i_paste (FNAME, __raw_objtable)[2] = scm_i_paste (FNAME, __subr_foreign); \ + scm_i_paste (FNAME, __raw_objtable)[1] = scm_i_paste (FNAME, __subr_foreign); \ /* Initialize the procedure name (an interned symbol). */ \ - scm_i_paste (FNAME, __raw_objtable)[3] = scm_i_paste (FNAME, __name); \ + scm_i_paste (FNAME, __raw_objtable)[2] = scm_i_paste (FNAME, __name); \ /* Initialize the objcode trampoline. */ \ SCM_SET_CELL_OBJECT (scm_i_paste (FNAME, __subr), 1, \ scm_subr_objcode_trampoline (REQ, OPT, VAR)); \ @@ -366,12 +366,11 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) /* for primitive-generics, add a foreign to the end */ #define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \ - static SCM_ALIGNED (8) SCM c_name[4] = \ + static SCM_ALIGNED (8) SCM c_name[3] = \ { \ SCM_PACK (scm_tc7_vector | (2 << 8)), \ - SCM_PACK (0), \ foreign, \ - SCM_BOOL_F, /* the name */ \ + SCM_BOOL_F /* the name */ \ } #define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \ diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 48db911c8..cd16789c6 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -33,7 +33,6 @@ #include "libguile/hash.h" #include "libguile/ports.h" #include "libguile/root.h" -#include "libguile/weaks.h" #include "libguile/gc.h" #include "libguile/validate.h" diff --git a/libguile/struct.c b/libguile/struct.c index 4a2a9d750..7f8f75d0b 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -29,7 +29,6 @@ #include "libguile/chars.h" #include "libguile/eval.h" #include "libguile/alist.h" -#include "libguile/weaks.h" #include "libguile/hashtab.h" #include "libguile/ports.h" #include "libguile/strings.h" diff --git a/libguile/threads.c b/libguile/threads.c index fcd1c1d2b..2560b69a2 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -56,7 +56,6 @@ #include "libguile/init.h" #include "libguile/scmsigs.h" #include "libguile/strings.h" -#include "libguile/weaks.h" #include <full-read.h> @@ -651,9 +650,9 @@ do_thread_exit (void *v) while (!scm_is_null (t->mutexes)) { - SCM mutex = SCM_WEAK_PAIR_CAR (t->mutexes); + SCM mutex = scm_c_weak_vector_ref (scm_car (t->mutexes), 0); - if (!SCM_UNBNDP (mutex)) + if (scm_is_true (mutex)) { fat_mutex *m = SCM_MUTEX_DATA (mutex); @@ -667,7 +666,7 @@ do_thread_exit (void *v) scm_i_pthread_mutex_unlock (&m->lock); } - t->mutexes = SCM_WEAK_PAIR_CDR (t->mutexes); + t->mutexes = scm_cdr (t->mutexes); } scm_i_pthread_mutex_unlock (&t->admin_mutex); @@ -1376,7 +1375,8 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) The weak pair itself is eventually removed when MUTEX is unlocked. Note that `t->mutexes' lists mutexes currently held by T, so it should be small. */ - t->mutexes = scm_weak_car_pair (mutex, t->mutexes); + t->mutexes = scm_cons (scm_make_weak_vector (SCM_INUM1, mutex), + t->mutexes); scm_i_pthread_mutex_unlock (&t->admin_mutex); } @@ -1520,6 +1520,25 @@ typedef struct { #define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x) #define SCM_CONDVAR_DATA(x) ((fat_cond *) SCM_SMOB_DATA (x)) +static void +remove_mutex_from_thread (SCM mutex, scm_i_thread *t) +{ + SCM walk, prev; + + for (prev = SCM_BOOL_F, walk = t->mutexes; scm_is_pair (walk); + walk = SCM_CDR (walk)) + { + if (scm_is_eq (mutex, scm_c_weak_vector_ref (SCM_CAR (walk), 0))) + { + if (scm_is_pair (prev)) + SCM_SETCDR (prev, SCM_CDR (walk)); + else + t->mutexes = SCM_CDR (walk); + break; + } + } +} + static int fat_mutex_unlock (SCM mutex, SCM cond, const scm_t_timespec *waittime, int relock) @@ -1564,7 +1583,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (m->level == 0) { /* Change the owner of MUTEX. */ - t->mutexes = scm_delq_x (mutex, t->mutexes); + remove_mutex_from_thread (mutex, t); m->owner = unblock_from_queue (m->waiting); } @@ -1612,7 +1631,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (m->level == 0) { /* Change the owner of MUTEX. */ - t->mutexes = scm_delq_x (mutex, t->mutexes); + remove_mutex_from_thread (mutex, t); m->owner = unblock_from_queue (m->waiting); } diff --git a/libguile/vectors.c b/libguile/vectors.c index e43fa0e0d..1640725e5 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -67,9 +67,7 @@ scm_vector_elements (SCM vec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { if (SCM_I_WVECTP (vec)) - /* FIXME: We should check each (weak) element of the vector for NULL and - convert it to SCM_BOOL_F. */ - abort (); + scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); scm_generalized_vector_get_handle (vec, h); if (lenp) @@ -86,9 +84,7 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { if (SCM_I_WVECTP (vec)) - /* FIXME: We should check each (weak) element of the vector for NULL and - convert it to SCM_BOOL_F. */ - abort (); + scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); scm_generalized_vector_get_handle (vec, h); if (lenp) @@ -205,40 +201,29 @@ scm_vector_ref (SCM v, SCM k) SCM scm_c_vector_ref (SCM v, size_t k) { - if (SCM_I_IS_VECTOR (v)) + if (SCM_I_IS_NONWEAK_VECTOR (v)) { - register SCM elt; - if (k >= SCM_I_VECTOR_LENGTH (v)) scm_out_of_range (NULL, scm_from_size_t (k)); - elt = (SCM_I_VECTOR_ELTS(v))[k]; - - if (SCM_UNPACK (elt) == 0 && SCM_I_WVECTP (v)) - /* ELT was a weak pointer and got nullified by the GC. */ - return SCM_BOOL_F; - - return elt; + return SCM_SIMPLE_VECTOR_REF (v, k); } + else if (SCM_I_WVECTP (v)) + return scm_c_weak_vector_ref (v, k); else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1) { scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v); SCM vv = SCM_I_ARRAY_V (v); - if (SCM_I_IS_VECTOR (vv)) - { - register SCM elt; - - if (k >= dim->ubnd - dim->lbnd + 1) - scm_out_of_range (NULL, scm_from_size_t (k)); - k = SCM_I_ARRAY_BASE (v) + k*dim->inc; - elt = (SCM_I_VECTOR_ELTS (vv))[k]; - - if (SCM_UNPACK (elt) == 0 && (SCM_I_WVECTP (vv))) - /* ELT was a weak pointer and got nullified by the GC. */ - return SCM_BOOL_F; - - return elt; - } - scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector"); + + k = SCM_I_ARRAY_BASE (v) + k*dim->inc; + if (k >= dim->ubnd - dim->lbnd + 1) + scm_out_of_range (NULL, scm_from_size_t (k)); + + if (SCM_I_IS_NONWEAK_VECTOR (vv)) + return SCM_SIMPLE_VECTOR_REF (vv, k); + else if (SCM_I_WVECTP (vv)) + return scm_c_weak_vector_ref (vv, k); + else + scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector"); } else return scm_wta_dispatch_2 (g_vector_ref, v, scm_from_size_t (k), 2, @@ -270,38 +255,27 @@ scm_vector_set_x (SCM v, SCM k, SCM obj) void scm_c_vector_set_x (SCM v, size_t k, SCM obj) { - if (SCM_I_IS_VECTOR (v)) + if (SCM_I_IS_NONWEAK_VECTOR (v)) { if (k >= SCM_I_VECTOR_LENGTH (v)) - scm_out_of_range (NULL, scm_from_size_t (k)); - (SCM_I_VECTOR_WELTS(v))[k] = obj; - if (SCM_I_WVECTP (v)) - { - /* Make it a weak pointer. */ - GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (v))[k]); - SCM_I_REGISTER_DISAPPEARING_LINK (link, - (GC_PTR) SCM2PTR (obj)); - } + scm_out_of_range (NULL, scm_from_size_t (k)); + SCM_SIMPLE_VECTOR_SET (v, k, obj); } + else if (SCM_I_WVECTP (v)) + scm_c_weak_vector_set_x (v, k, obj); else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1) { scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v); SCM vv = SCM_I_ARRAY_V (v); - if (SCM_I_IS_VECTOR (vv)) - { - if (k >= dim->ubnd - dim->lbnd + 1) - scm_out_of_range (NULL, scm_from_size_t (k)); - k = SCM_I_ARRAY_BASE (v) + k*dim->inc; - (SCM_I_VECTOR_WELTS (vv))[k] = obj; - - if (SCM_I_WVECTP (vv)) - { - /* Make it a weak pointer. */ - GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (vv))[k]); - SCM_I_REGISTER_DISAPPEARING_LINK (link, - (GC_PTR) SCM2PTR (obj)); - } - } + + k = SCM_I_ARRAY_BASE (v) + k*dim->inc; + if (k >= dim->ubnd - dim->lbnd + 1) + scm_out_of_range (NULL, scm_from_size_t (k)); + + if (SCM_I_IS_NONWEAK_VECTOR (vv)) + SCM_SIMPLE_VECTOR_SET (vv, k, obj); + else if (SCM_I_WVECTP (vv)) + scm_c_weak_vector_set_x (vv, k, obj); else scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector"); } @@ -339,28 +313,17 @@ SCM scm_c_make_vector (size_t k, SCM fill) #define FUNC_NAME s_scm_make_vector { - SCM *vector; - - vector = (SCM *) - scm_gc_malloc ((k + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM), - "vector"); + SCM vector; + unsigned long int j; - if (k > 0) - { - SCM *base; - unsigned long int j; - - SCM_ASSERT_RANGE (1, scm_from_ulong (k), k <= VECTOR_MAX_LENGTH); + SCM_ASSERT_RANGE (1, scm_from_size_t (k), k <= VECTOR_MAX_LENGTH); - base = vector + SCM_I_VECTOR_HEADER_SIZE; - for (j = 0; j != k; ++j) - base[j] = fill; - } + vector = scm_words ((k << 8) | scm_tc7_vector, k + 1); - ((scm_t_bits *) vector)[0] = (k << 8) | scm_tc7_vector; - ((scm_t_bits *) vector)[1] = 0; + for (j = 0; j < k; ++j) + SCM_SIMPLE_VECTOR_SET (vector, j, fill); - return PTR2SCM (vector); + return vector; } #undef FUNC_NAME @@ -389,72 +352,6 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0, #undef FUNC_NAME -/* Weak vectors. */ - -/* Allocate memory for the elements of a weak vector on behalf of the - caller. */ -static SCM -make_weak_vector (scm_t_bits type, size_t c_size) -{ - SCM *vector; - size_t total_size; - - total_size = (c_size + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM); - vector = (SCM *) scm_gc_malloc_pointerless (total_size, "weak vector"); - - ((scm_t_bits *) vector)[0] = (c_size << 8) | scm_tc7_wvect; - ((scm_t_bits *) vector)[1] = type; - - return PTR2SCM (vector); -} - -/* Return a new weak vector. 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. */ -SCM -scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill) -{ - SCM wv, *base; - size_t c_size, j; - - if (SCM_UNBNDP (fill)) - fill = SCM_UNSPECIFIED; - - c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH); - wv = make_weak_vector (type, c_size); - base = SCM_I_WVECT_GC_WVELTS (wv); - - for (j = 0; j != c_size; ++j) - base[j] = fill; - - return wv; -} - -/* Return a new weak vector with type TYPE and whose content are taken from - list LST. */ -SCM -scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst) -{ - SCM wv, *elt; - long c_size; - - c_size = scm_ilength (lst); - SCM_ASSERT (c_size >= 0, lst, SCM_ARG2, "scm_i_make_weak_vector_from_list"); - - wv = make_weak_vector(type, (size_t) c_size); - - for (elt = SCM_I_WVECT_GC_WVELTS (wv); - scm_is_pair (lst); - lst = SCM_CDR (lst), elt++) - { - *elt = SCM_CAR (lst); - } - - return wv; -} - - - SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, (SCM v), "Return a newly allocated list composed of the elements of @var{v}.\n" diff --git a/libguile/vectors.h b/libguile/vectors.h index 3746e9026..fd69a1c4c 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -3,7 +3,7 @@ #ifndef SCM_VECTORS_H #define SCM_VECTORS_H -/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -63,31 +63,14 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec, /* Internals */ -/* Vectors have a 2-word header: 1 for the type tag, and 1 for the weak - vector extra data (see below.) */ -#define SCM_I_VECTOR_HEADER_SIZE 2U - #define SCM_I_IS_VECTOR(x) (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector)) #define SCM_I_IS_NONWEAK_VECTOR(x) (!SCM_IMP(x) && (SCM_TYP7(x)==scm_tc7_vector)) #define SCM_I_VECTOR_ELTS(x) ((const SCM *) SCM_I_VECTOR_WELTS (x)) -#define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, SCM_I_VECTOR_HEADER_SIZE)) +#define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1)) #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8) SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y); -/* Weak vectors share implementation details with ordinary vectors, - but no one else should. */ - -#define SCM_I_WVECTP(x) (!SCM_IMP (x) && \ - SCM_TYP7 (x) == scm_tc7_wvect) -#define SCM_I_WVECT_LENGTH SCM_I_VECTOR_LENGTH -#define SCM_I_WVECT_VELTS SCM_I_VECTOR_ELTS -#define SCM_I_WVECT_GC_WVELTS SCM_I_VECTOR_WELTS -#define SCM_I_WVECT_EXTRA(x) (SCM_CELL_WORD_1 (x)) -#define SCM_I_SET_WVECT_EXTRA(x, t) (SCM_SET_CELL_WORD_1 ((x),(t))) - -SCM_INTERNAL SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill); -SCM_INTERNAL SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst); SCM_INTERNAL void scm_init_vectors (void); diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c new file mode 100644 index 000000000..a42166bf5 --- /dev/null +++ b/libguile/weak-vector.c @@ -0,0 +1,207 @@ +/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + + + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <stdio.h> + +#include "libguile/_scm.h" +#include "libguile/vectors.h" + +#include "libguile/validate.h" + + + +/* {Weak Vectors} + */ + +#define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8) + +static SCM +make_weak_vector (size_t len, SCM fill) +#define FUNC_NAME "make-weak-vector" +{ + SCM wv; + size_t j; + + SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= VECTOR_MAX_LENGTH); + + if (SCM_UNBNDP (fill)) + fill = SCM_UNSPECIFIED; + + wv = PTR2SCM (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM), + "weak vector")); + + SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect); + + if (SCM_NIMP (fill)) + { + memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM)); + for (j = 0; j < len; j++) + scm_c_weak_vector_set_x (wv, j, fill); + } + else + for (j = 0; j < len; j++) + SCM_SIMPLE_VECTOR_SET (wv, j, fill); + + return wv; +} +#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" + "argument @var{fill} is given, all entries in the vector will be\n" + "set to @var{fill}. The default value for @var{fill} is the\n" + "empty list.") +#define FUNC_NAME s_scm_make_weak_vector +{ + return make_weak_vector (scm_to_size_t (size), fill); +} +#undef FUNC_NAME + + +SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector); + +SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, + (SCM lst), + "@deffnx {Scheme Procedure} list->weak-vector lst\n" + "Construct a weak vector from a list: @code{weak-vector} uses\n" + "the list of its arguments while @code{list->weak-vector} uses\n" + "its only argument @var{l} (a list) to construct a weak vector\n" + "the same way @code{list->vector} would.") +#define FUNC_NAME s_scm_weak_vector +{ + SCM wv; + size_t i; + long c_size; + + SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, c_size); + + wv = make_weak_vector ((size_t) c_size, SCM_BOOL_F); + + for (i = 0; scm_is_pair (lst); lst = SCM_CDR (lst), i++) + scm_c_weak_vector_set_x (wv, i, SCM_CAR (lst)); + + return wv; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a weak vector. Note that all\n" + "weak hashes are also weak vectors.") +#define FUNC_NAME s_scm_weak_vector_p +{ + return scm_from_bool (SCM_I_WVECTP (obj)); +} +#undef FUNC_NAME + + +struct weak_vector_ref_data +{ + SCM wv; + size_t k; +}; + +static void* +weak_vector_ref (void *data) +{ + struct weak_vector_ref_data *d = data; + + return SCM_SIMPLE_VECTOR_REF (d->wv, d->k); +} + +SCM +scm_c_weak_vector_ref (SCM wv, size_t k) +{ + struct weak_vector_ref_data d; + void *ret; + + d.wv = wv; + d.k = k; + + if (k >= SCM_I_VECTOR_LENGTH (wv)) + scm_out_of_range (NULL, scm_from_size_t (k)); + + ret = GC_call_with_alloc_lock (weak_vector_ref, &d); + + if (ret) + return PTR2SCM (ret); + else + return SCM_BOOL_F; +} + + +void +scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x) +{ + SCM *elts; + struct weak_vector_ref_data d; + void *prev; + + d.wv = wv; + d.k = k; + + if (k >= SCM_I_VECTOR_LENGTH (wv)) + scm_out_of_range (NULL, scm_from_size_t (k)); + + prev = GC_call_with_alloc_lock (weak_vector_ref, &d); + + elts = SCM_I_VECTOR_WELTS (wv); + + if (prev && SCM_NIMP (PTR2SCM (prev))) + GC_unregister_disappearing_link ((GC_PTR) &elts[k]); + + elts[k] = x; + + if (SCM_NIMP (x)) + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &elts[k], + (GC_PTR) SCM2PTR (x)); +} + + + +static void +scm_init_weak_vector_builtins (void) +{ +#ifndef SCM_MAGIC_SNARFER +#include "libguile/weak-vector.x" +#endif +} + +void +scm_init_weak_vectors () +{ + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, + "scm_init_weak_vector_builtins", + (scm_t_extension_init_func)scm_init_weak_vector_builtins, + NULL); +} + + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h new file mode 100644 index 000000000..80bb41497 --- /dev/null +++ b/libguile/weak-vector.h @@ -0,0 +1,48 @@ +/* classes: h_files */ + +#ifndef SCM_WEAK_VECTOR_H +#define SCM_WEAK_VECTOR_H + +/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + + + +#include "libguile/__scm.h" + + +/* Weak vectors. */ + +#define SCM_I_WVECTP(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_wvect) + +SCM_API SCM scm_make_weak_vector (SCM k, SCM fill); +SCM_API SCM scm_weak_vector (SCM l); +SCM_API SCM scm_weak_vector_p (SCM x); +SCM_INTERNAL SCM scm_c_weak_vector_ref (SCM v, size_t k); +SCM_INTERNAL void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x); + +SCM_INTERNAL void scm_init_weak_vectors (void); + + +#endif /* SCM_WEAK_VECTOR_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/weaks.c b/libguile/weaks.c deleted file mode 100644 index 92d351e51..000000000 --- a/libguile/weaks.c +++ /dev/null @@ -1,294 +0,0 @@ -/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 3 of - * the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#ifdef HAVE_CONFIG_H -# include <config.h> -#endif - -#include <stdio.h> - -#include "libguile/_scm.h" -#include "libguile/vectors.h" -#include "libguile/hashtab.h" - -#include "libguile/validate.h" -#include "libguile/weaks.h" - -#include "libguile/bdw-gc.h" -#include <gc/gc_typed.h> - - - -/* Weak pairs for use in weak alist vectors and weak hash tables. - - We have weal-car pairs, weak-cdr pairs, and doubly weak pairs. In weak - pairs, the weak component(s) are not scanned for pointers and are - registered as disapperaring links; therefore, the weak component may be - set to NULL by the garbage collector when no other reference to that word - exist. Thus, users should only access weak pairs via the - `SCM_WEAK_PAIR_C[AD]R ()' macros. See also `scm_fixup_weak_alist ()' in - `hashtab.c'. */ - -/* Type descriptors for weak-c[ad]r pairs. */ -static GC_descr wcar_pair_descr, wcdr_pair_descr; - - -SCM -scm_weak_car_pair (SCM car, SCM cdr) -{ - scm_t_cell *cell; - - cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell), - wcar_pair_descr); - - cell->word_0 = car; - cell->word_1 = cdr; - - if (SCM_NIMP (car)) - /* Weak car cells make sense iff the car is non-immediate. */ - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_0, - (GC_PTR) SCM2PTR (car)); - - return (SCM_PACK (cell)); -} - -SCM -scm_weak_cdr_pair (SCM car, SCM cdr) -{ - scm_t_cell *cell; - - cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell), - wcdr_pair_descr); - - cell->word_0 = car; - cell->word_1 = cdr; - - if (SCM_NIMP (cdr)) - /* Weak cdr cells make sense iff the cdr is non-immediate. */ - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_1, - (GC_PTR) SCM2PTR (cdr)); - - return (SCM_PACK (cell)); -} - -SCM -scm_doubly_weak_pair (SCM car, SCM cdr) -{ - /* Doubly weak cells shall not be scanned at all for pointers. */ - scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell), - "weak cell"); - - cell->word_0 = car; - cell->word_1 = cdr; - - if (SCM_NIMP (car)) - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_0, - (GC_PTR) SCM2PTR (car)); - if (SCM_NIMP (cdr)) - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_1, - (GC_PTR) SCM2PTR (cdr)); - - return (SCM_PACK (cell)); -} - - - - -/* 1. The current hash table implementation in hashtab.c uses weak alist - * vectors (formerly called weak hash tables) internally. - * - * 2. All hash table operations still work on alist vectors. - * - * 3. The weak vector and alist vector Scheme API is accessed through - * the module (ice-9 weak-vector). - */ - - -/* {Weak Vectors} - */ - - -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" - "argument @var{fill} is given, all entries in the vector will be\n" - "set to @var{fill}. The default value for @var{fill} is the\n" - "empty list.") -#define FUNC_NAME s_scm_make_weak_vector -{ - return scm_i_make_weak_vector (0, size, fill); -} -#undef FUNC_NAME - - -SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector); - -SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, - (SCM l), - "@deffnx {Scheme Procedure} list->weak-vector l\n" - "Construct a weak vector from a list: @code{weak-vector} uses\n" - "the list of its arguments while @code{list->weak-vector} uses\n" - "its only argument @var{l} (a list) to construct a weak vector\n" - "the same way @code{list->vector} would.") -#define FUNC_NAME s_scm_weak_vector -{ - return scm_i_make_weak_vector_from_list (0, l); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a weak vector. Note that all\n" - "weak hashes are also weak vectors.") -#define FUNC_NAME s_scm_weak_vector_p -{ - return scm_from_bool (SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj)); -} -#undef FUNC_NAME - - -/* Weak alist vectors, i.e., vectors of alists. - - The alist vector themselves are _not_ weak. The `car' (or `cdr', or both) - of the pairs within it are weak. See `hashtab.c' for details. */ - - -/* FIXME: We used to have two implementations of weak hash tables: the one in - here and the one in `hashtab.c'. The difference is that weak alist - vectors could be used as vectors while (weak) hash tables can't. We need - to unify that. */ - -SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, 0, - (SCM size), - "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n" - "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n" - "Return a weak hash table with @var{size} buckets. As with any\n" - "hash table, choosing a good size for the table requires some\n" - "caution.\n" - "\n" - "You can modify weak hash tables in exactly the same way you\n" - "would modify regular hash tables. (@pxref{Hash Tables})") -#define FUNC_NAME s_scm_make_weak_key_alist_vector -{ - return scm_make_weak_key_hash_table (size); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, 1, 0, - (SCM size), - "Return a hash table with weak values with @var{size} buckets.\n" - "(@pxref{Hash Tables})") -#define FUNC_NAME s_scm_make_weak_value_alist_vector -{ - return scm_make_weak_value_hash_table (size); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", 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_alist_vector -{ - return scm_make_doubly_weak_hash_table (size); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0, - (SCM obj), - "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n" - "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n" - "Return @code{#t} if @var{obj} is the specified weak hash\n" - "table. Note that a doubly weak hash table is neither a weak key\n" - "nor a weak value hash table.") -#define FUNC_NAME s_scm_weak_key_alist_vector_p -{ - return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC (obj)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a weak value hash table.") -#define FUNC_NAME s_scm_weak_value_alist_vector_p -{ - return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_V (obj)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a doubly weak hash table.") -#define FUNC_NAME s_scm_doubly_weak_alist_vector_p -{ - return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_B (obj)); -} -#undef FUNC_NAME - - - - -SCM -scm_init_weaks_builtins () -{ -#include "libguile/weaks.x" - return SCM_UNSPECIFIED; -} - -void -scm_weaks_prehistory () -{ - /* Initialize weak pairs. */ - GC_word wcar_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 }; - GC_word wcdr_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 }; - - /* In a weak-car pair, only the second word must be scanned for - pointers. */ - GC_set_bit (wcar_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_1)); - wcar_pair_descr = GC_make_descriptor (wcar_pair_bitmap, - GC_WORD_LEN (scm_t_cell)); - - /* Conversely, in a weak-cdr pair, only the first word must be scanned for - pointers. */ - GC_set_bit (wcdr_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_0)); - wcdr_pair_descr = GC_make_descriptor (wcdr_pair_bitmap, - GC_WORD_LEN (scm_t_cell)); - -} - -void -scm_init_weaks () -{ - scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0, - scm_init_weaks_builtins); -} - - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/weaks.h b/libguile/weaks.h deleted file mode 100644 index fc16f8bf8..000000000 --- a/libguile/weaks.h +++ /dev/null @@ -1,101 +0,0 @@ -/* classes: h_files */ - -#ifndef SCM_WEAKS_H -#define SCM_WEAKS_H - -/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 3 of - * the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#include "libguile/__scm.h" - - - -#define SCM_WVECTF_WEAK_KEY 1 -#define SCM_WVECTF_WEAK_VALUE 2 - -#define SCM_WVECT_WEAK_KEY_P(x) (SCM_I_WVECT_EXTRA(x) & SCM_WVECTF_WEAK_KEY) -#define SCM_WVECT_WEAK_VALUE_P(x) (SCM_I_WVECT_EXTRA(x) & SCM_WVECTF_WEAK_VALUE) - -#define SCM_I_WVECT_TYPE(x) (SCM_I_WVECT_EXTRA(x) & 7) -#define SCM_I_SET_WVECT_TYPE(x,t) (SCM_I_SET_WVECT_EXTRA \ - ((x), (SCM_I_WVECT_EXTRA (x) & ~7) | (t))) -#define SCM_IS_WHVEC(X) (SCM_I_WVECT_TYPE (X) == 1) -#define SCM_IS_WHVEC_V(X) (SCM_I_WVECT_TYPE (X) == 2) -#define SCM_IS_WHVEC_B(X) (SCM_I_WVECT_TYPE (X) == 3) -#define SCM_IS_WHVEC_ANY(X) (SCM_I_WVECT_TYPE (X) != 0) - - -/* Weak pairs. */ - -SCM_INTERNAL SCM scm_weak_car_pair (SCM car, SCM cdr); -SCM_INTERNAL SCM scm_weak_cdr_pair (SCM car, SCM cdr); -SCM_INTERNAL SCM scm_doubly_weak_pair (SCM car, SCM cdr); - -/* Testing the weak component(s) of a cell for reachability. */ -#define SCM_WEAK_PAIR_WORD_DELETED_P(_cell, _word) \ - (SCM_UNPACK (SCM_CELL_OBJECT ((_cell), (_word))) == 0) -#define SCM_WEAK_PAIR_CAR_DELETED_P(_cell) \ - (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 0)) -#define SCM_WEAK_PAIR_CDR_DELETED_P(_cell) \ - (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 1)) - -#define SCM_WEAK_PAIR_DELETED_P(_cell) \ - ((SCM_WEAK_PAIR_CAR_DELETED_P (_cell)) \ - || (SCM_WEAK_PAIR_CDR_DELETED_P (_cell))) - -/* Accessing the components of a weak cell. These return `SCM_UNDEFINED' if - the car/cdr has been collected. */ -#define SCM_WEAK_PAIR_WORD(_cell, _word) \ - (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), (_word)) \ - ? SCM_UNDEFINED \ - : SCM_CELL_OBJECT ((_cell), (_word))) -#define SCM_WEAK_PAIR_CAR(_cell) (SCM_WEAK_PAIR_WORD ((_cell), 0)) -#define SCM_WEAK_PAIR_CDR(_cell) (SCM_WEAK_PAIR_WORD ((_cell), 1)) - - - -/* Weak vectors and weak hash tables. */ - -SCM_API SCM scm_make_weak_vector (SCM k, SCM fill); -SCM_API SCM scm_weak_vector (SCM l); -SCM_API SCM scm_weak_vector_p (SCM x); -SCM_API SCM scm_make_weak_key_alist_vector (SCM k); -SCM_API SCM scm_make_weak_value_alist_vector (SCM k); -SCM_API SCM scm_make_doubly_weak_alist_vector (SCM k); -SCM_API SCM scm_weak_key_alist_vector_p (SCM x); -SCM_API SCM scm_weak_value_alist_vector_p (SCM x); -SCM_API SCM scm_doubly_weak_alist_vector_p (SCM x); -SCM_INTERNAL SCM scm_init_weaks_builtins (void); -SCM_INTERNAL void scm_weaks_prehistory (void); -SCM_INTERNAL void scm_init_weaks (void); - -SCM_INTERNAL void scm_i_init_weak_vectors_for_gc (void); -SCM_INTERNAL void scm_i_mark_weak_vector (SCM w); -SCM_INTERNAL int scm_i_mark_weak_vectors_non_weaks (void); -SCM_INTERNAL void scm_i_remove_weaks_from_weak_vectors (void); - - -#endif /* SCM_WEAKS_H */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/module/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm index 09e2e0a8d..31d79ec6f 100644 --- a/module/ice-9/weak-vector.scm +++ b/module/ice-9/weak-vector.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -19,13 +19,8 @@ (define-module (ice-9 weak-vector) - :export (make-weak-vector list->weak-vector weak-vector weak-vector? - make-weak-key-alist-vector - make-weak-value-alist-vector - make-doubly-weak-alist-vector - weak-key-alist-vector? - weak-value-alist-vector? - doubly-weak-alist-vector?) ; C - ) + #:export (make-weak-vector list->weak-vector weak-vector weak-vector?)) -(%init-weaks-builtins) ; defined in libguile/weaks.c +(eval-when (load eval compile) + (load-extension (string-append "libguile-" (effective-version)) + "scm_init_weak_vector_builtins")) diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test index d0f6c5ef5..9475eed55 100644 --- a/test-suite/tests/weaks.test +++ b/test-suite/tests/weaks.test @@ -68,28 +68,28 @@ exception:wrong-type-arg (list->weak-vector 32))) - (with-test-prefix "make-weak-key-alist-vector" + (with-test-prefix "make-weak-key-hash-table" (pass-if "create" - (make-weak-key-alist-vector 17) + (make-weak-key-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg - (make-weak-key-alist-vector '(bad arg)))) - (with-test-prefix "make-weak-value-alist-vector" + (make-weak-key-hash-table '(bad arg)))) + (with-test-prefix "make-weak-value-hash-table" (pass-if "create" - (make-weak-value-alist-vector 17) + (make-weak-value-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg - (make-weak-value-alist-vector '(bad arg)))) + (make-weak-value-hash-table '(bad arg)))) - (with-test-prefix "make-doubly-weak-alist-vector" + (with-test-prefix "make-doubly-weak-hash-table" (pass-if "create" - (make-doubly-weak-alist-vector 17) + (make-doubly-weak-hash-table 17) #t) (pass-if-exception "bad-args" exception:wrong-type-arg - (make-doubly-weak-alist-vector '(bad arg))))) + (make-doubly-weak-hash-table '(bad arg))))) @@ -138,9 +138,9 @@ (or (not value) (equal? value initial-value))) - (let ((x (make-weak-key-alist-vector 17)) - (y (make-weak-value-alist-vector 17)) - (z (make-doubly-weak-alist-vector 17)) + (let ((x (make-weak-key-hash-table 17)) + (y (make-weak-value-hash-table 17)) + (z (make-doubly-weak-hash-table 17)) (test-key "foo") (test-value "bar")) (with-test-prefix |