diff --git a/libguile/weak-table.c b/libguile/weak-table.c index 599c4cf0e..461d4a47c 100644 --- a/libguile/weak-table.c +++ b/libguile/weak-table.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc. +/* Copyright (C) 2011, 2012, 2013, 2014, 2017 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 @@ -25,13 +25,12 @@ #include #include "libguile/bdw-gc.h" -#include +#include #include "libguile/_scm.h" #include "libguile/hash.h" #include "libguile/eval.h" #include "libguile/ports.h" - #include "libguile/validate.h" #include "libguile/weak-list.h" #include "libguile/weak-table.h" @@ -44,83 +43,62 @@ data, but when you don't have space to store the data in the object. For example, procedure properties are implemented with weak tables. - Weak tables are implemented using an open-addressed hash table. - Basically this means that there is an array of entries, and the item - is expected to be found the slot corresponding to its hash code, - modulo the length of the array. - - Collisions are handled using linear probing with the Robin Hood - technique. See Pedro Celis' paper, "Robin Hood Hashing": - - http://www.cs.uwaterloo.ca/research/tr/1986/CS-86-14.pdf - - The vector of entries is allocated in such a way that the GC doesn't - 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. + This is a normal bucket-and-chain hash table, except that the chain + entries are allocated in such a way that the GC doesn't 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. 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 - never 0. In this way we can detect removed entries (key of zero but - nonzero hash code), and can then reshuffle elements as needed to - maintain the robin hood ordering. + with the hash code of the key. - Compared to buckets-and-chains hash tables, open addressing has the - advantage that it is very cache-friendly. It also uses less memory. - - Implementation-wise, there are two things to note. - - 1. We assume that hash codes are evenly distributed across the - range of unsigned longs. The actual hash code stored in the - entry is left-shifted by 1 bit (losing 1 bit of hash precision), - and then or'd with 1. In this way we ensure that the hash field - of an occupied entry is nonzero. To map to an index, we - 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. + Note that since the weak references are stored in an atomic region + with disappearing links, they need to be accessed with the GC alloc + lock. `read_weak_entry' will do that for you. The hash code itself + can be read outside the lock, though. */ -typedef struct { +typedef struct scm_weak_entry scm_t_weak_entry; + +struct scm_weak_entry { unsigned long hash; + scm_t_weak_entry *next; scm_t_bits key; scm_t_bits value; -} scm_t_weak_entry; +}; struct weak_entry_data { - scm_t_weak_entry *in; - scm_t_weak_entry *out; + scm_t_weak_entry *entry; + scm_t_bits key; + scm_t_bits value; }; static void* -do_copy_weak_entry (void *data) +do_read_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; + e->key = e->entry->key; + e->value = e->entry->value; return NULL; } static void -copy_weak_entry (scm_t_weak_entry *src, scm_t_weak_entry *dst) +read_weak_entry (scm_t_weak_entry *entry, scm_t_bits *key, scm_t_bits *value) { struct weak_entry_data data; - data.in = src; - data.out = dst; - - GC_call_with_alloc_lock (do_copy_weak_entry, &data); + data.entry = entry; + GC_call_with_alloc_lock (do_read_weak_entry, &data); + + *key = data.key; + *value = data.value; } static void @@ -152,64 +130,17 @@ unregister_disappearing_links (scm_t_weak_entry *entry, GC_unregister_disappearing_link ((void **) &entry->value); } -#ifndef HAVE_GC_MOVE_DISAPPEARING_LINK -static void -GC_move_disappearing_link (void **from, void **to) -{ - GC_unregister_disappearing_link (from); - SCM_I_REGISTER_DISAPPEARING_LINK (to, *to); -} -#endif - -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) -{ - if ((kind == SCM_WEAK_TABLE_KIND_KEY || kind == SCM_WEAK_TABLE_KIND_BOTH) - && SCM_HEAP_OBJECT_P (key)) - GC_move_disappearing_link ((void **) &from->key, (void **) &to->key); - - if ((kind == SCM_WEAK_TABLE_KIND_VALUE || kind == SCM_WEAK_TABLE_KIND_BOTH) - && SCM_HEAP_OBJECT_P (value)) - GC_move_disappearing_link ((void **) &from->value, (void **) &to->value); -} - -static void -move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry *to, - scm_t_weak_table_kind kind) -{ - 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); - } - else - { - to->hash = 0; - to->key = 0; - to->value = 0; - } -} - - typedef struct { - scm_t_weak_entry *entries; /* the data */ + scm_t_weak_entry **buckets; /* 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_buckets; /* total number of buckets. */ 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 */ + GC_word last_gc_no; } scm_t_weak_table; @@ -219,171 +150,52 @@ typedef struct { #define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x)) -static unsigned long -hash_to_index (unsigned long hash, unsigned long size) -{ - return (hash >> 1) % size; -} - -static unsigned long -entry_distance (unsigned long hash, unsigned long k, unsigned long size) -{ - unsigned long origin = hash_to_index (hash, size); - - if (k >= origin) - return k - origin; - else - /* The other key was displaced and wrapped around. */ - return size - origin + k; -} - -static void -rob_from_rich (scm_t_weak_table *table, unsigned long k) -{ - unsigned long empty, size; - - size = table->size; - - /* If we are to free up slot K in the table, we need room to do so. */ - assert (table->n_items < size); - - empty = k; - do - empty = (empty + 1) % size; - while (table->entries[empty].hash); - - do - { - unsigned long last = empty ? (empty - 1) : (size - 1); - move_weak_entry (&table->entries[last], &table->entries[empty], - table->kind); - empty = last; - } - while (empty != k); - - table->entries[empty].hash = 0; - table->entries[empty].key = 0; - table->entries[empty].value = 0; -} - -static void -give_to_poor (scm_t_weak_table *table, unsigned long k) -{ - /* Slot K was just freed up; possibly shuffle others down. */ - unsigned long size = table->size; - - while (1) - { - 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); - - k = next; - } - - /* We have shuffled down any entries that should be shuffled down; now - free the end. */ - table->entries[k].hash = 0; - table->entries[k].key = 0; - table->entries[k].value = 0; -} - - -/* The GC "kinds" for singly-weak tables. */ -static int weak_key_gc_kind; -static int weak_value_gc_kind; - -static struct GC_ms_entry * -mark_weak_key_table (GC_word *addr, struct GC_ms_entry *mark_stack_ptr, - struct GC_ms_entry *mark_stack_limit, GC_word env) -{ - scm_t_weak_entry *entries = (scm_t_weak_entry*) addr; - unsigned long k, size = GC_size (addr) / sizeof (scm_t_weak_entry); - - for (k = 0; k < size; k++) - if (entries[k].hash && entries[k].key) - { - SCM value = SCM_PACK (entries[k].value); - mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM2PTR (value), - mark_stack_ptr, mark_stack_limit, - NULL); - } - - return mark_stack_ptr; -} - -static struct GC_ms_entry * -mark_weak_value_table (GC_word *addr, struct GC_ms_entry *mark_stack_ptr, - struct GC_ms_entry *mark_stack_limit, GC_word env) -{ - scm_t_weak_entry *entries = (scm_t_weak_entry*) addr; - unsigned long k, size = GC_size (addr) / sizeof (scm_t_weak_entry); - - for (k = 0; k < size; k++) - if (entries[k].hash && entries[k].value) - { - SCM key = SCM_PACK (entries[k].key); - mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM2PTR (key), - mark_stack_ptr, mark_stack_limit, - NULL); - } - - return mark_stack_ptr; -} +/* GC descriptors for the various kinds of scm_t_weak_entry. */ +static GC_descr weak_key_descr; +static GC_descr weak_value_descr; +static GC_descr doubly_weak_descr; static scm_t_weak_entry * -allocate_entries (unsigned long size, scm_t_weak_table_kind kind) +allocate_entry (scm_t_weak_table_kind kind) { scm_t_weak_entry *ret; - size_t bytes = size * sizeof (*ret); switch (kind) { case SCM_WEAK_TABLE_KIND_KEY: - ret = GC_generic_malloc (bytes, weak_key_gc_kind); + ret = GC_malloc_explicitly_typed (sizeof (*ret), weak_key_descr); break; case SCM_WEAK_TABLE_KIND_VALUE: - ret = GC_generic_malloc (bytes, weak_value_gc_kind); + ret = GC_malloc_explicitly_typed (sizeof (*ret), weak_value_descr); break; case SCM_WEAK_TABLE_KIND_BOTH: - ret = scm_gc_malloc_pointerless (bytes, "weak-table"); + ret = GC_malloc_explicitly_typed (sizeof (*ret), doubly_weak_descr); break; default: abort (); } - memset (ret, 0, bytes); - return ret; } +static void +add_entry (scm_t_weak_table *table, scm_t_weak_entry *entry) +{ + unsigned long bucket = entry->hash % table->n_buckets; + entry->next = table->buckets[bucket]; + table->buckets[bucket] = entry; + table->n_items++; +} + /* Growing or shrinking is triggered when the load factor * * L = N / S (N: number of items in table, S: bucket vector length) * - * passes an upper limit of 0.9 or a lower limit of 0.2. + * passes an upper limit of 0.9 or a lower limit of 0.25. * * The implementation stores the upper and lower number of items which * trigger a resize in the hashtable object. @@ -400,168 +212,97 @@ static unsigned long hashtable_size[] = { #define HASHTABLE_SIZE_N (sizeof(hashtable_size)/sizeof(unsigned long)) -static int -compute_size_index (scm_t_weak_table *table) -{ - int i = table->size_index; - - if (table->n_items < table->lower) - { - /* rehashing is not triggered when i <= min_size */ - do - --i; - while (i > table->min_size_index - && table->n_items < hashtable_size[i] / 5); - } - else if (table->n_items > table->upper) - { - ++i; - if (i >= HASHTABLE_SIZE_N) - /* The biggest size currently is 230096423, which for a 32-bit - machine will occupy 2.3GB of memory at a load of 80%. There - is probably something better to do here, but if you have a - weak map of that size, you are hosed in any case. */ - abort (); - } - - return i; -} - -static int -is_acceptable_size_index (scm_t_weak_table *table, int size_index) -{ - int computed = compute_size_index (table); - - if (size_index == computed) - /* We were going to grow or shrink, and allocating the new vector - didn't change the target size. */ - return 1; - - if (size_index == computed + 1) - { - /* We were going to enlarge the table, but allocating the new - vector finalized some objects, making an enlargement - unnecessary. It might still be a good idea to use the larger - table, though. (This branch also gets hit if, while allocating - the vector, some other thread was actively removing items from - the table. That is less likely, though.) */ - unsigned long new_lower = hashtable_size[size_index] / 5; - - return table->size > new_lower; - } - - if (size_index == computed - 1) - { - /* We were going to shrink the table, but when we dropped the lock - to allocate the new vector, some other thread added elements to - the table. */ - return 0; - } - - /* The computed size differs from our newly allocated size by more - than one size index -- recalculate. */ - return 0; -} - static void resize_table (scm_t_weak_table *table) { - scm_t_weak_entry *old_entries, *new_entries; + scm_t_weak_entry **old_buckets, **new_buckets; int new_size_index; - unsigned long old_size, new_size, old_k; + unsigned long old_n_buckets, new_n_buckets, old_k; - do + new_size_index = table->size_index; + if (table->n_items < table->lower) { - new_size_index = compute_size_index (table); - if (new_size_index == table->size_index) - return; - new_size = hashtable_size[new_size_index]; - new_entries = allocate_entries (new_size, table->kind); + /* Rehashing is not triggered when i <= min_size. */ + do + new_size_index -= 1; + while (new_size_index > table->min_size_index + && table->n_items < hashtable_size[new_size_index] / 4); } - while (!is_acceptable_size_index (table, new_size_index)); + else if (table->n_items > table->upper) + { + new_size_index += 1; + if (new_size_index >= HASHTABLE_SIZE_N) + /* Limit max bucket count. */ + return; + } + else + /* Nothing to do. */ + return; - old_entries = table->entries; - old_size = table->size; + new_n_buckets = hashtable_size[new_size_index]; + new_buckets = scm_gc_malloc (sizeof (*new_buckets) * new_n_buckets, + "weak table buckets"); + + old_buckets = table->buckets; + old_n_buckets = table->n_buckets; table->size_index = new_size_index; - table->size = new_size; + table->n_buckets = new_n_buckets; if (new_size_index <= table->min_size_index) table->lower = 0; else - table->lower = new_size / 5; - table->upper = 9 * new_size / 10; + table->lower = new_n_buckets / 4; + table->upper = 9 * new_n_buckets / 10; table->n_items = 0; - table->entries = new_entries; + table->buckets = new_buckets; - for (old_k = 0; old_k < old_size; old_k++) + for (old_k = 0; old_k < old_n_buckets; 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); - - for (distance = 0; ; distance++, new_k = (new_k + 1) % new_size) + scm_t_weak_entry *entry = old_buckets[old_k]; + while (entry) { - unsigned long other_hash = new_entries[new_k].hash; - - if (!other_hash) - /* Found an empty entry. */ - break; - - /* Displace the entry if our distance is less, otherwise keep - looking. */ - if (entry_distance (other_hash, new_k, new_size) < distance) - { - rob_from_rich (table, new_k); - break; - } + scm_t_weak_entry *next = entry->next; + entry->next = NULL; + add_entry (table, entry); + entry = next; } - - 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. */ + goes. It might resize the table if it reaps enough buckets. */ static void vacuum_weak_table (scm_t_weak_table *table) { - scm_t_weak_entry *entries = table->entries; - unsigned long size = table->size; + GC_word gc_no = GC_get_gc_no (); unsigned long k; - for (k = 0; k < size; k++) + if (gc_no == table->last_gc_no) + return; + + table->last_gc_no = gc_no; + + for (k = 0; k < table->n_buckets; k++) { - unsigned long hash = entries[k].hash; - - if (hash) + scm_t_weak_entry **loc = table->buckets + k; + scm_t_weak_entry *entry; + + for (entry = *loc; entry; entry = *loc) { - scm_t_weak_entry copy; + scm_t_bits key, value; - copy_weak_entry (&entries[k], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ + read_weak_entry (entry, &key, &value); + if (!key || !value) + /* Lost weak reference; prune entry. */ { - give_to_poor (table, k); + *loc = entry->next; table->n_items--; + entry->next = NULL; + unregister_disappearing_links (entry, table->kind); } + else + loc = &entry->next; } } @@ -577,52 +318,22 @@ weak_table_ref (scm_t_weak_table *table, unsigned long hash, scm_t_table_predicate_fn pred, void *closure, SCM dflt) { - unsigned long k, distance, size; - scm_t_weak_entry *entries; - - size = table->size; - entries = table->entries; + unsigned long bucket = hash % table->n_buckets; + scm_t_weak_entry *entry; - hash = (hash << 1) | 0x1; - k = hash_to_index (hash, size); - - for (distance = 0; distance < size; distance++, k = (k + 1) % size) + for (entry = table->buckets[bucket]; entry; entry = entry->next) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; - - if (!other_hash) - /* Not found. */ - return dflt; - - if (hash == other_hash) + if (entry->hash == hash) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); + scm_t_bits key, value; - 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)) + read_weak_entry (entry, &key, &value); + if (key && value && pred (SCM_PACK (key), SCM_PACK (value), closure)) /* Found. */ - return SCM_PACK (copy.value); + return SCM_PACK (value); } - - /* If the entry's distance is less, our key is not in the table. */ - if (entry_distance (other_hash, k, size) < distance) - return dflt; } - /* If we got here, then we were unfortunate enough to loop through the - whole table. Shouldn't happen, but hey. */ return dflt; } @@ -632,81 +343,37 @@ weak_table_put_x (scm_t_weak_table *table, unsigned long hash, scm_t_table_predicate_fn pred, void *closure, SCM key, SCM value) { - unsigned long k, distance, size; - scm_t_weak_entry *entries; - - size = table->size; - entries = table->entries; + unsigned long bucket = hash % table->n_buckets; + scm_t_weak_entry *entry; - hash = (hash << 1) | 0x1; - k = hash_to_index (hash, size); - - for (distance = 0; ; distance++, k = (k + 1) % size) + for (entry = table->buckets[bucket]; entry; entry = entry->next) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; - - if (!other_hash) - /* Found an empty entry. */ - break; - - if (other_hash == hash) + if (entry->hash == hash) { - scm_t_weak_entry copy; + scm_t_bits k, v; - copy_weak_entry (&entries[k], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ + read_weak_entry (entry, &k, &v); + if (k && v && pred (SCM_PACK (k), SCM_PACK (v), closure)) { - give_to_poor (table, k); - table->n_items--; - goto retry; + unregister_disappearing_links (entry, table->kind); + key = SCM_PACK (k); + entry->value = SCM_UNPACK (value); + register_disappearing_links (entry, key, value, table->kind); + return; } - - if (pred (SCM_PACK (copy.key), SCM_PACK (copy.value), closure)) - /* Found an entry with this key. */ - break; - } - - 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); - } - - /* Displace the entry if our distance is less, otherwise keep - looking. */ - if (entry_distance (other_hash, k, size) < distance) - { - rob_from_rich (table, k); - break; } } - - /* Fast path for updated values for existing entries of weak-key - tables. */ - if (table->kind == SCM_WEAK_TABLE_KIND_KEY && - entries[k].hash == hash && - entries[k].key == SCM_UNPACK (key)) - { - entries[k].value = SCM_UNPACK (value); - return; - } - if (entries[k].hash) - unregister_disappearing_links (&entries[k], table->kind); - else - table->n_items++; + if (table->n_items > table->upper) + /* Full table, time to resize. */ + resize_table (table); - 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); + entry = allocate_entry (table->kind); + entry->hash = hash; + entry->key = SCM_UNPACK (key); + entry->value = SCM_UNPACK (value); + register_disappearing_links (entry, key, value, table->kind); + add_entry (table, entry); } @@ -714,62 +381,34 @@ static void weak_table_remove_x (scm_t_weak_table *table, unsigned long hash, scm_t_table_predicate_fn pred, void *closure) { - unsigned long k, distance, size; - scm_t_weak_entry *entries; - - size = table->size; - entries = table->entries; + unsigned long bucket = hash % table->n_buckets; + scm_t_weak_entry **loc = table->buckets + bucket; + scm_t_weak_entry *entry; - hash = (hash << 1) | 0x1; - k = hash_to_index (hash, size); - - for (distance = 0; distance < size; distance++, k = (k + 1) % size) + for (entry = *loc; entry; entry = *loc) { - unsigned long other_hash; - - retry: - other_hash = entries[k].hash; - - if (!other_hash) - /* Not found. */ - return; - - if (other_hash == hash) + if (entry->hash == hash) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); - - if (!copy.key || !copy.value) - /* Lost weak reference; reshuffle. */ + scm_t_bits k, v; + + read_weak_entry (entry, &k, &v); + if (k && v && pred (SCM_PACK (k), SCM_PACK (v), closure)) { - give_to_poor (table, k); + *loc = entry->next; table->n_items--; - goto retry; - } + entry->next = NULL; + unregister_disappearing_links (entry, table->kind); - 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); - - if (--table->n_items < table->lower) + if (table->n_items < table->lower) resize_table (table); - else - give_to_poor (table, k); return; } } - - /* If the entry's distance is less, our key is not in the table. */ - if (entry_distance (other_hash, k, size) < distance) - return; + loc = &entry->next; } + + return; } @@ -785,14 +424,16 @@ make_weak_table (unsigned long k, scm_t_weak_table_kind kind) n = hashtable_size[i]; table = scm_gc_malloc (sizeof (*table), "weak-table"); - table->entries = allocate_entries (n, kind); + table->buckets = scm_gc_malloc (sizeof (*table->buckets) * n, + "weak table buckets"); table->kind = kind; table->n_items = 0; - table->size = n; + table->n_buckets = n; table->lower = 0; table->upper = 9 * n / 10; table->size_index = i; table->min_size_index = i; + table->last_gc_no = GC_get_gc_no (); scm_i_pthread_mutex_init (&table->lock, NULL); return scm_cell (scm_tc7_weak_table, (scm_t_bits)table); @@ -805,7 +446,7 @@ scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate) scm_puts ("weak-table ", port); scm_uintprint (SCM_WEAK_TABLE (exp)->n_items, 10, port); scm_putc ('/', port); - scm_uintprint (SCM_WEAK_TABLE (exp)->size, 10, port); + scm_uintprint (SCM_WEAK_TABLE (exp)->n_buckets, 10, port); scm_puts (">", port); } @@ -822,8 +463,10 @@ do_vacuum_weak_table (SCM table) custom predicate, or via finalizers run explicitly by (gc) or in an async (for non-threaded Guile). We add a restriction that prohibits the first case, by convention. But since we can't - prohibit the second case, here we trylock instead of lock. Not so - nice. */ + prohibit the second case, here we trylock instead of lock. In any + case, if the mutex is held by another thread, then the table is in + active use, so the next user of the table will handle the vacuum + for us. */ if (scm_i_pthread_mutex_trylock (&t->lock) == 0) { vacuum_weak_table (t); @@ -879,6 +522,8 @@ scm_c_weak_table_ref (SCM table, unsigned long raw_hash, scm_i_pthread_mutex_lock (&t->lock); + vacuum_weak_table (t); + ret = weak_table_ref (t, raw_hash, pred, closure, dflt); scm_i_pthread_mutex_unlock (&t->lock); @@ -901,6 +546,8 @@ scm_c_weak_table_put_x (SCM table, unsigned long raw_hash, scm_i_pthread_mutex_lock (&t->lock); + vacuum_weak_table (t); + weak_table_put_x (t, raw_hash, pred, closure, key, value); scm_i_pthread_mutex_unlock (&t->lock); @@ -921,6 +568,8 @@ scm_c_weak_table_remove_x (SCM table, unsigned long raw_hash, scm_i_pthread_mutex_lock (&t->lock); + vacuum_weak_table (t); + weak_table_remove_x (t, raw_hash, pred, closure); scm_i_pthread_mutex_unlock (&t->lock); @@ -961,6 +610,8 @@ scm_weak_table_clear_x (SCM table) #define FUNC_NAME "weak-table-clear!" { scm_t_weak_table *t; + unsigned long k; + scm_t_weak_entry *entry; SCM_VALIDATE_WEAK_TABLE (1, table); @@ -968,7 +619,14 @@ scm_weak_table_clear_x (SCM table) scm_i_pthread_mutex_lock (&t->lock); - memset (t->entries, 0, sizeof (scm_t_weak_entry) * t->size); + t->last_gc_no = GC_get_gc_no (); + + for (k = 0; k < t->n_buckets; k++) + { + for (entry = t->buckets[k]; entry; entry = entry->next) + unregister_disappearing_links (entry, t->kind); + t->buckets[k] = NULL; + } t->n_items = 0; scm_i_pthread_mutex_unlock (&t->lock); @@ -980,38 +638,34 @@ scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure, SCM init, SCM table) { scm_t_weak_table *t; - scm_t_weak_entry *entries; - unsigned long k, size; + unsigned long k; + SCM alist = SCM_EOL; t = SCM_WEAK_TABLE (table); scm_i_pthread_mutex_lock (&t->lock); - size = t->size; - entries = t->entries; + vacuum_weak_table (t); - for (k = 0; k < size; k++) + for (k = 0; k < t->n_buckets; k++) { - if (entries[k].hash) + scm_t_weak_entry *entry; + for (entry = t->buckets[k]; entry; entry = entry->next) { - scm_t_weak_entry copy; - - copy_weak_entry (&entries[k], ©); + scm_t_bits key, value; + read_weak_entry (entry, &key, &value); - if (copy.key && copy.value) - { - /* Release table lock while we call the function. */ - scm_i_pthread_mutex_unlock (&t->lock); - init = proc (closure, - SCM_PACK (copy.key), SCM_PACK (copy.value), - init); - scm_i_pthread_mutex_lock (&t->lock); - } + if (key && value) + alist = scm_acons (SCM_PACK (key), SCM_PACK (value), alist); } } scm_i_pthread_mutex_unlock (&t->lock); + /* Call the proc outside the lock. */ + for (; !scm_is_null (alist); alist = scm_cdr (alist)) + init = proc (closure, scm_caar (alist), scm_cdar (alist), init); + return init; } @@ -1155,14 +809,23 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, void scm_weak_table_prehistory (void) { - weak_key_gc_kind = - GC_new_kind (GC_new_free_list (), - GC_MAKE_PROC (GC_new_proc (mark_weak_key_table), 0), - 0, 0); - weak_value_gc_kind = - GC_new_kind (GC_new_free_list (), - GC_MAKE_PROC (GC_new_proc (mark_weak_value_table), 0), - 0, 0); + GC_word weak_key_bitmap[GC_BITMAP_SIZE (scm_t_weak_entry)] = { 0 }; + GC_word weak_value_bitmap[GC_BITMAP_SIZE (scm_t_weak_entry)] = { 0 }; + GC_word doubly_weak_bitmap[GC_BITMAP_SIZE (scm_t_weak_entry)] = { 0 }; + + GC_set_bit (weak_key_bitmap, GC_WORD_OFFSET (scm_t_weak_entry, next)); + GC_set_bit (weak_value_bitmap, GC_WORD_OFFSET (scm_t_weak_entry, next)); + GC_set_bit (doubly_weak_bitmap, GC_WORD_OFFSET (scm_t_weak_entry, next)); + + GC_set_bit (weak_key_bitmap, GC_WORD_OFFSET (scm_t_weak_entry, value)); + GC_set_bit (weak_value_bitmap, GC_WORD_OFFSET (scm_t_weak_entry, key)); + + weak_key_descr = GC_make_descriptor (weak_key_bitmap, + GC_WORD_LEN (scm_t_weak_entry)); + weak_value_descr = GC_make_descriptor (weak_value_bitmap, + GC_WORD_LEN (scm_t_weak_entry)); + doubly_weak_descr = GC_make_descriptor (doubly_weak_bitmap, + GC_WORD_LEN (scm_t_weak_entry)); } void