X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=07dfaf1af1f66a3da8a7132d7cc1d179acbf536c;hb=f71445c16693bf12ac835a46763e1dfb25a6db0a;hp=54c7c51359b3ca998706f7013d7593d3a6cf95f9;hpb=4fa1c71c7dfa5c6d361304321cc67069a6410694;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 54c7c51..07dfaf1 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -157,6 +157,8 @@
   (element-type 'base-char)
   ;; the Unix file descriptor
   (fd -1 :type fixnum)
+  ;; What do we know about the FD?
+  (fd-type :unknown :type keyword)
   ;; controls when the output buffer is flushed
   (buffering :full :type (member :full :line :none))
   ;; controls whether the input buffer must be cleared before output
@@ -970,11 +972,9 @@
            (count 0))
     (tagbody
        ;; Check for blocking input before touching the stream if we are to
-       ;; serve events: if the FD is blocking, we don't want to hang on the
-       ;; write if we are to serve events or notice timeouts.
-       (if (and (or (fd-stream-serve-events stream)
-                    (fd-stream-timeout stream)
-                    *deadline*)
+       ;; serve events: if the FD is blocking, we don't want to try an uninterruptible
+       ;; read(). Regular files should never block, so we can elide the check.
+       (if (and (neq :regular (fd-stream-fd-type stream))
                 (sysread-may-block-p stream))
            (go :wait-for-input)
            (go :main))
@@ -2217,6 +2217,7 @@
         ((not (or input output))
          (error "File descriptor must be opened either for input or output.")))
   (let ((stream (%make-fd-stream :fd fd
+                                 :fd-type (sb!unix:fd-type fd)
                                  :name name
                                  :file file
                                  :original original