CMUCL commit: src/code (3 files)

Raymond Toy rtoy at common-lisp.net
Wed Sep 8 05:04:54 CEST 2010


    Date: Tuesday, September 7, 2010 @ 23:04:54
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: fd-stream-extfmt.lisp fd-stream.lisp stream.lisp

Clean up how (setf stream-external-format) works.  This change
requires a cross-compile using the default cross-compile script.

fd-stream.lisp:
o Remove the SAVED-OC-STATE slot from an FD-STREAM because we don't
  need it anymore since we have the OCTET-COUNT slot.

stream.lisp:
o Don't need to copy the current OC-STATE to SAVED-OC-STATE.  Remove
  code and update comments.

fd-stream-extfmt.lisp:
o Use the OCTET-COUNT slot to figure out how many octets have been
  consumed so far to produce the characters that have already been
  read.  Don't need to do the re-conversion anymore, so we don't need
  the SAVED-OC-STATE anymore.
o Add support for the case where we were using the ISO8859-1 external
  format and are now switching to another external format that
  requires the string-buffer.


-----------------------+
 fd-stream-extfmt.lisp |  145 ++++++++++++++++++++++++++++--------------------
 fd-stream.lisp        |    6 -
 stream.lisp           |   17 +----
 3 files changed, 91 insertions(+), 77 deletions(-)


Index: src/code/fd-stream-extfmt.lisp
diff -u src/code/fd-stream-extfmt.lisp:1.11 src/code/fd-stream-extfmt.lisp:1.12
--- src/code/fd-stream-extfmt.lisp:1.11	Mon Sep  6 15:01:56 2010
+++ src/code/fd-stream-extfmt.lisp	Tue Sep  7 23:04:54 2010
@@ -5,7 +5,7 @@
 ;;; domain.
 ;;; 
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.11 2010-09-06 19:01:56 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.12 2010-09-08 03:04:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -76,65 +76,90 @@
       (setf (fd-stream-out stream) (ef-cout extfmt)
 	    ;;@@ (fd-stream-sout stream) (ef-sout extfmt)
 	    ))
-    ;; FIXME: We currently don't handle the case of changing from
-    ;; ISO8859-1 to something else.  This is because ISO8859-1 doesn't
-    ;; use the string-buffer, so when we switch to another external
-    ;; format that does, we need to set up the string-buffer
-    ;; appropriately.
-    (when (and lisp::*enable-stream-buffer-p* updatep
-	       (lisp-stream-string-buffer stream))
-      ;; We want to reconvert any octets that haven't been converted
-      ;; yet.  So, we need to figure out which octet to start with.
-      ;; This is done by converting (the previously converted) octets
-      ;; until we've converted the right number of characters.
-      (let ((ibuf (lisp-stream-in-buffer stream))
-	    (sindex (lisp-stream-string-index stream))
-	    (index 0)
-	    (state (fd-stream-saved-oc-state stream)))
-	;; Reconvert all the octets we've already converted and read.
-	;; We don't know how many octets that is, but do know how many
-	;; characters there are.
-	(multiple-value-bind (s pos count new-state)
-	    (octets-to-string ibuf
-			      :start 0
-			      :external-format old-format
-			      :string (make-string (1- sindex))
-			      :state state
-			      :error (fd-stream-octets-to-char-error stream))
-	  (declare (ignore s pos))
-	  (setf state new-state)
-	  (setf index count))
-	;; 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.
-	(multiple-value-bind (s pos count new-state)
-	    (octets-to-string ibuf
-			      :start index
-			      :end (fd-stream-in-length stream)
-			      :external-format (fd-stream-external-format stream)
-			      :string (lisp-stream-string-buffer stream)
-			      :s-start sindex
-			      :state state
-			      :error (fd-stream-octets-to-char-error stream))
-	  (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))))))
+    ;; The following handles the case of setting the external format
+    ;; for input streams where we need to handle the various buffering
+    ;; strategies.
+    ;;
+    (cond
+      ((eq old-format (fd-stream-external-format stream))
+       ;; Nothing to do if the new and old formats are the same.
+       )
+      ((and lisp::*enable-stream-buffer-p* updatep
+	    (lisp-stream-string-buffer stream))
+       ;; We want to reconvert any octets that haven't been converted
+       ;; yet.  So, we need to figure out which octet to start with.
+       ;; This is done by converting (the previously converted) octets
+       ;; 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)))
+	 ;; 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)))))))
+      ((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
+       ;; the octets that haven't been processed yet and place them in
+       ;; the string buffer.  We also need to adjust the in-buffer to
+       ;; put those octets in the expected place at the beginning of
+       ;; in-buffer.
+       (let ((index (lisp-stream-in-index stream))
+	     (ibuf (lisp-stream-in-buffer stream)))
+	 (setf (lisp-stream-string-buffer stream)
+	       (make-string (1+ in-buffer-length)))
+	 (setf (lisp-stream-string-index stream) 1)
+	 ;; 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)))))
     extfmt))
 
 
Index: src/code/fd-stream.lisp
diff -u src/code/fd-stream.lisp:1.118 src/code/fd-stream.lisp:1.119
--- src/code/fd-stream.lisp:1.118	Wed Aug 18 12:42:06 2010
+++ src/code/fd-stream.lisp	Tue Sep  7 23:04:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.118 2010-08-18 16:42:06 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.119 2010-09-08 03:04:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -255,10 +255,6 @@
   (co-state nil)
   #+unicode
   (last-char-read-size 0 :type index)
-  ;; Saved state needed for (setf stream-external-format) when the
-  ;; fast string-buffer is used.
-  #+unicode
-  (saved-oc-state nil)
   ;;
   ;; The number of octets in in-buffer.  Normally equal to
   ;; in-buffer-length, but could be less if we reached the
Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.98 src/code/stream.lisp:1.99
--- src/code/stream.lisp:1.98	Mon Sep  6 15:01:56 2010
+++ src/code/stream.lisp	Tue Sep  7 23:04:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.98 2010-09-06 19:01:56 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.99 2010-09-08 03:04:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -795,20 +795,13 @@
 			  (type (integer 0 #.(1+ in-buffer-length)) slen)
 			  (optimize (speed 3)))
 
-		 ;; Update in-length and saved-oc-state.  These are
-		 ;; needed if we change the external-format of the
-		 ;; stream because we need to know how many octets are
-		 ;; valid (in case end-of-file was reached), and what
-		 ;; the state was when originally converting the octets
-		 ;; to characters.
+		 ;; Update in-length.  This is needed if we change the
+		 ;; external-format of the stream because we need to
+		 ;; know how many octets are valid (in case
+		 ;; end-of-file was reached)
 		 (setf (fd-stream-in-length stream) (+ count index))
 		 #+(or debug-frc-sr)
 		 (format t "in-length = ~D~%" (fd-stream-in-length stream))
-		 (let ((state (fd-stream-oc-state stream)))
-		   (setf (fd-stream-saved-oc-state stream)
-			 (cons (car state)
-			       (funcall (ef-copy-state (fd-stream-external-format stream))
-					(cdr state)))))
 
 		 #+(or debug-frc-sr)
 		 (format t "slen = ~A~%" slen)



More information about the cmucl-commit mailing list