Add GUARANTEE-THREAD-MUTEX-OWNED.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f7214dc0232b00bc68d4e5bc55c029a36c355e46..13da579e4767ab4411d39138227cabe0f56f63f4 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5014,6 +5014,7 @@ USA.
          deregister-timer-event
          detach-thread
          exit-current-thread
+         guarantee-thread-mutex-owned
          join-thread
          lock-thread-mutex
          make-thread-mutex

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 222a88a8533e5afd1ad3768e2a2d8b1448055e0d..d1fe0abd963cf85d5ea478760ad08d6fb01bb42c 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -1041,6 +1041,13 @@ USA.
   (if (not (thread-mutex? mutex))
       (error:wrong-type-argument mutex "thread-mutex" procedure)))
 
+(define (guarantee-thread-mutex-owned mutex #!optional caller)
+  (guarantee-thread-mutex mutex 'GUARANTEE-THREAD-MUTEX-OWNED)
+  (if (not (eq? (current-thread) (thread-mutex/owner mutex)))
+      (if (default-object? caller)
+         (error "Don't own mutex:" mutex)
+         (error "Don't own mutex:" mutex caller))))
+
 (define (thread-mutex-owner mutex)
   (guarantee-thread-mutex mutex 'THREAD-MUTEX-OWNER)
   (thread-mutex/owner mutex))