mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

* guardians.c (F_GREEDY, F_LISTED, F_DESTROYED, GREEDY_P,

Browse source 
SET_GREEDY, LISTED_P, SET_LISTED, CLR_LISTED, DESTROYED_P,
 	SET_DESTROYED): new defines/macros.
	(GUARDIAN_LIVE, GUARDIAN_ZOMBIES, GUARDIAN_NEXT): deleted.
	(add_to_live_list): takes a `guardian_t *' now, not SCM.
	(guardian_print): print more info.
	(guardian_apply): check if the guardian is destroyed, and throw an
 	error if so.  take one more optional argument `throw_p'.
	(scm_guard): depending on the value of `throw_p', return a boolean
 	result.
	(scm_get_one_zombie): remove redundant property test.
	(guardian_t): represent the various (currently 3, I hope nothing
 	more gets added) boolean fields as bit flags.
	(scm_guardian_destroyed_p, scm_guardian_greedy_p): new predicates.
	(scm_destroy_guardian_x): new procedure.

	* guardians.h: added prototypes for `scm_guardian_greedy_p' and
	`scm_guardian_destroyed_p'.  changed prototype for `scm_guard'.
This commit is contained in:
Michael Livshin 2001-01-04 13:00:31 +00:00
parent 0c6d2191ef
commit c0a5d88835
4 changed files with 227 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

49
NEWS
View file

