CMUCL commit: src/code (fd-stream-extfmt.lisp)

Raymond Toy rtoy at common-lisp.net
Fri Sep 24 02:36:03 CEST 2010


    Date: Thursday, September 23, 2010 @ 20:36:03
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: fd-stream-extfmt.lisp

o When changing external format from :iso8859-1 to another format, we
  need to call octets-to-string-counted to setup the octet count array
  correctly.
o Minor cleanup of code.


-----------------------+
 fd-stream-extfmt.lisp |  105 +++++++++++++++++++++++++-----------------------
 1 file changed, 55 insertions(+), 50 deletions(-)


Index: src/code/fd-stream-extfmt.lisp
diff -u src/code/fd-stream-extfmt.lisp:1.12 src/code/fd-stream-extfmt.lisp:1.13
--- src/code/fd-stream-extfmt.lisp:1.12	Tue Sep  7 23:04:54 2010
+++ src/code/fd-stream-extfmt.lisp	Thu Sep 23 20:36:03 2010
@@ -5,7 +5,7 @@
 ;;; domain.
 ;;; 
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.12 2010-09-08 03:04:54 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.13 2010-09-24 00:36:03 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -92,44 +92,44 @@
        ;; until we've converted the right number of characters.  Or,
        ;; since we have the octet-count, just sum up them up to figure
        ;; out how many octets we've already consumed.
-       (let ((ibuf (lisp-stream-in-buffer stream))
-	     (sindex (lisp-stream-string-index stream))
-	     (index 0)
-	     (octet-count (fd-stream-octet-count stream)))
-	 (setf index (loop for k of-type fixnum from 0 below (1- sindex) summing (aref octet-count k)))
+       (let* ((ibuf (lisp-stream-in-buffer stream))
+	      (sindex (lisp-stream-string-index stream))
+	      (octet-count (fd-stream-octet-count stream))
+	      (oc (make-array in-buffer-length :element-type '(unsigned-byte 8)))
+	      (index (loop for k of-type fixnum from 0 below (1- sindex)
+			summing (aref octet-count k))))
 	 ;; We now know the last octet that was used.  Now convert the
 	 ;; rest of the octets using the new format.  The new
 	 ;; characters are placed in the string buffer at the point
 	 ;; just after the last character that we've already read.
-	 (let ((oc (make-array in-buffer-length :element-type '(unsigned-byte 8))))
-	   (multiple-value-bind (s pos count new-state)
-	       (stream::octets-to-string-counted ibuf
-						 oc
-						 :start index
-						 :end (fd-stream-in-length stream)
-						 :external-format (fd-stream-external-format stream)
-						 :string (lisp-stream-string-buffer stream)
-						 :s-start sindex
-						 :error (fd-stream-octets-to-char-error stream))
-	     (replace octet-count oc :start1 index :end2 pos)
-	     (cond ((eq (fd-stream-external-format stream) :iso8859-1)
-		    ;; ISO8859-1 doesn't use the string-buffer, so we
-		    ;; need to copy the string to the in-buffer and then
-		    ;; set the string-buffer to nil to indicate we're not
-		    ;; using the string buffer anymore.
-		    (let ((index (- in-buffer-length count)))
-		      (dotimes (k count)
-			(setf (aref ibuf (+ k index))
-			      (char-code (aref s (+ k sindex)))))
-		      (setf (lisp-stream-in-index stream) index)
-		      (setf (lisp-stream-string-buffer stream) nil)
-		      (setf (lisp-stream-string-buffer-len stream) 0)
-		      (setf (lisp-stream-string-index stream) 0)))
-		   (t
-		    (setf (lisp-stream-string-index stream) sindex)
-		    (setf (lisp-stream-string-buffer-len stream) pos)
-		    (setf (lisp-stream-in-index stream) (+ index count))
-		    (setf (fd-stream-oc-state stream) new-state)))))))
+	 (multiple-value-bind (s pos count new-state)
+	     (stream::octets-to-string-counted ibuf
+					       oc
+					       :start index
+					       :end (fd-stream-in-length stream)
+					       :external-format (fd-stream-external-format stream)
+					       :string (lisp-stream-string-buffer stream)
+					       :s-start sindex
+					       :error (fd-stream-octets-to-char-error stream))
+	   (replace octet-count oc :start1 index :end2 pos)
+	   (cond ((eq (fd-stream-external-format stream) :iso8859-1)
+		  ;; ISO8859-1 doesn't use the string-buffer, so we
+		  ;; need to copy the string to the in-buffer and then
+		  ;; set the string-buffer to nil to indicate we're not
+		  ;; using the string buffer anymore.
+		  (let ((index (- in-buffer-length count)))
+		    (dotimes (k count)
+		      (setf (aref ibuf (+ k index))
+			    (char-code (aref s (+ k sindex)))))
+		    (setf (lisp-stream-in-index stream) index)
+		    (setf (lisp-stream-string-buffer stream) nil)
+		    (setf (lisp-stream-string-buffer-len stream) 0)
+		    (setf (lisp-stream-string-index stream) 0)))
+		 (t
+		  (setf (lisp-stream-string-index stream) sindex)
+		  (setf (lisp-stream-string-buffer-len stream) pos)
+		  (setf (lisp-stream-in-index stream) (+ index count))
+		  (setf (fd-stream-oc-state stream) new-state))))))
       ((and updatep (lisp-stream-in-buffer stream))
        ;; This means the external format was ISO8859-1 and we're
        ;; switching to something else.  If so, we need to convert all
@@ -145,21 +145,26 @@
 	 ;; Set the unread char to be the last read octet.
 	 (setf (aref (lisp-stream-string-buffer stream) 0)
 	       (code-char (aref ibuf (1- index))))
-	 (multiple-value-bind (s pos count new-state)
-	     (octets-to-string ibuf
-			       :start index
-			       :external-format (fd-stream-external-format stream)
-			       :string (lisp-stream-string-buffer stream)
-			       :s-start 1
-			       :error (fd-stream-octets-to-char-error stream))
-	   (declare (ignore s))
-	   (setf (lisp-stream-string-buffer-len stream) pos)
-	   (setf (fd-stream-oc-state stream) new-state)
-	   ;; Move the octets from the end of the in-buffer to the
-	   ;; beginning.  Set the index to the number of octets we've
-	   ;; processed.
-	   (replace ibuf ibuf :start2 index)
-	   (setf (lisp-stream-in-index stream) count)))))
+	 
+	 (let ((oc (or (fd-stream-octet-count stream)
+		       (setf (fd-stream-octet-count stream)
+			     (make-array in-buffer-length :element-type '(unsigned-byte 8))))))
+	   (multiple-value-bind (s pos count new-state)
+	       (stream::octets-to-string-counted ibuf
+						 oc
+						 :start index
+						 :external-format (fd-stream-external-format stream)
+						 :string (lisp-stream-string-buffer stream)
+						 :s-start 1
+						 :error (fd-stream-octets-to-char-error stream))
+	     (declare (ignore s))
+	     (setf (lisp-stream-string-buffer-len stream) pos)
+	     (setf (fd-stream-oc-state stream) new-state)
+	     ;; Move the octets from the end of the in-buffer to the
+	     ;; beginning.  Set the index to the number of octets we've
+	     ;; processed.
+	     (replace ibuf ibuf :start2 index)
+	     (setf (lisp-stream-in-index stream) count))))))
     extfmt))
 
 



More information about the cmucl-commit mailing list