From 4c17de91f7bff30c058ed2bf571f8e1078c87a0c Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Sat, 4 Sep 1999 19:43:15 +0000
Subject: [PATCH] Within process-wait-until-fd-usable, handle interrupted
 unix-fast-select calls - only return when usable or upon an error.

---
 code/multi-proc.lisp | 36 +++++++++++++++++++++---------------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp
index 27c5942bb..f8ff75576 100644
--- a/code/multi-proc.lisp
+++ b/code/multi-proc.lisp
@@ -5,7 +5,7 @@
 ;;; the Public domain, and is provided 'as is'.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.34 1999/03/13 15:13:02 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.35 1999/09/04 19:43:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1456,22 +1456,28 @@
       ;; Other processes use process-wait.
       (flet ((fd-usable-for-input ()
 	       (declare (optimize (speed 3) (safety 1)))
-	       (not (eql (alien:with-alien ((read-fds
-					     (alien:struct unix:fd-set)))
-			   (unix:fd-zero read-fds)
-			   (unix:fd-set fd read-fds)
-			   (unix:unix-fast-select
-			    (1+ fd) (alien:addr read-fds) nil nil 0 0))
-			 0)))
+	       (alien:with-alien ((read-fds (alien:struct unix:fd-set)))
+		 (unix:fd-zero read-fds)
+		 (unix:fd-set fd read-fds)
+		 (multiple-value-bind (value err)
+		     (unix:unix-fast-select
+		      (1+ fd) (alien:addr read-fds) nil nil 0 0)
+		   ;; Return true when input is available or there is
+		   ;; an error other than an interrupt.
+		   (and (not (eql value 0))
+			(or value (not (eql err unix:eintr)))))))
 	     (fd-usable-for-output ()
 	       (declare (optimize (speed 3) (safety 1)))
-	       (not (eql (alien:with-alien ((write-fds
-					     (alien:struct unix:fd-set)))
-			   (unix:fd-zero write-fds)
-			   (unix:fd-set fd write-fds)
-			   (unix:unix-fast-select
-			    (1+ fd) nil (alien:addr write-fds) nil 0 0))
-			 0))))
+	       (alien:with-alien ((write-fds (alien:struct unix:fd-set)))
+		 (unix:fd-zero write-fds)
+		 (unix:fd-set fd write-fds)
+		 (multiple-value-bind (value err)
+		     (unix:unix-fast-select
+		      (1+ fd) nil (alien:addr write-fds) nil 0 0)
+		   ;; Return true when ready for output or there is an
+		   ;; error other than an interrupt.
+		   (and (not (eql value 0))
+			(or value (not (eql err unix:eintr))))))))
 
 	(ecase direction
 	  (:input
-- 
GitLab