Convert emit-linear-dispatch to use match
[bpt/guile.git] / libguile / guardians.c
index 8a0d296..86e39ee 100644 (file)
@@ -1,5 +1,5 @@
 /* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009, 2011,
- *   2012 Free Software Foundation, Inc.
+ *   2012, 2013 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
@@ -40,7 +40,6 @@
  * monsters we had...
  *
  * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Courtès.
- * FIXME: This is currently not thread-safe.
  */
 
 /* Uncomment the following line to debug guardian finalization.  */
@@ -51,7 +50,6 @@
 #endif
 
 #include "libguile/_scm.h"
-#include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/print.h"
 #include "libguile/smob.h"
@@ -71,6 +69,7 @@ static scm_t_bits tc16_guardian;
 
 typedef struct t_guardian
 {
+  scm_i_pthread_mutex_t mutex;
   unsigned long live;
   SCM zombies;
   struct t_guardian *next;
@@ -146,6 +145,9 @@ finalize_guarded (void *ptr, void *finalizer_data)
        }
 
       g = GUARDIAN_DATA (guardian);
+
+      scm_i_pthread_mutex_lock (&g->mutex);
+
       if (g->live == 0)
        abort ();
 
@@ -159,7 +161,8 @@ finalize_guarded (void *ptr, void *finalizer_data)
       g->zombies = zombies;
 
       g->live--;
-      g->zombies = zombies;
+
+      scm_i_pthread_mutex_unlock (&g->mutex);
     }
 
   if (scm_is_true (proxied_finalizer))
@@ -210,6 +213,8 @@ scm_i_guard (SCM guardian, SCM obj)
       void *prev_data;
       SCM guardians_for_obj, finalizer_data;
 
+      scm_i_pthread_mutex_lock (&g->mutex);
+
       g->live++;
 
       /* Note: GUARDIANS_FOR_OBJ holds weak references to guardians so
@@ -253,6 +258,8 @@ scm_i_guard (SCM guardian, SCM obj)
                                        SCM_PACK_POINTER (prev_data));
          SCM_SETCAR (finalizer_data, proxied_finalizer);
        }
+
+      scm_i_pthread_mutex_unlock (&g->mutex);
     }
 }
 
@@ -262,6 +269,8 @@ scm_i_get_one_zombie (SCM guardian)
   t_guardian *g = GUARDIAN_DATA (guardian);
   SCM res = SCM_BOOL_F;
 
+  scm_i_pthread_mutex_lock (&g->mutex);
+
   if (!scm_is_null (g->zombies))
     {
       /* Note: We return zombies in reverse order.  */
@@ -269,6 +278,8 @@ scm_i_get_one_zombie (SCM guardian)
       g->zombies = SCM_CDR (g->zombies);
     }
 
+  scm_i_pthread_mutex_unlock (&g->mutex);
+
   return res;
 }
 
@@ -339,6 +350,8 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
   t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
   SCM z;
 
+  scm_i_pthread_mutex_init (&g->mutex, NULL);
+
   /* A tconc starts out with one tail pair. */
   g->live = 0;
   g->zombies = SCM_EOL;
@@ -355,7 +368,7 @@ void
 scm_init_guardians ()
 {
   /* We use unordered finalization `a la Java.  */
-  GC_java_finalization = 1;
+  GC_set_java_finalization (1);
 
   tc16_guardian = scm_make_smob_type ("guardian", 0);