Remove without-interrupts from runtime/global.scm.

Clean-obarray runs as a secondary-gc-deamon and thus, in SMPing
worlds, it may run in parallel with other threads on other processors.

A number of primitives and compiler utilities modify the obarray so an
SMPing microcode will use a pthread mutex to serialize access to it.
Clean-obarray now uses a new procedure, with-obarray-lock, that uses
new primitives to participate in the serialization.

diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 5790243a07f2a2039f4c747af604db3de25cdcdd..e6e79b09771c488d90868816a2fc2123898c8e50 100644 (file)
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -314,7 +314,9 @@ USA.
   (object-new-type (ucode-type constant) 1))
 \f
 (define (for-each-interned-symbol procedure)
-  (for-each-symbol-in-obarray (fixed-objects-item 'OBARRAY) procedure))
+  (with-obarray-lock
+    (lambda ()
+      (for-each-symbol-in-obarray (fixed-objects-item 'OBARRAY) procedure))))
 
 (define (for-each-symbol-in-obarray obarray procedure)
   (let per-bucket ((index (vector-length obarray)))
@@ -343,7 +345,7 @@ USA.
     list))
 
 (define (clean-obarray)
-  (without-interrupts
+  (with-obarray-lock
    (lambda ()
      (let ((obarray (fixed-objects-item 'OBARRAY)))
        (let loop ((index (vector-length obarray)))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 3f9435b94cf083b433274bc9b97a3d2977dbeb24..6bd86cd68ade1a27b7f16638949b3b2cc6da4707 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -543,6 +543,8 @@ USA.
          with-interrupt-mask
          with-values
          write-to-string)
+  (import (runtime thread)
+         with-obarray-lock)
   (initialization (initialize-package!)))
 
 (define-package (runtime alternative-lambda)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 370b91357a9a6ee7576f81728114cf425906d935..6074bbb4813312f63acf9fb562663b6f192f2720 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -180,6 +180,23 @@ USA.
       (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
+       (lambda ()
+        (if (not (eq? #t ((ucode-primitive smp-lock-obarray 1) #t)))
+            (outf-error "\nwith-obarray-lock: lock failed\n"))
+        (let ((value (thunk)))
+          (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)))
+
 (define (threads-list)
   (map-over-population thread-population (lambda (thread) thread)))