0.9.2.12:
authorGabor Melis <mega@hotpop.com>
Fri, 1 Jul 2005 14:35:00 +0000 (14:35 +0000)
committerGabor Melis <mega@hotpop.com>
Fri, 1 Jul 2005 14:35:00 +0000 (14:35 +0000)
  * 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

NEWS
make-genesis-2.sh
make-host-1.sh
make-host-2.sh
package-data-list.lisp-expr
src/code/fd-stream.lisp
src/code/unix.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 7257ff4..581c5b6 100644 (file)
--- 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
index 42efb07..a76ea79 100644 (file)
@@ -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
index cf3e216..34598a0 100644 (file)
@@ -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
index ae5ae3d..580af2f 100644 (file)
@@ -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
index d861f4b..872f51b 100644 (file)
@@ -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"
index 5091687..69660e8 100644 (file)
             (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
                   (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)
      (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)
index 2f1888f..c5e6ee1 100644 (file)
 
 (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))
 \f
 ;;;; hacking the Unix environment
 
index f1313df..69bafa4 100644 (file)
@@ -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"