mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Fixed the weak cell implementation (for weak hash tables).
* libguile/hashtab.c (wcar_cell_descr): New. (wcdr_cell_descr): New. (scm_weak_car_cell): Use `GC_malloc_explicitly_typed ()' instead of `scm_gc_malloc_pointerless ()'. (scm_weak_cdr_cell): Likewise. (SCM_WEAK_CELL_WORD_DELETED_P): Use `SCM_CELL_OBJECT' instead of `SCM_CELL_WORD'. (scm_hash_fn_get_handle): Call `GC_disable ()' before calling `scm_fixup_weak_alist ()' and `GC_enable ()' afterwards. (scm_hash_fn_create_handle_x): Likewise. (scm_hash_fn_remove_x): Likewise. (scm_hashtab_prehistory): Initialize WCAR_CELL_DESCR and WCDR_CELL_DESCR. git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-8
This commit is contained in:
Ludovic Courtes
Ludovic Courtès
parent
3a2de079d5
commit
e4d21e6bc9
1 changed files with 78 additions and 11 deletions
|
|
@ -30,6 +30,11 @@
|
|||
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/hashtab.h"
|
||||
|
||||
#include <gc/gc.h>
|
||||
#include <gc/gc_typed.h>
|
||||
|
||||
|
||||
|
||||
|
||||
/* NOTES
|
||||
|
|
@ -80,14 +85,29 @@ 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).
|
||||
|
||||
We have weal-car cells, weak-cdr cells, and doubly weak cells. In weak
|
||||
cells, the weak component(s) are not scanned for pointers and are
|
||||
registered as disapperaring links; therefore, the weak component may be
|
||||
set to NULL by the garbage collector when no other reference to that word
|
||||
exist. Thus, we use `scm_fixup_weak_alist ()' to check for nullified weak
|
||||
cells and remove them. */
|
||||
|
||||
|
||||
/* Type descriptors for weak-c[ad]r cells. */
|
||||
static GC_descr wcar_cell_descr, wcdr_cell_descr;
|
||||
|
||||
|
||||
static SCM
|
||||
scm_weak_car_cell (SCM car, SCM cdr)
|
||||
{
|
||||
scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell),
|
||||
"weak cell");
|
||||
scm_t_cell *cell;
|
||||
|
||||
cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
|
||||
wcar_cell_descr);
|
||||
|
||||
cell->word_0 = car;
|
||||
cell->word_1 = cdr;
|
||||
|
|
@ -105,8 +125,10 @@ scm_weak_car_cell (SCM car, SCM cdr)
|
|||
static SCM
|
||||
scm_weak_cdr_cell (SCM car, SCM cdr)
|
||||
{
|
||||
scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell),
|
||||
"weak cell");
|
||||
scm_t_cell *cell;
|
||||
|
||||
cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
|
||||
wcdr_cell_descr);
|
||||
|
||||
cell->word_0 = car;
|
||||
cell->word_1 = cdr;
|
||||
|
|
@ -124,6 +146,7 @@ scm_weak_cdr_cell (SCM car, SCM cdr)
|
|||
static SCM
|
||||
scm_doubly_weak_cell (SCM car, SCM cdr)
|
||||
{
|
||||
/* Doubly weak cells shall not be scanned at all for pointers. */
|
||||
scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell),
|
||||
"weak cell");
|
||||
|
||||
|
|
@ -146,7 +169,7 @@ scm_doubly_weak_cell (SCM car, SCM cdr)
|
|||
|
||||
/* Testing the weak component(s) of a cell for reachability. */
|
||||
#define SCM_WEAK_CELL_WORD_DELETED_P(_cell, _word) \
|
||||
(SCM_CELL_WORD ((_cell), (_word)) == SCM_PACK (NULL))
|
||||
(SCM_CELL_OBJECT ((_cell), (_word)) == SCM_PACK (NULL))
|
||||
#define SCM_WEAK_CELL_CAR_DELETED_P(_cell) \
|
||||
(SCM_WEAK_CELL_WORD_DELETED_P ((_cell), 0))
|
||||
#define SCM_WEAK_CELL_CDR_DELETED_P(_cell) \
|
||||
|
|
@ -529,6 +552,7 @@ SCM
|
|||
scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
|
||||
#define FUNC_NAME "scm_hash_fn_get_handle"
|
||||
{
|
||||
int weak = 0;
|
||||
unsigned long k;
|
||||
SCM alist, h;
|
||||
|
||||
|
|
@ -547,11 +571,20 @@ scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*as
|
|||
/* XXX: We assume that if TABLE is a vector, then it's a weak vector. */
|
||||
if ((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table)))
|
||||
|| (SCM_I_IS_VECTOR (table)))
|
||||
/* FIXME: We could maybe trigger a rehash here depending on whether
|
||||
`scm_fixup_weak_alist ()' noticed some change. */
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
{
|
||||
/* Disable the GC so that ALIST remains valid until ASSOC_FN has
|
||||
returned. */
|
||||
/* FIXME: We could maybe trigger a rehash here depending on whether
|
||||
`scm_fixup_weak_alist ()' noticed some change. */
|
||||
GC_disable ();
|
||||
weak = 1;
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
}
|
||||
|
||||
h = assoc_fn (obj, alist, closure);
|
||||
if (weak)
|
||||
GC_enable ();
|
||||
|
||||
return h;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
@ -562,6 +595,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_
|
|||
SCM (*assoc_fn)(), void * closure)
|
||||
#define FUNC_NAME "scm_hash_fn_create_handle_x"
|
||||
{
|
||||
int weak = 0;
|
||||
unsigned long k;
|
||||
SCM buckets, alist, it;
|
||||
|
||||
|
|
@ -583,9 +617,16 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_
|
|||
alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
|
||||
if ((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table)))
|
||||
|| (SCM_I_IS_VECTOR (table)))
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
{
|
||||
GC_disable ();
|
||||
weak = 1;
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
}
|
||||
|
||||
it = assoc_fn (obj, alist, closure);
|
||||
if (weak)
|
||||
GC_enable ();
|
||||
|
||||
if (scm_is_true (it))
|
||||
return it;
|
||||
else
|
||||
|
|
@ -675,6 +716,7 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
|
|||
SCM (*assoc_fn)(),
|
||||
void *closure)
|
||||
{
|
||||
int weak = 0;
|
||||
unsigned long k;
|
||||
SCM buckets, alist, h;
|
||||
|
||||
|
|
@ -696,9 +738,16 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
|
|||
alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
|
||||
if ((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table)))
|
||||
|| (SCM_I_IS_VECTOR (table)))
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
{
|
||||
GC_disable ();
|
||||
weak = 1;
|
||||
alist = scm_fixup_weak_alist (alist);
|
||||
}
|
||||
|
||||
h = assoc_fn (obj, alist, closure);
|
||||
if (weak)
|
||||
GC_enable ();
|
||||
|
||||
if (scm_is_true (h))
|
||||
{
|
||||
SCM_SIMPLE_VECTOR_SET
|
||||
|
|
@ -1222,6 +1271,24 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0,
|
|||
void
|
||||
scm_hashtab_prehistory ()
|
||||
{
|
||||
/* Initialize weak cells. */
|
||||
GC_word wcar_cell_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
|
||||
GC_word wcdr_cell_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
|
||||
|
||||
/* In a weak-car cell, only the second word must be scanned for
|
||||
pointers. */
|
||||
GC_set_bit (wcar_cell_bitmap, GC_WORD_OFFSET (scm_t_cell, word_1));
|
||||
wcar_cell_descr = GC_make_descriptor (wcar_cell_bitmap,
|
||||
GC_WORD_LEN (scm_t_cell));
|
||||
|
||||
/* Conversely, in a weak-cdr cell, only the first word must be scanned for
|
||||
pointers. */
|
||||
GC_set_bit (wcdr_cell_bitmap, GC_WORD_OFFSET (scm_t_cell, word_0));
|
||||
wcdr_cell_descr = GC_make_descriptor (wcdr_cell_bitmap,
|
||||
GC_WORD_LEN (scm_t_cell));
|
||||
|
||||
|
||||
/* Initialize the hashtab SMOB type. */
|
||||
scm_tc16_hashtable = scm_make_smob_type (s_hashtable, 0);
|
||||
scm_set_smob_mark (scm_tc16_hashtable, scm_markcdr);
|
||||
scm_set_smob_print (scm_tc16_hashtable, hashtable_print);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue