X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=7ffffc2a3137409a3d9bbba6aefad41b642f4f2d;hb=65b5ab7e713d04e0d76bc0ee196374f6e57b922f;hp=e795f0180dc722170fa701fc869db621a1246a9e;hpb=76f3e23c8ad6f98d60ff97233e11082a41faf894;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index e795f01..7ffffc2 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -135,7 +135,7 @@
 
 ;;;; file position and file length
 (defun external-format-char-size (external-format)
-  (let ((ef-entry (find-external-format external-format)))
+  (let ((ef-entry (get-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))))
@@ -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
@@ -1129,7 +1134,7 @@
     ;; not work either.
     (when (echo-stream-unread-stuff stream)
       (let* ((char (read-char stream))
-             (octets (octets-to-string
+             (octets (string-to-octets
                       (string char)
                       :external-format
                       (stream-external-format
@@ -1604,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))
@@ -1638,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)))