From 3fd97fd237fec5ef9a3646e482805a8479388adb Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 9 Jul 2015 19:30:06 -0700 Subject: [PATCH] Add without-preemption. --- src/runtime/runtime.pkg | 1 + src/runtime/thread.scm | 8 ++++++++ 2 files changed, 9 insertions(+) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index eadfc386d..e6e3d9b68 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -5078,6 +5078,7 @@ USA. with-thread-mutex-unlocked with-thread-timer-stopped (without-interruption with-thread-events-blocked) + without-preemption without-thread-mutex-lock yield-current-thread) (export (runtime interrupt-handler) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index ca55b1089..f61946fd0 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -127,6 +127,14 @@ USA. (set-interrupt-enables! interrupt-mask) value))) +(define (without-preemption thunk) + (let* ((thread (current-thread)) + (state (thread/execution-state thread))) + (set-thread/execution-state! thread 'RUNNING-WITHOUT-PREEMPTION) + (let ((value (thunk))) + (set-thread/execution-state! thread state) + value))) + (define (threads-list) (map-over-population thread-population (lambda (thread) thread))) -- 2.25.1