From d27718a05c0c188221c0d0c6fac815624d12df3b Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sun, 12 Jul 2015 15:42:00 -0700 Subject: [PATCH] Add with-thread-mutex-try-lock. --- src/runtime/runtime.pkg | 1 + src/runtime/thread.scm | 11 +++++++++++ 2 files changed, 12 insertions(+) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index e13a7c9ff..602a5a3ed 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -5074,6 +5074,7 @@ USA. with-thread-events-blocked with-thread-mutex-lock with-thread-mutex-locked + with-thread-mutex-try-lock with-thread-mutex-unlocked with-thread-timer-stopped without-thread-mutex-lock diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index feafed932..ca55b1089 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -1122,6 +1122,17 @@ USA. thunk (lambda () (lock-thread-mutex mutex)))) +(define (with-thread-mutex-try-lock mutex locked not-locked) + (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-TRY-LOCK) + (let ((locked?)) + (dynamic-wind (lambda () + (set! locked? (try-lock-thread-mutex mutex))) + (lambda () + (if locked? (locked) (not-locked))) + (lambda () + (if locked? (unlock-thread-mutex mutex)) + (set! locked?))))) + ;;; 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 -- 2.25.1