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 /libguile/gc.c | |
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
Diffstat (limited to 'libguile/gc.c')
-rw-r--r-- | libguile/gc.c | 88 |
1 files changed, 88 insertions, 0 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. */ |