From 3a5046c52bc47ff00948f4d52e2796a34af95ad7 Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 17 Nov 2014 06:04:26 +0000
Subject: [PATCH] Tweak condition variable locking.
- Use WITH-THREAD-MUTEX-LOCKED.
- Use ASSERT-THREAD-MUTEX-OWNED.
No functional changes intended.
---
src/runtime/condvar.scm | 36 ++++++++++--------------------------
1 file changed, 10 insertions(+), 26 deletions(-)
diff --git a/src/runtime/condvar.scm b/src/runtime/condvar.scm
index c1d23ce48..552c45310 100644
--- a/src/runtime/condvar.scm
+++ b/src/runtime/condvar.scm
@@ -42,7 +42,7 @@ USA.
(waiter-head #f read-only #t)
(waiter-tail #f read-only #t)
(specific unspecific)
- (thread-mutex (make-thread-mutex) read-only #t))
+ (lock (make-thread-mutex) read-only #t))
(define-guarantee condition-variable "condition variable")
@@ -54,23 +54,6 @@ USA.
(set-waiter.previous! waiter-tail waiter-head)
(%make-condition-variable name waiter-head waiter-tail)))
-(define (with-condition-variable-locked condvar procedure)
- (assert (condition-variable? condvar))
- (guarantee-procedure-of-arity procedure 0 'WITH-CONDITION-VARIABLE-LOCKED)
- (assert (not (condition-variable-locked? condvar)))
- (let ((thread-mutex (condition-variable.thread-mutex condvar)))
- (dynamic-wind (let ((done? #f))
- (lambda ()
- (if done? (error "Re-entry prohibited!"))
- (set! done? #t)
- (lock-thread-mutex thread-mutex)))
- procedure
- (lambda () (unlock-thread-mutex thread-mutex)))))
-
-(define (condition-variable-locked? condvar)
- (eq? (current-thread)
- (thread-mutex-owner (condition-variable.thread-mutex condvar))))
-
(define (condition-variable-name condvar)
(guarantee-condition-variable condvar 'CONDITION-VARIABLE-NAME)
(condition-variable.name condvar))
@@ -96,9 +79,10 @@ USA.
(define (%condition-variable-wait!/unlock condvar thread-mutex timeout)
(let ((waiter (make-waiter (current-thread))))
- (define (with-lock body) (with-condition-variable-locked condvar body))
(let ((blocked? (block-thread-events)))
- (with-lock (lambda () (enqueue-waiter! condvar waiter)))
+ (with-thread-mutex-locked (condition-variable.lock condvar)
+ (lambda ()
+ (enqueue-waiter! condvar waiter)))
(unlock-thread-mutex thread-mutex)
(let ((registration
(if (default-object? timeout)
@@ -118,7 +102,7 @@ USA.
(loop))))
(if (not (default-object? timeout))
(deregister-timer-event registration))
- (with-lock
+ (with-thread-mutex-locked (condition-variable.lock condvar)
(lambda ()
;; Signaller got interrupted or we timed out. Clean up.
(if (not (waiter-detached? condvar waiter))
@@ -128,7 +112,7 @@ USA.
(define (condition-variable-signal! condvar)
(guarantee-condition-variable condvar 'CONDITION-VARIABLE-SIGNAL!)
- (with-condition-variable-locked condvar
+ (with-thread-mutex-locked (condition-variable.lock condvar)
(lambda ()
(let ((head (condition-variable.waiter-head condvar))
(tail (condition-variable.waiter-tail condvar)))
@@ -159,7 +143,7 @@ USA.
(define (condition-variable-broadcast! condvar)
(guarantee-condition-variable condvar 'CONDITION-VARIABLE-BROADCAST!)
- (with-condition-variable-locked condvar
+ (with-thread-mutex-locked (condition-variable.lock condvar)
(lambda ()
(let ((head (condition-variable.waiter-head condvar))
(tail (condition-variable.waiter-tail condvar)))
@@ -187,13 +171,13 @@ USA.
(define (waiter-detached? condvar waiter)
(assert (condition-variable? condvar))
- (assert (condition-variable-locked? condvar))
+ (assert-thread-mutex-owned (condition-variable.lock condvar))
(not (or (waiter.previous waiter)
(waiter.next waiter))))
(define (enqueue-waiter! condvar waiter)
(assert (condition-variable? condvar))
- (assert (condition-variable-locked? condvar))
+ (assert-thread-mutex-owned (condition-variable.lock condvar))
(assert (waiter? waiter))
(assert (not (waiter.previous waiter)))
(assert (not (waiter.next waiter)))
@@ -214,7 +198,7 @@ USA.
(define (remove-waiter! condvar waiter)
(assert (condition-variable? condvar))
- (assert (condition-variable-locked? condvar))
+ (assert-thread-mutex-owned (condition-variable.lock condvar))
(assert (waiter? waiter))
(let ((previous (waiter.previous waiter))
(next (waiter.next waiter)))
--
2.25.1