Date: Thursday, September 23, 2010 @ 20:51:03 Author: rtoy Path: /project/cmucl/cvsroot/src/code Tag: RELEASE-20B-BRANCH
Modified: fd-stream-extfmt.lisp
Merge change from HEAD that fixes the case of changing the external format from :iso8859-1 to something else.
-----------------------+ fd-stream-extfmt.lisp | 150 ++++++++++++++++++++++++++++-------------------- 1 file changed, 90 insertions(+), 60 deletions(-)
Index: src/code/fd-stream-extfmt.lisp diff -u src/code/fd-stream-extfmt.lisp:1.10.2.1 src/code/fd-stream-extfmt.lisp:1.10.2.2 --- src/code/fd-stream-extfmt.lisp:1.10.2.1 Mon Sep 6 11:41:30 2010 +++ src/code/fd-stream-extfmt.lisp Thu Sep 23 20:51:03 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.10.2.1 2010-09-06 15:41:30 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.10.2.2 2010-09-24 00:51:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -76,65 +76,95 @@ (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)) + (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. + (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)))) + + (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))