mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

weak hash tables vacuum stale entries after a gc

Browse source 
* libguile/hashtab.c (scm_c_register_weak_gc_callback): New private
  helper, arranges for a C function to be called with a SCM as an
  argument, as long as the argument is reachable by GC.
  (scm_make_weak_key_hash_table)
  (scm_make_weak_value_hash_table)
  (scm_make_doubly_weak_hash_table): Register a weak GC callback to
  vacuum_weak_hash_table.
This commit is contained in:
Andy Wingo 2011-02-24 17:00:30 +01:00
parent ec7f624d65
commit 62c290e977
1 changed files with 49 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

70
libguile/hashtab.c
View file

@ -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"
@ -417,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"
@ -442,13 +471,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
@ -459,16 +492,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
@ -673,14 +708,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket);
SCM_HASHTABLE_INCREMENT (table);
/* Maybe rehash the table. If it's a weak table, pump all of the
buckets first to remove stale links. If the weak table is of
the kind that gets lots of insertions of short-lived values, we
might never need to actually rehash. */
if (SCM_HASHTABLE_WEAK_P (table)
&& SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
vacuum_weak_hash_table (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);