diff options
author | Andy Wingo <wingo@pobox.com> | 2012-02-19 12:51:53 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-02-19 20:52:03 +0100 |
commit | 543328b5aed9b4898e2943b3ae3718f5c786491f (patch) | |
tree | f86f672bd65e8a1aa16a5c57d5afff33ea8d5f13 | |
parent | 6978c673393a960d7caf604b8c72ff2b5fe0f4ec (diff) | |
download | guile-543328b5aed9b4898e2943b3ae3718f5c786491f.tar.gz |
reimplement weak tables using finalizers instead of disappearing links
* libguile/weak-table.c: Rewrite to use finalizers instead of
disappearing links. This will allow weak table associations to
persist beyond resuscitation of an object by a guardian. It also
removes the need to periodically vacuum the table.
* test-suite/tests/guardians.test: Add test for weak maps persisting
across guardian resuscitations.
-rw-r--r-- | libguile/weak-table.c | 617 | ||||
-rw-r--r-- | test-suite/tests/guardians.test | 24 |
2 files changed, 252 insertions, 389 deletions
diff --git a/libguile/weak-table.c b/libguile/weak-table.c index 49d5b6dc9..1cacde1df 100644 --- a/libguile/weak-table.c +++ b/libguile/weak-table.c @@ -57,9 +57,8 @@ trace the weak values. For doubly-weak tables, this means that the entries are allocated as an "atomic" piece of memory. Key-weak and value-weak tables use a special GC kind with a custom mark procedure. - When items are added weakly into table, a disappearing link is - registered to their locations. If the referent is collected, then - that link will be zeroed out. + When items are added weakly into table, we attach a finalizer onto + them that will remove them from the table if they become unreachable. An entry in the table consists of the key and the value, together with the hash code of the key. We munge hash codes so that they are @@ -80,10 +79,10 @@ right-shift the hash by one, divide by the size, and take the remainder. - 2. Since the weak references are stored in an atomic region with - disappearing links, they need to be accessed with the GC alloc - lock. `copy_weak_entry' will do that for you. The hash code - itself can be read outside the lock, though. + 2. Since the weak references are cleared using finalizers, and + finalizers can rnu during allocation, we need to be very careful + when allocating memory, because it might modify the table we are + working on. */ @@ -93,135 +92,135 @@ typedef struct { scm_t_bits value; } scm_t_weak_entry; +typedef struct { + scm_t_weak_entry *entries; /* the data */ + scm_i_pthread_mutex_t lock; /* the lock */ + scm_t_weak_table_kind kind; /* what kind of table it is */ + unsigned long size; /* total number of slots. */ + unsigned long n_items; /* number of items in table */ + unsigned long lower; /* when to shrink */ + unsigned long upper; /* when to grow */ + int size_index; /* index into hashtable_size */ + int min_size_index; /* minimum size_index */ +} scm_t_weak_table; -struct weak_entry_data { - scm_t_weak_entry *in; - scm_t_weak_entry *out; -}; - -static void* -do_copy_weak_entry (void *data) -{ - struct weak_entry_data *e = data; - e->out->hash = e->in->hash; - e->out->key = e->in->key; - e->out->value = e->in->value; +#define SCM_WEAK_TABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_table)) +#define SCM_VALIDATE_WEAK_TABLE(pos, arg) \ + SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_TABLE_P, "weak-table") +#define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x)) + - return NULL; + + +static void +lock_weak_table (scm_t_weak_table *table) +{ + scm_i_pthread_mutex_lock (&table->lock); } static void -copy_weak_entry (scm_t_weak_entry *src, scm_t_weak_entry *dst) +unlock_weak_table (scm_t_weak_table *table) { - struct weak_entry_data data; + scm_i_pthread_mutex_unlock (&table->lock); +} - data.in = src; - data.out = dst; - - GC_call_with_alloc_lock (do_copy_weak_entry, &data); + + +static void weak_table_remove_x (scm_t_weak_table *table, unsigned long hash, + scm_t_table_predicate_fn pred, void *closure); + +static int +key_eq_predicate (SCM x, SCM y, void *closure) +{ + return scm_is_eq (x, SCM_PACK_POINTER (closure)); } - -static void -register_disappearing_links (scm_t_weak_entry *entry, - SCM k, SCM v, - scm_t_weak_table_kind kind) + +static int +value_eq_predicate (SCM x, SCM y, void *closure) { - if (SCM_UNPACK (k) && SCM_HEAP_OBJECT_P (k) - && (kind == SCM_WEAK_TABLE_KIND_KEY - || kind == SCM_WEAK_TABLE_KIND_BOTH)) - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->key, - (GC_PTR) SCM2PTR (k)); - - if (SCM_UNPACK (v) && SCM_HEAP_OBJECT_P (v) - && (kind == SCM_WEAK_TABLE_KIND_VALUE - || kind == SCM_WEAK_TABLE_KIND_BOTH)) - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->value, - (GC_PTR) SCM2PTR (v)); + return scm_is_eq (y, SCM_PACK_POINTER (closure)); } static void -unregister_disappearing_links (scm_t_weak_entry *entry, - scm_t_weak_table_kind kind) +key_eq_finalizer (void *k, void *t) { - if (kind == SCM_WEAK_TABLE_KIND_KEY || kind == SCM_WEAK_TABLE_KIND_BOTH) - GC_unregister_disappearing_link ((GC_PTR) &entry->key); + SCM key = SCM_PACK_POINTER (k); + scm_t_weak_table *table = t; + weak_table_remove_x (table, scm_ihashq (key, -1), + key_eq_predicate, SCM_UNPACK_POINTER (key)); +} - if (kind == SCM_WEAK_TABLE_KIND_VALUE || kind == SCM_WEAK_TABLE_KIND_BOTH) - GC_unregister_disappearing_link ((GC_PTR) &entry->value); +struct finalizer_data { + scm_t_weak_table *table; + unsigned long hash; +}; + +static struct finalizer_data * +make_finalizer_data (scm_t_weak_table *t, unsigned long hash) +{ + struct finalizer_data *data; + data = scm_gc_malloc (sizeof (*data), "weak table finalizer"); + data->table = t; + data->hash = hash >> 1; + return data; } static void -move_disappearing_links (scm_t_weak_entry *from, scm_t_weak_entry *to, - SCM key, SCM value, scm_t_weak_table_kind kind) +key_finalizer (void *obj, void *data) { - if ((kind == SCM_WEAK_TABLE_KIND_KEY || kind == SCM_WEAK_TABLE_KIND_BOTH) - && SCM_HEAP_OBJECT_P (key)) - { -#ifdef HAVE_GC_MOVE_DISAPPEARING_LINK - GC_move_disappearing_link ((GC_PTR) &from->key, (GC_PTR) &to->key); -#else - GC_unregister_disappearing_link (&from->key); - SCM_I_REGISTER_DISAPPEARING_LINK (&to->key, SCM2PTR (key)); -#endif - } + struct finalizer_data *d = data; + weak_table_remove_x (d->table, d->hash, key_eq_predicate, obj); +} - if ((kind == SCM_WEAK_TABLE_KIND_VALUE || kind == SCM_WEAK_TABLE_KIND_BOTH) - && SCM_HEAP_OBJECT_P (value)) - { -#ifdef HAVE_GC_MOVE_DISAPPEARING_LINK - GC_move_disappearing_link ((GC_PTR) &from->value, (GC_PTR) &to->value); -#else - GC_unregister_disappearing_link (&from->value); - SCM_I_REGISTER_DISAPPEARING_LINK (&to->value, SCM2PTR (value)); -#endif - } +static void +value_finalizer (void *obj, void *data) +{ + struct finalizer_data *d = data; + weak_table_remove_x (d->table, d->hash, value_eq_predicate, obj); } static void -move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry *to, - scm_t_weak_table_kind kind) +register_finalizers_for_key (scm_t_weak_table *t, unsigned long hash, + SCM key) { - if (from->hash) - { - scm_t_weak_entry copy; - - copy_weak_entry (from, ©); - to->hash = copy.hash; - to->key = copy.key; - to->value = copy.value; - - move_disappearing_links (from, to, - SCM_PACK (copy.key), SCM_PACK (copy.value), - kind); - } + if (t->kind == SCM_WEAK_TABLE_KIND_VALUE) + return; + + if (!SCM_HEAP_OBJECT_P (key)) + return; + + if (t->kind == SCM_WEAK_TABLE_KIND_KEY + && hash == ((scm_ihashq (key, -1) << 1) | 0x1)) + scm_i_add_finalizer (SCM2PTR (key), key_eq_finalizer, t); else - { - to->hash = 0; - to->key = 0; - to->value = 0; - } + scm_i_add_finalizer (SCM2PTR (key), key_finalizer, + make_finalizer_data (t, hash)); } +static void +register_finalizers_for_value (scm_t_weak_table *t, unsigned long hash, + SCM value) +{ + if (t->kind == SCM_WEAK_TABLE_KIND_KEY) + return; -typedef struct { - scm_t_weak_entry *entries; /* the data */ - scm_i_pthread_mutex_t lock; /* the lock */ - scm_t_weak_table_kind kind; /* what kind of table it is */ - unsigned long size; /* total number of slots. */ - unsigned long n_items; /* number of items in table */ - unsigned long lower; /* when to shrink */ - unsigned long upper; /* when to grow */ - int size_index; /* index into hashtable_size */ - int min_size_index; /* minimum size_index */ -} scm_t_weak_table; + if (!SCM_HEAP_OBJECT_P (value)) + return; + scm_i_add_finalizer (SCM2PTR (value), value_finalizer, + make_finalizer_data (t, hash)); +} -#define SCM_WEAK_TABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_table)) -#define SCM_VALIDATE_WEAK_TABLE(pos, arg) \ - SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_TABLE_P, "weak-table") -#define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x)) + +static void +copy_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry *to) +{ + to->hash = from->hash; + to->key = from->key; + to->value = from->value; +} static unsigned long hash_to_index (unsigned long hash, unsigned long size) @@ -259,8 +258,7 @@ rob_from_rich (scm_t_weak_table *table, unsigned long k) do { unsigned long last = empty ? (empty - 1) : (size - 1); - move_weak_entry (&table->entries[last], &table->entries[empty], - table->kind); + copy_weak_entry (&table->entries[last], &table->entries[empty]); empty = last; } while (empty != k); @@ -280,25 +278,13 @@ give_to_poor (scm_t_weak_table *table, unsigned long k) { unsigned long next = (k + 1) % size; unsigned long hash; - scm_t_weak_entry copy; hash = table->entries[next].hash; if (!hash || hash_to_index (hash, size) == next) break; - copy_weak_entry (&table->entries[next], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference. */ - { - give_to_poor (table, next); - table->n_items--; - continue; - } - - move_weak_entry (&table->entries[next], &table->entries[k], - table->kind); + copy_weak_entry (&table->entries[next], &table->entries[k]); k = next; } @@ -480,11 +466,11 @@ resize_table (scm_t_weak_table *table) if (new_size_index == table->size_index) return; new_size = hashtable_size[new_size_index]; - scm_i_pthread_mutex_unlock (&table->lock); + unlock_weak_table (table); /* Allocating memory might cause finalizers to run, which could run anything, so drop our lock to avoid deadlocks. */ new_entries = allocate_entries (new_size, table->kind); - scm_i_pthread_mutex_unlock (&table->lock); + lock_weak_table (table); } while (!is_acceptable_size_index (table, new_size_index)); @@ -503,18 +489,12 @@ resize_table (scm_t_weak_table *table) for (old_k = 0; old_k < old_size; old_k++) { - scm_t_weak_entry copy; unsigned long new_k, distance; if (!old_entries[old_k].hash) continue; - copy_weak_entry (&old_entries[old_k], ©); - - if (!copy.key || !copy.value) - continue; - - new_k = hash_to_index (copy.hash, new_size); + new_k = hash_to_index (old_entries[old_k].hash, new_size); for (distance = 0; ; distance++, new_k = (new_k + 1) % new_size) { @@ -534,47 +514,8 @@ resize_table (scm_t_weak_table *table) } table->n_items++; - new_entries[new_k].hash = copy.hash; - new_entries[new_k].key = copy.key; - new_entries[new_k].value = copy.value; - - register_disappearing_links (&new_entries[new_k], - SCM_PACK (copy.key), SCM_PACK (copy.value), - table->kind); - } -} - -/* Run after GC via do_vacuum_weak_table, this function runs over the - whole table, removing lost weak references, reshuffling the table as it - goes. It might resize the table if it reaps enough entries. */ -static void -vacuum_weak_table (scm_t_weak_table *table) -{ - scm_t_weak_entry *entries = table->entries; - unsigned long size = table->size; - unsigned long k; - - for (k = 0; k < size; k++) - { - unsigned long hash = entries[k].hash; - - if (hash) - { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ - { - give_to_poor (table, k); - table->n_items--; - } - } + copy_weak_entry (&old_entries[old_k], &new_entries[new_k]); } - - if (table->n_items < table->lower) - resize_table (table); } @@ -588,49 +529,48 @@ weak_table_ref (scm_t_weak_table *table, unsigned long hash, unsigned long k, distance, size; scm_t_weak_entry *entries; + hash = (hash << 1) | 0x1; + + lock_weak_table (table); + + retry: size = table->size; entries = table->entries; - - hash = (hash << 1) | 0x1; k = hash_to_index (hash, size); for (distance = 0; distance < size; distance++, k = (k + 1) % size) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; + unsigned long other_hash = entries[k].hash; if (!other_hash) /* Not found. */ - return dflt; + break; if (hash == other_hash) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ - { - give_to_poor (table, k); - table->n_items--; - goto retry; - } + SCM key = SCM_PACK (entries[k].key); + SCM value = SCM_PACK (entries[k].value); - if (pred (SCM_PACK (copy.key), SCM_PACK (copy.value), closure)) + unlock_weak_table (table); + if (pred (key, value, closure)) /* Found. */ - return SCM_PACK (copy.value); + return value; + lock_weak_table (table); + + if (table->entries != entries || table->size != size + || !scm_is_eq (SCM_PACK (entries[k].key), key)) + /* The predicate caused the table to be changed. */ + goto retry; + + continue; } /* If the entry's distance is less, our key is not in the table. */ if (entry_distance (other_hash, k, size) < distance) - return dflt; + break; } - /* If we got here, then we were unfortunate enough to loop through the - whole table. Shouldn't happen, but hey. */ + unlock_weak_table (table); return dflt; } @@ -643,51 +583,66 @@ weak_table_put_x (scm_t_weak_table *table, unsigned long hash, unsigned long k, distance, size; scm_t_weak_entry *entries; + hash = (hash << 1) | 0x1; + + lock_weak_table (table); + + retry: size = table->size; entries = table->entries; - - hash = (hash << 1) | 0x1; k = hash_to_index (hash, size); for (distance = 0; ; distance++, k = (k + 1) % size) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; + unsigned long other_hash = entries[k].hash; if (!other_hash) /* Found an empty entry. */ break; - if (other_hash == hash) + if (hash == other_hash) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); + SCM prev_key = SCM_PACK (entries[k].key); + SCM prev_value = SCM_PACK (entries[k].value); + int have_match; + + unlock_weak_table (table); + have_match = pred (prev_key, prev_value, closure); + lock_weak_table (table); + + if (table->entries != entries || table->size != size + || !scm_is_eq (SCM_PACK (entries[k].key), prev_key)) + /* The predicate caused the table to be changed. */ + goto retry; + + if (!have_match) + /* No match, keep looking. */ + continue; - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ - { - give_to_poor (table, k); - table->n_items--; - goto retry; - } + /* We have a match; update the table and add finalizers if + needed. */ + entries[k].key = SCM_UNPACK (key); + entries[k].value = SCM_UNPACK (value); - if (pred (SCM_PACK (copy.key), SCM_PACK (copy.value), closure)) - /* Found an entry with this key. */ - break; + unlock_weak_table (table); + + if (!scm_is_eq (prev_key, key)) + register_finalizers_for_key (table, hash, key); + if (!scm_is_eq (prev_value, value)) + register_finalizers_for_value (table, hash, value); + + return; } if (table->n_items > table->upper) /* Full table, time to resize. */ { resize_table (table); - return weak_table_put_x (table, hash >> 1, pred, closure, key, value); + goto retry; } /* Displace the entry if our distance is less, otherwise keep - looking. */ + looking. */ if (entry_distance (other_hash, k, size) < distance) { rob_from_rich (table, k); @@ -695,16 +650,16 @@ weak_table_put_x (scm_t_weak_table *table, unsigned long hash, } } - if (entries[k].hash) - unregister_disappearing_links (&entries[k], table->kind); - else - table->n_items++; - + /* Insert a new entry. */ + table->n_items++; entries[k].hash = hash; entries[k].key = SCM_UNPACK (key); entries[k].value = SCM_UNPACK (value); - register_disappearing_links (&entries[k], key, value, table->kind); + unlock_weak_table (table); + + register_finalizers_for_key (table, hash, key); + register_finalizers_for_value (table, hash, value); } @@ -715,76 +670,66 @@ weak_table_remove_x (scm_t_weak_table *table, unsigned long hash, unsigned long k, distance, size; scm_t_weak_entry *entries; + hash = (hash << 1) | 0x1; + + lock_weak_table (table); + + retry: size = table->size; entries = table->entries; - - hash = (hash << 1) | 0x1; k = hash_to_index (hash, size); for (distance = 0; distance < size; distance++, k = (k + 1) % size) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; + unsigned long other_hash = entries[k].hash; if (!other_hash) /* Not found. */ - return; + break; - if (other_hash == hash) + if (hash == other_hash) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); + SCM prev_key = SCM_PACK (entries[k].key); + SCM prev_value = SCM_PACK (entries[k].value); + int have_match; + + unlock_weak_table (table); + have_match = pred (prev_key, prev_value, closure); + lock_weak_table (table); + + if (table->entries != entries || table->size != size + || !scm_is_eq (SCM_PACK (entries[k].key), prev_key)) + /* The predicate caused the table to be changed. */ + goto retry; + + if (!have_match) + /* No match, keep looking. */ + continue; - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ - { - give_to_poor (table, k); - table->n_items--; - goto retry; - } - - if (pred (SCM_PACK (copy.key), SCM_PACK (copy.value), closure)) - /* Found an entry with this key. */ - { - entries[k].hash = 0; - entries[k].key = 0; - entries[k].value = 0; - - unregister_disappearing_links (&entries[k], table->kind); + /* We have a match; remove the entry. */ + entries[k].hash = 0; + entries[k].key = 0; + entries[k].value = 0; - if (--table->n_items < table->lower) - resize_table (table); - else - give_to_poor (table, k); + if (--table->n_items < table->lower) + resize_table (table); + else + give_to_poor (table, k); - return; - } + break; } /* If the entry's distance is less, our key is not in the table. */ if (entry_distance (other_hash, k, size) < distance) - return; + break; } + + unlock_weak_table (table); } -static void -lock_weak_table (scm_t_weak_table *table) -{ - scm_i_pthread_mutex_lock (&table->lock); -} - -static void -unlock_weak_table (scm_t_weak_table *table) -{ - scm_i_pthread_mutex_unlock (&table->lock); -} - /* A weak table of weak tables, for use in the pthread_atfork handler. */ static SCM all_weak_tables = SCM_BOOL_F; @@ -796,7 +741,6 @@ lock_all_weak_tables (void) scm_t_weak_table *s; scm_t_weak_entry *entries; unsigned long k, size; - scm_t_weak_entry copy; s = SCM_WEAK_TABLE (all_weak_tables); lock_weak_table (s); @@ -805,11 +749,7 @@ lock_all_weak_tables (void) for (k = 0; k < size; k++) if (entries[k].hash) - { - copy_weak_entry (&entries[k], ©); - if (copy.key) - lock_weak_table (SCM_WEAK_TABLE (SCM_PACK (copy.key))); - } + lock_weak_table (SCM_WEAK_TABLE (SCM_PACK (entries[k].key))); } static void @@ -818,7 +758,6 @@ unlock_all_weak_tables (void) scm_t_weak_table *s; scm_t_weak_entry *entries; unsigned long k, size; - scm_t_weak_entry copy; s = SCM_WEAK_TABLE (all_weak_tables); size = s->size; @@ -826,11 +765,7 @@ unlock_all_weak_tables (void) for (k = 0; k < size; k++) if (entries[k].hash) - { - copy_weak_entry (&entries[k], ©); - if (copy.key) - unlock_weak_table (SCM_WEAK_TABLE (SCM_PACK (copy.key))); - } + unlock_weak_table (SCM_WEAK_TABLE (SCM_PACK (entries[k].key))); unlock_weak_table (s); } @@ -881,82 +816,10 @@ scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate) scm_puts_unlocked (">", port); } -static void -do_vacuum_weak_table (SCM table) -{ - scm_t_weak_table *t; - - t = SCM_WEAK_TABLE (table); - - if (scm_i_pthread_mutex_trylock (&t->lock) == 0) - { - vacuum_weak_table (t); - unlock_weak_table (t); - } - - return; -} - -/* The before-gc C hook only runs if GC_table_start_callback is available, - so if not, fall back on a finalizer-based implementation. */ -static int -weak_gc_callback (void **weak) -{ - void *val = weak[0]; - void (*callback) (SCM) = weak[1]; - - if (!val) - return 0; - - callback (SCM_PACK_POINTER (val)); - - return 1; -} - -#ifdef HAVE_GC_TABLE_START_CALLBACK -static void* -weak_gc_hook (void *hook_data, void *fn_data, void *data) -{ - if (!weak_gc_callback (fn_data)) - scm_c_hook_remove (&scm_before_gc_c_hook, weak_gc_hook, fn_data); - - return NULL; -} -#else -static void -weak_gc_finalizer (void *ptr, void *data) -{ - if (weak_gc_callback (ptr)) - scm_i_set_finalizer (ptr, weak_gc_finalizer, data); -} -#endif - -static void -scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM)) -{ - void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2); - - weak[0] = SCM_UNPACK_POINTER (obj); - weak[1] = (void*)callback; - GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj)); - -#ifdef HAVE_GC_TABLE_START_CALLBACK - scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0); -#else - scm_i_set_finalizer (weak, weak_gc_finalizer, NULL); -#endif -} - SCM scm_c_make_weak_table (unsigned long k, scm_t_weak_table_kind kind) { - SCM ret; - - ret = make_weak_table (k, kind); - - scm_c_register_weak_gc_callback (ret, do_vacuum_weak_table); - - return ret; + return make_weak_table (k, kind); } SCM @@ -971,20 +834,13 @@ scm_c_weak_table_ref (SCM table, unsigned long raw_hash, void *closure, SCM dflt) #define FUNC_NAME "weak-table-ref" { - SCM ret; scm_t_weak_table *t; SCM_VALIDATE_WEAK_TABLE (1, table); t = SCM_WEAK_TABLE (table); - lock_weak_table (t); - - ret = weak_table_ref (t, raw_hash, pred, closure, dflt); - - unlock_weak_table (t); - - return ret; + return weak_table_ref (t, raw_hash, pred, closure, dflt); } #undef FUNC_NAME @@ -1000,11 +856,7 @@ scm_c_weak_table_put_x (SCM table, unsigned long raw_hash, t = SCM_WEAK_TABLE (table); - lock_weak_table (t); - weak_table_put_x (t, raw_hash, pred, closure, key, value); - - unlock_weak_table (t); } #undef FUNC_NAME @@ -1020,20 +872,10 @@ scm_c_weak_table_remove_x (SCM table, unsigned long raw_hash, t = SCM_WEAK_TABLE (table); - lock_weak_table (t); - weak_table_remove_x (t, raw_hash, pred, closure); - - unlock_weak_table (t); } #undef FUNC_NAME -static int -assq_predicate (SCM x, SCM y, void *closure) -{ - return scm_is_eq (x, SCM_PACK_POINTER (closure)); -} - SCM scm_weak_table_refq (SCM table, SCM key, SCM dflt) { @@ -1041,7 +883,7 @@ scm_weak_table_refq (SCM table, SCM key, SCM dflt) dflt = SCM_BOOL_F; return scm_c_weak_table_ref (table, scm_ihashq (key, -1), - assq_predicate, SCM_UNPACK_POINTER (key), + key_eq_predicate, SCM_UNPACK_POINTER (key), dflt); } @@ -1049,7 +891,7 @@ SCM scm_weak_table_putq_x (SCM table, SCM key, SCM value) { scm_c_weak_table_put_x (table, scm_ihashq (key, -1), - assq_predicate, SCM_UNPACK_POINTER (key), + key_eq_predicate, SCM_UNPACK_POINTER (key), key, value); return SCM_UNSPECIFIED; } @@ -1058,7 +900,7 @@ SCM scm_weak_table_remq_x (SCM table, SCM key) { scm_c_weak_table_remove_x (table, scm_ihashq (key, -1), - assq_predicate, SCM_UNPACK_POINTER (key)); + key_eq_predicate, SCM_UNPACK_POINTER (key)); return SCM_UNSPECIFIED; } @@ -1102,19 +944,18 @@ scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure, { if (entries[k].hash) { - scm_t_weak_entry copy; + SCM key, value; + + key = SCM_PACK (entries[k].key); + value = SCM_PACK (entries[k].value); - copy_weak_entry (&entries[k], ©); - - if (copy.key && copy.value) - { - /* Release table lock while we call the function. */ - unlock_weak_table (t); - init = proc (closure, - SCM_PACK (copy.key), SCM_PACK (copy.value), - init); - lock_weak_table (t); - } + /* Release table lock while we call the function. */ + unlock_weak_table (t); + init = proc (closure, key, value, init); + lock_weak_table (t); + if (entries != t->entries) + /* Nothing sensible to do here; just break out. */ + break; } } diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test index 470de4569..bf5524a3e 100644 --- a/test-suite/tests/guardians.test +++ b/test-suite/tests/guardians.test @@ -1,7 +1,7 @@ ;;;; guardians.test --- test suite for Guile Guardians -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- July 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006, 2012 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 @@ -318,3 +318,25 @@ #t) ) + +(with-test-prefix "guardians and weak references" + (let ((p (make-object-property)) + (g (make-guardian)) + (x (list 100))) + (set! (p x) 100) + (pass-if "(p x) (1)" + (equal? (p x) 100)) + (g x) + (pass-if "(p x) (2)" + (equal? (p x) 100)) + (set! x #f) + (gc) (gc) (gc) (gc) + (set! x (g)) + (pass-if "(g) => x" + (if (not x) + (throw 'unresolved) + (equal? x '(100)))) + (pass-if "(p x) (3)" + (if (not x) + (throw 'unresolved) + (equal? (p x) 100))))) |