X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=2bc1aa71a87620ca654c9b71c5fba5d45be2d86f;hb=b14a61c6af3e3005c94e633e727177346240066e;hp=9003e426f4d9e622ab923678139e5ea27e55fc13;hpb=d08b394edb36c45ae3b9d535135e5ef600f566f3;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 9003e42..2bc1aa7 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -133,12 +133,9 @@ (setf (ansi-stream-sout stream) #'closed-flame) (setf (ansi-stream-misc stream) #'closed-flame)) -;;;; file position and file length +;;;; for file position and file length (defun external-format-char-size (external-format) - (let ((ef-entry (find-external-format external-format))) - (if (variable-width-external-format-p ef-entry) - (bytes-for-char-fun ef-entry) - (funcall (bytes-for-char-fun ef-entry) #\x)))) + (ef-char-size (get-external-format external-format))) ;;; Call the MISC method with the :FILE-POSITION operation. #!-sb-fluid (declaim (inline ansi-stream-file-position)) @@ -146,7 +143,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 @@ -444,10 +441,8 @@ ;; a-s-read-sequence and needs a lambda list that's congruent with ;; that of a-s-read-char (declare (ignore recursive-p)) - (prepare-for-fast-read-byte stream - (prog1 - (fast-read-byte eof-error-p eof-value t) - (done-with-fast-read-byte)))) + (with-fast-read-byte (t stream eof-error-p eof-value) + (fast-read-byte))) (defun read-byte (stream &optional (eof-error-p t) eof-value) (if (ansi-stream-p stream) @@ -548,22 +543,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 @@ -687,7 +687,7 @@ (defun clear-output (&optional (stream *standard-output*)) (with-out-stream stream (ansi-stream-misc :clear-output) - (stream-force-output)) + (stream-clear-output)) nil) (defun write-byte (integer stream) @@ -1299,7 +1299,7 @@ ;; end of the stream. (index-cache 0 :type index) ;; Requested element type - (element-type 'character)) + (element-type 'character :type type-specifier)) #!+sb-doc (setf (fdocumentation 'make-string-output-stream 'function) @@ -1458,6 +1458,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") (defun string-out-misc (stream operation &optional arg1 arg2) (declare (ignore arg2)) + (declare (optimize speed)) (case operation (:charpos ;; Keeping this first is a silly micro-optimization: FRESH-LINE @@ -1467,8 +1468,10 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") (buffer (string-output-stream-buffer stream)) (prev (string-output-stream-prev stream)) (base 0)) + (declare (type (or null (simple-array character (*))) buffer)) :next - (let ((pos (position #\newline buffer :from-end t :end pointer))) + (let ((pos (when buffer + (position #\newline buffer :from-end t :end pointer)))) (when (or pos (not buffer)) ;; If newline is at index I, and pointer at index I+N, charpos ;; is N-1. If there is no newline, and pointer is at index N, @@ -1566,9 +1569,14 @@ benefit of the function GET-OUTPUT-STREAM-STRING.") ;;; FIXME: need to support (VECTOR NIL), ideally without destroying all hope ;;; of efficiency. +(declaim (inline vector-with-fill-pointer)) +(defun vector-with-fill-pointer-p (x) + (and (vectorp x) + (array-has-fill-pointer-p x))) + (deftype string-with-fill-pointer () - '(and (or (vector character) (vector base-char)) - (satisfies array-has-fill-pointer-p))) + `(and (or (vector character) (vector base-char)) + (satisfies vector-with-fill-pointer-p))) (defstruct (fill-pointer-output-stream (:include ansi-stream