1.0.14.31: better ANSI-STREAM-FILE-POSITION

 * Instead of searching for the external-format object to obtain
   the character-width function, store the function (or its result
   for fixed-width external formats) directly into the FD-STREAM
   object. Non-FD-STREAM ANSI-STREAMS use the old strategy.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 9cbafaf..8d369bd 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -185,6 +185,8 @@
   ;; pathname of the file this stream is opened to (returned by PATHNAME)
   (pathname nil :type (or pathname null))
   (external-format :default)
+  ;; fixed width, or function to call with a character
+  (char-size 1 :type (or fixnum function))
   (output-bytes #'ill-out :type function))
 (def!method print-object ((fd-stream fd-stream) stream)
   (declare (type stream stream))
@@ -2307,6 +2309,7 @@
                                  :buffering buffering
                                  :dual-channel-p dual-channel-p
                                  :external-format external-format
+                                 :char-size (external-format-char-size external-format)
                                  :timeout
                                  (if timeout
                                      (coerce timeout 'single-float)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 272bde6..740f91a 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -134,6 +134,11 @@
   (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))
@@ -155,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)

diff --git a/version.lisp-expr b/version.lisp-expr
index 17553c4..47934f2 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.14.30"
+"1.0.14.31"