@ -87,28 +87,51 @@ Example:
* Changes to Scheme functions and syntax
** The "guardian" facility has changed (mostly compatibly).
** The semantics of guardians has changed.
There are now two types of guardians: greedy and sharing.
The changes are for the most part compatible. An important criteria
was to keep the typical usage of guardians as simple as before, but to
make the semantics safer and (as a result) more useful.
If you call (make-guardian #t) or without any arguments, you get a
greedy guardian, else a sharing guardian.
*** All objects returned from guardians are now properly alive.
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.
It is now guaranteed that any object referenced by an object returned
from a guardian is alive. It's now impossible for a guardian to
return a "contained" object before its "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.
*** There are now two types of guardians: greedy and sharing.
If you call (make-guardian #t) or just (make-guardian), you'll get a
greedy guardian, and for (make-guardian #f) a sharing guardian.
Greedy guardians are the default because they are more "defensive".
You can only greedily guard an object once. If you guard an object
more than once, once in a greedy guardian and the rest of times in
sharing guardians, then it is guaranteed that the object won't be
returned from sharing guardians as long as it is greedily guarded
and/or alive.
Guardians returned by calls to `make-guardian' can now take one more
optional parameter, which says whether to throw an error in case an
attempt is made to greedily guard an object that is already greedily
guarded. The default is true, i.e. throw an error. If the parameter
is false, the guardian invocation returns #t if guarding was
successful and #f if it wasn't.
Also, since greedy guarding is, in effect, a side-effecting operation
on objects, a new function is introduced: `destroy-guardian!'.
Invoking this function on a guardian renders it unoperative and, if
the guardian is greedy, clears the "greedily guarded" property of the
objects that were guarded by it, thus undoing the side effect.
Note that all this hair is hardly very important, since guardian
objects are usually permanent.
** Escape procedures created by call-with-current-continuation now
accept any number of arguments, as required by R5RS.

23
libguile/ChangeLog
View file

@ -1,3 +1,24 @@
2001-01-03 Michael Livshin <mlivshin@bigfoot.com>
* guardians.c (F_GREEDY, F_LISTED, F_DESTROYED, GREEDY_P,
SET_GREEDY, LISTED_P, SET_LISTED, CLR_LISTED, DESTROYED_P,
SET_DESTROYED): new defines/macros.
(GUARDIAN_LIVE, GUARDIAN_ZOMBIES, GUARDIAN_NEXT): deleted.
(add_to_live_list): takes a `guardian_t *' now, not SCM.
(guardian_print): print more info.
(guardian_apply): check if the guardian is destroyed, and throw an
error if so. take one more optional argument `throw_p'.
(scm_guard): depending on the value of `throw_p', return a boolean
result.
(scm_get_one_zombie): remove redundant property test.
(guardian_t): represent the various (currently 3, I hope nothing
more gets added) boolean fields as bit flags.
(scm_guardian_destroyed_p, scm_guardian_greedy_p): new predicates.
(scm_destroy_guardian_x): new procedure.
* guardians.h: added prototypes for `scm_guardian_greedy_p' and
`scm_guardian_destroyed_p'. changed prototype for `scm_guard'.
2001-01-01 Gary Houston <ghouston@arglist.com>
* fports.c (fport_write): bugfix: handle short writes for
@ -19,7 +40,7 @@
* guardians.c: (greedily_guarded_prop): deleted.
(greedily_guarded_whash): new variable. a doubly-weak hash table
used to keep the "greedily hashed" object property. the previous
used to keep the "greedily guarded" object property. the previous
implementation (via primitive object properties) was incorrect due
to its only-the-key-is-weak semantics.
(scm_guard, get_one_zombie, scm_init_guardians): use/init

221
libguile/guardians.c
View file

@ -109,18 +109,25 @@ typedef struct guardian_t
tconc_t live;
tconc_t zombies;
struct guardian_t *next;
int greedy_p;
int listed_p;
unsigned long flags;
} 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)
#define F_GREEDY 1L
#define F_LISTED (1L << 1)
#define F_DESTROYED (1L << 2)
#define GREEDY_P(x) (((x)->flags & F_GREEDY) != 0)
#define SET_GREEDY(x) ((x)->flags |= F_GREEDY)
#define LISTED_P(x) (((x)->flags & F_LISTED) != 0)
#define SET_LISTED(x) ((x)->flags |= F_LISTED)
#define CLR_LISTED(x) ((x)->flags &= ~F_LISTED)
#define DESTROYED_P(x) (((x)->flags & F_DESTROYED) != 0)
#define SET_DESTROYED(x) ((x)->flags |= F_DESTROYED)
/* during the gc mark phase, live guardians are linked into the lists
here. */
@ -136,30 +143,30 @@ static SCM self_centered_zombies = SCM_EOL;
static void
add_to_live_list (SCM g)
add_to_live_list (guardian_t *g)
{
if (GUARDIAN_LISTED_P (g))
if (LISTED_P (g))
return;
if (GUARDIAN_GREEDY_P (g))
if (GREEDY_P (g))
{
GUARDIAN_NEXT (g) = greedy_guardians;
greedy_guardians = GUARDIAN (g);
g->next = greedy_guardians;
greedy_guardians = g;
}
else
{
GUARDIAN_NEXT (g) = sharing_guardians;
sharing_guardians = GUARDIAN (g);
g->next = sharing_guardians;
sharing_guardians = g;
}
GUARDIAN_LISTED_P (g) = 1;
SET_LISTED (g);
}
/* mark a guardian by adding it to the live guardian list. */
static SCM
guardian_mark (SCM ptr)
{
add_to_live_list (ptr);
add_to_live_list (GUARDIAN (ptr));
/* the objects protected by the guardian are not marked here: that
would prevent them from ever getting collected. instead marking
@ -177,43 +184,69 @@ guardian_free (SCM ptr)
static int
guardian_print (SCM g, SCM port, scm_print_state *pstate)
guardian_print (SCM guardian, SCM port, scm_print_state *pstate)
{
guardian_t *g = GUARDIAN (guardian);
scm_puts ("#<", port);
if (GUARDIAN_GREEDY_P (g))
scm_puts ("greedy ", port);
if (DESTROYED_P (g))
scm_puts ("destroyed ", port);
if (GREEDY_P (g))
scm_puts ("greedy", port);
else
scm_puts ("sharing ", port);
scm_puts ("guardian (reachable: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_LIVE (g).head)), port);
scm_puts (" unreachable: ", port);
scm_display (scm_length (SCM_CDR (GUARDIAN_ZOMBIES (g).head)), port);
scm_puts (")>", port);
scm_puts ("sharing", port);
scm_puts (" guardian 0x", port);
scm_intprint ((long) g, 16, port);
if (! DESTROYED_P (g))
{
scm_puts (" (reachable: ", port);
scm_display (scm_length (SCM_CDR (g->live.head)), port);
scm_puts (" unreachable: ", port);
scm_display (scm_length (SCM_CDR (g->zombies.head)), port);
scm_puts (")", port);
}
scm_puts (">", port);
return 1;
}
/* This 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.
/* This is the Scheme entry point for each guardian: If OBJ is an
* object, it's added to the guardian's live list. If OBJ is unbound,
* the next available unreachable object (or #f if none) is returned.
*
* If the second optional argument THROW_P is true (the default), then
* an error is raised if GUARDIAN is greedy and OBJ is already greedily
* guarded. If THROW_P is false, #f is returned instead of raising the
* error, and #t is returned if everything is fine.
*/
static SCM
guardian_apply (SCM guardian, SCM arg)
guardian_apply (SCM guardian, SCM obj, SCM throw_p)
{
if (!SCM_UNBNDP (arg))
{
scm_guard (guardian, arg);
return SCM_UNSPECIFIED;
}
if (DESTROYED_P (GUARDIAN (guardian)))
scm_misc_error ("guard", "attempted use of destroyed guardian: ~A",
SCM_LIST1 (guardian));
if (!SCM_UNBNDP (obj))
return scm_guard (guardian, obj,
(SCM_UNBNDP (throw_p)
? 1
: SCM_NFALSEP (throw_p)));
else
return scm_get_one_zombie (guardian);
}
void
scm_guard (SCM guardian, SCM obj)
SCM
scm_guard (SCM guardian, SCM obj, int throw_p)
{
guardian_t *g = GUARDIAN (guardian);
if (!SCM_IMP (obj))
{
SCM z;
@ -223,43 +256,49 @@ scm_guard (SCM guardian, SCM obj)
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
if (GUARDIAN_GREEDY_P (guardian))
if (GREEDY_P (g))
{
if (SCM_NFALSEP (scm_hashq_get_handle
(greedily_guarded_whash, obj)))
{
SCM_ALLOW_INTS;
scm_misc_error ("guard",
"object is already greedily guarded", obj);
if (throw_p)
scm_misc_error ("guard",
"object is already greedily guarded: ~A",
SCM_LIST1 (obj));
else
return SCM_BOOL_F;
}
else
scm_hashq_create_handle_x (greedily_guarded_whash,
obj, guardian);
}
TCONC_IN (GUARDIAN_LIVE (guardian), obj, z);
TCONC_IN (g->live, obj, z);
SCM_ALLOW_INTS;
}
return throw_p ? SCM_UNSPECIFIED : SCM_BOOL_T;
}
SCM
scm_get_one_zombie (SCM guardian)
{
guardian_t *g = GUARDIAN (guardian);
SCM res = SCM_BOOL_F;
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
if (!TCONC_EMPTYP (GUARDIAN_ZOMBIES (guardian)))
TCONC_OUT (GUARDIAN_ZOMBIES (guardian), res);
if (!TCONC_EMPTYP (g->zombies))
TCONC_OUT (g->zombies, res);
if (SCM_NFALSEP (res)
&& GUARDIAN_GREEDY_P (guardian)
&& SCM_NFALSEP (scm_hashq_get_handle
(greedily_guarded_whash, res)))
&& GREEDY_P (g))
scm_hashq_remove_x (greedily_guarded_whash, res);
SCM_ALLOW_INTS;
@ -284,9 +323,9 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0,
"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"
"new guardian should be greedy or sharing. 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"
"then you should 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"
@ -305,13 +344,14 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 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);
g->next = NULL;
g->flags = 0L;
/* [cmm] the UNBNDP check below is redundant but I like it. */
if (SCM_UNBNDP (greedy_p) || SCM_NFALSEP (greedy_p))
SET_GREEDY (g);
SCM_NEWSMOB (z, tc16_guardian, g);
return z;
@ -319,6 +359,73 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_guardian_destroyed_p, "guardian-destroyed?", 1, 0, 0,
(SCM guardian),
"Is @var{guardian} destroyed?")
#define FUNC_NAME s_scm_guardian_destroyed_p
{
SCM res = SCM_BOOL_F;
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
res = SCM_BOOL (DESTROYED_P (GUARDIAN (guardian)));
SCM_ALLOW_INTS;
return res;
}
#undef FUNC_NAME
SCM_DEFINE (scm_guardian_greedy_p, "guardian_greedy?", 1, 0, 0,
(SCM guardian),
"Is @var{guardian} greedy?")
#define FUNC_NAME s_scm_guardian_greedy_p
{
return SCM_BOOL (GREEDY_P (GUARDIAN (guardian)));
}
#undef FUNC_NAME
SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0,
(SCM guardian),
"Destroys @var{guardian}, by making it impossible to put any more\n"
"objects in it or get any objects from it. It also unguards any\n"
"objects guarded by @var{guardian}.")
#define FUNC_NAME s_scm_destroy_guardian_x
{
guardian_t *g = GUARDIAN (guardian);
/* This critical section barrier will be replaced by a mutex. */
SCM_DEFER_INTS;
if (DESTROYED_P (g))
{
SCM_ALLOW_INTS;
SCM_MISC_ERROR ("guardian is already destroyed: ~A", SCM_LIST1 (guardian));
}
if (GREEDY_P (g))
{
/* clear the "greedily guarded" property of the objects */
SCM pair;
for (pair = g->live.head; pair != g->live.tail; pair = SCM_CDR (pair))
scm_hashq_remove_x (greedily_guarded_whash, SCM_CAR (pair));
for (pair = g->zombies.head; pair != g->zombies.tail; pair = SCM_CDR (pair))
scm_hashq_remove_x (greedily_guarded_whash, SCM_CAR (pair));
}
/* empty the lists */
g->live.head = g->live.tail;
g->zombies.head = g->zombies.tail;
SET_DESTROYED (g);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
/* called before gc mark phase begins to initialise the live guardian list. */
static void *
guardian_gc_init (void *dummy1, void *dummy2, void *dummy3)
@ -364,7 +471,7 @@ mark_dependencies_in_tconc (tconc_t *tc)
/* 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);
add_to_live_list (GUARDIAN (obj));
prev_ptr = SCM_CDRLOC (pair);
}
@ -397,7 +504,7 @@ mark_and_zombify (guardian_t *g)
/* out of the live list! */
*prev_ptr = next_pair;
if (g->greedy_p)
if (GREEDY_P (g))
/* 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));
@ -462,12 +569,12 @@ guardian_zombify (void *dummy1, void *dummy2, void *dummy3)
for (g = greedy_guardians; g; g = g->next)
{
mark_and_zombify (g);
g->listed_p = 0;
CLR_LISTED (g);
}
for (g = sharing_guardians; g; g = g->next)
{
mark_and_zombify (g);
g->listed_p = 0;
CLR_LISTED (g);
}
/* Preserve the zombies in their undead state, by marking to prevent
@ -510,7 +617,7 @@ scm_init_guardians ()
scm_set_smob_mark (tc16_guardian, guardian_mark);
scm_set_smob_free (tc16_guardian, guardian_free);
scm_set_smob_print (tc16_guardian, guardian_print);
scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 1, 0);
scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 2, 0);
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);

6
libguile/guardians.h
View file

@ -47,9 +47,13 @@
#include "libguile/__scm.h"
SCM scm_make_guardian (SCM greedy_p);
SCM scm_destroy_guardian_x (SCM guardian);
SCM scm_guardian_greedy_p (SCM guardian);
SCM scm_guardian_destroyed_p (SCM guardian);
/* these are to be called from C: */
void scm_guard (SCM guardian, SCM obj);
SCM scm_guard (SCM guardian, SCM obj, int throw_p);
SCM scm_get_one_zombie (SCM guardian);
void scm_init_guardians (void);