X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;fp=src%2Fcode%2Fstream.lisp;h=740f91a6ee4470f9ea6065d736fcb33a18308faa;hb=de7e68bb937622ca7fe99a1acbf26703b7695cc7;hp=272bde62d20cf16c6ba299ed68dddfe985a75b16;hpb=a6bd77d792d22785860bd082d55692f4a1c65fd7;p=sbcl.git 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)