From a8a631ff14ad80a3e8fae4de410f2ca20bd1a2f3 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/thread.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 968eb6065..fb5ed81fb 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -85,6 +85,14 @@ USA. (%outf-error "with-obarray-lock: unlock failed"))) (%outf-error "with-obarray-lock: lock failed")))) (without-interrupts thunk))) + +(define (without-preemption thunk) + (let* ((thread first-running-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-structure (thread (constructor %make-thread (properties)) -- 2.25.1