From de7e68bb937622ca7fe99a1acbf26703b7695cc7 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 17 Feb 2008 08:18:40 +0000 Subject: [PATCH] 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. --- src/code/fd-stream.lisp | 3 +++ src/code/stream.lisp | 30 ++++++++++++++++++------------ version.lisp-expr | 2 +- 3 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 9cbafaf..8d369bd 100644 --- 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 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -134,6 +134,11 @@ (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)) @@ -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 --- 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" -- 1.7.10.4