X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=eb40f586401d127a418f48c475fbd528c1193c24;hb=b9519773faa7b3c98915eccb9cb1fd8a8270ee56;hp=4f69d9db39ca352e6dcc18277cf4dcd7742068de;hpb=e98706e107b99ae4f0850f5275af4197501b42ce;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 4f69d9d..eb40f58 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -53,7 +53,7 @@
          :format-arguments (list stream)))
 (defun closed-flame (stream &rest ignore)
   (declare (ignore ignore))
-  (error "~S is closed." stream))
+  (error 'closed-stream-error :stream stream))
 (defun no-op-placeholder (&rest ignore)
   (declare (ignore ignore)))
 
@@ -128,13 +128,17 @@
   (setf (ansi-stream-in stream) #'closed-flame)
   (setf (ansi-stream-bin stream) #'closed-flame)
   (setf (ansi-stream-n-bin stream) #'closed-flame)
-  (setf (ansi-stream-in stream) #'closed-flame)
   (setf (ansi-stream-out stream) #'closed-flame)
   (setf (ansi-stream-bout stream) #'closed-flame)
   (setf (ansi-stream-sout stream) #'closed-flame)
   (setf (ansi-stream-misc stream) #'closed-flame))
 
 ;;;; 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))))
 
 ;;; Call the MISC method with the :FILE-POSITION operation.
 #!-sb-fluid (declaim (inline ansi-stream-file-position))
@@ -156,19 +160,20 @@
             (- +ansi-stream-in-buffer-length+
                (ansi-stream-in-index stream)))
          #!+sb-unicode
-         (let* ((external-format (stream-external-format stream))
-                (ef-entry (find-external-format external-format))
-                (variable-width-p (variable-width-external-format-p ef-entry))
-                (char-len (bytes-for-char-fun ef-entry)))
+         (let ((char-size (if (fd-stream-p stream)
+                              (fd-stream-char-size stream)
+                              (external-format-char-size (stream-external-format stream)))))
            (- res
-              (if variable-width-p
-                  (loop with buffer = (ansi-stream-cin-buffer stream)
-                        with start = (ansi-stream-in-index stream)
-                        for i from start below +ansi-stream-in-buffer-length+
-                        sum (funcall char-len (aref buffer i)))
-                  (* (funcall char-len #\x)  ; arbitrary argument
-                     (- +ansi-stream-in-buffer-length+
-                        (ansi-stream-in-index stream)))))))))))
+              (etypecase char-size
+                (function
+                 (loop with buffer = (ansi-stream-cin-buffer stream)
+                       with start = (ansi-stream-in-index stream)
+                       for i from start below +ansi-stream-in-buffer-length+
+                       sum (funcall char-size (aref buffer i))))
+                (fixnum
+                 (* char-size
+                    (- +ansi-stream-in-buffer-length+
+                       (ansi-stream-in-index stream))))))))))))
 
 (defun file-position (stream &optional position)
   (if (ansi-stream-p stream)
@@ -263,7 +268,7 @@
                               :start2 %frc-index% :end2 pos)
                      (setf %frc-index% (1+ pos)))
                    (done-with-fast-read-char)
-                   (return-from ansi-stream-read-line-from-frc-buffer res)))
+                   (return-from ansi-stream-read-line-from-frc-buffer (values res (null pos)))))
                (add-chunk ()
                  (let* ((end (length %frc-buffer%))
                         (len (- end %frc-index%))
@@ -273,7 +278,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
@@ -1526,14 +1532,20 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
     (flet ((replace-all (fun)
              (let ((start 0))
                (declare (index start))
-               (dolist (buffer (nreverse prev))
+               (setf prev (nreverse prev))
+               (dolist (buffer prev)
                  (funcall fun buffer start)
                  (incf start (length buffer)))
                (funcall fun this start)
                (incf start (length this))
                (dolist (buffer next)
                  (funcall fun buffer start)
-                 (incf start (length buffer))))))
+                 (incf start (length buffer)))
+               ;; Hack: erase the pointers to strings, to make it less
+               ;; likely that the conservative GC will accidentally
+               ;; retain the buffers.
+               (fill prev nil)
+               (fill next nil))))
       (macrolet ((frob (type)
                    `(replace-all (lambda (buffer from)
                                    (declare (type ,type result)
@@ -2106,6 +2118,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