[Sbcl-commits] CVS: sbcl/src/code fd-stream.lisp, 1.123, 1.124 stream.lisp, 1.101, 1.102

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv24412/src/code

Modified Files:
	fd-stream.lisp stream.lisp 
Log Message:
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.



Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.123
retrieving revision 1.124
diff -u -d -r1.123 -r1.124
--- fd-stream.lisp	16 Jan 2008 15:46:22 -0000	1.123
+++ fd-stream.lisp	17 Feb 2008 08:18:40 -0000	1.124
@@ -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)

Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -d -r1.101 -r1.102
--- stream.lisp	21 Jan 2008 14:43:15 -0000	1.101
+++ stream.lisp	17 Feb 2008 08:18:40 -0000	1.102
@@ -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)