Merge commit '2437c7b2e8b4ab7786847ee1ce0b59e446a70fe2'

Conflicts:
	libguile/guardians.c

diff --combined libguile/guardians.c
index 7619acf,2bf07a8..f2651a8
--- 1/libguile/guardians.c
--- 2/libguile/guardians.c
+++ b/libguile/guardians.c
@@@ -40,7 -40,6 +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.  */
@@@ -58,6 -57,7 +57,6 @@@
  #include "libguile/validate.h"
  #include "libguile/root.h"
  #include "libguile/hashtab.h"
 -#include "libguile/weaks.h"
  #include "libguile/deprecation.h"
  #include "libguile/eval.h"
  
@@@ -71,6 -71,7 +70,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;
@@@ -87,16 -88,16 +87,16 @@@ guardian_print (SCM guardian, SCM port
  {
    t_guardian *g = GUARDIAN_DATA (guardian);
    
 -  scm_puts ("#<guardian ", port);
 +  scm_puts_unlocked ("#<guardian ", port);
    scm_uintprint ((scm_t_bits) g, 16, port);
  
 -  scm_puts (" (reachable: ", port);
 +  scm_puts_unlocked (" (reachable: ", port);
    scm_display (scm_from_uint (g->live), port);
 -  scm_puts (" unreachable: ", port);
 +  scm_puts_unlocked (" unreachable: ", port);
    scm_display (scm_length (g->zombies), port);
 -  scm_puts (")", port);
 +  scm_puts_unlocked (")", port);
  
 -  scm_puts (">", port);
 +  scm_puts_unlocked (">", port);
  
    return 1;
  }
@@@ -109,9 -110,9 +109,9 @@@ finalize_guarded (void *ptr, void *fina
    SCM cell_pool;
    SCM obj, guardian_list, proxied_finalizer;
  
 -  obj = PTR2SCM (ptr);
 -  guardian_list = SCM_CDR (PTR2SCM (finalizer_data));
 -  proxied_finalizer = SCM_CAR (PTR2SCM (finalizer_data));
 +  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",
@@@ -131,12 -132,9 +131,12 @@@
         guardian_list = SCM_CDR (guardian_list))
      {
        SCM zombies;
 +      SCM guardian;
        t_guardian *g;
  
 -      if (SCM_WEAK_PAIR_CAR_DELETED_P (guardian_list))
 +      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
@@@ -145,7 -143,10 +145,10 @@@
          continue;
        }
  
 -      g = GUARDIAN_DATA (SCM_CAR (guardian_list));
 +      g = GUARDIAN_DATA (guardian);
+ 
+       scm_i_pthread_mutex_lock_block_asyncs (&g->mutex);
+ 
        if (g->live == 0)
        abort ();
  
@@@ -159,7 -160,8 +162,8 @@@
        g->zombies = zombies;
  
        g->live--;
-       g->zombies = zombies;
+ 
+       scm_i_pthread_mutex_unlock_unblock_asyncs (&g->mutex);
      }
  
    if (scm_is_true (proxied_finalizer))
@@@ -169,8 -171,8 +173,8 @@@
        GC_finalization_proc finalizer, prev_finalizer;
        void *finalizer_data, *prev_finalizer_data;
  
 -      finalizer = (GC_finalization_proc) SCM2PTR (SCM_CAR (proxied_finalizer));
 -      finalizer_data = SCM2PTR (SCM_CDR (proxied_finalizer));
 +      finalizer = (GC_finalization_proc) SCM_UNPACK_POINTER (SCM_CAR (proxied_finalizer));
 +      finalizer_data = SCM_UNPACK_POINTER (SCM_CDR (proxied_finalizer));
  
        if (finalizer == NULL)
        abort ();
@@@ -194,7 -196,7 +198,7 @@@ scm_i_guard (SCM guardian, SCM obj
  {
    t_guardian *g = GUARDIAN_DATA (guardian);
  
 -  if (SCM_NIMP (obj))
 +  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
@@@ -210,17 -212,17 +214,19 @@@
        void *prev_data;
        SCM guardians_for_obj, finalizer_data;
  
+       scm_i_pthread_mutex_lock_block_asyncs (&g->mutex);
+ 
        g->live++;
  
 -      /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be
 -       collected before the objects it guards (see `guardians.test').  */
 -      guardians_for_obj = scm_weak_car_pair (guardian, SCM_EOL);
 +      /* 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 (SCM2PTR (obj), finalize_guarded,
 -                                    SCM2PTR (finalizer_data),
 +      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)
@@@ -232,7 -234,7 +238,7 @@@
          if (prev_data == NULL)
            abort ();
  
 -        prev_finalizer_data = PTR2SCM (prev_data);
 +        prev_finalizer_data = SCM_PACK_POINTER (prev_data);
          if (!scm_is_pair (prev_finalizer_data))
            abort ();
  
@@@ -249,10 -251,12 +255,12 @@@
             `finalize_guarded ()' has finished.  */
          SCM proxied_finalizer;
  
 -        proxied_finalizer = scm_cons (PTR2SCM (prev_finalizer),
 -                                      PTR2SCM (prev_data));
 +        proxied_finalizer = scm_cons (SCM_PACK_POINTER (prev_finalizer),
 +                                      SCM_PACK_POINTER (prev_data));
          SCM_SETCAR (finalizer_data, proxied_finalizer);
        }
+ 
+       scm_i_pthread_mutex_unlock_unblock_asyncs (&g->mutex);
      }
  }
  
@@@ -262,6 -266,8 +270,8 @@@ scm_i_get_one_zombie (SCM guardian
    t_guardian *g = GUARDIAN_DATA (guardian);
    SCM res = SCM_BOOL_F;
  
+   scm_i_pthread_mutex_lock_block_asyncs (&g->mutex);
+ 
    if (!scm_is_null (g->zombies))
      {
        /* Note: We return zombies in reverse order.  */
@@@ -269,6 -275,8 +279,8 @@@
        g->zombies = SCM_CDR (g->zombies);
      }
  
+   scm_i_pthread_mutex_unlock_unblock_asyncs (&g->mutex);
+ 
    return res;
  }
  
@@@ -339,6 -347,8 +351,8 @@@ SCM_DEFINE (scm_make_guardian, "make-gu
    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 -365,13 +369,7 @@@ voi
  scm_init_guardians ()
  {
    /* We use unordered finalization `a la Java.  */
 -#ifdef HAVE_GC_SET_JAVA_FINALIZATION
 -  /* This function was added in 7.2alpha2 (June 2009).  */
    GC_set_java_finalization (1);
 -#else
 -  /* This symbol is deprecated as of 7.3.  */
 -  GC_java_finalization = 1;
 -#endif
  
    tc16_guardian = scm_make_smob_type ("guardian", 0);