diff --git a/scheme/vm/interp.scm b/scheme/vm/interp.scm index bfd65aa..13677ce 100644 --- a/scheme/vm/interp.scm +++ b/scheme/vm/interp.scm @@ -28,7 +28,6 @@ ; Interrupts (define *enabled-interrupts*) ; bitmask of enabled interrupts -(define *pending-interrupts*) ; bitmask of pending interrupts (define s48-*pending-interrupt?*) ; true if an interrupt is pending (define *interrupted-template*) ; template in place when the most recent @@ -60,7 +59,7 @@ (set! *finalizer-alist* null) (set! *finalize-these* null) - (set! *pending-interrupts* 0) + (pending-interrupts-clear!) (set! s48-*pending-interrupt?* #f) (set! *interrupted-template* false) unspecific-value) diff --git a/scheme/vm/interrupt.scm b/scheme/vm/interrupt.scm index f9521e7..d6472a1 100644 --- a/scheme/vm/interrupt.scm +++ b/scheme/vm/interrupt.scm @@ -112,7 +112,7 @@ (goto return-unspecific 0))) ; The players: -; *pending-interrupts* A bit mask of pending interrupts +; pending-interrupts-X A bit mask of pending interrupts ; *enabled-interrupts* A bit mask of enabled interrupts ; s48-*pending-interrupt?* True if either an event or interrupt is pending ; s48-*pending-events?* True if an event is pending @@ -154,23 +154,20 @@ (define (any-pending-interrupts?) (or (pending-interrupt?) - (not (= 0 *pending-interrupts*)))) + (not (pending-interrupts-empty?)))) ; Add INTERRUPT to the set of pending interrupts, then check to see if it ; is currently pending. (define (note-interrupt! interrupt) - (set! *pending-interrupts* - (bitwise-ior *pending-interrupts* (interrupt-bit interrupt))) + (pending-interrupts-add! (interrupt-bit interrupt)) (check-for-enabled-interrupt!)) ; Remove INTERRUPT from the set of pending interrupts, then recheck for pending ; interrupts; INTERRUPT may have been the only one. (define (clear-interrupt! interrupt) - (set! *pending-interrupts* - (bitwise-and *pending-interrupts* - (bitwise-not (interrupt-bit interrupt)))) + (pending-interrupts-remove! (interrupt-bit interrupt)) (check-for-enabled-interrupt!)) ; Install a new set of enabled interrupts. As usual we have to recheck for @@ -195,7 +192,7 @@ ; set S48-*PENDING-INTERRUPT?* to the correct value. (define (check-for-enabled-interrupt!) - (if (= 0 (bitwise-and *pending-interrupts* *enabled-interrupts*)) + (if (= 0 (bitwise-and (pending-interrupts-mask) *enabled-interrupts*)) (begin (set! s48-*pending-interrupt?* #f) ; Done first to avoid a race condition. (if s48-*pending-events?* @@ -206,13 +203,12 @@ ; are about to be disabled. (define (get-highest-priority-interrupt!) - (let ((n (bitwise-and *pending-interrupts* *enabled-interrupts*))) + (let ((n (bitwise-and (pending-interrupts-mask) *enabled-interrupts*))) (let loop ((i 0) (m 1)) (cond ((= 0 (bitwise-and n m)) (loop (+ i 1) (* m 2))) (else - (set! *pending-interrupts* - (bitwise-and *pending-interrupts* (bitwise-not m))) + (pending-interrupts-remove! m) i))))) ; Process any pending OS events. PROCESS-EVENT returns a mask of any interrupts @@ -221,9 +217,7 @@ (define (check-events) (receive (type channel status) (get-next-event) - (set! *pending-interrupts* - (bitwise-ior (process-event type channel status) - *pending-interrupts*)) + (pending-interrupts-add! (process-event type channel status)) (if (eq? type (enum events no-event)) (begin (check-for-enabled-interrupt!) @@ -258,9 +252,5 @@ (error-message "unknown type of event") 0))) -; Return a bitmask for INTERRUPT. - -(define (interrupt-bit interrupt) - (shift-left 1 interrupt)) diff --git a/scheme/vm/package-defs.scm b/scheme/vm/package-defs.scm index 005dc94..f291a60 100644 --- a/scheme/vm/package-defs.scm +++ b/scheme/vm/package-defs.scm @@ -45,6 +45,7 @@ (interpreter-internal interpreter-internal-interface)) (open prescheme ps-receive vm-utilities vm-architecture enum-case events + pending-interrupts memory data stob struct allocation vmio interpreter-gc gc heap stack environment external) @@ -53,6 +54,39 @@ ;(optimize auto-integrate) ) +(define-structure pending-interrupts (export pending-interrupts-empty? + pending-interrupts-remove! + pending-interrupts-add! + pending-interrupts-clear! + pending-interrupts-mask + interrupt-bit) + (open prescheme) + (begin + (define *pending-interrupts*) ; bitmask of pending interrupts + + (define (pending-interrupts-add! interrupt-bit) + (set! *pending-interrupts* + (bitwise-ior *pending-interrupts* interrupt-bit))) + + (define (pending-interrupts-remove! interrupt-bit) + (set! *pending-interrupts* + (bitwise-and *pending-interrupts* + (bitwise-not interrupt-bit)))) + (define (pending-interrupts-clear!) + (set! *pending-interrupts* 0)) + + (define (pending-interrupts-empty?) + (= *pending-interrupts* 0)) + + (define (pending-interrupts-mask) + *pending-interrupts*) + + ; Return a bitmask for INTERRUPT. + + (define (interrupt-bit interrupt) + (shift-left 1 interrupt)) + )) + ; Assorted additional opcodes (define-structure arithmetic-opcodes (export) @@ -181,6 +215,7 @@ (define-structure vmio vmio-interface (open prescheme ps-receive channel-io vm-utilities data stob struct allocation memory + pending-interrupts interpreter-gc ;ensure-space vm-architecture) ;port-status ;(optimize auto-integrate) diff --git a/scheme/vm/vmio.scm b/scheme/vm/vmio.scm index 6cc4c6e..c147527 100644 --- a/scheme/vm/vmio.scm +++ b/scheme/vm/vmio.scm @@ -300,9 +300,18 @@ (enter-fixnum (channel-abort (extract-fixnum (channel-os-index channel))))) ((vm-eq? channel head) - (if input? - (dequeue-input-channel!) - (dequeue-output-channel!)) + (cond (input? + (dequeue-input-channel!) + (if (false? *pending-input-channels-head*) + (pending-interrupts-remove! + (interrupt-bit + (enum interrupt i/o-read-completion))))) + (else + (dequeue-output-channel!) + (if (false? *pending-output-channels-head*) + (pending-interrupts-remove! + (interrupt-bit + (enum interrupt i/o-write-completion)))))) (channel-os-status channel)) (else (let loop ((ch (channel-next head)) (prev head))