run finalizers asynchronously (in asyncs and/or pthreads)

* libguile/finalizers.c: New excitement!  We'll be running finalizers in
  threads, if that's available.  If it's not available, during early
  boot, we can run finalizers in asyncs.  This will make it safer to
  allocate while holding a mutex.

* libguile/posix.c (scm_fork): Shut down the finalizer thread before
  forking.

* libguile/init.c (scm_i_init_guile): Init the async finalizer mechanism
  during boot and, if available, initialialize the finalizer thread at
  the very end.

* libguile/gc.c (scm_storage_prehistory): Tell libgc we'll be finalizing
  on demand.
  (scm_gc): Explicitly run finalizers here.  If you're calling this
  function, you probably want synchronous GC.

libguile/finalizers.c

@@ -23,12 +23,24 @@
 # include <config.h>
 #endif
 
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+
+#include <full-write.h>
+
 #include "libguile/bdw-gc.h"
 #include "libguile/_scm.h"
 #include "libguile/finalizers.h"
 #include "libguile/gc.h"
 #include "libguile/threads.h"
 
+
+
+static size_t finalization_count;
+
+
 
 
 void
@@ -117,10 +129,176 @@ scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
   shuffle_resuscitators_to_front (chained_data);
 }
 
+
 
 
+static SCM finalizer_async_cell;
+
+static SCM
+run_finalizers_async_thunk (void)
+{
+  finalization_count += GC_invoke_finalizers ();
+  return SCM_UNSPECIFIED;
+}
+
+
+/* The function queue_after_gc_hook is run by the scm_before_gc_c_hook
+ * at the end of the garbage collection.  The only purpose of this
+ * function is to mark the after_gc_async (which will eventually lead to
+ * the execution of the after_gc_async_thunk).
+ */
+static void
+queue_finalizer_async (void)
+{
+  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+  static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+  scm_i_pthread_mutex_lock (&lock);
+  if (scm_is_false (SCM_CDR (finalizer_async_cell)))
+    {
+      SCM_SETCDR (finalizer_async_cell, t->active_asyncs);
+      t->active_asyncs = finalizer_async_cell;
+      t->pending_asyncs = 1;
+    }
+  scm_i_pthread_mutex_unlock (&lock);
+}
+
+
+
+
+#if SCM_USE_PTHREAD_THREADS
+
+static int finalization_pipe[2];
+static scm_i_pthread_mutex_t finalization_thread_lock =
+  SCM_I_PTHREAD_MUTEX_INITIALIZER;
+static SCM finalization_thread = SCM_BOOL_F;
+
+static void
+notify_finalizers_to_run (void)
+{
+  char byte = 0;
+  full_write (finalization_pipe[1], &byte, 1);
+}
+
+static void
+notify_about_to_fork (void)
+{
+  char byte = 1;
+  full_write (finalization_pipe[1], &byte, 1);
+}
+
+struct finalization_pipe_data
+{
+  char byte;
+  ssize_t n;
+  int err;
+};
+
+static void*
+read_finalization_pipe_data (void *data)
+{
+  struct finalization_pipe_data *fdata = data;
+  
+  fdata->n = read (finalization_pipe[0], &fdata->byte, 1);
+  fdata->err = errno;
+
+  return NULL;
+}
+  
+static SCM
+finalization_thread_proc (void *unused)
+{
+  while (1)
+    {
+      struct finalization_pipe_data data;
+
+      scm_without_guile (read_finalization_pipe_data, &data);
+      
+      if (data.n <= 0 && data.err != EINTR) 
+        {
+          perror ("error in finalization delivery thread");
+          return SCM_UNSPECIFIED;
+        }
+
+      switch (data.byte)
+        {
+        case 0:
+          finalization_count += GC_invoke_finalizers ();
+          break;
+        case 1:
+          return SCM_UNSPECIFIED;
+        default:
+          abort ();
+        }
+    }
+}
+
+static void
+start_finalization_thread (void)
+{
+  scm_i_pthread_mutex_lock (&finalization_thread_lock);
+  if (scm_is_false (finalization_thread))
+    finalization_thread = scm_spawn_thread (finalization_thread_proc, NULL,
+                                            scm_handle_by_message,
+                                            "finalization thread");
+  scm_i_pthread_mutex_unlock (&finalization_thread_lock);
+}
+
+static void
+stop_finalization_thread (void)
+{
+  scm_i_pthread_mutex_lock (&finalization_thread_lock);
+  if (scm_is_true (finalization_thread))
+    {
+      notify_about_to_fork ();
+      scm_join_thread (finalization_thread);
+      finalization_thread = SCM_BOOL_F;
+    }
+  scm_i_pthread_mutex_unlock (&finalization_thread_lock);
+}
+
+static void
+spawn_finalizer_thread (void)
+{
+  GC_set_finalizer_notifier (notify_finalizers_to_run);
+  start_finalization_thread ();
+}
+
+#endif /* SCM_USE_PTHREAD_THREADS */
+
+
+
+
+void
+scm_i_finalizer_pre_fork (void)
+{
+#if SCM_USE_PTHREAD_THREADS
+  stop_finalization_thread ();
+  GC_set_finalizer_notifier (spawn_finalizer_thread);
+#endif
+}
+
+
+
 
 void
 scm_init_finalizers (void)
 {
+  /* When the async is to run, the cdr of the pair gets set to the
+     asyncs queue of the current thread.  */
+  finalizer_async_cell =
+    scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
+                                run_finalizers_async_thunk),
+              SCM_BOOL_F);
+  GC_set_finalizer_notifier (queue_finalizer_async);
+}
+
+void
+scm_init_finalizer_thread (void)
+{
+#if SCM_USE_PTHREAD_THREADS
+  if (pipe2 (finalization_pipe, O_CLOEXEC) != 0)
+    scm_syserror (NULL);
+  GC_set_finalizer_notifier (spawn_finalizer_thread);
+#endif
 }

