From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 9 Jun 2015 04:21:20 +0000 (+0000)
Subject: New WITH-THREAD-MUTEX-LOCKED rejects recursion like LOCK-THREAD-MUTEX.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~95
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cffc216516afc0f098155747a7bce92a89f4841e;p=mit-scheme.git

New WITH-THREAD-MUTEX-LOCKED rejects recursion like LOCK-THREAD-MUTEX.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 500cb5d2f..c56ba71f4 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5044,9 +5044,11 @@ USA.
 	  unlock-thread-mutex
 	  with-create-thread-continuation
 	  with-thread-events-blocked
+	  with-thread-mutex-lock
 	  with-thread-mutex-locked
 	  with-thread-mutex-unlocked
 	  with-thread-timer-stopped
+	  without-thread-mutex-lock
 	  yield-current-thread)
   (export (runtime interrupt-handler)
 	  thread-timer-interrupt-handler)
diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 95ae27f4d..f831f3ca0 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -1097,7 +1097,7 @@ USA.
     (set-thread-mutex/owner! mutex thread)
     (if thread (%signal-thread-event thread #f))
     thread))
-
+
 (define (try-lock-thread-mutex mutex)
   (guarantee-thread-mutex mutex 'TRY-LOCK-THREAD-MUTEX)
   (without-interrupts
@@ -1107,6 +1107,24 @@ USA.
 	    (set-thread-mutex/owner! mutex thread)
 	    (add-thread-mutex! thread mutex)
 	    #t)))))
+
+(define (with-thread-mutex-lock mutex thunk)
+  (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-LOCK)
+  (dynamic-wind (lambda () (lock-thread-mutex mutex))
+		thunk
+		(lambda () (unlock-thread-mutex mutex))))
+
+(define (without-thread-mutex-lock mutex thunk)
+  (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-LOCK)
+  (dynamic-wind (lambda () (unlock-thread-mutex mutex))
+		thunk
+		(lambda () (lock-thread-mutex mutex))))
+
+;;; WITH-THREAD-MUTEX-LOCKED is retained for compatibility for old
+;;; programs that require recursion.  For new programs, better to
+;;; refactor into clearer invariants that do not require recursion if
+;;; possible and use WITH-THREAD-MUTEX-LOCK to help detect lock order
+;;; mistakes.
 
 (define (with-thread-mutex-locked mutex thunk)
   (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-LOCKED)