dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* gc.c: (scm_gc_mark_dependencies): new function. like

Browse source 
`scm_gc_mark', but doesn't mark the argument itself.  defined
using an arrangement similar to that in eval.c: `scm_gc_mark' and
`scm_gc_mark_dependencies' are derived from the same "template"
by ugly preprocessor magic.

* gc.h: added prototype for `scm_gc_mark_dependencies'.

* init.c (scm_init_guile_1): call the renamed
`scm_init_guardians'.

* guardians.h: changed prototypes for `scm_make_guardian' and
`scm_init_guardians'.

* guardians.c (guardian_t): added new fields `greedy_p' and
`listed_p'.
(GUARDIAN_P): predicate that says whether its argument is a
guardian.
(GUARDIAN_GREEDY_P, GUARDIAN_LISTED_P): new predicates.
(greedy_guardians, sharing_guardians): new variables.  hold the
greedy and sharing live guardian lists, respectively.
(first_live_guardian, current_link_field): removed.
(greedily_guarded_prop): new variable.  holds the "is greedily
guarded" object property.
(self_centered_zombies): new variable.  stores guarded objects
that are parts of cycles.
(add_to_live_list): new function, introduced to decouple marking a
guardian and adding it to the live list.
(guardian_mark): call `add_to_live_list'.
(guardian_print): print whether the guardian is greedy or not.
also change "live" and "zombie" to "reachable" and "unreachable"
respectively, to be less confusing.
(scm_guard): if the guardian is greedy, test whether the object is
already greedily marked.  throw an error if so.
(scm_get_one_zombie): if the guardian is greedy, remove the
"greedily guarded" property from the object.
(scm_make_guardian): add a new optional boolean argument which
says whether the guardian is greedy or sharing.
(guardian_gc_init): init the new live lists.
(mark_dependencies): new function.
(mark_and_zombify): new function.
(guardian_zombify): reworked to support the new guardian
semantics.  move some logic to `mark_dependencies' and
`mark_and_zombify'.
(whine_about_self_centered_zombies): new function.  installed in
the `after-gc-hook' to complain about guarded objects which are
parts of cycles.
(scm_init_guardians): init the new stuff.  renamed from
`scm_init_guardian'.
This commit is contained in:
Michael Livshin 2000-12-23 23:00:23 +00:00
commit 56495472c2
7 changed files with 399 additions and 103 deletions
Download patch file Download diff file Expand all files Collapse all files

22
NEWS
View file

