1.0.13.14: Reduce character stream input consing

        * Inline UNIX-READ into REFILL-INPUT-BUFFER to remove SAP boxing,
          remove non-local exits over full call boundaries (patch by Paul
          Khuong).
        * Inline REFILL-BUFFER in READ-SEQUENCE and READ-LINE.
        * D-X-allocate value cells in REFILL-INPUT-BUFFER.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 9a7ce72..4e9aab7 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -845,6 +845,7 @@
   (let ((fd (fd-stream-fd stream))
         (errno 0)
         (count 0))
+    (declare (dynamic-extent fd errno count))
     (tagbody
        ;; Check for blocking input before touching the stream, as if
        ;; we happen to wait we are liable to be interrupted, and the
@@ -868,49 +869,61 @@
        ;; Since the read should not block, we'll disable the
        ;; interrupts here, so that we don't accidentally unwind and
        ;; leave the stream in an inconsistent state.
-       (without-interrupts
-         ;; Check the buffer: if it is null, then someone has closed
-         ;; the stream from underneath us. This is not ment to fix
-         ;; multithreaded races, but to deal with interrupt handlers
-         ;; closing the stream.
-         (let* ((ibuf (or (fd-stream-ibuf stream) (go :closed-flame)))
-                (sap (buffer-sap ibuf))
-                (length (buffer-length ibuf))
-                (head (buffer-head ibuf))
-                (tail (buffer-tail ibuf)))
-           (declare (index length head tail))
-           (unless (zerop head)
-             (cond ((eql head tail)
-                    ;; Buffer is empty, but not at yet reset -- make it so.
-                    (setf head 0
-                          tail 0)
-                    (reset-buffer ibuf))
-                   (t
-                    ;; Buffer has things in it, but they are not at the head
-                    ;; -- move them there.
-                    (let ((n (- tail head)))
-                      (system-area-ub8-copy sap head sap 0 n)
-                      (setf head 0
-                            (buffer-head ibuf) head
-                            tail n
-                            (buffer-tail ibuf) tail)))))
-           (setf (fd-stream-listen stream) nil)
-           (setf (values count errno)
-                 (sb!unix:unix-read fd (sap+ sap tail) (- length tail)))
-           (cond ((null count)
-                  #!+win32
-                  (go :read-error)
-                  #!-win32
-                  (if (eql errno sb!unix:ewouldblock)
-                      (go :wait-for-input)
-                      (go :read-error)))
-                 ((zerop count)
-                  (setf (fd-stream-listen stream) :eof)
-                  (/show0 "THROWing EOF-INPUT-CATCHER")
-                  (throw 'eof-input-catcher nil))
-                 (t
-                  ;; Success! (Do not use INCF, for sake of other threads.)
-                  (setf (buffer-tail ibuf) (+ count tail)))))))
+
+       ;; Execute the nlx outside without-interrupts to ensure the
+       ;; resulting thunk is stack-allocatable.
+       ((lambda (return-reason)
+          (ecase return-reason
+            ((nil))             ; fast path normal cases
+            ((:wait-for-input) (go :wait-for-input))
+            ((:closed-flame)   (go :closed-flame))
+            ((:read-error)     (go :read-error))))
+        (without-interrupts
+          ;; Check the buffer: if it is null, then someone has closed
+          ;; the stream from underneath us. This is not ment to fix
+          ;; multithreaded races, but to deal with interrupt handlers
+          ;; closing the stream.
+          (block nil
+            (prog1 nil
+              (let* ((ibuf (or (fd-stream-ibuf stream) (return :closed-flame)))
+                     (sap (buffer-sap ibuf))
+                     (length (buffer-length ibuf))
+                     (head (buffer-head ibuf))
+                     (tail (buffer-tail ibuf)))
+                (declare (index length head tail)
+                         (inline sb!unix:unix-read))
+                (unless (zerop head)
+                  (cond ((eql head tail)
+                         ;; Buffer is empty, but not at yet reset -- make it so.
+                         (setf head 0
+                               tail 0)
+                         (reset-buffer ibuf))
+                        (t
+                         ;; Buffer has things in it, but they are not at the
+                         ;; head -- move them there.
+                         (let ((n (- tail head)))
+                           (system-area-ub8-copy sap head sap 0 n)
+                           (setf head 0
+                                 (buffer-head ibuf) head
+                                 tail n
+                                 (buffer-tail ibuf) tail)))))
+                (setf (fd-stream-listen stream) nil)
+                (setf (values count errno)
+                      (sb!unix:unix-read fd (sap+ sap tail) (- length tail)))
+                (cond ((null count)
+                       #!+win32
+                       (return :read-error)
+                       #!-win32
+                       (if (eql errno sb!unix:ewouldblock)
+                           (return :wait-for-input)
+                           (return :read-error)))
+                      ((zerop count)
+                       (setf (fd-stream-listen stream) :eof)
+                       (/show0 "THROWing EOF-INPUT-CATCHER")
+                       (throw 'eof-input-catcher nil))
+                      (t
+                       ;; Success! (Do not use INCF, for sake of other threads.)
+                       (setf (buffer-tail ibuf) (+ count tail))))))))))
     count))
 
 ;;; Make sure there are at least BYTES number of bytes in the input

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 4f69d9d..fd49263 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -273,7 +273,8 @@
                    (incf chunks-total-length len)
                    (when (refill-buffer)
                      (make-and-return-result-string nil)))))
-        (declare (inline make-and-return-result-string))
+        (declare (inline make-and-return-result-string
+                         refill-buffer))
         (when (and (= %frc-index% +ansi-stream-in-buffer-length+)
                    (refill-buffer))
           ;; EOF had been reached before we read anything
@@ -2106,6 +2107,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                      (done-with-fast-read-char)
                      (return-from ansi-stream-read-string-from-frc-buffer
                        read)))))
+        (declare (inline refill-buffer))
         (when (and (= %frc-index% +ansi-stream-in-buffer-length+)
                    (refill-buffer))
           ;; EOF had been reached before we read anything

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index e3a4ba2..be73122 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -296,6 +296,10 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
 ;;; It attempts to read len bytes from the device associated with fd
 ;;; and store them into the buffer. It returns the actual number of
 ;;; bytes read.
+
+#!-sb!fluid
+(declaim (maybe-inline unix-read))
+
 (defun unix-read (fd buf len)
   (declare (type unix-fd fd)
            (type (unsigned-byte 32) len))

diff --git a/version.lisp-expr b/version.lisp-expr
index d93884b..07453ed 100644 (file)
--- 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".)
-"1.0.13.13"
+"1.0.13.14"