From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 9 Jun 2015 03:44:38 +0000 (+0000)
Subject: Revert "Remove support for recursion in WITH-THREAD-MUTEX-LOCKED."
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~96
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b334e9bf0578821ed02762962bbcba5526a5a4da;p=mit-scheme.git

Revert "Remove support for recursion in WITH-THREAD-MUTEX-LOCKED."

This reverts commit d7241d6fe8b151f6d15db9cac8fba44b074ca215.

Evidently people did rely on this.
---

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)))