From: Matt Birkholz Date: Sun, 12 Jul 2015 23:47:14 +0000 (-0700) Subject: Remove without-interrupts from runtime/intrpt.scm. X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~36 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aa48e492d3733f374bb42996830808c97ba10e5f;p=mit-scheme.git 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(?). --- diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm index 866673bc0..71447caf6 100644 --- a/src/runtime/intrpt.scm +++ b/src/runtime/intrpt.scm @@ -193,83 +193,73 @@ 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/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