libguile/finalizers.h

@@ -34,6 +34,9 @@ SCM_INTERNAL void scm_i_add_finalizer (void *obj, scm_t_finalizer_proc,
 SCM_INTERNAL void scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc,
                                           void *data);
 
+SCM_INTERNAL void scm_i_finalizer_pre_fork (void);
+
 SCM_INTERNAL void scm_init_finalizers (void);
+SCM_INTERNAL void scm_init_finalizer_thread (void);
 
 #endif  /* SCM_FINALIZERS_H */

libguile/gc.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 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
@@ -384,6 +384,7 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
 #define FUNC_NAME s_scm_gc
 {
   scm_i_gc ("call");
+  GC_invoke_finalizers ();
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -616,6 +617,7 @@ scm_storage_prehistory ()
   minimum_free_space_divisor = free_space_divisor;
   target_free_space_divisor = free_space_divisor;
   GC_set_free_space_divisor (free_space_divisor);
+  GC_set_finalize_on_demand (1);
 
   GC_INIT ();
 

libguile/init.c

@@ -59,6 +59,7 @@
 #include "libguile/expand.h"
 #include "libguile/feature.h"
 #include "libguile/filesys.h"
+#include "libguile/finalizers.h"
 #include "libguile/fluids.h"
 #include "libguile/fports.h"
 #include "libguile/frames.h"
@@ -421,6 +422,7 @@ scm_i_init_guile (void *base)
   scm_init_dynwind ();            /* requires smob_prehistory */
   scm_init_eq ();
   scm_init_error ();
+  scm_init_finalizers ();
   scm_init_fluids ();
   scm_init_control ();            /* requires fluids */
   scm_init_feature ();
@@ -529,6 +531,9 @@ scm_i_init_guile (void *base)
   /* Capture the dynamic state after loading boot-9, so that new threads end up
      in the guile-user module. */
   scm_init_threads_default_dynamic_state ();
+
+  /* Finally, cause finalizers to run in a separate thread.  */
+  scm_init_finalizer_thread ();
 }
 
 /*

libguile/posix.c

@@ -1248,6 +1248,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 #define FUNC_NAME s_scm_fork
 {
   int pid;
+  scm_i_finalizer_pre_fork ();
   if (scm_ilength (scm_all_threads ()) != 1)
     /* Other threads may be holding on to resources that Guile needs --
        it is not safe to permit one thread to fork while others are