From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 10 Jul 2015 02:32:28 +0000 (-0700)
Subject: runtime/global: Use without-preemption in with-obarray-lock.
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ac15a3f764adef44a3e3d49881cf60619ce27042;p=mit-scheme.git

runtime/global: Use without-preemption in with-obarray-lock.
---

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index fb5ed81fb..e947ae8b6 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -76,15 +76,18 @@ USA.
   ;; Serialize with myriad parts of the microcode that hack the
   ;; obarray element of the fixed-objects vector.
   (if enable-smp?
-      (without-interrupts
+      (without-preemption
        (lambda ()
-	 (if (eq? #t ((ucode-primitive smp-lock-obarray 1) #t))
-	     (let ((value (thunk)))
-	       (if (eq? #t ((ucode-primitive smp-lock-obarray 1) #f))
-		   value
-		   (%outf-error "with-obarray-lock: unlock failed")))
-	     (%outf-error "with-obarray-lock: lock failed"))))
-      (without-interrupts thunk)))
+	 (if (not (eq? #t ((ucode-primitive smp-lock-obarray 1) #t)))
+	     (%outf-error "with-obarray-lock: lock failed"))
+	 (let ((value (thunk)))
+	   (if (not (eq? #t ((ucode-primitive smp-lock-obarray 1) #f)))
+	       (%outf-error "with-obarray-lock: unlock failed"))
+	   value)))
+      (let* ((mask (set-interrupt-enables! interrupt-mask/gc-ok))
+	     (value (thunk)))
+	(set-interrupt-enables! mask)
+	value)))
 
 (define (without-preemption thunk)
   (let* ((thread first-running-thread)