From 3a5046c52bc47ff00948f4d52e2796a34af95ad7 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell 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