From c84c224ffea5264463b0d28213907561c0e6f220 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 9 Jul 2015 19:13:14 -0700 Subject: [PATCH] For master: 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 9ceeeb101..3c4b9d12b 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -5084,6 +5084,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-interruption with-thread-events-blocked) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 71ecfe30f..968eb6065 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -1392,6 +1392,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