From f4e45e91f265429ad1c42d3905dd3c05a0bc0924 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 26 May 2011 18:14:32 +0200
Subject: [PATCH 1/2] lazily init futures worker pool

* module/ice-9/futures.scm (%workers, %create-workers!)
  (create-workers!): Define a mechanism to spawn off the future threads
  only when the first future is created.
  (make-future): Call create-workers! here.
---
 module/ice-9/futures.scm | 35 ++++++++++++++++++++++-------------
 1 file changed, 22 insertions(+), 13 deletions(-)

diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 1aebaa626..012ebbf3f 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011 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
@@ -54,6 +54,7 @@
   "Return a new future for THUNK.  Execution may start at any point
 concurrently, or it can start at the time when the returned future is
 touched."
+  (create-workers!)
   (let ((future (%make-future thunk #f (make-mutex))))
     (register-future! future)
     future))
@@ -145,19 +146,27 @@ touched."
       (- (current-processor-count) 1)
       0))
 
-(define %workers
-  ;; A dock of workers that stay here forever.
+;; A dock of workers that stay here forever.
 
-  ;; TODO
-  ;; 1. Allocate lazily.
-  ;; 2. Allow the pool to be shrunk, as in libgomp (though that we'd
-  ;;    need semaphores, which aren't yet in libguile!).
-  ;; 3. Provide a `worker-count' fluid.
-  (unfold (lambda (i) (>= i %worker-count))
-          (lambda (i)
-            (call-with-new-thread process-futures))
-          1+
-          0))
+;; TODO
+;; 1. Allow the pool to be shrunk, as in libgomp (though that we'd
+;;    need semaphores, which aren't yet in libguile!).
+;; 2. Provide a `worker-count' fluid.
+(define %workers '())
+
+(define (%create-workers!)
+  (lock-mutex %futures-mutex)
+  (set! %workers
+        (unfold (lambda (i) (>= i %worker-count))
+                (lambda (i)
+                  (call-with-new-thread process-futures))
+                1+
+                0))
+  (set! create-workers! (lambda () #t))
+  (unlock-mutex %futures-mutex))
+
+(define create-workers!
+  (lambda () (%create-workers!)))
 
 
 ;;;

From af4081e9fd1d3bfaf4df906cac990c88e2e7cfa2 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 26 May 2011 18:29:05 +0200
Subject: [PATCH 2/2] leave guile when reading signal pipe

* libguile/scmsigs.c (read_signal_pipe_data, signal_delivery_thread):
  Leave guile when reading from the signal pipe.  Hopefully that lets GC
  know not to wake up this thread.
---
 libguile/scmsigs.c | 36 ++++++++++++++++++++++++++++--------
 1 file changed, 28 insertions(+), 8 deletions(-)

diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 699a6de83..641d1b3c8 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009, 2011 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
@@ -148,11 +148,28 @@ take_signal (int signum)
 #endif
 }
 
+struct signal_pipe_data
+{
+  char sigbyte;
+  ssize_t n;
+  int err;
+};
+
+static void*
+read_signal_pipe_data (void * data)
+{
+  struct signal_pipe_data *sdata = data;
+  
+  sdata->n = read (signal_pipe[0], &sdata->sigbyte, 1);
+  sdata->err = errno;
+
+  return NULL;
+}
+  
 static SCM
 signal_delivery_thread (void *data)
 {
-  int n, sig;
-  char sigbyte;
+  int sig;
 #if HAVE_PTHREAD_SIGMASK  /* not on mingw, see notes above */
   sigset_t all_sigs;
   sigfillset (&all_sigs);
@@ -161,9 +178,12 @@ signal_delivery_thread (void *data)
 
   while (1)
     {
-      n = read (signal_pipe[0], &sigbyte, 1);
-      sig = sigbyte;
-      if (n == 1 && sig >= 0 && sig < NSIG)
+      struct signal_pipe_data sigdata;
+
+      scm_without_guile (read_signal_pipe_data, &sigdata);
+      
+      sig = sigdata.sigbyte;
+      if (sigdata.n == 1 && sig >= 0 && sig < NSIG)
 	{
 	  SCM h, t;
 
@@ -172,9 +192,9 @@ signal_delivery_thread (void *data)
 	  if (scm_is_true (h))
 	    scm_system_async_mark_for_thread (h, t);
 	}
-      else if (n == 0)
+      else if (sigdata.n == 0)
 	break; /* the signal pipe was closed. */
-      else if (n < 0 && errno != EINTR)
+      else if (sigdata.n < 0 && sigdata.err != EINTR)
 	perror ("error in signal delivery thread");
     }