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