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

First stab at the guardian implementation. Works fine at first glance!

Browse source 
* libguile/guardians.c: Overhauled.  Removed the `tconc' structure.
  Much, much, simpler.
  (finalize_guarded): New function.

* libguile/init.c (scm_i_init_guile): Call `scm_init_guardians ()'.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-11
This commit is contained in:
Ludovic Courtes 2006-04-25 16:23:31 +00:00 • committed by Ludovic Courtès
parent 89f423d5ad
commit bc700b6dd3
2 changed files with 96 additions and 147 deletions
Download patch file Download diff file Expand all files Collapse all files

241
libguile/guardians.c
View file

@ -16,8 +16,6 @@
*/
#if 0 /* FIXME: Not re-implemented for Boehm's GC. */
/* This is an implementation of guardians as described in
* R. Kent Dybvig, Carl Bruggeman, and David Eby (1993) "Guardians in
* a Generation-Based Garbage Collector" ACM SIGPLAN Conference on
@ -38,6 +36,9 @@
* Now they should again behave like those described in the paper.
* Scheme guardians should be simple and friendly, not like the greedy
* monsters we had...
*
* Rewritten for the Boehm-Wiser GC by Ludovic Courtès.
* FIXME: This is currently not thread-safe.
*/
@ -54,150 +55,25 @@
#include "libguile/eval.h"
#include "libguile/guardians.h"
#include <gc/gc.h>
/* The live and zombies FIFOs are implemented as tconcs as described
in Dybvig's paper. This decouples addition and removal of elements
so that no synchronization between these needs to take place.
*/
typedef struct t_tconc
{
SCM head;
SCM tail;
} t_tconc;
#define TCONC_EMPTYP(tc) (scm_is_eq ((tc).head, (tc).tail))
#define TCONC_IN(tc, obj, pair) \
do { \
SCM_SETCAR ((tc).tail, obj); \
SCM_SET_CELL_OBJECT_1 (pair, SCM_EOL); \
SCM_SET_CELL_OBJECT_0 (pair, SCM_BOOL_F); \
SCM_SETCDR ((tc).tail, pair); \
(tc).tail = pair; \
} while (0)
#define TCONC_OUT(tc, res) \
do { \
(res) = SCM_CAR ((tc).head); \
(tc).head = SCM_CDR ((tc).head); \
} while (0)
static scm_t_bits tc16_guardian;
typedef struct t_guardian
{
t_tconc live;
t_tconc zombies;
unsigned long live;
SCM zombies;
struct t_guardian *next;
} t_guardian;
#define GUARDIAN_P(x) SCM_SMOB_PREDICATE(tc16_guardian, x)
#define GUARDIAN_DATA(x) ((t_guardian *) SCM_CELL_WORD_1 (x))
static t_guardian *guardians;
void
scm_i_init_guardians_for_gc ()
{
guardians = NULL;
}
/* mark a guardian by adding it to the live guardian list. */
static SCM
guardian_mark (SCM ptr)
{
t_guardian *g = GUARDIAN_DATA (ptr);
g->next = guardians;
guardians = g;
return SCM_BOOL_F;
}
/* Identify inaccessible objects and move them from the live list to
the zombie list. An object is inaccessible when it is unmarked at
this point. Therefore, the inaccessible objects are not marked yet
since that would prevent them from being recognized as
inaccessible.
The pairs that form the life list itself are marked, tho.
*/
void
scm_i_identify_inaccessible_guardeds ()
{
t_guardian *g;
for (g = guardians; g; g = g->next)
{
SCM pair, next_pair;
SCM *prev_ptr;
for (pair = g->live.head, prev_ptr = &g->live.head;
!scm_is_eq (pair, g->live.tail);
pair = next_pair)
{
SCM obj = SCM_CAR (pair);
next_pair = SCM_CDR (pair);
if (!SCM_GC_MARK_P (obj))
{
/* Unmarked, move to 'inaccessible' list.
*/
*prev_ptr = next_pair;
TCONC_IN (g->zombies, obj, pair);
}
else
{
SCM_SET_GC_MARK (pair);
prev_ptr = SCM_CDRLOC (pair);
}
}
SCM_SET_GC_MARK (pair);
}
}
int
scm_i_mark_inaccessible_guardeds ()
{
t_guardian *g;
int again = 0;
/* We never need to see the guardians again that are processed here,
so we clear the list. Calling scm_gc_mark below might find new
guardians, however (and other things), and we inform the GC about
this by returning non-zero. See scm_mark_all in gc-mark.c
*/
g = guardians;
guardians = NULL;
for (; g; g = g->next)
{
SCM pair;
for (pair = g->zombies.head;
!scm_is_eq (pair, g->zombies.tail);
pair = SCM_CDR (pair))
{
if (!SCM_GC_MARK_P (pair))
{
scm_gc_mark (SCM_CAR (pair));
SCM_SET_GC_MARK (pair);
again = 1;
}
}
SCM_SET_GC_MARK (pair);
}
return again;
}
static size_t
guardian_free (SCM ptr)
{
scm_gc_free (GUARDIAN_DATA (ptr), sizeof (t_guardian), "guardian");
return 0;
}
static int
guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
@ -208,9 +84,9 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
scm_uintprint ((scm_t_bits) g, 16, port);
scm_puts (" (reachable: ", port);
scm_display (scm_length (SCM_CDR (g->live.head)), port);
scm_display (scm_from_uint (g->live), port);
scm_puts (" unreachable: ", port);
scm_display (scm_length (SCM_CDR (g->zombies.head)), port);
scm_display (scm_length (g->zombies), port);
scm_puts (")", port);
scm_puts (">", port);
@ -218,16 +94,87 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
return 1;
}
/* Handle finalization of OBJ which is guarded by the guardians listed in
GUARDIAN_LIST. */
static void
finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
{
SCM cell_pool;
#if 0
printf ("finalizing guarded %p (%u guardians)\n",
obj, scm_to_uint (scm_length (guardian_list)));
scm_write (guardian_list, scm_current_output_port ());
#endif
/* Preallocate a bunch of cells so that we can make sure that no garbage
collection (and, thus, nested calls to `finalize_guarded ()') occurs
while executing the following loop. This is quite inefficient (call to
`scm_length ()') but that shouldn't be a problem in most cases. */
cell_pool = scm_make_list (scm_length (guardian_list), SCM_UNSPECIFIED);
/* Tell each guardian interested in OBJ that OBJ is no longer
reachable. */
for (;
guardian_list != SCM_EOL;
guardian_list = SCM_CDR (guardian_list))
{
SCM zombies;
t_guardian *g = GUARDIAN_DATA (SCM_CAR (guardian_list));
if (g->live == 0)
abort ();
/* Get a fresh cell from CELL_POOL. */
zombies = cell_pool;
cell_pool = SCM_CDR (cell_pool);
/* Compute and update G's zombie list. */
SCM_SETCAR (zombies, SCM_PACK (obj));
SCM_SETCDR (zombies, g->zombies);
g->zombies = zombies;
g->live--;
g->zombies = zombies;
}
#if 0
printf ("end of finalize (%p)\n", obj);
#endif
}
/* Add OBJ as a guarded object of GUARDIAN. */
static void
scm_i_guard (SCM guardian, SCM obj)
{
t_guardian *g = GUARDIAN_DATA (guardian);
if (!SCM_IMP (obj))
{
SCM z;
z = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
TCONC_IN (g->live, obj, z);
/* Register a finalizer and pass a list of guardians interested in OBJ
as the ``client data'' argument. */
GC_finalization_proc prev_finalizer;
GC_PTR prev_data;
SCM guardians_for_obj;
g->live++;
guardians_for_obj = scm_cons (guardian, SCM_EOL);
GC_REGISTER_FINALIZER_NO_ORDER ((GC_PTR)obj, finalize_guarded,
(GC_PTR)guardians_for_obj,
&prev_finalizer, &prev_data);
if ((prev_finalizer == finalize_guarded) && (prev_data != NULL))
{
/* OBJ is already guarded by another guardian: add GUARDIAN to its
list of guardians. */
SCM prev_guardian_list = SCM_PACK (prev_data);
if (!scm_is_pair (prev_guardian_list))
abort ();
SCM_SETCDR (guardians_for_obj, prev_guardian_list);
}
}
}
@ -237,8 +184,12 @@ scm_i_get_one_zombie (SCM guardian)
t_guardian *g = GUARDIAN_DATA (guardian);
SCM res = SCM_BOOL_F;
if (!TCONC_EMPTYP (g->zombies))
TCONC_OUT (g->zombies, res);
if (g->zombies != SCM_EOL)
{
/* Note: We return zombies in reverse order. */
res = SCM_CAR (g->zombies);
g->zombies = SCM_CDR (g->zombies);
}
return res;
}
@ -315,13 +266,11 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
#define FUNC_NAME s_scm_make_guardian
{
t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
SCM z1 = scm_cons (SCM_BOOL_F, SCM_EOL);
SCM z2 = scm_cons (SCM_BOOL_F, SCM_EOL);
SCM z;
/* A tconc starts out with one tail pair. */
g->live.head = g->live.tail = z1;
g->zombies.head = g->zombies.tail = z2;
g->live = 0;
g->zombies = SCM_EOL;
g->next = NULL;
@ -334,9 +283,11 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
void
scm_init_guardians ()
{
/* We use unordered finalization `a la Java. */
GC_java_finalization = 1;
tc16_guardian = scm_make_smob_type ("guardian", 0);
scm_set_smob_mark (tc16_guardian, guardian_mark);
scm_set_smob_free (tc16_guardian, guardian_free);
scm_set_smob_print (tc16_guardian, guardian_print);
#if ENABLE_DEPRECATED
scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 2, 0);
@ -352,5 +303,3 @@ scm_init_guardians ()
c-file-style: "gnu"
End:
*/
#endif