diff options
-rw-r--r-- | libguile/guardians.c | 211 | ||||
-rw-r--r-- | test-suite/tests/guardians.test | 10 |
2 files changed, 72 insertions, 149 deletions
diff --git a/libguile/guardians.c b/libguile/guardians.c index a3d03230a..89eda7a9e 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -63,8 +63,54 @@ #include "libguile/guardians.h" #include "libguile/bdw-gc.h" +static scm_i_pthread_mutex_t guardian_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; +SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (guardian_lock); +/* A weak-key table mapping guarded values to the guardians that guard + them. The values are themselves weak tables: guardian -> count. */ +static SCM guarded_values; +static void finalize_guarded (void *obj, void *data); + +static void +register_guarded_value (SCM val, SCM guardian) +{ + SCM t, n; + int new_value = 0; + + scm_i_pthread_mutex_lock (&guardian_lock); + t = scm_weak_table_refq (guarded_values, val, SCM_BOOL_F); + if (scm_is_false (t)) + { + new_value = 1; + t = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_BOTH); + scm_weak_table_putq_x (guarded_values, val, t); + } + n = scm_weak_table_refq (t, guardian, SCM_INUM0); + scm_weak_table_putq_x (t, guardian, scm_oneplus (n)); + scm_i_pthread_mutex_unlock (&guardian_lock); + + if (new_value) + scm_i_add_resuscitator (SCM_UNPACK_POINTER (val), finalize_guarded, + SCM_UNPACK_POINTER (t)); +} + +static SCM +for_each_guardian (void *closure, SCM guardian, SCM n, SCM val) +{ + void (*callback) (SCM, SCM) = closure; + for (; scm_is_true (scm_positive_p (n)); n = scm_oneminus (n)) + callback (val, guardian); + return val; +} + +static void +unregister_guarded_value (SCM val, SCM guardians, + void (*callback) (SCM val, SCM guardian)) +{ + scm_weak_table_remq_x (guarded_values, val); + scm_c_weak_table_fold (for_each_guardian, callback, val, guardians); +} static scm_t_bits tc16_guardian; @@ -72,15 +118,12 @@ typedef struct t_guardian { unsigned long live; SCM zombies; - struct t_guardian *next; } t_guardian; #define GUARDIAN_P(x) SCM_SMOB_PREDICATE(tc16_guardian, x) #define GUARDIAN_DATA(x) ((t_guardian *) SCM_SMOB_DATA_1 (x)) - - static int guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED) { @@ -100,91 +143,19 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED) return 1; } -/* Handle finalization of OBJ which is guarded by the guardians listed in - GUARDIAN_LIST. */ static void -finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) +add_zombie (SCM val, SCM guardian) { - SCM cell_pool; - SCM obj, guardian_list, proxied_finalizer; - - obj = SCM_PACK_POINTER (ptr); - guardian_list = SCM_CDR (SCM_PACK_POINTER (finalizer_data)); - proxied_finalizer = SCM_CAR (SCM_PACK_POINTER (finalizer_data)); - -#ifdef DEBUG_GUARDIANS - printf ("finalizing guarded %p (%u guardians)\n", - ptr, scm_to_uint (scm_length (guardian_list))); -#endif - - /* Preallocate a bunch of cells so that we can make sure that no garbage - collection (and, thus, nested calls to `finalize_guarded ()') occurs - while executing the following loop. This is quite inefficient (call to - `scm_length ()') but that shouldn't be a problem in most cases. */ - cell_pool = scm_make_list (scm_length (guardian_list), SCM_UNSPECIFIED); - - /* Tell each guardian interested in OBJ that OBJ is no longer - reachable. */ - for (; - !scm_is_null (guardian_list); - guardian_list = SCM_CDR (guardian_list)) - { - SCM zombies; - SCM guardian; - t_guardian *g; - - guardian = scm_c_weak_vector_ref (scm_car (guardian_list), 0); - - if (scm_is_false (guardian)) - { - /* The guardian itself vanished in the meantime. */ -#ifdef DEBUG_GUARDIANS - printf (" guardian for %p vanished\n", ptr); -#endif - continue; - } - - g = GUARDIAN_DATA (guardian); - if (g->live == 0) - abort (); - - /* Get a fresh cell from CELL_POOL. */ - zombies = cell_pool; - cell_pool = SCM_CDR (cell_pool); - - /* Compute and update G's zombie list. */ - SCM_SETCAR (zombies, obj); - SCM_SETCDR (zombies, g->zombies); - g->zombies = zombies; - - g->live--; - g->zombies = zombies; - } - - if (scm_is_true (proxied_finalizer)) - { - /* Re-register the finalizer that was in place before we installed this - one. */ - GC_finalization_proc finalizer, prev_finalizer; - GC_PTR finalizer_data, prev_finalizer_data; - - finalizer = (GC_finalization_proc) SCM_UNPACK_POINTER (SCM_CAR (proxied_finalizer)); - finalizer_data = SCM_UNPACK_POINTER (SCM_CDR (proxied_finalizer)); - - if (finalizer == NULL) - abort (); - - GC_REGISTER_FINALIZER_NO_ORDER (ptr, finalizer, finalizer_data, - &prev_finalizer, &prev_finalizer_data); + t_guardian *g = GUARDIAN_DATA (guardian); -#ifdef DEBUG_GUARDIANS - printf (" reinstalled proxied finalizer %p for %p\n", finalizer, ptr); -#endif - } + g->zombies = scm_cons (val, g->zombies); +} -#ifdef DEBUG_GUARDIANS - printf ("end of finalize (%p)\n", ptr); -#endif +static void +finalize_guarded (void *obj, void *data) +{ + unregister_guarded_value (SCM_PACK_POINTER (obj), SCM_PACK_POINTER (data), + add_zombie); } /* Add OBJ as a guarded object of GUARDIAN. */ @@ -193,66 +164,11 @@ scm_i_guard (SCM guardian, SCM obj) { t_guardian *g = GUARDIAN_DATA (guardian); - if (SCM_HEAP_OBJECT_P (obj)) - { - /* Register a finalizer and pass a pair as the ``client data'' - argument. The pair contains in its car `#f' or a pair describing a - ``proxied'' finalizer (see below); its cdr contains a list of - guardians interested in OBJ. - - A ``proxied'' finalizer is a finalizer that was registered for OBJ - before OBJ became guarded (e.g., a SMOB `free' function). We are - assuming here that finalizers are only used internally, either at - the very beginning of an object's lifetime (e.g., see `SCM_NEWSMOB') - or by this function. */ - GC_finalization_proc prev_finalizer; - GC_PTR prev_data; - SCM guardians_for_obj, finalizer_data; - - g->live++; - - /* Note: GUARDIANS_FOR_OBJ holds weak references to guardians so - that a guardian can be collected before the objects it guards - (see `guardians.test'). */ - guardians_for_obj = scm_cons (scm_make_weak_vector (SCM_INUM1, guardian), - SCM_EOL); - finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj); - - GC_REGISTER_FINALIZER_NO_ORDER (SCM_UNPACK_POINTER (obj), finalize_guarded, - SCM_UNPACK_POINTER (finalizer_data), - &prev_finalizer, &prev_data); - - if (prev_finalizer == finalize_guarded) - { - /* OBJ is already guarded by another guardian: add GUARDIAN to its - list of guardians. */ - SCM prev_guardian_list, prev_finalizer_data; - - if (prev_data == NULL) - abort (); - - prev_finalizer_data = SCM_PACK_POINTER (prev_data); - if (!scm_is_pair (prev_finalizer_data)) - abort (); - - prev_guardian_list = SCM_CDR (prev_finalizer_data); - SCM_SETCDR (guardians_for_obj, prev_guardian_list); - - /* Also copy information about proxied finalizers. */ - SCM_SETCAR (finalizer_data, SCM_CAR (prev_finalizer_data)); - } - else if (prev_finalizer != NULL) - { - /* There was already a finalizer registered for OBJ so we will - ``proxy'' it, i.e., record it so that we can re-register it once - `finalize_guarded ()' has finished. */ - SCM proxied_finalizer; - - proxied_finalizer = scm_cons (SCM_PACK_POINTER (prev_finalizer), - SCM_PACK_POINTER (prev_data)); - SCM_SETCAR (finalizer_data, proxied_finalizer); - } - } + if (!SCM_HEAP_OBJECT_P (obj)) + return; + + register_guarded_value (obj, guardian); + g->live++; } static SCM @@ -338,12 +254,9 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0, t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian"); SCM z; - /* A tconc starts out with one tail pair. */ g->live = 0; g->zombies = SCM_EOL; - g->next = NULL; - SCM_NEWSMOB (z, tc16_guardian, g); return z; @@ -361,6 +274,8 @@ scm_init_guardians () scm_set_smob_print (tc16_guardian, guardian_print); scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 1, 0); + guarded_values = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); + #include "libguile/guardians.x" } diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test index bf5524a3e..aa62b3203 100644 --- a/test-suite/tests/guardians.test +++ b/test-suite/tests/guardians.test @@ -321,6 +321,7 @@ (with-test-prefix "guardians and weak references" (let ((p (make-object-property)) + (q (make-object-property)) (g (make-guardian)) (x (list 100))) (set! (p x) 100) @@ -329,6 +330,9 @@ (g x) (pass-if "(p x) (2)" (equal? (p x) 100)) + (set! (q x) 200) + (pass-if "(q x) (1)" + (equal? (q x) 200)) (set! x #f) (gc) (gc) (gc) (gc) (set! x (g)) @@ -339,4 +343,8 @@ (pass-if "(p x) (3)" (if (not x) (throw 'unresolved) - (equal? (p x) 100))))) + (equal? (p x) 100))) + (pass-if "(q x) (2)" + (if (not x) + (throw 'unresolved) + (equal? (q x) 200))))) |