Re: [PATCH] Futures: Avoid creating the worker pool more than once

[Mark H Weaver]

Here's an improved version the patch that gracefully handles the case
where creation of the worker pool is unsuccessful due to an exception or
cancelled thread.

What do you think?

    Mark

>From b0d936a348b916e73e9071abeb7baae3d7c126d3 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Wed, 7 Nov 2012 08:39:42 -0500
Subject: [PATCH] Futures: Avoid creating the worker pool more than once.

* module/ice-9/futures.scm (%create-workers!): Use 'with-mutex' in case
  an exception is thrown.  Within the critical section, check to make
  sure the worker pool hasn't already been created by another thread.
---
 module/ice-9/futures.scm |   24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 0f64b5c..7fbccf6 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -19,6 +19,7 @@
 (define-module (ice-9 futures)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 threads)
   #:use-module (ice-9 q)
   #:export (future make-future future? touch))
 
@@ -157,15 +158,20 @@ touched."
 (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))
+  (with-mutex
+   %futures-mutex
+   ;; Setting 'create-workers!' to a no-op is an optimization, but it is
+   ;; still possible for '%create-workers!' to be called more than once
+   ;; from different threads.  Therefore, to avoid creating %workers more
+   ;; than once (and thus creating too many threads), we check to make
+   ;; sure %workers is empty within the critical section.
+   (when (null? %workers)
+     (set! %workers
+           (unfold (lambda (i) (>= i %worker-count))
+                   (lambda (i) (call-with-new-thread process-futures))
+                   1+
+                   0))
+     (set! create-workers! (lambda () #t)))))
 
 (define create-workers!
   (lambda () (%create-workers!)))
-- 
1.7.10.4