CMUCL commit: RELEASE-20B-BRANCH src/code (fd-stream-extfmt.lisp)
Raymond Toy
rtoy at common-lisp.net
Fri Sep 24 02:51:03 CEST 2010
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))
More information about the cmucl-commit
mailing list