+ Factor out pending interrupts into a separate package.

+ Let vm-channel-abort clear the pending-i/o interrupt if the queue became empty

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)

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))
 
 

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)

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))