-/* Copyright (C) 1998, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
do { \
SCM_SETCAR ((tc).tail, obj); \
SCM_SETCAR (pair, SCM_BOOL_F); \
- SCM_SETCDR (pair, SCM_BOOL_F); \
+ SCM_SETCDR (pair, SCM_EOL); \
SCM_SETCDR ((tc).tail, pair); \
(tc).tail = pair; \
} while (0)
#define GUARDIAN_ZOMBIES(x) (GUARDIAN (x)->zombies)
#define GUARDIAN_NEXT(x) (GUARDIAN (x)->next)
-static guardian_t *first_live_guardian = NULL;
-static guardian_t **current_link_field = NULL;
-
-static SCM
-g_mark (SCM ptr)
-{
- *current_link_field = GUARDIAN (ptr);
- current_link_field = &GUARDIAN_NEXT (ptr);
- GUARDIAN_NEXT (ptr) = NULL;
-
- /* Can't mark zombies here since they can refer to objects which are
- living dead, thereby preventing them to join the zombies. */
- return SCM_BOOL_F;
-}
-
-static int
-g_print (SCM exp, SCM port, scm_print_state *pstate)
-{
- char buf[256];
- sprintf (buf, "#<guardian live objs: %lu zombies: %lu>",
- scm_ilength (SCM_CDR (GUARDIAN_LIVE (exp).head)),
- scm_ilength (SCM_CDR (GUARDIAN_ZOMBIES (exp).head)));
- scm_puts (buf, port);
-
- return 1;
-}
-
#define CCLO_G(cclo) (SCM_VELTS (cclo)[1])
+/* subr constructed from guard below. */
+static SCM guard1;
+
+/* this is wrapped in a compiled closure and is the Scheme entry point
+ for each guardian: if arg is an object, it's added to the
+ guardian's live list. if arg is unbound, the next available
+ zombified object (or #f if none) is returned. */
static SCM
guard (SCM cclo, SCM arg)
{
return scm_get_one_zombie (cclo);
}
-static SCM guard1;
+void
+scm_guard (SCM guardian, SCM obj)
+{
+ SCM g = CCLO_G (guardian);
+
+ if (SCM_NIMP (obj))
+ {
+ SCM z;
+
+ SCM_NEWCELL (z);
+
+ /* This critical section barrier will be replaced by a mutex. */
+ SCM_DEFER_INTS;
+ TCONC_IN (GUARDIAN_LIVE (g), obj, z);
+ SCM_ALLOW_INTS;
+ }
+}
+
+SCM
+scm_get_one_zombie (SCM guardian)
+{
+ SCM g = CCLO_G (guardian);
+ SCM res = SCM_BOOL_F;
+
+ /* This critical section barrier will be replaced by a mutex. */
+ SCM_DEFER_INTS;
+ if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (g)))
+ TCONC_OUT (GUARDIAN_ZOMBIES (g), res);
+ SCM_ALLOW_INTS;
+ return res;
+}
SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
(),
- "Return a new guardian object.\n"
- "A guardian allows dynamically allocated objects to be\n"
- "saved from deallocation by the garbage collector so that\n"
- "clean up or other actions can be performed using the data\n"
- "stored within the objects.\n"
+ "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"
+
+ "make-guardian returns a procedure representing the guardian.\n"
+ "Calling the guardian procedure with an argument adds the\n"
+ "argument to the guardian's set of protected objects.\n"
+ "Calling the guardian procedure without an argument returns\n"
+ "one of the protected objects which are ready for garbage\n"
+ "collection or @code{#f} if no such object is available.\n"
+ "Objects which are returned in this way are removed from\n"
+ "the guardian.\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\n.")
+ "and Implementation, June 1993.")
#define FUNC_NAME s_scm_make_guardian
{
SCM cclo = scm_makcclo (guard1, 2L);
guardian_t *g = SCM_MUST_MALLOC_TYPE(guardian_t);
- SCM z1 = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
- SCM z2 = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
+ 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;
}
#undef FUNC_NAME
+/* 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;
+
+/* called before gc mark phase begins to initialise the live guardian
+ list. */
void
scm_guardian_gc_init()
{
first_live_guardian = NULL;
}
-void
-scm_guardian_zombify ()
+/* mark a guardian by adding it to the live guardian list. */
+static SCM
+g_mark (SCM ptr)
+{
+ *current_link_field = GUARDIAN (ptr);
+ current_link_field = &GUARDIAN_NEXT (ptr);
+ GUARDIAN_NEXT (ptr) = NULL;
+
+ /* 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. */
+ return SCM_BOOL_F;
+}
+
+/* this is called by the garbage collector between the mark and sweep
+ phases. for each marked guardian, it moves any unmarked object in
+ its live list (tconc) to its zombie list (tconc). */
+void scm_guardian_zombify (void)
{
guardian_t *g;
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. */
+
for (g = first_live_guardian; g; g = g->next)
{
- /* Scan the live list for unmarked objects, and move them to the
- zombies tconc. */
SCM tconc_tail = g->live.tail;
SCM *prev_ptr = &g->live.head;
SCM pair = g->live.head;
/* out of the live list! */
*prev_ptr = next_pair;
- /* to the zombie list! */
+ /* into the zombie list! */
TCONC_IN (g->zombies, SCM_CAR (pair), pair);
}
else
pair = next_pair;
}
- /* Mark the cells of the live list. */
+ /* 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_NIMP (pair); pair = SCM_GCCDR (pair))
- SCM_SETGCMARK (pair);
+ SCM_SETGCMARK (pair);
+
+ /* Preserve the zombies in their undead state, by marking to
+ prevent collection. */
+
+ /* ghouston: possible bug: this may mark objects which are
+ protected by other guardians, but which have no references
+ from outside of the guardian system. section 3 of the paper
+ mentions shared and cyclic objects and it seems that all
+ parts should be made available for collection. Currently the
+ behaviour depends on the order in which guardians are
+ scanned.
+
+ 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. */
- /* Bring the zombies back from the dead. */
scm_gc_mark (g->zombies.head);
}
}
-void
-scm_guard (SCM guardian, SCM obj)
-{
- SCM g = CCLO_G (guardian);
-
- if (SCM_NIMP (obj))
- {
- SCM z;
-
- SCM_NEWCELL (z);
-
- /* This critical section barrier will be replaced by a mutex. */
- SCM_DEFER_INTS;
- TCONC_IN (GUARDIAN_LIVE (g), obj, z);
- SCM_ALLOW_INTS;
- }
-}
-
-SCM
-scm_get_one_zombie (SCM guardian)
+/* not generally used, since guardian smob is wrapped in a closure.
+ maybe useful for debugging. */
+static int
+g_print (SCM exp, SCM port, scm_print_state *pstate)
{
- SCM g = CCLO_G (guardian);
- SCM res = SCM_BOOL_F;
-
- /* This critical section barrier will be replaced by a mutex. */
- SCM_DEFER_INTS;
- if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (g)))
- TCONC_OUT (GUARDIAN_ZOMBIES (g), res);
- SCM_ALLOW_INTS;
+ char buf[256];
+ sprintf (buf, "#<guardian live objs: %lu zombies: %lu>",
+ scm_ilength (SCM_CDR (GUARDIAN_LIVE (exp).head)),
+ scm_ilength (SCM_CDR (GUARDIAN_ZOMBIES (exp).head)));
+ scm_puts (buf, port);
- return res;
+ return 1;
}
void
scm_init_guardian()
{
scm_tc16_guardian = scm_make_smob_type_mfpe ("guardian", sizeof (guardian_t),
- g_mark, NULL, g_print, NULL);
+ g_mark, NULL, g_print, NULL);
guard1 = scm_make_subr_opt ("guardian", scm_tc7_subr_2o, guard, 0);
#include "guardians.x"
HCoop / bpt / guile.git / commitdiff