diff options
Diffstat (limited to 'libguile/hashtab.c')
-rw-r--r-- | libguile/hashtab.c | 78 |
1 files changed, 71 insertions, 7 deletions
diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 48660d75c..37d168cf4 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -761,21 +761,56 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, +struct set_weak_cdr_data +{ + SCM pair; + SCM new_val; +}; + +static void* +set_weak_cdr (void *data) +{ + struct set_weak_cdr_data *d = data; + + if (SCM_NIMP (SCM_WEAK_PAIR_CDR (d->pair)) && !SCM_NIMP (d->new_val)) + { + GC_unregister_disappearing_link ((void *) SCM_CDRLOC (d->pair)); + SCM_SETCDR (d->pair, d->new_val); + } + else + { + SCM_SETCDR (d->pair, d->new_val); + SCM_I_REGISTER_DISAPPEARING_LINK ((void *) SCM_CDRLOC (d->pair), + SCM2PTR (d->new_val)); + } + return NULL; +} + SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void *closure) { - SCM it; + SCM pair; - it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn, closure); - SCM_SETCDR (it, val); + pair = scm_hash_fn_create_handle_x (table, obj, val, + hash_fn, assoc_fn, closure); - if (SCM_HASHTABLE_WEAK_VALUE_P (table) && SCM_NIMP (val)) - /* IT is a weak-cdr pair. Register a disappearing link from IT's - cdr to VAL like `scm_weak_cdr_pair' does. */ - SCM_I_REGISTER_DISAPPEARING_LINK ((void *) SCM_CDRLOC (it), SCM2PTR (val)); + if (SCM_UNLIKELY (!scm_is_eq (SCM_CDR (pair), val))) + { + if (SCM_UNLIKELY (SCM_HASHTABLE_WEAK_VALUE_P (table))) + { + struct set_weak_cdr_data data; + data.pair = pair; + data.new_val = val; + + GC_call_with_alloc_lock (set_weak_cdr, &data); + } + else + SCM_SETCDR (pair, val); + } + return val; } @@ -843,6 +878,9 @@ SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0, "Uses @code{eq?} for equality testing.") #define FUNC_NAME s_scm_hashq_get_handle { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, @@ -858,6 +896,9 @@ SCM_DEFINE (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashq_create_handle_x { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, @@ -924,6 +965,9 @@ SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0, "Uses @code{eqv?} for equality testing.") #define FUNC_NAME s_scm_hashv_get_handle { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, @@ -939,6 +983,9 @@ SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashv_create_handle_x { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, @@ -1003,6 +1050,9 @@ SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0, "Uses @code{equal?} for equality testing.") #define FUNC_NAME s_scm_hash_get_handle { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, @@ -1018,6 +1068,9 @@ SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hash_create_handle_x { + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, @@ -1117,6 +1170,10 @@ SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; + + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_get_handle (table, key, scm_ihashx, scm_sloppy_assx, (void *) &closure); } @@ -1136,6 +1193,10 @@ SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; + + if (SCM_UNLIKELY (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + return scm_hash_fn_create_handle_x (table, key, init, scm_ihashx, scm_sloppy_assx, (void *)&closure); } @@ -1265,6 +1326,9 @@ SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0, SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, 1, FUNC_NAME); SCM_VALIDATE_HASHTABLE (2, table); + if (SCM_UNLIKELY (SCM_HASHTABLE_WEAK_P (table))) + SCM_MISC_ERROR ("Handle access not permitted on weak table", SCM_EOL); + scm_internal_hash_for_each_handle ((scm_t_hash_handle_fn) scm_call_1, (void *) SCM_UNPACK (proc), table); |