Remove without-interrupts from runtime/intrpt.scm.
authorMatt Birkholz <puck@birchwood-abbey.net>
Sun, 12 Jul 2015 23:47:14 +0000 (16:47 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Mon, 17 Aug 2015 23:52:59 +0000 (16:52 -0700)
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(?).

src/runtime/intrpt.scm

index 866673bc01f1748c1ec9eceb5238db64e63397f4..71447caf677e706348f3ffe7106a29a98b2aafaa 100644 (file)
@@ -193,83 +193,73 @@ 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/gc-ok)
-
-        (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/gc-ok)
+
+       (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)
+
+       (set-fixed-objects-vector! fov)))))
\ No newline at end of file