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 902bbcf1d88515c28c2bce40c3d8fed58236fbdd..95ae27f4dbdda23f8bb896e9282ccf6062193a8d 100644 (file)
--- 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)))