summaryrefslogtreecommitdiff
path: root/libguile/hashtab.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/hashtab.c')
-rw-r--r--libguile/hashtab.c78
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);