0.9.18.71: fix build on Darwin 7.9.0 (OS X 10.3)

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

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index b2ea43d..5d339b7 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -157,9 +157,24 @@
     (t
      (let ((res (funcall (ansi-stream-misc stream) stream :file-position nil)))
        (when res
+         #!-sb-unicode
          (- res
             (- +ansi-stream-in-buffer-length+
-               (ansi-stream-in-index stream))))))))
+               (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)))
+           (- 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)))))))))))
 
 
 (defun file-position (stream &optional position)
@@ -248,7 +263,7 @@
            (cond (ch
                   (when (char= ch #\newline)
                     (done-with-fast-read-char)
-                    (return (values (shrink-vector res index) nil)))
+                    (return (values (%shrink-vector res index) nil)))
                   (when (= index len)
                     (setq len (* len 2))
                     (let ((new (make-string len)))
@@ -266,7 +281,7 @@
                  ;; shouldn't do another READ-CHAR.
                  (t
                   (done-with-fast-read-char)
-                  (return (values (shrink-vector res index) t)))))))))
+                  (return (values (%shrink-vector res index) t)))))))))
 
 (defun read-line (&optional (stream *standard-input*) (eof-error-p t) eof-value
                             recursive-p)