@ -87,6 +87,28 @@ Example:
* Changes to Scheme functions and syntax
** The "guardian" facility has changed (mostly compatibly).
There are now two types of guardians: greedy and sharing.
If you call (make-guardian #t) or without any arguments, you get a
greedy guardian, else a sharing guardian.
Greedy guardians are made the default because they are more
"defensive". You can only greedily guard an object once. If you
guard an object more than once, then it is guaranteed that the object
won't be returned from sharing guardians as long as it is greedily
guarded.
The second change is making sure that all objects returned by
guardians are properly live, i.e. it is impossible to return a
contained object before the containing object.
One incompatible (but probably not very important) change resulting
from this is that it is no longer possible to guard objects that
indirectly reference themselves (i.e. are parts of cycles). If you do
so accidentally, you'll get a warning.
** Escape procedures created by call-with-current-continuation now
accept any number of arguments, as required by R5RS.

52
libguile/ChangeLog
View file

@ -1,3 +1,55 @@
2000-12-24 Michael Livshin <mlivshin@bigfoot.com>
* gc.c: (scm_gc_mark_dependencies): new function. like
`scm_gc_mark', but doesn't mark the argument itself. defined
using an arrangement similar to that in eval.c: `scm_gc_mark' and
`scm_gc_mark_dependencies' are derived from the same "template"
by ugly preprocessor magic.
* gc.h: added prototype for `scm_gc_mark_dependencies'.
* init.c (scm_init_guile_1): call the renamed
`scm_init_guardians'.
* guardians.h: changed prototypes for `scm_make_guardian' and
`scm_init_guardians'.
* guardians.c (guardian_t): added new fields `greedy_p' and
`listed_p'.
(GUARDIAN_P): predicate that says whether its argument is a
guardian.
(GUARDIAN_GREEDY_P, GUARDIAN_LISTED_P): new predicates.
(greedy_guardians, sharing_guardians): new variables. hold the
greedy and sharing live guardian lists, respectively.
(first_live_guardian, current_link_field): removed.
(greedily_guarded_prop): new variable. holds the "is greedily
guarded" object property.
(self_centered_zombies): new variable. stores guarded objects
that are parts of cycles.
(add_to_live_list): new function, introduced to decouple marking a
guardian and adding it to the live list.
(guardian_mark): call `add_to_live_list'.
(guardian_print): print whether the guardian is greedy or not.
also change "live" and "zombie" to "reachable" and "unreachable"
respectively, to be less confusing.
(scm_guard): if the guardian is greedy, test whether the object is
already greedily marked. throw an error if so.
(scm_get_one_zombie): if the guardian is greedy, remove the
"greedily guarded" property from the object.
(scm_make_guardian): add a new optional boolean argument which
says whether the guardian is greedy or sharing.
(guardian_gc_init): init the new live lists.
(mark_dependencies): new function.
(mark_and_zombify): new function.
(guardian_zombify): reworked to support the new guardian
semantics. move some logic to `mark_dependencies' and
`mark_and_zombify'.
(whine_about_self_centered_zombies): new function. installed in
the `after-gc-hook' to complain about guarded objects which are
parts of cycles.
(scm_init_guardians): init the new stuff. renamed from
`scm_init_guardian'.
2000-12-23 Dirk Herrmann <D.Herrmann@tu-bs.de>
* procs.h (scm_subr_entry): Removed unused struct member

90
libguile/gc.c
View file

@ -44,6 +44,11 @@
/* #define DEBUGINFO */
/* SECTION: This code is compiled once.
*/
#ifndef MARK_DEPENDENCIES
#include <stdio.h>
#include "libguile/_scm.h"
@ -1087,24 +1092,47 @@ scm_igc (const char *what)
/* {Mark/Sweep}
*/
#define MARK scm_gc_mark
#define FNAME "scm_gc_mark"
#endif /*!MARK_DEPENDENCIES*/
/* Mark an object precisely.
*/
void
scm_gc_mark (SCM p)
#define FUNC_NAME "scm_gc_mark"
MARK (SCM p)
#define FUNC_NAME FNAME
{
register long i;
register SCM ptr;
#ifndef MARK_DEPENDENCIES
# define RECURSE scm_gc_mark
#else
/* go through the usual marking, but not for self-cycles. */
# define RECURSE(x) do { if ((x) != p) scm_gc_mark (x); } while (0)
#endif
ptr = p;
#ifdef MARK_DEPENDENCIES
goto gc_mark_loop_first_time;
#endif
gc_mark_loop:
if (SCM_IMP (ptr))
return;
gc_mark_nimp:
#ifdef MARK_DEPENDENCIES
if (ptr == p)
return;
scm_gc_mark (ptr);
gc_mark_loop_first_time:
#endif
if (!SCM_CELLP (ptr))
SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL);
@ -1115,11 +1143,15 @@ gc_mark_nimp:
#endif
#ifndef MARK_DEPENDENCIES
if (SCM_GCMARKP (ptr))
return;
SCM_SETGCMARK (ptr);
#endif
switch (SCM_TYP7 (ptr))
{
case scm_tcs_cons_nimcar:
@ -1128,14 +1160,14 @@ gc_mark_nimp:
ptr = SCM_CAR (ptr);
goto gc_mark_nimp;
}
scm_gc_mark (SCM_CAR (ptr));
RECURSE (SCM_CAR (ptr));
ptr = SCM_CDR (ptr);
goto gc_mark_nimp;
case scm_tcs_cons_imcar:
ptr = SCM_CDR (ptr);
goto gc_mark_loop;
case scm_tc7_pws:
scm_gc_mark (SCM_CELL_OBJECT_2 (ptr));
RECURSE (SCM_CELL_OBJECT_2 (ptr));
ptr = SCM_CDR (ptr);
goto gc_mark_loop;
case scm_tcs_cons_gloc:
@ -1153,7 +1185,7 @@ gc_mark_nimp:
{
/* ptr is a gloc */
SCM gloc_car = SCM_PACK (word0);
scm_gc_mark (gloc_car);
RECURSE (gloc_car);
ptr = SCM_CDR (ptr);
goto gc_mark_loop;
}
@ -1167,8 +1199,8 @@ gc_mark_nimp:
if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
{
scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_procedure]));
scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_setter]));
RECURSE (SCM_PACK (struct_data[scm_struct_i_procedure]));
RECURSE (SCM_PACK (struct_data[scm_struct_i_setter]));
}
if (len)
{
@ -1176,14 +1208,14 @@ gc_mark_nimp:
for (x = 0; x < len - 2; x += 2, ++struct_data)
if (fields_desc[x] == 'p')
scm_gc_mark (SCM_PACK (*struct_data));
RECURSE (SCM_PACK (*struct_data));
if (fields_desc[x] == 'p')
{
if (SCM_LAYOUT_TAILP (fields_desc[x + 1]))
for (x = *struct_data; x; --x)
scm_gc_mark (SCM_PACK (*++struct_data));
for (x = *struct_data++; x; --x, ++struct_data)
RECURSE (SCM_PACK (*struct_data));
else
scm_gc_mark (SCM_PACK (*struct_data));
RECURSE (SCM_PACK (*struct_data));
}
}
/* mark vtable */
@ -1198,7 +1230,7 @@ gc_mark_nimp:
ptr = SCM_CLOSCAR (ptr);
goto gc_mark_nimp;
}
scm_gc_mark (SCM_CLOSCAR (ptr));
RECURSE (SCM_CLOSCAR (ptr));
ptr = SCM_CDR (ptr);
goto gc_mark_nimp;
case scm_tc7_vector:
@ -1207,7 +1239,7 @@ gc_mark_nimp:
break;
while (--i > 0)
if (SCM_NIMP (SCM_VELTS (ptr)[i]))
scm_gc_mark (SCM_VELTS (ptr)[i]);
RECURSE (SCM_VELTS (ptr)[i]);
ptr = SCM_VELTS (ptr)[0];
goto gc_mark_loop;
#ifdef CCLO
@ -1219,7 +1251,7 @@ gc_mark_nimp:
{
SCM obj = SCM_CCLO_REF (ptr, j);
if (!SCM_IMP (obj))
scm_gc_mark (obj);
RECURSE (obj);
}
ptr = SCM_CCLO_REF (ptr, 0);
goto gc_mark_loop;
@ -1293,13 +1325,13 @@ gc_mark_nimp:
* won't prematurely drop table entries.
*/
if (!weak_keys)
scm_gc_mark (SCM_CAR (kvpair));
RECURSE (SCM_CAR (kvpair));
if (!weak_values)
scm_gc_mark (SCM_CDR (kvpair));
RECURSE (SCM_CDR (kvpair));
alist = next_alist;
}
if (SCM_NIMP (alist))
scm_gc_mark (alist);
RECURSE (alist);
}
}
break;
@ -1314,7 +1346,7 @@ gc_mark_nimp:
if (!(i < scm_numptob))
goto def;
if (SCM_PTAB_ENTRY(ptr))
scm_gc_mark (SCM_FILENAME (ptr));
RECURSE (SCM_FILENAME (ptr));
if (scm_ptobs[i].mark)
{
ptr = (scm_ptobs[i].mark) (ptr);
@ -1352,6 +1384,24 @@ gc_mark_nimp:
}
#undef FUNC_NAME
#ifndef MARK_DEPENDENCIES
#undef MARK
#undef RECURSE
#undef FNAME
/* And here we define `scm_gc_mark_dependencies', by including this
* same file in itself.
*/
#define MARK scm_gc_mark_dependencies
#define FNAME "scm_gc_mark_dependencies"
#define MARK_DEPENDENCIES
#include "gc.c"
#undef MARK_DEPENDENCIES
#undef MARK
#undef RECURSE
#undef FNAME
/* Mark a Region Conservatively
*/
@ -2599,6 +2649,8 @@ scm_init_gc ()
#endif
}
#endif /*MARK_DEPENDENCIES*/
/*
Local Variables:
c-file-style: "gnu"

1
libguile/gc.h
View file

@ -338,6 +338,7 @@ extern void scm_alloc_cluster (struct scm_freelist_t *master);
#endif
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
extern void scm_gc_mark_dependencies (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
extern int scm_cellp (SCM value);
extern void scm_gc_sweep (void);

331
libguile/guardians.c
View file

@ -50,8 +50,14 @@
* Programming Language Design and Implementation, June 1993
* ftp://ftp.cs.indiana.edu/pub/scheme-repository/doc/pubs/guardians.ps.gz
*
* Author: Michael N. Livshin
* Modified by: Mikael Djurfeldt
* By this point, the semantics are actually quite different from
* those described in the abovementioned paper. The semantic changes
* are there to improve safety and intuitiveness. The interface is
* still (mostly) the one described by the paper, however.
*
* Original design: Mikael Djurfeldt
* Original implementation: Michael Livshin
* Hacked on since by: everybody
*/
@ -59,8 +65,10 @@
#include "libguile/ports.h"
#include "libguile/print.h"
#include "libguile/smob.h"
#include "libguile/validate.h"
#include "libguile/properties.h"
#include "libguile/root.h"
#include "libguile/guardians.h"
@ -100,30 +108,63 @@ typedef struct guardian_t
tconc_t live;
tconc_t zombies;
struct guardian_t *next;
int greedy_p;
int listed_p;
} guardian_t;
#define GUARDIAN_P(x) SCM_SMOB_PREDICATE(tc16_guardian, x)
#define GUARDIAN(x) ((guardian_t *) SCM_CELL_WORD_1 (x))
#define GUARDIAN_LIVE(x) (GUARDIAN (x)->live)
#define GUARDIAN_ZOMBIES(x) (GUARDIAN (x)->zombies)
#define GUARDIAN_NEXT(x) (GUARDIAN (x)->next)
#define GUARDIAN_GREEDY_P(x) (GUARDIAN (x)->greedy_p)
#define GUARDIAN_LISTED_P(x) (GUARDIAN (x)->listed_p)
/* during the gc mark phase, live guardians are linked into a list here. */
static guardian_t *first_live_guardian = NULL;
static guardian_t **current_link_field = NULL;
/* during the gc mark phase, live guardians are linked into the lists
here. */
static guardian_t *greedy_guardians = NULL;
static guardian_t *sharing_guardians = NULL;
/* greedily guarded objects have this property set, so that we can
catch any attempt to greedily guard them again */
static SCM greedily_guarded_prop = SCM_EOL;
/* this is the list of guarded objects that are parts of cycles. we
don't know in which order to return them from guardians, so we just
unguard them and whine about it in after-gc-hook */
static SCM self_centered_zombies = SCM_EOL;
static void
add_to_live_list (SCM g)
{
if (GUARDIAN_LISTED_P (g))
return;
if (GUARDIAN_GREEDY_P (g))
{
GUARDIAN_NEXT (g) = greedy_guardians;
greedy_guardians = GUARDIAN (g);
}
else
{
GUARDIAN_NEXT (g) = sharing_guardians;
sharing_guardians = GUARDIAN (g);
}
GUARDIAN_LISTED_P (g) = 1;
}
/* mark a guardian by adding it to the live guardian list. */
static SCM
guardian_mark (SCM ptr)
{
*current_link_field = GUARDIAN (ptr);
current_link_field = &GUARDIAN_NEXT (ptr);
GUARDIAN_NEXT (ptr) = NULL;
add_to_live_list (ptr);
/* the objects protected by the guardian are not marked here: that
would prevent them from ever getting collected. instead marking
is done at the end of the mark phase by scm_guardian_zombify. */
is done at the end of the mark phase by guardian_zombify. */
return SCM_BOOL_F;
}
@ -139,11 +180,14 @@ guardian_free (SCM ptr)
static int
guardian_print (SCM g, SCM port, scm_print_state *pstate)
{
scm_puts ("#<guardian live objs: ", port);
scm_puts ("#<", port);
if (GUARDIAN_GREEDY_P (g))
scm_puts ("greedy ", port);
scm_puts ("guardian (reachable: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_LIVE (g).head)), port);
scm_puts (" zombies: ", port);
scm_puts (" unreachable: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_ZOMBIES (g).head)), port);
scm_puts (">", port);
scm_puts (")>", port);
return 1;
}
@ -173,8 +217,19 @@ scm_guard (SCM guardian, SCM obj)
{
SCM z;
SCM_NEWCELL (z);
if (GUARDIAN_GREEDY_P (guardian))
{
if (SCM_NFALSEP (scm_primitive_property_ref
(greedily_guarded_prop, obj)))
scm_misc_error ("guard",
"object is already greedily guarded", obj);
else
scm_primitive_property_set_x (greedily_guarded_prop,
obj, SCM_BOOL_T);
}
SCM_NEWCELL (z);
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
TCONC_IN (GUARDIAN_LIVE (guardian), obj, z);
@ -193,12 +248,19 @@ scm_get_one_zombie (SCM guardian)
if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (guardian)))
TCONC_OUT (GUARDIAN_ZOMBIES (guardian), res);
SCM_ALLOW_INTS;
if (SCM_NFALSEP (res)
&& GUARDIAN_GREEDY_P (guardian)
&& SCM_NFALSEP (scm_primitive_property_ref
(greedily_guarded_prop, res)))
scm_primitive_property_del_x (greedily_guarded_prop, res);
return res;
}
SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
(),
SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0,
(SCM greedy_p),
"Create a new guardian.\n"
"A guardian protects a set of objects from garbage collection,\n"
"allowing a program to apply cleanup or other actions.\n\n"
@ -212,10 +274,18 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
"Objects which are returned in this way are removed from\n"
"the guardian.\n\n"
"make-guardian takes one optional argument that says whether the\n"
"new guardian should be greedy or not. if there is any chance\n"
"that any object protected by the guardian may be resurrected,\n"
"then make the guardian greedy (this is the default).\n\n"
"See R. Kent Dybvig, Carl Bruggeman, and David Eby (1993)\n"
"\"Guardians in a Generation-Based Garbage Collector\".\n"
"ACM SIGPLAN Conference on Programming Language Design\n"
"and Implementation, June 1993.")
"and Implementation, June 1993.\n\n"
"(the semantics are slightly different at this point, but the\n"
"paper still (mostly) accurately describes the interface).")
#define FUNC_NAME s_scm_make_guardian
{
guardian_t *g = SCM_MUST_MALLOC_TYPE (guardian_t);
@ -226,6 +296,12 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
/* A tconc starts out with one tail pair. */
g->live.head = g->live.tail = z1;
g->zombies.head = g->zombies.tail = z2;
g->listed_p = 0;
if (SCM_UNBNDP (greedy_p))
g->greedy_p = 1;
else
g->greedy_p = SCM_NFALSEP (greedy_p);
SCM_NEWSMOB (z, tc16_guardian, g);
@ -238,12 +314,94 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
static void *
guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
{
current_link_field = &first_live_guardian;
first_live_guardian = NULL;
greedy_guardians = sharing_guardians = NULL;
return 0;
}
static void
mark_dependencies (guardian_t *g)
{
SCM pair, next_pair;
SCM *prev_ptr;
/* scan the live list for unmarked objects, and mark their
dependencies */
for (pair = g->live.head, prev_ptr = &g->live.head;
! SCM_EQ_P (pair, g->live.tail);
pair = next_pair)
{
SCM obj = SCM_CAR (pair);
next_pair = SCM_CDR (pair);
if (! SCM_MARKEDP (obj))
{
/* a candidate for finalizing */
scm_gc_mark_dependencies (obj);
if (SCM_MARKEDP (obj))
{
/* uh oh. a cycle. transfer this object (the
spine cell, to be exact) to
self_centered_zombies, so we'll be able to
complain about it later. */
*prev_ptr = next_pair;
SCM_SETGCMARK (pair);
SCM_SETCDR (pair, SCM_CDR (self_centered_zombies));
SCM_SETCDR (self_centered_zombies, pair);
}
else
{
/* see if this is a guardian. if yes, list it (but don't
mark it yet). */
if (GUARDIAN_P (obj))
add_to_live_list (obj);
prev_ptr = SCM_CDRLOC (pair);
}
}
}
}
static void
mark_and_zombify (guardian_t *g)
{
SCM tconc_tail = g->live.tail;
SCM *prev_ptr = &g->live.head;
SCM pair = g->live.head;
while (! SCM_EQ_P (pair, tconc_tail))
{
SCM next_pair = SCM_CDR (pair);
if (SCM_NMARKEDP (SCM_CAR (pair)))
{
/* got you, zombie! */
/* out of the live list! */
*prev_ptr = next_pair;
if (g->greedy_p)
/* if the guardian is greedy, mark this zombie now. this
way it won't be zombified again this time around. */
SCM_SETGCMARK (SCM_CAR (pair));
/* into the zombie list! */
TCONC_IN (g->zombies, SCM_CAR (pair), pair);
}
else
prev_ptr = SCM_CDRLOC (pair);
pair = next_pair;
}
/* Mark the cells of the live list (yes, the cells in the list, we
don't care about objects pointed to by the list cars, since we
know they are already marked). */
for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair))
SCM_SETGCMARK (pair);
}
/* this is called by the garbage collector between the mark and sweep
phases. for each marked guardian, it moves any unmarked object in
@ -251,83 +409,86 @@ guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
static void *
guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
{
guardian_t *first_guardian;
guardian_t **link_field = &first_live_guardian;
guardian_t *last_greedy_guardian = NULL;
guardian_t *last_sharing_guardian = NULL;
guardian_t *first_greedy_guardian = NULL;
guardian_t *first_sharing_guardian = NULL;
guardian_t *g;
/* Note that new guardians may be stuck on the end of the live
guardian list as we run this loop. As we move unmarked objects
to the zombie list and mark them, we may find some guarded
guardians. The guardian mark function will stick them on the end
of this list, so they'll be processed properly. */
/* First, find all newly unreachable objects and mark their
dependencies.
Note that new guardians may be stuck on the end of the live
guardian lists as we run this loop, since guardians might be
guarded too. When we mark a guarded guardian, its mark function
sticks in the appropriate live guardian list. The loop
terminates when no new guardians are found. */
do {
guardian_t *g;
first_guardian = *link_field;
link_field = current_link_field;
first_greedy_guardian = greedy_guardians;
first_sharing_guardian = sharing_guardians;
/* first, scan all the guardians that are currently known to be live
and move their unmarked objects to zombie lists. */
for (g = greedy_guardians; g != last_greedy_guardian;
g = g->next)
mark_dependencies (g);
for (g = sharing_guardians; g != last_sharing_guardian;
g = g->next)
mark_dependencies (g);
for (g = first_guardian; g; g = g->next)
{
SCM tconc_tail = g->live.tail;
SCM *prev_ptr = &g->live.head;
SCM pair = g->live.head;
last_greedy_guardian = first_greedy_guardian;
last_sharing_guardian = first_sharing_guardian;
} while (first_greedy_guardian != greedy_guardians
|| first_sharing_guardian != sharing_guardians);
while (! SCM_EQ_P (pair, tconc_tail))
{
SCM next_pair = SCM_CDR (pair);
/* now, scan all the guardians that are currently known to be live
and move their unmarked objects to zombie lists. */
if (SCM_NMARKEDP (SCM_CAR (pair)))
{
/* got you, zombie! */
for (g = greedy_guardians; g; g = g->next)
{
mark_and_zombify (g);
g->listed_p = 0;
}
for (g = sharing_guardians; g; g = g->next)
{
mark_and_zombify (g);
g->listed_p = 0;
}
/* Preserve the zombies in their undead state, by marking to prevent
collection. */
for (g = greedy_guardians; g; g = g->next)
scm_gc_mark (g->zombies.head);
for (g = sharing_guardians; g; g = g->next)
scm_gc_mark (g->zombies.head);
/* out of the live list! */
*prev_ptr = next_pair;
return 0;
}
/* into the zombie list! */
TCONC_IN (g->zombies, SCM_CAR (pair), pair);
}
else
prev_ptr = SCM_CDRLOC (pair);
static void *
whine_about_self_centered_zombies (void *dummy1, void *dummy2, void *dummy3)
{
if (! SCM_NULLP (SCM_CDR (self_centered_zombies)))
{
SCM pair;
scm_puts ("** WARNING: the following guarded objects were unguarded due to cycles:",
scm_cur_errp);
scm_newline (scm_cur_errp);
for (pair = SCM_CDR (self_centered_zombies);
! SCM_NULLP (pair); pair = SCM_CDR (pair))
{
scm_display (SCM_CAR (pair), scm_cur_errp);
scm_newline (scm_cur_errp);
}
pair = next_pair;
}
/* Mark the cells of the live list (yes, the cells in the list,
even though we don't care about objects pointed to by the list
cars, since we know they are already marked). */
for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair))
SCM_SETGCMARK (pair);
}
/* ghouston: Doesn't it seem a bit disturbing that if a zombie
is returned to full life after getting returned from the
guardian procedure, it may reference objects which are in a
guardian's zombie list? Is it not necessary to move such
zombies back to the live list, to avoid allowing the
guardian procedure to return an object which is referenced,
so not collectable? The paper doesn't give this
impression.
cmm: the paper does explicitly say that an object that is
guarded more than once should be returned more than once.
I believe this covers the above scenario. */
/* Preserve the zombies in their undead state, by marking to
prevent collection. Note that this may uncover zombified
guardians -- if so, they'll be processed in the next loop. */
for (g = first_guardian; g != *link_field; g = g->next)
scm_gc_mark (g->zombies.head);
} while (current_link_field != link_field);
SCM_SETCDR (self_centered_zombies, SCM_EOL);
}
return 0;
}
void
scm_init_guardian()
scm_init_guardians ()
{
tc16_guardian = scm_make_smob_type ("guardian", 0);
scm_set_smob_mark (tc16_guardian, guardian_mark);
@ -338,6 +499,14 @@ scm_init_guardian()
scm_c_hook_add (&scm_before_mark_c_hook, guardian_gc_init, 0, 0);
scm_c_hook_add (&scm_before_sweep_c_hook, guardian_zombify, 0, 0);
greedily_guarded_prop =
scm_permanent_object (scm_primitive_make_property (SCM_BOOL_F));
self_centered_zombies =
scm_permanent_object (scm_cons (SCM_UNDEFINED, SCM_EOL));
scm_c_hook_add (&scm_after_gc_c_hook,
whine_about_self_centered_zombies, 0, 0);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/guardians.x"
#endif

4
libguile/guardians.h
View file

@ -46,13 +46,13 @@
#include "libguile/__scm.h"
SCM scm_make_guardian (void);
SCM scm_make_guardian (SCM exclusive_p);
/* these are to be called from C: */
void scm_guard (SCM guardian, SCM obj);
SCM scm_get_one_zombie (SCM guardian);
void scm_init_guardian (void);
void scm_init_guardians (void);
#endif /* !SCM_GUARDIANH */

2
libguile/init.c
View file

@ -555,7 +555,7 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_init_vectors ();
scm_init_version ();
scm_init_weaks ();
scm_init_guardian ();
scm_init_guardians ();
scm_init_vports ();
scm_init_eval ();
scm_init_evalext ();