Add without-preemption.

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 968eb606535207bf567fca5e5b1575b88f2295b4..fb5ed81fb4274e3862a0f277033fa9277ad2783c 100644 (file)
--- 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)))
 \f
 (define-structure (thread
                   (constructor %make-thread (properties))