summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtes <ludovic.courtes@laas.fr>2006-05-23 21:59:00 +0000
committerLudovic Courtès <ludo@gnu.org>2008-09-05 09:33:29 +0200
commitfebd2677c9b1028bc3cd30401672ccc7e3314199 (patch)
tree28d0fe987374322e03be73152f3539a6e0f373c9
parent378f262561cb381e8b3cff3faac1157605422015 (diff)
downloadguile-febd2677c9b1028bc3cd30401672ccc7e3314199.tar.gz
Generalized BGC's finalizer mechanism. Use it in `guardians.c'.
* libguile/gc.c (finalizer_trampoline): New. (scm_gc_register_finalizer): New. * libguile/gc.h (scm_gc_register_finalizer): New declaration. * libguile/guardians.c (finalize_guarded): Updated to the new prototype. (scm_i_guard): Use `scm_gc_register_finalizer ()' instead of `GC_REGISTER_FINALIZER_NO_ORDER ()'. git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-23
-rw-r--r--libguile/gc.c88
-rw-r--r--libguile/gc.h2
-rw-r--r--libguile/guardians.c36
3 files changed, 104 insertions, 22 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index eba10038c..2223c004a 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -678,8 +678,96 @@ scm_gc_unregister_roots (SCM *b, unsigned long n)
int scm_i_terminating;
+/* Finalizers. */
+static void
+finalizer_trampoline (GC_PTR ptr, GC_PTR data)
+{
+ register SCM obj, finalizers;
+
+ obj = PTR2SCM (ptr);
+ for (finalizers = PTR2SCM (data);
+ scm_is_pair (finalizers);
+ finalizers = SCM_CDR (finalizers))
+ {
+ SCM f = SCM_CAR (finalizers);
+
+ scm_call_2 (SCM_CAR (f), obj, SCM_CDR (f));
+ }
+}
+
+
+/* Register FINALIZER as a finalization procedure for OBJ. FINALIZER will be
+ invoked when storage for OBJ is to be reclaimed and will be passed OBJ and
+ DATA. If ORDERED is non-zero, finalization will be "ordered" (see the
+ Boehm-GC doc for details). The function returns the data previously
+ registered for OBJ and FINALIZER, or `#f' if FINALIZER had not been
+ registered for OBJ before.
+
+ Note that finalizers in general are known to be problematic. As such,
+ this function should only be used internally, and only to implement
+ functionalities that could not be implemented otherwise (e.g., guardians,
+ SMOB's free procedures). */
+SCM
+scm_gc_register_finalizer (SCM obj, SCM (*finalizer) (SCM, SCM),
+ SCM data, int ordered)
+{
+ SCM prev_data = SCM_BOOL_F;
+ SCM finalization_data, finalization_subr;
+ GC_finalization_proc old_finalizer;
+ GC_PTR old_finalization_data;
+
+ finalization_subr = scm_c_make_gsubr ("%%finalizer", 2, 0, 0,
+ finalizer);
+ finalization_data = scm_cons (scm_cons (finalization_subr, data),
+ SCM_EOL);
+ if (ordered)
+ GC_REGISTER_FINALIZER (SCM2PTR (obj), finalizer_trampoline,
+ SCM2PTR (finalization_data),
+ &old_finalizer, &old_finalization_data);
+ else
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalizer_trampoline,
+ SCM2PTR (finalization_data),
+ &old_finalizer, &old_finalization_data);
+
+ if ((old_finalizer != NULL) && (old_finalizer != finalizer_trampoline))
+ /* Inconsistent use of the mechanism. */
+ abort ();
+
+ if (old_finalization_data != NULL)
+ {
+ SCM f, prev, old_finalizer_list = PTR2SCM (old_finalization_data);
+
+ if (!scm_is_pair (old_finalizer_list))
+ abort ();
+
+ /* Look for FINALIZER among the previously-installed finalizers. */
+ for (f = old_finalizer_list, prev = SCM_BOOL_F;
+ scm_is_pair (f);
+ prev = f, f = SCM_CDR (f))
+ {
+ if (SCM_SUBRF (SCM_CAR (f)) == finalizer)
+ break;
+ }
+
+ if (scm_is_pair (f))
+ {
+ prev_data = SCM_CDAR (f);
+ if (prev != SCM_BOOL_F)
+ SCM_SETCDR (prev, SCM_CDR (f));
+ else
+ old_finalizer_list = SCM_CDR (old_finalizer_list);
+ }
+
+ /* Concatenate the new finalizer list with the old one. */
+ SCM_SETCDR (finalization_data, old_finalizer_list);
+ }
+ return prev_data;
+}
+
+
+
/*
MOVE THIS FUNCTION. IT DOES NOT HAVE ANYTHING TODO WITH GC.
*/
diff --git a/libguile/gc.h b/libguile/gc.h
index 117301272..671c15a30 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -235,6 +235,8 @@ SCM_API void *scm_gc_realloc (void *mem, size_t old_size,
SCM_API void scm_gc_free (void *mem, size_t size, const char *what);
SCM_API char *scm_gc_strdup (const char *str, const char *what);
SCM_API char *scm_gc_strndup (const char *str, size_t n, const char *what);
+SCM_API SCM scm_gc_register_finalizer (SCM obj, SCM (*finalizer) (SCM, SCM),
+ SCM data, int ordered);
SCM_API void scm_remember_upto_here_1 (SCM obj);
SCM_API void scm_remember_upto_here_2 (SCM obj1, SCM obj2);
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 328498247..b73da5467 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -96,14 +96,14 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
/* 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)
+static SCM
+finalize_guarded (SCM obj, SCM guardian_list)
{
SCM cell_pool;
#if 0
printf ("finalizing guarded %p (%u guardians)\n",
- obj, scm_to_uint (scm_length (guardian_list)));
+ SCM2PTR (obj), scm_to_uint (scm_length (guardian_list)));
scm_write (guardian_list, scm_current_output_port ());
#endif
@@ -130,7 +130,7 @@ finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
cell_pool = SCM_CDR (cell_pool);
/* Compute and update G's zombie list. */
- SCM_SETCAR (zombies, SCM_PACK (obj));
+ SCM_SETCAR (zombies, obj);
SCM_SETCDR (zombies, g->zombies);
g->zombies = zombies;
@@ -139,8 +139,10 @@ finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
}
#if 0
- printf ("end of finalize (%p)\n", obj);
+ printf ("end of finalize (%p)\n", SCM2PTR (obj));
#endif
+
+ return SCM_UNSPECIFIED;
}
/* Add OBJ as a guarded object of GUARDIAN. */
@@ -153,28 +155,18 @@ scm_i_guard (SCM guardian, SCM obj)
{
/* 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;
+ SCM guardians_for_obj, prev_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 ();
+ prev_guardians_for_obj =
+ scm_gc_register_finalizer (obj, finalize_guarded,
+ guardians_for_obj, 0);
- SCM_SETCDR (guardians_for_obj, prev_guardian_list);
- }
+ if (scm_is_pair (prev_guardians_for_obj))
+ /* Concatenate the previous list of guardians for OBJ. */
+ SCM_SETCDR (guardians_for_obj, prev_guardians_for_obj);
}
}