Allow thread barriers to be named.

diff --git a/src/runtime/thread-barrier.scm b/src/runtime/thread-barrier.scm
index 48a75d92a962a72c49c578cd3f7ccc71d7efdeff..01e64f874cf5cc02c7d654b40a396393d8dd9fd9 100644 (file)
--- a/src/runtime/thread-barrier.scm
+++ b/src/runtime/thread-barrier.scm
@@ -30,19 +30,23 @@ USA.
 (declare (usual-integrations))
 \f
 (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)