X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=a0a0cb4573dff629f6a0b12488444db222babb48;hb=75476d1d19ac3d7239c8963a498c447a8368433d;hp=245e47e7a8439c605f00e62258ada6c9169778dd;hpb=f5522c7149744e4faf34313b18d0d3588d2a9d98;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 245e47e..a0a0cb4 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -146,7 +146,7 @@ (declare (type stream stream)) (declare (type (or index (alien sb!unix:off-t) (member nil :start :end)) position)) - ;; FIXME: It woud be good to comment on the stuff that is done here... + ;; FIXME: It would be good to comment on the stuff that is done here... ;; FIXME: This doesn't look interrupt safe. (cond (position @@ -548,22 +548,27 @@ ;; An empty count does not necessarily mean that we reached ;; the EOF, it's also possible that it's e.g. due to a ;; invalid octet sequence in a multibyte stream. To handle - ;; the resyncing case correctly we need to call the - ;; single-character reading function and check whether an - ;; EOF was really reached. If not, we can just fill the - ;; buffer by one character, and hope that the next refill - ;; will not need to resync. - (let* ((value (funcall (ansi-stream-in stream) stream nil :eof)) - (index (1- +ansi-stream-in-buffer-length+))) - (case value - ((:eof) - ;; Mark buffer as empty. + ;; the resyncing case correctly we need to call the reading + ;; function and check whether an EOF was really reached. If + ;; not, we can just fill the buffer by one character, and + ;; hope that the next refill will not need to resync. + ;; + ;; KLUDGE: we can't use FD-STREAM functions (which are the + ;; only ones which will give us decoding errors) here, + ;; because this code is generic. We can't call the N-BIN + ;; function, because near the end of a real file that can + ;; legitimately bounce us to the IN function. So we have + ;; to call ANSI-STREAM-IN. + (let* ((index (1- +ansi-stream-in-buffer-length+)) + (value (funcall (ansi-stream-in stream) stream nil :eof))) + (cond + ((eql value :eof) + ;; definitely EOF now (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) - ;; EOF. Redo the read, this time with the real eof parameters. - (values t (funcall (ansi-stream-in stream) - stream eof-error-p eof-value))) - (otherwise + (values t (eof-or-lose stream eof-error-p eof-value))) + ;; we resynced or were given something instead + (t (setf (aref ibuf index) value) (values nil (setf (ansi-stream-in-index stream) index)))))) (t @@ -939,7 +944,6 @@ (macrolet ((in-fun (name fun &rest args) `(defun ,name (stream ,@args) - (force-output (two-way-stream-output-stream stream)) (,fun (two-way-stream-input-stream stream) ,@args)))) (in-fun two-way-in read-char eof-error-p eof-value) (in-fun two-way-bin read-byte eof-error-p eof-value) @@ -1082,7 +1086,7 @@ (n-bin #'echo-n-bin)) (:constructor %make-echo-stream (input-stream output-stream)) (:copier nil)) - unread-stuff) + (unread-stuff nil :type boolean)) (def!method print-object ((x echo-stream) stream) (print-unreadable-object (x stream :type t :identity t) (format stream @@ -1107,47 +1111,55 @@ (macrolet ((in-fun (name in-fun out-fun &rest args) `(defun ,name (stream ,@args) - (or (pop (echo-stream-unread-stuff stream)) - (let* ((in (echo-stream-input-stream stream)) - (out (echo-stream-output-stream stream)) - (result (if eof-error-p - (,in-fun in ,@args) - (,in-fun in nil in)))) - (cond - ((eql result in) eof-value) - (t (,out-fun result out) result))))))) + (let* ((unread-stuff-p (echo-stream-unread-stuff stream)) + (in (echo-stream-input-stream stream)) + (out (echo-stream-output-stream stream)) + (result (if eof-error-p + (,in-fun in ,@args) + (,in-fun in nil in)))) + (setf (echo-stream-unread-stuff stream) nil) + (cond + ((eql result in) eof-value) + ;; If unread-stuff was true, the character read + ;; from the input stream was previously echoed. + (t (unless unread-stuff-p (,out-fun result out)) result)))))) (in-fun echo-in read-char write-char eof-error-p eof-value) (in-fun echo-bin read-byte write-byte eof-error-p eof-value)) (defun echo-n-bin (stream buffer start numbytes eof-error-p) - (let ((new-start start) - (read 0)) - (loop - (let ((thing (pop (echo-stream-unread-stuff stream)))) - (cond - (thing - (setf (aref buffer new-start) thing) - (incf new-start) - (incf read) - (when (= read numbytes) - (return-from echo-n-bin numbytes))) - (t (return nil))))) - (let ((bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer - new-start (- numbytes read) nil))) - (cond - ((not eof-error-p) - (write-sequence buffer (echo-stream-output-stream stream) - :start new-start :end (+ new-start bytes-read)) - (+ bytes-read read)) - ((> numbytes (+ read bytes-read)) - (write-sequence buffer (echo-stream-output-stream stream) - :start new-start :end (+ new-start bytes-read)) - (error 'end-of-file :stream stream)) - (t - (write-sequence buffer (echo-stream-output-stream stream) - :start new-start :end (+ new-start bytes-read)) - (aver (= numbytes (+ new-start bytes-read))) - numbytes))))) + (let ((bytes-read 0)) + ;; Note: before ca 1.0.27.18, the logic for handling unread + ;; characters never could have worked, so probably nobody has ever + ;; tried doing bivalent block I/O through an echo stream; this may + ;; not work either. + (when (echo-stream-unread-stuff stream) + (let* ((char (read-char stream)) + (octets (string-to-octets + (string char) + :external-format + (stream-external-format + (echo-stream-input-stream stream)))) + (octet-count (length octets)) + (blt-count (min octet-count numbytes))) + (replace buffer octets :start1 start :end1 (+ start blt-count)) + (incf start blt-count) + (decf numbytes blt-count))) + (incf bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer + start numbytes nil)) + (cond + ((not eof-error-p) + (write-sequence buffer (echo-stream-output-stream stream) + :start start :end (+ start bytes-read)) + bytes-read) + ((> numbytes bytes-read) + (write-sequence buffer (echo-stream-output-stream stream) + :start start :end (+ start bytes-read)) + (error 'end-of-file :stream stream)) + (t + (write-sequence buffer (echo-stream-output-stream stream) + :start start :end (+ start bytes-read)) + (aver (= numbytes (+ start bytes-read))) + numbytes)))) ;;;; STRING-INPUT-STREAM stuff @@ -1597,7 +1609,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") (setf workspace new-workspace offset-current current) (set-array-header buffer workspace new-length - current+1 0 new-length nil)) + current+1 0 new-length nil nil)) (setf (fill-pointer buffer) current+1)) (setf (char workspace offset-current) character)))) current+1)) @@ -1631,7 +1643,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") offset-current current offset-dst-end dst-end) (set-array-header buffer workspace new-length - dst-end 0 new-length nil)) + dst-end 0 new-length nil nil)) (setf (fill-pointer buffer) dst-end)) (replace workspace string :start1 offset-current :start2 start :end2 end)))