From 149f941587b5d8bd7573470ab4b821ac369f68b1 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 13 Nov 2014 22:45:03 +0000 Subject: [PATCH] Add GUARANTEE-THREAD-MUTEX-OWNED. --- src/runtime/runtime.pkg | 1 + src/runtime/thread.scm | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index f7214dc02..13da579e4 100644 --- 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 222a88a85..d1fe0abd9 100644 --- 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)) -- 2.25.1