diff options
Diffstat (limited to 'libguile/hashtab.c')
-rw-r--r-- | libguile/hashtab.c | 100 |
1 files changed, 79 insertions, 21 deletions
diff --git a/libguile/hashtab.c b/libguile/hashtab.c index f3887c213..a76c03812 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -33,6 +33,7 @@ #include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/ports.h" +#include "libguile/bdw-gc.h" #include "libguile/validate.h" #include "libguile/hashtab.h" @@ -120,6 +121,26 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items) return result; } +static void +vacuum_weak_hash_table (SCM table) +{ + SCM buckets = SCM_HASHTABLE_VECTOR (table); + unsigned long k = SCM_SIMPLE_VECTOR_LENGTH (buckets); + size_t len = SCM_HASHTABLE_N_ITEMS (table); + + while (k--) + { + size_t removed; + SCM alist = SCM_SIMPLE_VECTOR_REF (buckets, k); + alist = scm_fixup_weak_alist (alist, &removed); + assert (removed <= len); + len -= removed; + SCM_SIMPLE_VECTOR_SET (buckets, k, alist); + } + + SCM_SET_HASHTABLE_N_ITEMS (table, len); +} + /* Packed arguments for `do_weak_bucket_fixup'. */ struct t_fixup_args @@ -397,6 +418,34 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0, } #undef FUNC_NAME +static void +weak_gc_callback (void *ptr, void *data) +{ + void **weak = ptr; + void *val = *weak; + + if (val) + { + void (*callback) (SCM) = data; + + GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_callback, data, NULL, NULL); + + callback (PTR2SCM (val)); + } +} + +static void +scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM)) +{ + void **weak = GC_MALLOC_ATOMIC (sizeof (void**)); + + *weak = SCM2PTR (obj); + GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj)); + + GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_callback, (void*)callback, + NULL, NULL); +} + SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0, (SCM n), "@deffnx {Scheme Procedure} make-weak-value-hash-table size\n" @@ -407,11 +456,17 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0, "would modify regular hash tables. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_key_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME); else - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, - scm_to_ulong (n), FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME @@ -422,13 +477,17 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 0, 1, "(@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_value_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME); else - { - return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, - scm_to_ulong (n), FUNC_NAME); - } + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME @@ -439,16 +498,18 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0 "buckets. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_doubly_weak_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, - 0, - FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, + 0, FUNC_NAME); else - { - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, - scm_to_ulong (n), - FUNC_NAME); - } + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME @@ -651,12 +712,9 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, } SCM_SETCDR (new_bucket, SCM_SIMPLE_VECTOR_REF (buckets, k)); SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket); - /* Update element count and maybe rehash the table. The - table might have too few entries here since weak hash - tables used with the hashx_* functions can not be - rehashed after GC. - */ SCM_HASHTABLE_INCREMENT (table); + + /* Maybe rehash the table. */ if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table) || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) scm_i_rehash (table, hash_fn, closure, FUNC_NAME); |