Punt without-preemption; use without-interrupts during callouts.

Using without-preemption in (runtime ffi) causes timer interrupts to
be ignored -- COMPLETELY ignored in the glxgears demo's animation
loop.  It is probably no more helpful in with-obarray-lock(?).

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 5c9095ebb3b8ef126facd2e040a5a4e0e892e644..12e8d01d0cb05be82cee2fea6116579fda787782 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -313,7 +313,7 @@ USA.
      (if (alien-function? arg)
         (alien-function-cache! arg)))
    args)
-  (without-preemption
+  (without-interrupts
    (lambda ()
      (call-alien* alien-function args))))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index cb3d757952fc4c7864e33647a9a27f256244eda7..4a9bdf35acf781c2cb9f32101621ca9ed9ff27b4 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5111,7 +5111,6 @@ USA.
          with-thread-mutex-unlocked
          with-thread-timer-stopped
          (without-interruption with-thread-events-blocked)
-         without-preemption
          without-thread-mutex-lock
          yield-current-thread)
   (import (runtime population)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 7dea7c180f89238dc69e1bfee3a3e805084344c7..fb9026a13be5f1a590a40b190ee455c0cdad7fa9 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -172,19 +172,11 @@ 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 (with-obarray-lock thunk)
   ;; Serialize with myriad parts of the microcode that hack the
   ;; obarray element of the fixed-objects vector.
   (if enable-smp?
-      (without-preemption
+      (without-interrupts
        (lambda ()
         (if (not (eq? #t ((ucode-primitive smp-lock-obarray 1) #t)))
             (outf-error "\nwith-obarray-lock: lock failed\n"))
@@ -192,10 +184,7 @@ USA.
           (if (not (eq? #t ((ucode-primitive smp-lock-obarray 1) #f)))
               (outf-error "\nwith-obarray-lock: unlock failed\n"))
           value)))
-      (let* ((mask (set-interrupt-enables! interrupt-mask/gc-ok))
-            (value (thunk)))
-       (set-interrupt-enables! mask)
-       value)))
+      (without-interrupts thunk)))
 
 (define (threads-list)
   (map-over-population thread-population (lambda (thread) thread)))