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