diff options
author | Ludovic Courtes <ludovic.courtes@laas.fr> | 2006-05-23 21:59:00 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-09-05 09:33:29 +0200 |
commit | febd2677c9b1028bc3cd30401672ccc7e3314199 (patch) | |
tree | 28d0fe987374322e03be73152f3539a6e0f373c9 | |
parent | 378f262561cb381e8b3cff3faac1157605422015 (diff) | |
download | guile-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.c | 88 | ||||
-rw-r--r-- | libguile/gc.h | 2 | ||||
-rw-r--r-- | libguile/guardians.c | 36 |
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); } } |