From: Gabor Melis <mega@hotpop.com>
Date: Fri, 1 Jul 2005 14:35:00 +0000 (+0000)
Subject: 0.9.2.12:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=de26f53dce412ab8ae84313d4937045498910d46;p=sbcl.git

0.9.2.12:
  * bug fix: no more highly sporadic "couldn't check whether ~S is
    readable" when reading a stream and an interrupt hits in the middle
    of a select system call
  * added with-restarted-syscall macro
  * added abcl support to build scripts
---

diff --git a/NEWS b/NEWS
index 7257ff4..581c5b6 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,9 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * Support for the koi8-r external format.  (thanks to Ivan Boldyrev)
   * Bug fix: OPEN no longer fails when *PRINT-READABLY* is T. (thanks
     to Zach Beane)
+  * bug fix: no more highly sporadic "couldn't check whether ~S is
+    readable" when reading a stream and an interrupt hits in the middle
+    of a select system call
   * threads
     ** added x86-64 support
     ** incompatible change: the threading api now works with thread
diff --git a/make-genesis-2.sh b/make-genesis-2.sh
index 42efb07..a76ea79 100644
--- a/make-genesis-2.sh
+++ b/make-genesis-2.sh
@@ -52,6 +52,7 @@ $SBCL_XC_HOST <<-'EOF' || exit 1
 		       :map-file-name "output/cold-sbcl.map")
         #+cmu (ext:quit)
         #+clisp (ext:quit)
+        #+abcl (ext:quit)
 	EOF
 
 echo //testing for consistency of first and second GENESIS passes
diff --git a/make-host-1.sh b/make-host-1.sh
index cf3e216..34598a0 100644
--- a/make-host-1.sh
+++ b/make-host-1.sh
@@ -54,4 +54,5 @@ $SBCL_XC_HOST <<-'EOF' || exit 1
 	(sb!vm:genesis :c-header-dir-name "src/runtime/genesis")
         #+cmu (ext:quit)
         #+clisp (ext:quit)
+        #+abcl (ext:quit)
 	EOF
diff --git a/make-host-2.sh b/make-host-2.sh
index ae5ae3d..580af2f 100644
--- a/make-host-2.sh
+++ b/make-host-2.sh
@@ -136,6 +136,7 @@ $SBCL_XC_HOST <<-'EOF' || exit 1
           #+clisp (ext:saveinitmem "output/after-xc.core"))
         #+cmu (ext:quit)
         #+clisp (ext:quit)
+        #+abcl (ext:quit)
 	EOF
 
 # Run GENESIS (again) in order to create cold-sbcl.core. (The first
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index d861f4b..872f51b 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1920,6 +1920,7 @@ no guarantees of interface stability."
                "NANOSLEEP"
 	       "UID-USERNAME"
 	       "UID-HOMEDIR"
+               "WITH-RESTARTED-SYSCALL"
 
 	       ;; stuff with a one-to-one mapping to Unix constructs
 	       "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" "DEV-T" "DIRECT"
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5091687..69660e8 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -638,22 +638,19 @@
 	     (setf (fd-stream-ibuf-head stream) 0)
 	     (setf (fd-stream-ibuf-tail stream) tail))))
     (setf (fd-stream-listen stream) nil)
