From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 16 Nov 2014 20:25:27 +0000 (+0000)
Subject: Allow thread barriers to be named.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~108
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f47a605d0d75c51ba386ba46f41d76466c12ba7a;p=mit-scheme.git

Allow thread barriers to be named.
---

diff --git a/src/runtime/thread-barrier.scm b/src/runtime/thread-barrier.scm
index 48a75d92a..01e64f874 100644
--- a/src/runtime/thread-barrier.scm
+++ b/src/runtime/thread-barrier.scm
@@ -30,19 +30,23 @@ USA.
 (declare (usual-integrations))
 
 (define-structure (thread-barrier
-		   (constructor %make-thread-barrier (count current))
+		   (constructor %make-thread-barrier (count current condvar))
 		   (conc-name thread-barrier.))
   (lock (make-thread-mutex) read-only #t)
-  (condvar (make-condition-variable) read-only #t)
+  (condvar #f read-only #t)
   (count #f read-only #t)
   current
   (generation 0))
 
 (define-guarantee thread-barrier "thread barrier")
 
-(define (make-thread-barrier count)
+(define (make-thread-barrier count #!optional name)
   (guarantee-exact-positive-integer count 'MAKE-THREAD-BARRIER)
-  (%make-thread-barrier count count))
+  (let ((current count)
+        (condvar
+         (make-condition-variable
+          (if (default-object? name) "thread barrier" name))))
+    (%make-thread-barrier count current condvar)))
 
 (define (thread-barrier-wait barrier)
   (guarantee-thread-barrier barrier 'THREAD-BARRIER-WAIT)