From 16568ba8e4b538858ab752fb2a5ae95e5f39e6dd Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Fri, 4 Jan 2008 01:49:37 +0000 Subject: [PATCH] 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. --- src/code/fd-stream.lisp | 99 +++++++++++++++++++++++++++-------------------- src/code/stream.lisp | 4 +- src/code/unix.lisp | 4 ++ version.lisp-expr | 2 +- 4 files changed, 64 insertions(+), 45 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 9a7ce72..4e9aab7 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4