summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-02-19 12:23:45 +0100
committerAndy Wingo <wingo@pobox.com>2012-02-19 20:52:25 +0100
commit36931b31b5e90e4135d57e864d9a617481678c67 (patch)
treedc700d48ba9b8bf01385bbc53e31c20b50157aed
parentb7ad674fdc0b1f734e77e89e68c5c67bc3785f79 (diff)
downloadguile-36931b31b5e90e4135d57e864d9a617481678c67.tar.gz
reimplement guardians in terms of chained finalizers and weak tables
* libguile/guardians.c: Reimplement in terms of chained finalizers and weak tables. * test-suite/tests/guardians.test: Add test for weak mappings added after registering an object with a guardian.
-rw-r--r--libguile/guardians.c211
-rw-r--r--test-suite/tests/guardians.test10
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)))))