From d24f869e8290ff7a7496231b7f6b3bb58d65ae16 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 10 Jul 2015 12:24:22 -0700 Subject: [PATCH] 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. --- src/runtime/intrpt.scm | 149 +++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 81 deletions(-) diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm index 45d408e6a..c32f8bff1 100644 --- 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))))))) (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 -- 2.25.1