From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 5 Jan 2016 18:45:39 +0000 (-0700)
Subject: Punt without-preemption; use without-interrupts during callouts.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~7
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5f77879e2b9610f77082e853cdc619617167b909;p=mit-scheme.git

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 5c9095ebb..12e8d01d0 100644
--- 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 cb3d75795..4a9bdf35a 100644
--- 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 7dea7c180..fb9026a13 100644
--- 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)))