From 8e62c5ced53fdb0a15eb7ea0a342ce15b48769ec Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 10 Sep 1993 19:15:54 +0000
Subject: [PATCH] Change BLOCK-ON-INPUT-DESCRIPTOR to return one of the three
 symbols: INPUT-AVAILABLE, PROCESS-STATUS-CHANGE, or INTERRUPT.  This call
 will now reliably return PROCESS-STATUS-CHANGE when the microcode signals
 such a change.

---
 v7/src/runtime/io.scm     |  6 ++--
 v7/src/runtime/thread.scm | 59 +++++++++++++++++++++++++--------------
 2 files changed, 40 insertions(+), 25 deletions(-)

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 5f2a0f543..55c60d8a7 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.36 1993/08/18 22:52:46 cph Exp $
+$Id: io.scm,v 14.37 1993/09/10 19:15:54 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -269,9 +269,7 @@ MIT in each case. |#
 (define (test-for-input-on-descriptor descriptor block?)
   (if block?
       (or (select-descriptor descriptor #f)
-	  (if (block-on-input-descriptor descriptor)
-	      'INPUT-AVAILABLE
-	      'INTERRUPT))
+	  (block-on-input-descriptor descriptor))
       (select-descriptor descriptor #f)))
 
 (define-integrable (channel-descriptor-for-select channel)
diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm
index 39569673d..3ffae18c3 100644
--- a/v7/src/runtime/thread.scm
+++ b/v7/src/runtime/thread.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.19 1993/09/10 17:54:35 cph Exp $
+$Id: thread.scm,v 1.20 1993/09/10 19:15:44 cph Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -404,9 +404,7 @@ MIT in each case. |#
 
 (define-integrable (maybe-signal-input-thread-events)
   (if input-registrations
-      (let ((result (select-registry-test input-registry #f)))
-	(if (pair? result)
-	    (signal-input-thread-events result)))))
+      (signal-select-result (select-registry-test input-registry #f))))
 
 (define (wait-for-input)
   (if (not input-registrations)
@@ -420,34 +418,51 @@ MIT in each case. |#
 	(set-interrupt-enables! interrupt-mask/all)
 	(let ((result (select-registry-test input-registry #t)))
 	  (set-interrupt-enables! interrupt-mask/gc-ok)
-	  (if (pair? result)
-	      (signal-input-thread-events result))
+	  (signal-select-result result)
 	  (let ((thread first-running-thread))
 	    (if thread
 		(if (thread/continuation thread)
 		    (run-thread thread))
 		(wait-for-input)))))))
+
+(define (signal-select-result result)
+  (cond ((pair? result)
+	 (signal-input-thread-events result))
+	((eq? 'PROCESS-STATUS-CHANGE result)
+	 (signal-input-thread-events '(PROCESS-STATUS-CHANGE)))))
 
 (define (block-on-input-descriptor descriptor)
   (without-interrupts
    (lambda ()
-     (let ((delivered? #f)
-	   (registration))
+     (let ((result 'INTERRUPT)
+	   (registration-1)
+	   (registration-2))
        (dynamic-wind
 	(lambda ()
-	  (set! registration
-		(%register-input-thread-event descriptor
-					      (current-thread)
-					      (lambda ()
-						(set! delivered? #t)
-						unspecific)
-					      #t))
+	  (let ((thread (current-thread)))
+	    (set! registration-1
+		  (%register-input-thread-event
+		   descriptor
+		   thread
+		   (lambda ()
+		     (set! result 'INPUT-AVAILABLE)
+		     unspecific)
+		   #t))
+	    (set! registration-2
+		  (%register-input-thread-event
+		   'PROCESS-STATUS-CHANGE
+		   thread
+		   (lambda ()
+		     (set! result 'PROCESS-STATUS-CHANGE)
+		     unspecific)
+		   #t)))
 	  unspecific)
 	(lambda ()
 	  (%suspend-current-thread)
-	  delivered?)
+	  result)
 	(lambda ()
-	  (%deregister-input-thread-event registration)))))))
+	  (%deregister-input-thread-event registration-1)
+	  (%deregister-input-thread-event registration-2)))))))
 
 (define (permanently-register-input-thread-event descriptor thread event)
   (guarantee-thread thread permanently-register-input-thread-event)
@@ -467,7 +482,7 @@ MIT in each case. |#
      (let ((tentry (%register-input-thread-event descriptor thread event #f)))
        (%maybe-toggle-thread-timer)
        tentry))))
-
+
 (define (%register-input-thread-event descriptor thread event front?)
   (let ((tentry (make-tentry)))
     (%%register-input-thread-event descriptor thread event front? tentry)
@@ -493,7 +508,8 @@ MIT in each case. |#
 	      (set-dentry/prev! input-registrations dentry))
 	  (set-dentry/next! dentry input-registrations)
 	  (set! input-registrations dentry)
-	  (add-to-select-registry! input-registry descriptor))
+	  (if (not (eq? 'PROCESS-STATUS-CHANGE descriptor))
+	      (add-to-select-registry! input-registry descriptor)))
 	(begin
 	  (set-tentry/dentry! tentry dentry)
 	  (if front?
@@ -573,8 +589,9 @@ MIT in each case. |#
 	(set-dentry/last-tentry! dentry prev))
     (if (not (or prev next))
 	(begin
-	  (remove-from-select-registry! input-registry
-					(dentry/descriptor dentry))
+	  (let ((descriptor (dentry/descriptor dentry)))
+	    (if (not (eq? 'PROCESS-STATUS-CHANGE descriptor))
+		(remove-from-select-registry! input-registry descriptor)))
 	  (let ((prev (dentry/prev dentry))
 		(next (dentry/next dentry)))
 	    (if prev
-- 
2.25.1