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

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 500cb5d2f1793c11b6be55a48dc1fc06785adda9..c56ba71f49b2a8f58e8dfc7d49fecdd2d4865d57 100644 (file)
--- 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 95ae27f4dbdda23f8bb896e9282ccf6062193a8d..f831f3ca02cae21a7229fa5be7869db57db67130 100644 (file)
--- 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))
-\f
+
 (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)))))
+\f
+(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)