From 069f884d4147a64cea3d306968238c3547d96938 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 8 Sep 2010 03:04:54 +0000 Subject: [PATCH] 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. --- code/fd-stream-extfmt.lisp | 145 ++++++++++++++++++++++--------------- code/fd-stream.lisp | 6 +- code/stream.lisp | 17 ++--- 3 files changed, 91 insertions(+), 77 deletions(-) diff --git a/code/fd-stream-extfmt.lisp b/code/fd-stream-extfmt.lisp index dfc8fa796..80304de43 100644 --- a/code/fd-stream-extfmt.lisp +++ b/code/fd-stream-extfmt.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.11 2010/09/06 19:01:56 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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)) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 23a6dd164..5f8d174c2 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.118 2010/08/18 16:42:06 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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 diff --git a/code/stream.lisp b/code/stream.lisp index 7af575fa7..18a3c450c 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.98 2010/09/06 19:01:56 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.99 2010/09/08 03:04:54 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -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) -- GitLab