From b334e9bf0578821ed02762962bbcba5526a5a4da Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 9 Jun 2015 03:44:38 +0000 Subject: [PATCH] Revert "Remove support for recursion in WITH-THREAD-MUTEX-LOCKED." This reverts commit d7241d6fe8b151f6d15db9cac8fba44b074ca215. Evidently people did rely on this. --- src/runtime/thread.scm | 38 ++++++++++++++++++++++++++++++++------ 1 file changed, 32 insertions(+), 6 deletions(-) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 902bbcf1d..95ae27f4d 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -1110,15 +1110,41 @@ USA. (define (with-thread-mutex-locked mutex thunk) (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-LOCKED) - (dynamic-wind (lambda () (lock-thread-mutex mutex)) - thunk - (lambda () (unlock-thread-mutex mutex)))) + (let ((thread (current-thread)) + (grabbed-lock?)) + (dynamic-wind + (lambda () + (let ((owner (thread-mutex/owner mutex))) + (if (eq? owner thread) + (begin + (set! grabbed-lock? #f) + unspecific) + (begin + (set! grabbed-lock? #t) + (%lock-thread-mutex mutex thread owner))))) + thunk + (lambda () + (if (and grabbed-lock? (eq? (thread-mutex/owner mutex) thread)) + (%unlock-thread-mutex mutex thread)))))) (define (with-thread-mutex-unlocked mutex thunk) (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-UNLOCKED) - (dynamic-wind (lambda () (unlock-thread-mutex mutex)) - thunk - (lambda () (lock-thread-mutex mutex)))) + (let ((thread (current-thread)) + (released-lock?)) + (dynamic-wind + (lambda () + (let ((owner (thread-mutex/owner mutex))) + (if (not (eq? owner thread)) + (set! released-lock? #f) + (begin + (set! released-lock? #t) + (%unlock-thread-mutex mutex owner))))) + thunk + (lambda () + (if released-lock? + (let ((owner (thread-mutex/owner mutex))) + (if (not (eq? owner thread)) + (%lock-thread-mutex mutex thread owner)))))))) (define (%disassociate-thread-mutexes thread) (do ((mutexes (thread/mutexes thread) (cdr mutexes))) -- 2.25.1