1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00

Moved weak pair code into `weaks.[ch]'.

* libguile/hashtab.c: Don't include <gc/gc_typed.h> and <gc/gc.h>.
  Updated users of weak
  (wcar_cell_descr): Removed.
  (wcdr_cell_descr): Removed.
  (scm_weak_car_cell): Removed.
  (scm_weak_cdr_cell): Removed.
  (scm_doubly_weak_cell): Removed.
  (SCM_WEAK_CELL_*_DELETED_P): Removed.
  (SCM_WEAK_CELL_WORD): Removed.
  (SCM_WEAK_CELL_C[AD]R): Removed.
  (scm_hashtab_prehistory): Don't initialize weak pairs.

* libguile/init.c (scm_i_init_guile): Invoke `scm_weaks_prehistory ()'
  before `scm_hashtab_prehistory ()' in order to initialize weak pairs.

* libguile/weaks.c: Include <gc/gc.h> and <gc/gc_typed.h>.
  (wc[ad]r_cell_descr): New.
  (scm_weak_c[ad]r_pair): New.
  (scm_doubly_weak_pair): New.
  (scm_weaks_prehistory): New.

* libguile/weaks.h (scm_weak_c[ad]r_pair): New declaration.
  (scm_doubly_weak_pair): New declaration.
  (SCM_WEAK_PAIR_WORD_DELETED_P): New.
  (SCM_WEAK_PAIR_CAR_DELETED_P): New.
  (SCM_WEAK_PAIR_CDR_DELETED_P): New.
  (SCM_WEAK_PAIR_DELETED_P): New.
  (SCM_WEAK_PAIR_WORD): New.
  (SCM_WEAK_PAIR_CAR): New.
  (SCM_WEAK_PAIR_CDR): New.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-39
This commit is contained in:
Ludovic Courtes 2006-06-25 22:42:19 +00:00 committed by Ludovic Courtès
parent c6a35e35f7
commit 986ec82209
4 changed files with 151 additions and 125 deletions

View file

@ -31,9 +31,6 @@
#include "libguile/validate.h"
#include "libguile/hashtab.h"
#include <gc/gc.h>
#include <gc/gc_typed.h>
@ -85,104 +82,12 @@ static char *s_hashtable = "hashtable";
/* Weak cells for use in weak alist vectors (aka. weak hash tables).
/* Helper functions and macros to deal with weak pairs.
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;
cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
wcar_cell_descr);
cell->word_0 = car;
cell->word_1 = cdr;
if (SCM_NIMP (car))
{
/* Weak car cells make sense iff the car is non-immediate. */
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
(GC_PTR)SCM_UNPACK (car));
}
return (SCM_PACK (cell));
}
static SCM
scm_weak_cdr_cell (SCM car, SCM cdr)
{
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;
if (SCM_NIMP (cdr))
{
/* Weak cdr cells make sense iff the cdr is non-immediate. */
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
(GC_PTR)SCM_UNPACK (cdr));
}
return (SCM_PACK (cell));
}
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");
cell->word_0 = car;
cell->word_1 = cdr;
if (SCM_NIMP (car))
{
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
(GC_PTR)SCM_UNPACK (car));
}
if (SCM_NIMP (cdr))
{
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
(GC_PTR)SCM_UNPACK (cdr));
}
return (SCM_PACK (cell));
}
/* Testing the weak component(s) of a cell for reachability. */
#define SCM_WEAK_CELL_WORD_DELETED_P(_cell, _word) \
(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) \
(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. */
#define SCM_WEAK_CELL_WORD(_cell, _word) \
((SCM_WEAK_CELL_WORD_DELETED_P ((_cell), (_word))) \
? SCM_BOOL_F : SCM_CAR (pair))
#define SCM_WEAK_CELL_CAR(_cell) (SCM_WEAK_CELL_WORD ((_cell), 0))
#define SCM_WEAK_CELL_CDR(_cell) (SCM_WEAK_CELL_WORD ((_cell), 1))
Weak pairs need to be accessed very carefully since their components can
be nullified by the GC when the object they refer to becomes unreachable.
Hence the macros and functions below that detect such weak pairs within
buckets and remove them. */
/* Return a ``usable'' version of ALIST, an alist of weak pairs. By
@ -204,8 +109,8 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
if (scm_is_pair (pair))
{
if ((SCM_WEAK_CELL_CAR_DELETED_P (pair))
|| (SCM_WEAK_CELL_CDR_DELETED_P (pair)))
if ((SCM_WEAK_PAIR_CAR_DELETED_P (pair))
|| (SCM_WEAK_PAIR_CDR_DELETED_P (pair)))
{
/* Remove from ALIST weak pair PAIR whose car/cdr has been
nullified by the GC. */
@ -369,7 +274,7 @@ scm_i_rehash (SCM table,
handle = SCM_CAR (cell);
ls = SCM_CDR (ls);
if (SCM_WEAK_CELL_DELETED_P (handle))
if (SCM_WEAK_PAIR_DELETED_P (handle))
/* HANDLE is a nullified weak pair: skip it. */
continue;
@ -609,11 +514,11 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_
/* FIXME: We don't support weak alist vectors. */
/* Use a weak cell. */
if (SCM_HASHTABLE_DOUBLY_WEAK_P (table))
handle = scm_doubly_weak_cell (obj, init);
handle = scm_doubly_weak_pair (obj, init);
else if (SCM_HASHTABLE_WEAK_KEY_P (table))
handle = scm_weak_car_cell (obj, init);
handle = scm_weak_car_pair (obj, init);
else
handle = scm_weak_cdr_cell (obj, init);
handle = scm_weak_cdr_pair (obj, init);
}
else
/* Use a regular, non-weak cell. */
@ -1106,7 +1011,7 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
if (IS_WEAK_THING (table))
{
if (SCM_WEAK_CELL_DELETED_P (handle))
if (SCM_WEAK_PAIR_DELETED_P (handle))
{
/* We hit a weak pair whose car/cdr has become
unreachable: unlink it from the bucket. */
@ -1264,23 +1169,6 @@ 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_print (scm_tc16_hashtable, hashtable_print);

View file

@ -422,7 +422,9 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_fluids_prehistory ();
scm_hashtab_prehistory (); /* requires storage_prehistory */
scm_weaks_prehistory ();
scm_hashtab_prehistory (); /* requires storage_prehistory, and
weaks_prehistory */
#ifdef GUILE_DEBUG_MALLOC
scm_debug_malloc_prehistory ();
#endif

View file

@ -52,6 +52,92 @@
#include "libguile/validate.h"
#include "libguile/weaks.h"
#include <gc/gc.h>
#include <gc/gc_typed.h>
/* Weak pairs for use in weak alist vectors and weak hash tables.
We have weal-car pairs, weak-cdr pairs, and doubly weak pairs. In weak
pairs, 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, users should only access weak pairs via the
`SCM_WEAK_PAIR_C[AD]R ()' macros. See also `scm_fixup_weak_alist ()' in
`hashtab.c'. */
/* Type descriptors for weak-c[ad]r pairs. */
static GC_descr wcar_pair_descr, wcdr_pair_descr;
SCM
scm_weak_car_pair (SCM car, SCM cdr)
{
scm_t_cell *cell;
cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
wcar_pair_descr);
cell->word_0 = car;
cell->word_1 = cdr;
if (SCM_NIMP (car))
{
/* Weak car cells make sense iff the car is non-immediate. */
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
(GC_PTR)SCM_UNPACK (car));
}
return (SCM_PACK (cell));
}
SCM
scm_weak_cdr_pair (SCM car, SCM cdr)
{
scm_t_cell *cell;
cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
wcdr_pair_descr);
cell->word_0 = car;
cell->word_1 = cdr;
if (SCM_NIMP (cdr))
{
/* Weak cdr cells make sense iff the cdr is non-immediate. */
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
(GC_PTR)SCM_UNPACK (cdr));
}
return (SCM_PACK (cell));
}
SCM
scm_doubly_weak_pair (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");
cell->word_0 = car;
cell->word_1 = cdr;
if (SCM_NIMP (car))
{
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
(GC_PTR)SCM_UNPACK (car));
}
if (SCM_NIMP (cdr))
{
GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
(GC_PTR)SCM_UNPACK (cdr));
}
return (SCM_PACK (cell));
}
/* 1. The current hash table implementation in hashtab.c uses weak alist
@ -201,6 +287,27 @@ scm_init_weaks_builtins ()
return SCM_UNSPECIFIED;
}
void
scm_weaks_prehistory ()
{
/* Initialize weak pairs. */
GC_word wcar_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
GC_word wcdr_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
/* In a weak-car pair, only the second word must be scanned for
pointers. */
GC_set_bit (wcar_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_1));
wcar_pair_descr = GC_make_descriptor (wcar_pair_bitmap,
GC_WORD_LEN (scm_t_cell));
/* Conversely, in a weak-cdr pair, only the first word must be scanned for
pointers. */
GC_set_bit (wcdr_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_0));
wcdr_pair_descr = GC_make_descriptor (wcdr_pair_bitmap,
GC_WORD_LEN (scm_t_cell));
}
void
scm_init_weaks ()
{

View file

@ -52,6 +52,34 @@
#define SCM_IS_WHVEC_ANY(X) (SCM_I_WVECT_TYPE (X) != 0)
/* Weak pairs. */
SCM_API SCM scm_weak_car_pair (SCM car, SCM cdr);
SCM_API SCM scm_weak_cdr_pair (SCM car, SCM cdr);
SCM_API SCM scm_doubly_weak_pair (SCM car, SCM cdr);
/* Testing the weak component(s) of a cell for reachability. */
#define SCM_WEAK_PAIR_WORD_DELETED_P(_cell, _word) \
(SCM_CELL_OBJECT ((_cell), (_word)) == SCM_PACK (NULL))
#define SCM_WEAK_PAIR_CAR_DELETED_P(_cell) \
(SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 0))
#define SCM_WEAK_PAIR_CDR_DELETED_P(_cell) \
(SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 1))
#define SCM_WEAK_PAIR_DELETED_P(_cell) \
((SCM_WEAK_PAIR_CAR_DELETED_P (_cell)) \
|| (SCM_WEAK_PAIR_CDR_DELETED_P (_cell)))
/* Accessing the components of a weak cell. */
#define SCM_WEAK_PAIR_WORD(_cell, _word) \
((SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), (_word))) \
? SCM_BOOL_F : SCM_CAR (pair))
#define SCM_WEAK_PAIR_CAR(_cell) (SCM_WEAK_PAIR_WORD ((_cell), 0))
#define SCM_WEAK_PAIR_CDR(_cell) (SCM_WEAK_PAIR_WORD ((_cell), 1))
/* Weak vectors and weak hash tables. */
SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
SCM_API SCM scm_weak_vector (SCM l);
@ -63,6 +91,7 @@ SCM_API SCM scm_weak_key_alist_vector_p (SCM x);
SCM_API SCM scm_weak_value_alist_vector_p (SCM x);
SCM_API SCM scm_doubly_weak_alist_vector_p (SCM x);
SCM_API SCM scm_init_weaks_builtins (void);
SCM_API void scm_weaks_prehistory (void);
SCM_API void scm_init_weaks (void);
SCM_API void scm_i_init_weak_vectors_for_gc (void);