Date: Tuesday, October 12, 2010 @ 17:52:44 Author: rtoy Path: /project/cmucl/cvsroot/src

Modified: code/fd-stream-extfmt.lisp code/fd-stream.lisp code/struct.lisp code/sysmacs.lisp compiler/dump.lisp

Make read-char and read-byte signal errors when given the wrong kind of streams. This is a change from current 20a and 20b behavior which didn't signal errors, but matches the behavior for releases 19f and earlier.

But allow them to work on binary-text-streams. This is the same behavior as before for binary-text-stream streams.

However, read-sequence no longer allows reading from streams into arbitrary objects, unless the stream is a binary-text-stream stream.

code/fd-stream-extfmt.lisp: o In %SET-FD-STREAM-EXTERNAL-FORMAT, only update fd-stream-in/fd-stream-out if we have a character or binary-text-stream stream. o Don't update the fd-stream-string-buffer or lisp-stream-in-buffer if we have a binary-text-stream because that will mess up how fast-read-char and fast-read-byte dispatch to do the right thing for binary-text-stream streams.

code/fd-stream.lisp: o Set the fd-stream-in and fd-stream-bin slots appropriately depending on whether we have a character, binary, or binary-text-stream stream. o Only create the lisp-stream-in-buffer if we do NOT have a binary-text-stream. (Binary streams didn't use the lisp-stream-buffer previously, so no change there. Character streams use the lisp-stream-buffer and/or lisp-string-buffer.) o Set the fd-stream-flags appropriately for the kind of stream this is. Checking a fixnum is faster than checking the type of a stream.

code/struct.lisp: o Add FLAGS slot to LISP-STREAM so we can tell what kind of stream (character, binary, binary-text-stream) we have.

code/sysmacs.lisp: o Change FAST-READ-CHAR so that if we have a have a binary or binary-text-stream stream, we dispatch to the fast-read-char methods to do the right thing, including signaling an error for the wrong kind of stream. o Change FAST-READ-BYTE so that if we do not have a binary stream, we dispatch to the fast-read-char method to do the right thing.

compiler/dump.lisp: o With the above changes, we can no longer write characters to a binary stream, like a FASL file. Make the fasl file a binary-text-stream so that we can. (Alternatively, we could create the FASL header as a string, convert to octets and dump the octest to the file. This is easier, and should still be fast for writing fasls.)

----------------------------+ code/fd-stream-extfmt.lisp | 178 ++++++++++++++++++++++--------------------- code/fd-stream.lisp | 61 ++++++++++---- code/struct.lisp | 16 +++ code/sysmacs.lisp | 24 +++-- compiler/dump.lisp | 5 - 5 files changed, 170 insertions(+), 114 deletions(-)

Index: src/code/fd-stream-extfmt.lisp diff -u src/code/fd-stream-extfmt.lisp:1.13 src/code/fd-stream-extfmt.lisp:1.14 --- src/code/fd-stream-extfmt.lisp:1.13 Thu Sep 23 20:36:03 2010 +++ src/code/fd-stream-extfmt.lisp Tue Oct 12 17:52:44 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.13 2010-09-24 00:36:03 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.14 2010-10-12 21:52:44 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -70,101 +70,113 @@ (stream::ef-name (stream::find-external-format extfmt)) (fd-stream-oc-state stream) nil (fd-stream-co-state stream) nil) - (when (fd-stream-ibuf-sap stream) ; input stream + ;; Set fd-stream-in only if we have an input stream for a + ;; character stream or binary-text-stream. + (when (and (fd-stream-ibuf-sap stream) + (plusp (logand #b101 (lisp-stream-flags stream)))) (setf (fd-stream-in stream) (ef-cin extfmt))) - (when (fd-stream-obuf-sap stream) ; output stream + ;; Set fd-stream-in only if we have an input stream for a + ;; character stream or binary-text-stream. + (when (and (fd-stream-obuf-sap stream) + (plusp (logand #b101 (lisp-stream-flags stream)))) (setf (fd-stream-out stream) (ef-cout extfmt) ;;@@ (fd-stream-sout stream) (ef-sout extfmt) )) + ;; 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)))))) + ;; strategies. But don't change anything if we have a + ;; binary-text-stream. In that case, we don't want to set the + ;; lisp-stream-in-buffer or lisp-stream-string-buffer which would + ;; cause the FAST-READ-CHAR/FAST-READ-BYTE functions to bypass the + ;; methods. + + (unless (typep stream 'binary-text-stream) + (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 1 + :s-start sindex :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)))))) + (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))

Index: src/code/fd-stream.lisp diff -u src/code/fd-stream.lisp:1.120 src/code/fd-stream.lisp:1.121 --- src/code/fd-stream.lisp:1.120 Wed Sep 15 07:32:49 2010 +++ src/code/fd-stream.lisp Tue Oct 12 17:52:44 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.120 2010-09-15 11:32:49 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.121 2010-10-12 21:52:44 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1402,9 +1402,16 @@ (setf (fd-stream-ibuf-sap stream) (next-available-buffer)) (setf (fd-stream-ibuf-length stream) bytes-per-buffer) (setf (fd-stream-ibuf-tail stream) 0) + + ;; Set the in and bin methods. Normally put an illegal input + ;; function in, but if we have a binary text stream, pick an + ;; appropriate input routine. (if (subtypep type 'character) (setf (fd-stream-in stream) routine - (fd-stream-bin stream) #'ill-bin) + (fd-stream-bin stream) (if (and binary-stream-p + (eql size 1)) + (pick-input-routine '(unsigned-byte 8)) + #'ill-bin)) (setf (fd-stream-in stream) (if (and binary-stream-p (eql size 1)) (pick-input-routine 'character) @@ -1423,17 +1430,17 @@ (or (eq 'unsigned-byte (and (consp type) (car type))) (eq type :default)) (eq type 'character))) - ;; We only create this buffer for streams of type - ;; (unsigned-byte 8) or character streams with an external - ;; format of :iso8859-1. Because there's no buffer, the - ;; other element-types will dispatch to the appropriate - ;; input (output) routine in fast-read-byte/fast-read-char. (when *enable-stream-buffer-p* - (setf (lisp-stream-in-buffer stream) - (make-array in-buffer-length - :element-type '(unsigned-byte 8))) + (when (and (not binary-stream-p) + (eq type 'character)) + ;; Create the in-buffer for any character (only) + ;; stream. Don't want one for binary-text-streams! + (setf (lisp-stream-in-buffer stream) + (make-array in-buffer-length + :element-type '(unsigned-byte 8)))) #+unicode - (when (and (eq type 'character) + (when (and (not binary-stream-p) + (eq type 'character) (not (eq :iso8859-1 (fd-stream-external-format stream)))) ;; For character streams, we create the string-buffer so ;; we can convert all available octets at once instead @@ -1444,6 +1451,7 @@ ;; For ISO8859-1, we don't want this because it's very ;; easy and quick to convert octets to iso8859-1. (See ;; FAST-READ-CHAR.) + (setf (lisp-stream-string-buffer stream) (make-string (1+ in-buffer-length))) (setf (fd-stream-octet-count stream) @@ -1464,15 +1472,23 @@ (setf (fd-stream-obuf-sap stream) (next-available-buffer)) (setf (fd-stream-obuf-length stream) bytes-per-buffer) (setf (fd-stream-obuf-tail stream) 0) + ;; Normally signal errors for reading from a stream with the + ;; wrong element type, but allow binary-text-streams to read + ;; from either. (if (subtypep type 'character) - (setf (fd-stream-out stream) routine - (fd-stream-bout stream) #'ill-bout) - (setf (fd-stream-out stream) - (or (if (eql size 1) + (setf (fd-stream-out stream) routine + (fd-stream-bout stream) + (if (and binary-stream-p + (eql size 1)) + (pick-output-routine '(unsigned-byte 8) + (fd-stream-buffering stream)) + #'ill-bout)) + (setf (fd-stream-out stream) + (if (and binary-stream-p (eql size 1)) (pick-output-routine 'base-char - (fd-stream-buffering stream))) - #'ill-out) - (fd-stream-bout stream) routine)) + (fd-stream-buffering stream)) + #'ill-out) + (fd-stream-bout stream) routine)) (setf (fd-stream-sout stream) (if (eql size 1) #'fd-sout #'ill-out)) (setf (fd-stream-char-pos stream) 0) @@ -1880,6 +1896,15 @@ :timeout timeout :char-to-octets-error e :octets-to-char-error d))))) + ;; Set the lisp-stream flags appropriately for the kind of stream + ;; we have (character, binary, binary-text-stream). + (cond ((typep stream 'binary-text-stream) + (setf (fd-stream-flags stream) #b100)) + ((subtypep element-type 'character) + (setf (fd-stream-flags stream) #b001)) + (t + (setf (fd-stream-flags stream) #b010))) + ;; FIXME: setting the external format here should be better ;; integrated into set-routines. We do it before so that ;; set-routines can create an in-buffer if appropriate. But we Index: src/code/struct.lisp diff -u src/code/struct.lisp:1.25 src/code/struct.lisp:1.26 --- src/code/struct.lisp:1.25 Sun Aug 15 08:04:44 2010 +++ src/code/struct.lisp Tue Oct 12 17:52:44 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/struct.lisp,v 1.25 2010-08-15 12:04:44 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/struct.lisp,v 1.26 2010-10-12 21:52:44 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -61,7 +61,19 @@ ;; in string-buffer. This is basically unused, except by ;; FILE-POSITION so that we can get the correct file position. #+unicode - (octet-count nil :type (or null (simple-array (unsigned-byte 8) (*))))) + (octet-count nil :type (or null (simple-array (unsigned-byte 8) (*)))) + ;; + ;; Flags indicating if the stream is a character stream, binary + ;; stream or binary-text-stream. This is somewhat redundant because + ;; binary-text-stream is its own type (defstruct). But we can't + ;; easily distinguish a character stream from a binary stream. + ;; + ;; #b001 - character (only) stream + ;; #b010 - binary (only) stream + ;; #b100 - binary-text-stream (supports character and binary) + ;; + ;; It is an error if both character and binary bits are set. + (flags 0 :type fixnum))

(declaim (inline streamp)) (defun streamp (stream) Index: src/code/sysmacs.lisp diff -u src/code/sysmacs.lisp:1.34 src/code/sysmacs.lisp:1.35 --- src/code/sysmacs.lisp:1.34 Sun Jul 4 23:40:02 2010 +++ src/code/sysmacs.lisp Tue Oct 12 17:52:44 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/sysmacs.lisp,v 1.34 2010-07-05 03:40:02 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/sysmacs.lisp,v 1.35 2010-10-12 21:52:44 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -184,6 +184,9 @@ ;;; (defmacro fast-read-char (&optional (eof-errorp t) (eof-value ())) `(cond + ((/= (lisp-stream-flags %frc-stream%) 1) + ;; Call the method if we're doing a read-char on a character stream. + (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value)) #+unicode (%frc-string-buffer% (cond ((>= %frc-string-index% %frc-string-length%) @@ -231,14 +234,17 @@ `(truly-the ,(if (and (eq eof-errorp 't) (not any-type)) '(unsigned-byte 8) 't) (cond - ((not %frc-buffer%) - (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value)) - ((= %frc-index% in-buffer-length) - (prog1 (fast-read-byte-refill %frc-stream% ,eof-errorp ,eof-value) - (setq %frc-index% (lisp-stream-in-index %frc-stream%)))) - (t - (prog1 (aref %frc-buffer% %frc-index%) - (incf %frc-index%)))))) + ((or (not %frc-buffer%) (/= (lisp-stream-flags %frc-stream%) #b10)) + ;; Call the method if we're doing a read-byte on a stream that + ;; is has no in-buffer (a binary-text-stream) or is not a + ;; binary stream (flags /= #b10). + (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value)) + ((= %frc-index% in-buffer-length) + (prog1 (fast-read-byte-refill %frc-stream% ,eof-errorp ,eof-value) + (setq %frc-index% (lisp-stream-in-index %frc-stream%)))) + (t + (prog1 (aref %frc-buffer% %frc-index%) + (incf %frc-index%)))))) ;;; (defmacro done-with-fast-read-byte () `(progn Index: src/compiler/dump.lisp diff -u src/compiler/dump.lisp:1.87 src/compiler/dump.lisp:1.88 --- src/compiler/dump.lisp:1.87 Tue Jun 1 16:27:09 2010 +++ src/compiler/dump.lisp Tue Oct 12 17:52:44 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/dump.lisp,v 1.87 2010-06-01 20:27:09 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/compiler/dump.lisp,v 1.88 2010-10-12 21:52:44 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -383,7 +383,8 @@ (declare (type pathname name)) (let* ((stream (open name :direction :output :if-exists :rename-and-delete - :element-type '(unsigned-byte 8))) + :element-type '(unsigned-byte 8) + :class 'binary-text-stream)) (res (make-fasl-file :stream stream))) (multiple-value-bind (version f-vers f-imp)