Remove without-interrupts from runtime/intrpt.scm.

It was only used in the internal install procedure where an "atomic"
updated was described.  Punted that and assumed the procedure is not
run in multiple threads concurrently.  It should be called only during
the single-threaded cold load or in a careful developer's REPL(?).

Remove set-fixed-objects-vector! too; assume the fixed objects vector
is not a copy.

diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm
index 45d408e6a77819c30e8148093b4d83e5da8e330f..c32f8bff14d5246cf3c905a4063e2f241eda9eb8 100644 (file)
--- a/src/runtime/intrpt.scm
+++ b/src/runtime/intrpt.scm
@@ -59,7 +59,6 @@ USA.
 (define-primitives
   (clear-interrupts! 1)
   (tty-next-interrupt-char 0)
-  set-fixed-objects-vector!
   (process-timer-clear 0)
   (real-timer-clear 0))
 
@@ -200,83 +199,71 @@ USA.
                (interrupt)))))))
 \f
 (define (install)
-  (without-interrupts
-   (lambda ()
-     (let ((system-interrupt-vector
-           (vector-ref (get-fixed-objects-vector) index:interrupt-vector))
-          (old-interrupt-mask-vector
-           (vector-ref (get-fixed-objects-vector)
-                       index:interrupt-mask-vector))
-          (old-termination-vector
-           (vector-ref (get-fixed-objects-vector) index:termination-vector)))
-       (let ((interrupt-mask-vector
-             (let ((length (vector-length system-interrupt-vector)))
-               (if (and (vector? old-interrupt-mask-vector)
-                        (= (vector-length old-interrupt-mask-vector) length))
-                   old-interrupt-mask-vector
-                   (make-vector length))))
-            (termination-vector
-             (let ((length (microcode-termination/code-limit)))
-               (if old-termination-vector
-                   (if (> length (vector-length old-termination-vector))
-                       (vector-grow old-termination-vector length)
-                       old-termination-vector)
-                   (make-vector length #f)))))
-
-        (let ((length (vector-length system-interrupt-vector)))
-          (do ((i 0 (fix:+ i 1)))
-              ((fix:= i length))
-            (if (not (vector-ref system-interrupt-vector i))
-                (let ((interrupt-bit (fix:lsh 1 i)))
-                  (vector-set! interrupt-mask-vector i
-                               (fix:- interrupt-bit 1)) ; higher priority only
-                  (vector-set! system-interrupt-vector i
-                               (illegal-interrupt-handler interrupt-bit))))))
-
-        (vector-set! interrupt-mask-vector stack-overflow-slot
-                     interrupt-mask/none)
-
-        (vector-set! interrupt-mask-vector gc-slot
-                     ;; interrupt-mask/none
-                     (fix:lsh 1 global-gc-slot))
-
-        (vector-set! system-interrupt-vector timer-slot
-                     timer-interrupt-handler)
-        (vector-set! interrupt-mask-vector timer-slot
-                     interrupt-mask/none)
-
-        (vector-set! system-interrupt-vector character-slot
-                     external-interrupt-handler)
-        (vector-set! interrupt-mask-vector character-slot
-                     interrupt-mask/timer-ok)
-
-        (vector-set! system-interrupt-vector after-gc-slot
-                     after-gc-interrupt-handler)
-        (vector-set! interrupt-mask-vector after-gc-slot
-                     interrupt-mask/timer-ok)
-
-        (vector-set! system-interrupt-vector suspend-slot
-                     suspend-interrupt-handler)
-        (vector-set! interrupt-mask-vector suspend-slot
-                     interrupt-mask/timer-ok)
-
-         (vector-set! system-interrupt-vector console-resize-slot
-                      console-resize-handler)
-         (vector-set! interrupt-mask-vector console-resize-slot
-                      interrupt-mask/all)
-
-        (vector-set! termination-vector
-                     (microcode-termination 'GC-OUT-OF-SPACE)
-                     gc-out-of-space-handler)
-
-        ;; Install the new tables atomically:
-
-        (vector-set! (get-fixed-objects-vector)
-                     index:interrupt-mask-vector
-                     interrupt-mask-vector)
-
-        (vector-set! (get-fixed-objects-vector)
-                     index:termination-vector
-                     termination-vector)
-
-        (set-fixed-objects-vector! (get-fixed-objects-vector)))))))
\ No newline at end of file
+  (let ((fov (get-fixed-objects-vector)))
+    (let ((system-interrupt-vector (vector-ref fov index:interrupt-vector))
+         (old-interrupt-mask-vector (vector-ref fov
+                                                index:interrupt-mask-vector))
+         (old-termination-vector (vector-ref fov index:termination-vector)))
+      (let ((interrupt-mask-vector
+            (let ((length (vector-length system-interrupt-vector)))
+              (if (and (vector? old-interrupt-mask-vector)
+                       (= (vector-length old-interrupt-mask-vector) length))
+                  old-interrupt-mask-vector
+                  (make-vector length))))
+           (termination-vector
+            (let ((length (microcode-termination/code-limit)))
+              (if old-termination-vector
+                  (if (> length (vector-length old-termination-vector))
+                      (vector-grow old-termination-vector length)
+                      old-termination-vector)
+                  (make-vector length #f)))))
+
+       (let ((length (vector-length system-interrupt-vector)))
+         (do ((i 0 (fix:+ i 1)))
+             ((fix:= i length))
+           (if (not (vector-ref system-interrupt-vector i))
+               (let ((interrupt-bit (fix:lsh 1 i)))
+                 (vector-set! interrupt-mask-vector i
+                              (fix:- interrupt-bit 1)) ; higher priority only
+                 (vector-set! system-interrupt-vector i
+                              (illegal-interrupt-handler interrupt-bit))))))
+
+       (vector-set! interrupt-mask-vector stack-overflow-slot
+                    interrupt-mask/none)
+
+       (vector-set! interrupt-mask-vector gc-slot
+                    ;; interrupt-mask/none
+                    (fix:lsh 1 global-gc-slot))
+
+       (vector-set! system-interrupt-vector timer-slot
+                    timer-interrupt-handler)
+       (vector-set! interrupt-mask-vector timer-slot
+                    interrupt-mask/none)
+
+       (vector-set! system-interrupt-vector character-slot
+                    external-interrupt-handler)
+       (vector-set! interrupt-mask-vector character-slot
+                    interrupt-mask/timer-ok)
+
+       (vector-set! system-interrupt-vector after-gc-slot
+                    after-gc-interrupt-handler)
+       (vector-set! interrupt-mask-vector after-gc-slot
+                    interrupt-mask/timer-ok)
+
+       (vector-set! system-interrupt-vector suspend-slot
+                    suspend-interrupt-handler)
+       (vector-set! interrupt-mask-vector suspend-slot
+                    interrupt-mask/timer-ok)
+
+       (vector-set! system-interrupt-vector console-resize-slot
+                    console-resize-handler)
+       (vector-set! interrupt-mask-vector console-resize-slot
+                    interrupt-mask/all)
+
+       (vector-set! termination-vector
+                    (microcode-termination 'GC-OUT-OF-SPACE)
+                    gc-out-of-space-handler)
+
+       (vector-set! fov index:interrupt-mask-vector interrupt-mask-vector)
+
+       (vector-set! fov index:termination-vector termination-vector)))))
\ No newline at end of file