mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Implemented rehashing of weak hash tables.

Browse source 
* libguile/hashtab.c (weak_hashtables): Removed.
  (SCM_WEAK_CELL_DELETED_P): New macro.
  (START_WEAK_BUCKET_FIXUP): Added the HASHFN argument.  Invoke
  `scm_i_rehash ()' when pairs have been removed.
  (END_WEAK_BUCKET_FIXUP): Added the HASHFN argument.
  (make_hash_table): Use `SCM_NEWSMOB2 ()' instead of `SCM_NEWSMOB3 ()'
  -- last argument used to be WEAK_HASHTABLES.
  (scm_i_rehash): Handle weak hash tables.
  (to_rehash): Removed.
  (scm_internal_hash_fold): Use `SCM_WEAK_CELL_DELETED_P ()' rather than
  hand-written equivalent code.
  (rehash_after_gc): Removed.
  (scm_hashtab_prehistory): Don't add it as an after-gc hook.

* libguile/hashtab.h (SCM_HASHTABLE_NEXT): Removed.
  (SCM_HASHTABLE_NEXTLOC): Removed.
  (SCM_SET_HASHTABLE_NEXT): Removed.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-38
This commit is contained in:
Ludovic Courtes 2006-06-13 20:17:32 +00:00 • committed by Ludovic Courtès
parent 651a073522
commit c6a35e35f7
2 changed files with 44 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

120
libguile/hashtab.c
View file

@ -83,8 +83,6 @@ static unsigned long hashtable_size[] = {
static char *s_hashtable = "hashtable"; static char *s_hashtable = "hashtable";
SCM weak_hashtables = SCM_EOL;
/* Weak cells for use in weak alist vectors (aka. weak hash tables). /* Weak cells for use in weak alist vectors (aka. weak hash tables).
@ -175,6 +173,10 @@ scm_doubly_weak_cell (SCM car, SCM cdr)
#define SCM_WEAK_CELL_CDR_DELETED_P(_cell) \ #define SCM_WEAK_CELL_CDR_DELETED_P(_cell) \
(SCM_WEAK_CELL_WORD_DELETED_P ((_cell), 1)) (SCM_WEAK_CELL_WORD_DELETED_P ((_cell), 1))
#define SCM_WEAK_CELL_DELETED_P(_cell) \
((SCM_WEAK_CELL_CAR_DELETED_P (_cell)) \
|| (SCM_WEAK_CELL_CDR_DELETED_P (_cell)))
/* Accessing the components of a weak cell. */ /* Accessing the components of a weak cell. */
#define SCM_WEAK_CELL_WORD(_cell, _word) \ #define SCM_WEAK_CELL_WORD(_cell, _word) \
((SCM_WEAK_CELL_WORD_DELETED_P ((_cell), (_word))) \ ((SCM_WEAK_CELL_WORD_DELETED_P ((_cell), (_word))) \
@ -233,30 +235,36 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table))) \ ((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table))) \
|| (SCM_I_IS_VECTOR (table))) || (SCM_I_IS_VECTOR (table)))
/* Fixup BUCKET, an alist part of weak hash table OBJ. BUCKETS is the full /* Fixup BUCKET, an alist part of weak hash table OBJ. BUCKETS is the full
bucket vector for OBJ and IDX is the index of BUCKET within this bucket vector for OBJ and IDX is the index of BUCKET within this
vector. See also `scm_internal_hash_fold ()'. */ vector. See also `scm_internal_hash_fold ()'. */
#define START_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket) \ #define START_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn) \
do \ do \
{ \ { \
size_t _removed; \ size_t _removed; \
\ \
/* Disable the GC so that BUCKET remains valid until ASSOC_FN has \ /* Disable the GC so that BUCKET remains valid until ASSOC_FN has \
returned. */ \ returned. */ \
/* FIXME: We could maybe trigger a rehash here depending on whether \ /* FIXME: We could maybe trigger a rehash here depending on whether \
`scm_fixup_weak_alist ()' noticed some change. */ \ `scm_fixup_weak_alist ()' noticed some change. */ \
GC_disable (); \ GC_disable (); \
(_bucket) = scm_fixup_weak_alist ((_bucket), &_removed); \ (_bucket) = scm_fixup_weak_alist ((_bucket), &_removed); \
SCM_SIMPLE_VECTOR_SET ((_buckets), (_idx), (_bucket)); \ SCM_SIMPLE_VECTOR_SET ((_buckets), (_idx), (_bucket)); \
\ \
if ((_removed) && (SCM_HASHTABLE_P (_obj))) \ if ((_removed) && (SCM_HASHTABLE_P (_obj))) \
SCM_SET_HASHTABLE_N_ITEMS ((_obj), \ { \
SCM_HASHTABLE_N_ITEMS (_obj) - _removed); \ SCM_SET_HASHTABLE_N_ITEMS ((_obj), \
} \ SCM_HASHTABLE_N_ITEMS (_obj) - _removed); \
scm_i_rehash ((_obj), (_hashfn), \
NULL, "START_WEAK_BUCKET_FIXUP"); \
} \
} \
while (0) while (0)
/* Terminate a weak bucket fixup phase. */ /* Terminate a weak bucket fixup phase. */
#define END_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket) \ #define END_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn) \
do { GC_enable (); } while (0) do { GC_enable (); } while (0)
@ -283,14 +291,9 @@ make_hash_table (int flags, unsigned long k, const char *func_name)
t->upper = 9 * n / 10; t->upper = 9 * n / 10;
t->flags = flags; t->flags = flags;
t->hash_fn = NULL; t->hash_fn = NULL;
if (flags)
{ SCM_NEWSMOB2 (table, scm_tc16_hashtable, vector, t);
/* FIXME: We should eventually remove WEAK_HASHTABLES. */
SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, weak_hashtables);
weak_hashtables = table;
}
else
SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, SCM_EOL);
return table; return table;
} }
@ -305,12 +308,6 @@ scm_i_rehash (SCM table,
unsigned long old_size; unsigned long old_size;
unsigned long new_size; unsigned long new_size;
if (SCM_HASHTABLE_P (table) && SCM_HASHTABLE_WEAK_P (table))
/* FIXME: We don't currently support weak hash table rehashing. In order
to support it, we need to pay attention to NULL pairs, as in
`scm_internal_hash_fold ()', `START_WEAK_BUCKET_FIXUP ()', et al. */
return;
if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)) if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
{ {
/* rehashing is not triggered when i <= min_size */ /* rehashing is not triggered when i <= min_size */
@ -367,9 +364,15 @@ scm_i_rehash (SCM table,
while (scm_is_pair (ls)) while (scm_is_pair (ls))
{ {
unsigned long h; unsigned long h;
cell = ls; cell = ls;
handle = SCM_CAR (cell); handle = SCM_CAR (cell);
ls = SCM_CDR (ls); ls = SCM_CDR (ls);
if (SCM_WEAK_CELL_DELETED_P (handle))
/* HANDLE is a nullified weak pair: skip it. */
continue;
h = hash_fn (SCM_CAR (handle), new_size, closure); h = hash_fn (SCM_CAR (handle), new_size, closure);
if (h >= new_size) if (h >= new_size)
scm_out_of_range (func_name, scm_from_ulong (h)); scm_out_of_range (func_name, scm_from_ulong (h));
@ -400,39 +403,6 @@ hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
return 1; return 1;
} }
/* keep track of hash tables that need to shrink after scan */
static SCM to_rehash = SCM_EOL;
static void *
rehash_after_gc (void *dummy1 SCM_UNUSED,
void *dummy2 SCM_UNUSED,
void *dummy3 SCM_UNUSED)
{
if (!scm_is_null (to_rehash))
{
SCM first = to_rehash, last, h;
/* important to clear to_rehash here so that we don't get stuck
in an infinite loop if scm_i_rehash causes GC */
to_rehash = SCM_EOL;
h = first;
do
{
/* Rehash only when we have a hash_fn.
*/
if (SCM_HASHTABLE (h)->hash_fn)
scm_i_rehash (h, SCM_HASHTABLE (h)->hash_fn, NULL,
"rehash_after_gc");
last = h;
h = SCM_HASHTABLE_NEXT (h);
} while (!scm_is_null (h));
/* move tables back to weak_hashtables */
SCM_SET_HASHTABLE_NEXT (last, weak_hashtables);
weak_hashtables = first;
}
return 0;
}
SCM SCM
scm_c_make_hash_table (unsigned long k) scm_c_make_hash_table (unsigned long k)
@ -578,11 +548,11 @@ scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*as
alist = SCM_SIMPLE_VECTOR_REF (buckets, k); alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
if (weak) if (weak)
START_WEAK_BUCKET_FIXUP (table, buckets, k, alist); START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
h = assoc_fn (obj, alist, closure); h = assoc_fn (obj, alist, closure);
if (weak) if (weak)
END_WEAK_BUCKET_FIXUP (table, buckets, k, alist); END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
return h; return h;
} }
@ -616,11 +586,11 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_
weak = IS_WEAK_THING (table); weak = IS_WEAK_THING (table);
alist = SCM_SIMPLE_VECTOR_REF (buckets, k); alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
if (weak) if (weak)
START_WEAK_BUCKET_FIXUP (table, buckets, k, alist); START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
it = assoc_fn (obj, alist, closure); it = assoc_fn (obj, alist, closure);
if (weak) if (weak)
END_WEAK_BUCKET_FIXUP (table, buckets, k, alist); END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
if (scm_is_true (it)) if (scm_is_true (it))
return it; return it;
@ -733,11 +703,11 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
weak = IS_WEAK_THING (table); weak = IS_WEAK_THING (table);
alist = SCM_SIMPLE_VECTOR_REF (buckets, k); alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
if (weak) if (weak)
START_WEAK_BUCKET_FIXUP (table, buckets, k, alist); START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
h = assoc_fn (obj, alist, closure); h = assoc_fn (obj, alist, closure);
if (weak) if (weak)
END_WEAK_BUCKET_FIXUP (table, buckets, k, alist); END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
if (scm_is_true (h)) if (scm_is_true (h))
{ {
@ -1136,8 +1106,7 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
if (IS_WEAK_THING (table)) if (IS_WEAK_THING (table))
{ {
if ((SCM_CAR (handle) == SCM_PACK (NULL)) if (SCM_WEAK_CELL_DELETED_P (handle))
|| (SCM_CDR (handle) == SCM_PACK (NULL)))
{ {
/* We hit a weak pair whose car/cdr has become /* We hit a weak pair whose car/cdr has become
unreachable: unlink it from the bucket. */ unreachable: unlink it from the bucket. */
@ -1315,7 +1284,6 @@ scm_hashtab_prehistory ()
/* Initialize the hashtab SMOB type. */ /* Initialize the hashtab SMOB type. */
scm_tc16_hashtable = scm_make_smob_type (s_hashtable, 0); scm_tc16_hashtable = scm_make_smob_type (s_hashtable, 0);
scm_set_smob_print (scm_tc16_hashtable, hashtable_print); scm_set_smob_print (scm_tc16_hashtable, hashtable_print);
scm_c_hook_add (&scm_after_gc_c_hook, rehash_after_gc, 0, 0);
} }
void void

3
libguile/hashtab.h
View file

@ -39,9 +39,6 @@ SCM_API scm_t_bits scm_tc16_hashtable;
#define SCM_HASHTABLE_VECTOR(h) SCM_SMOB_OBJECT (h) #define SCM_HASHTABLE_VECTOR(h) SCM_SMOB_OBJECT (h)
#define SCM_SET_HASHTABLE_VECTOR(x, v) SCM_SET_SMOB_OBJECT ((x), (v)) #define SCM_SET_HASHTABLE_VECTOR(x, v) SCM_SET_SMOB_OBJECT ((x), (v))
#define SCM_HASHTABLE(x) ((scm_t_hashtable *) SCM_SMOB_DATA_2 (x)) #define SCM_HASHTABLE(x) ((scm_t_hashtable *) SCM_SMOB_DATA_2 (x))
#define SCM_HASHTABLE_NEXT(x) SCM_SMOB_OBJECT_3 (x)
#define SCM_HASHTABLE_NEXTLOC(x) SCM_SMOB_OBJECT_3_LOC (x)
#define SCM_SET_HASHTABLE_NEXT(x, n) SCM_SET_SMOB_OBJECT_3 ((x), (n))
#define SCM_HASHTABLE_FLAGS(x) (SCM_HASHTABLE (x)->flags) #define SCM_HASHTABLE_FLAGS(x) (SCM_HASHTABLE (x)->flags)
#define SCM_HASHTABLE_WEAK_KEY_P(x) \ #define SCM_HASHTABLE_WEAK_KEY_P(x) \
(SCM_HASHTABLE_FLAGS (x) & SCM_HASHTABLEF_WEAK_CAR) (SCM_HASHTABLE_FLAGS (x) & SCM_HASHTABLEF_WEAK_CAR)