-    (multiple-value-bind (count errno)
-	;; FIXME: Judging from compiler warnings, this WITH-ALIEN form expands
-	;; into something which uses the not-yet-defined type
-	;;   (SB!ALIEN-INTERNALS:ALIEN (* (SB!ALIEN:STRUCT SB!UNIX:FD-SET))).
-	;; This is probably inefficient and unsafe and generally bad, so
-	;; try to find some way to make that type known before
-	;; this is compiled.
-	(sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set)))
-	  (sb!unix:fd-zero read-fds)
-	  (sb!unix:fd-set fd read-fds)
-	  (sb!unix:unix-fast-select (1+ fd)
-				    (sb!alien:addr read-fds)
-				    nil
-				    nil
-				    0
-				    0))
+    (sb!unix:with-restarted-syscall (count errno)
+      ;; FIXME: Judging from compiler warnings, this WITH-ALIEN form expands
+      ;; into something which uses the not-yet-defined type
+      ;;   (SB!ALIEN-INTERNALS:ALIEN (* (SB!ALIEN:STRUCT SB!UNIX:FD-SET))).
+      ;; This is probably inefficient and unsafe and generally bad, so
+      ;; try to find some way to make that type known before
+      ;; this is compiled.
+      (sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set)))
+        (sb!unix:fd-zero read-fds)
+        (sb!unix:fd-set fd read-fds)
+        (sb!unix:unix-fast-select (1+ fd)
+                                  (sb!alien:addr read-fds)
+                                  nil nil 0 0))
       (case count
 	(1)
 	(0
@@ -1515,13 +1512,14 @@
 		   (fd-stream-ibuf-tail fd-stream)))
 	 (fd-stream-listen fd-stream)
 	 (setf (fd-stream-listen fd-stream)
-	       (eql (sb!alien:with-alien ((read-fds (sb!alien:struct
-						     sb!unix:fd-set)))
-		      (sb!unix:fd-zero read-fds)
-		      (sb!unix:fd-set (fd-stream-fd fd-stream) read-fds)
-		      (sb!unix:unix-fast-select (1+ (fd-stream-fd fd-stream))
-						(sb!alien:addr read-fds)
-						nil nil 0 0))
+	       (eql (sb!unix:with-restarted-syscall ()
+                      (sb!alien:with-alien ((read-fds (sb!alien:struct
+                                                       sb!unix:fd-set)))
+                        (sb!unix:fd-zero read-fds)
+                        (sb!unix:fd-set (fd-stream-fd fd-stream) read-fds)
+                        (sb!unix:unix-fast-select (1+ (fd-stream-fd fd-stream))
+                                                  (sb!alien:addr read-fds)
+                                                  nil nil 0 0)))
 		    1))))
     (:unread
      (setf (fd-stream-unread fd-stream) arg1)
@@ -1602,16 +1600,14 @@
      (setf (fd-stream-ibuf-tail fd-stream) 0)
      (catch 'eof-input-catcher
        (loop
-	(let ((count (sb!alien:with-alien ((read-fds (sb!alien:struct
-						      sb!unix:fd-set)))
-		       (sb!unix:fd-zero read-fds)
-		       (sb!unix:fd-set (fd-stream-fd fd-stream) read-fds)
-		       (sb!unix:unix-fast-select (1+ (fd-stream-fd fd-stream))
-						 (sb!alien:addr read-fds)
-						 nil
-						 nil
-						 0
-						 0))))
+	(let ((count (sb!unix:with-restarted-syscall ()
+                       (sb!alien:with-alien ((read-fds (sb!alien:struct
+                                                        sb!unix:fd-set)))
+                         (sb!unix:fd-zero read-fds)
+                         (sb!unix:fd-set (fd-stream-fd fd-stream) read-fds)
+                         (sb!unix:unix-fast-select (1+ (fd-stream-fd fd-stream))
+                                                   (sb!alien:addr read-fds)
+                                                   nil nil 0 0)))))
 	  (cond ((eql count 1)
 		 (refill-buffer/fd fd-stream)
 		 (setf (fd-stream-ibuf-head fd-stream) 0)
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 2f1888f..c5e6ee1 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -91,6 +91,19 @@
 
 (defmacro int-syscall ((name &rest arg-types) &rest args)
   `(syscall (,name ,@arg-types) (values result 0) ,@args))
+
+(defmacro with-restarted-syscall ((&optional (value (gensym))
+                                             (errno (gensym)))
+                                  syscall-form &rest body)
+  #!+sb-doc
+  "Evaluate BODY with VALUE and ERRNO bound to the return values of
+SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
+  `(let (,value ,errno)
+     (loop (multiple-value-setq (,value ,errno)
+             ,syscall-form)
+        (unless (eql ,errno sb!unix:eintr)
+          (return (values ,value ,errno))))
+     ,@body))
 
 ;;;; hacking the Unix environment
 
diff --git a/version.lisp-expr b/version.lisp-expr
index f1313df..69bafa4 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.2.11"
+"0.9.2.12"