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