From f47a605d0d75c51ba386ba46f41d76466c12ba7a Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 16 Nov 2014 20:25:27 +0000 Subject: [PATCH] Allow thread barriers to be named. --- src/runtime/thread-barrier.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) 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) -- 2.25.1