1.0.16.35: improved TIME output

[sbcl.git] / src / code / stream.lisp

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 223a9a1..740f91a 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -59,38 +59,30 @@
 \f
 ;;; stream manipulation functions
 
-(declaim (inline ansi-stream-input-stream-p))
 (defun ansi-stream-input-stream-p (stream)
   (declare (type ansi-stream stream))
-
-  (when (synonym-stream-p stream)
-    (setf stream
-          (symbol-value (synonym-stream-symbol stream))))
-
-  (and (not (eq (ansi-stream-in stream) #'closed-flame))
+  (if (synonym-stream-p stream)
+      (input-stream-p (symbol-value (synonym-stream-symbol stream)))
+      (and (not (eq (ansi-stream-in stream) #'closed-flame))
        ;;; KLUDGE: It's probably not good to have EQ tests on function
        ;;; values like this. What if someone's redefined the function?
        ;;; Is there a better way? (Perhaps just VALID-FOR-INPUT and
        ;;; VALID-FOR-OUTPUT flags? -- WHN 19990902
-       (or (not (eq (ansi-stream-in stream) #'ill-in))
-           (not (eq (ansi-stream-bin stream) #'ill-bin)))))
+           (or (not (eq (ansi-stream-in stream) #'ill-in))
+               (not (eq (ansi-stream-bin stream) #'ill-bin))))))
 
 (defun input-stream-p (stream)
   (declare (type stream stream))
   (and (ansi-stream-p stream)
        (ansi-stream-input-stream-p stream)))
 
-(declaim (inline ansi-stream-output-stream-p))
 (defun ansi-stream-output-stream-p (stream)
   (declare (type ansi-stream stream))
-
-  (when (synonym-stream-p stream)
-    (setf stream (symbol-value
-                  (synonym-stream-symbol stream))))
-
-  (and (not (eq (ansi-stream-in stream) #'closed-flame))
-       (or (not (eq (ansi-stream-out stream) #'ill-out))
-           (not (eq (ansi-stream-bout stream) #'ill-bout)))))
+  (if (synonym-stream-p stream)
+      (output-stream-p (symbol-value (synonym-stream-symbol stream)))
+      (and (not (eq (ansi-stream-in stream) #'closed-flame))
+           (or (not (eq (ansi-stream-out stream) #'ill-out))
+               (not (eq (ansi-stream-bout stream) #'ill-bout))))))
 
 (defun output-stream-p (stream)
   (declare (type stream stream))
@@ -136,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))
 \f
 ;;;; 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))
@@ -164,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)
@@ -281,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
@@ -2108,11 +2106,13 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                               :start2 %frc-index%
                               :end2 (+ %frc-index% len)))
                    (incf read len)
+                   (incf %frc-index% len)
                    (when (or (eql needed read)
                              (refill-buffer))
                      (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