0.9.15.48: more precice unions of array types

[sbcl.git] / src / code / fd-stream.lisp

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 9503594..ef0c2c4 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -325,6 +325,7 @@
                      (intern (format nil name-fmt (string (car buffering))))))
                 `(progn
                    (defun ,function (stream byte)
+                     (declare (ignorable byte))
                      (output-wrapper/variable-width (stream ,size ,buffering ,restart)
                        ,@body))
                    (setf *output-routines*
@@ -752,6 +753,7 @@
                                                       ,stream-var)
                                                      (fd-stream-ibuf-head
                                                       ,stream-var))))
+                               (declare (ignorable byte))
                                (setq size ,bytes)
                                (input-at-least ,stream-var size)
                                (setq ,element-var (locally ,@read-forms))
@@ -1001,6 +1003,16 @@
     (when sizer
       (loop for char across string summing (funcall sizer char)))))
 
+(defun find-external-format (external-format)
+  (when external-format
+    (find external-format *external-formats* :test #'member :key #'car)))
+
+(defun variable-width-external-format-p (ef-entry)
+  (when (eighth ef-entry) t))
+
+(defun bytes-for-char-fun (ef-entry)
+  (if ef-entry (symbol-function (ninth ef-entry)) (constantly 1)))
+
 ;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp
 (defmacro define-external-format (external-format size output-restart
                                   out-expr in-expr)
@@ -1134,6 +1146,7 @@
          (size-function (symbolicate "BYTES-FOR-CHAR/" name)))
     `(progn
       (defun ,size-function (byte)
+        (declare (ignorable byte))
         ,out-size-expr)
       (defun ,out-function (stream string flush-p start end)
         (let ((start (or start 0))
@@ -1218,6 +1231,7 @@
               (setf decode-break-reason
                     (block decode-break-reason
                       (let ((byte (sap-ref-8 sap head)))
+                        (declare (ignorable byte))
                         (setq size ,in-size-expr)
                         (when (> size (- tail head))
                           (return))
@@ -1262,6 +1276,7 @@
                                                            ,in-size-expr
                                                            sap head)
         (let ((byte (sap-ref-8 sap head)))
+          (declare (ignorable byte))
           ,in-expr))
       (defun ,resync-function (stream)
         (loop (input-at-least stream 2)
@@ -1271,6 +1286,7 @@
                                (head (fd-stream-ibuf-head stream))
                                (byte (sap-ref-8 sap head))
                                (size ,in-size-expr))
+                          (declare (ignorable byte))
                           (input-at-least stream size)
                           (let ((sap (fd-stream-ibuf-sap stream))
                                 (head (fd-stream-ibuf-head stream)))
@@ -1582,33 +1598,36 @@
   (declare (ignore arg2))
   (case operation
     (:listen
-     (or (not (eql (fd-stream-ibuf-head fd-stream)
-                   (fd-stream-ibuf-tail fd-stream)))
-         (fd-stream-listen fd-stream)
-         #!+win32
-         (setf (fd-stream-listen fd-stream)
-               (sb!win32:fd-listen (fd-stream-fd fd-stream)))
-         #!-win32
-         (setf (fd-stream-listen fd-stream)
-               (if (sysread-may-block-p fd-stream)
-                   nil
-                   ;; select(2) and CL:LISTEN have slightly different
-                   ;; semantics.  The former returns that an FD is
-                   ;; readable when a read operation wouldn't block.
-                   ;; That includes EOF.  However, LISTEN must return
-                   ;; NIL at EOF.
-                   (progn (catch 'eof-input-catcher
-                            ;; r-b/f too calls select, but it shouldn't
-                            ;; block as long as read can return once w/o
-                            ;; blocking
-                            (refill-buffer/fd fd-stream))
-                          ;; If REFILL-BUFFER/FD set the FD-STREAM-LISTEN
-                          ;; slot to a non-nil value (i.e. :EOF), keep
-                          ;; that value.
-                          (or (fd-stream-listen fd-stream)
-                              ;; Otherwise we have data -> set the slot
-                              ;; to T.
-                              t))))))
+     (labels ((do-listen ()
+                (or (not (eql (fd-stream-ibuf-head fd-stream)
+                              (fd-stream-ibuf-tail fd-stream)))
+                    (fd-stream-listen fd-stream)
+                    #!+win32
+                    (sb!win32:fd-listen (fd-stream-fd fd-stream))
+                    #!-win32
+                    ;; If the read can block, LISTEN will certainly return NIL.
+                    (if (sysread-may-block-p fd-stream)
+                        nil
+                        ;; Otherwise select(2) and CL:LISTEN have slightly
+                        ;; different semantics.  The former returns that an FD
+                        ;; is readable when a read operation wouldn't block.
+                        ;; That includes EOF.  However, LISTEN must return NIL
+                        ;; at EOF.
+                        (progn (catch 'eof-input-catcher
+                                 ;; r-b/f too calls select, but it shouldn't
+                                 ;; block as long as read can return once w/o
+                                 ;; blocking
+                                 (refill-buffer/fd fd-stream))
+                               ;; At this point either IBUF-HEAD != IBUF-TAIL
+                               ;; and FD-STREAM-LISTEN is NIL, in which case
+                               ;; we should return T, or IBUF-HEAD ==
+                               ;; IBUF-TAIL and FD-STREAM-LISTEN is :EOF, in
+                               ;; which case we should return :EOF for this
+                               ;; call and all future LISTEN call on this stream.
+                               ;; Call ourselves again to determine which case
+                               ;; applies.
+                               (do-listen))))))
+       (do-listen)))
     (:unread
      (setf (fd-stream-unread fd-stream) arg1)
      (setf (fd-stream-listen fd-stream) t))