From 5372b2c1c640cf4b0ea5e2b13190eee6d29da716 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 5 Jan 2016 02:46:36 -0700
Subject: [PATCH] Punt without-preemption; use without-interrupts during
 callouts.

Its use 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(?).
---
 src/gl/gl-glxgears.scm  |  2 +-
 src/gl/gl.scm           |  2 +-
 src/runtime/ffi.scm     |  2 +-
 src/runtime/runtime.pkg |  1 -
 src/runtime/thread.scm  | 15 ++-------------
 5 files changed, 5 insertions(+), 17 deletions(-)

diff --git a/src/gl/gl-glxgears.scm b/src/gl/gl-glxgears.scm
index eafae92ee..f725055ee 100644
--- a/src/gl/gl-glxgears.scm
+++ b/src/gl/gl-glxgears.scm
@@ -198,7 +198,7 @@ USA.
 		(let loop ()
 
 		  ;; Sleep when not realized?, not animate?, or obscured.
-		  (without-interrupts
+		  (with-thread-events-blocked
 		   (lambda ()
 		     (let ((visibility (glxgears-demo-visibility widget)))
 		       (if (or (not (glxgears-demo-realized? widget))
diff --git a/src/gl/gl.scm b/src/gl/gl.scm
index d77326ced..0a6475a82 100644
--- a/src/gl/gl.scm
+++ b/src/gl/gl.scm
@@ -387,7 +387,7 @@ USA.
   (init))
 
 (define (with-gl-library thunk)
-  (with-thread-mutex-locked gl-library-mutex thunk))
+  (with-thread-mutex-lock gl-library-mutex thunk))
 
 (define (guarantee-current operator)
   (if (not (eq? (current-thread)
diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 0484ac535..55025e58c 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 43a57fca3..7b9a99b02 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5112,7 +5112,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 f3eee99dd..ac7d5dc4f 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)))
-- 
2.25.1