From 56495472c24c131152f75ec8c537d6ba07faac42 Mon Sep 17 00:00:00 2001 From: Michael Livshin Date: Sat, 23 Dec 2000 23:00:23 +0000 Subject: [PATCH] * 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'. --- NEWS | 22 +++ libguile/ChangeLog | 52 +++++++ libguile/gc.c | 90 +++++++++--- libguile/gc.h | 1 + libguile/guardians.c | 343 ++++++++++++++++++++++++++++++++----------- libguile/guardians.h | 4 +- libguile/init.c | 2 +- 7 files changed, 405 insertions(+), 109 deletions(-) diff --git a/NEWS b/NEWS index fb1f4af5e..f171f8082 100644 --- a/NEWS +++ b/NEWS @@ -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. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 321e2da21..9077d137e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,55 @@ +2000-12-24 Michael Livshin + + * 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 * procs.h (scm_subr_entry): Removed unused struct member diff --git a/libguile/gc.c b/libguile/gc.c index 23eff9ae7..ebafc9f87 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -44,6 +44,11 @@ /* #define DEBUGINFO */ +/* SECTION: This code is compiled once. + */ + +#ifndef MARK_DEPENDENCIES + #include #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" diff --git a/libguile/gc.h b/libguile/gc.h index 02e39890b..c0c8ce70b 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -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); diff --git a/libguile/guardians.c b/libguile/guardians.c index c32746ecf..5a53a6222 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -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 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; -/* 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; + 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 ("#", 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; - - /* 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. */ + 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; + + /* 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, scan all the guardians that are currently known to be live - and move their unmarked objects to zombie lists. */ - - 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; - - 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; - - /* into the zombie list! */ - TCONC_IN (g->zombies, SCM_CAR (pair), pair); - } - else - prev_ptr = SCM_CDRLOC (pair); + first_greedy_guardian = greedy_guardians; + first_sharing_guardian = sharing_guardians; + + 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); + + last_greedy_guardian = first_greedy_guardian; + last_sharing_guardian = first_sharing_guardian; + } while (first_greedy_guardian != greedy_guardians + || first_sharing_guardian != sharing_guardians); - 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); + /* now, scan all the guardians that are currently known to be live + and move their unmarked objects to zombie lists. */ + + 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); + return 0; } +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); + } + + 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 diff --git a/libguile/guardians.h b/libguile/guardians.h index 2c98c3711..687f6c435 100644 --- a/libguile/guardians.h +++ b/libguile/guardians.h @@ -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 */ diff --git a/libguile/init.c b/libguile/init.c index e180b99ae..ff37d9c0a 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -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 (); -- 2.20.1