diff --git a/bootfiles/20a/boot-2010-08-1.lisp b/bootfiles/20a/boot-2010-08-1.lisp new file mode 100644 index 0000000000000000000000000000000000000000..6c757b53218eac69e57fc6f9a2ee79bb705a8818 --- /dev/null +++ b/bootfiles/20a/boot-2010-08-1.lisp @@ -0,0 +1,28 @@ +;; Need to add a new ef macro id for OCTETS-TO-STRING-COUNTED. +;; +;; 2010-09 (probably) needs to be cross-compiled from 2010-08 (aka +;; 20b-pre1). Use something like +;; +;; src/tools/cross-build-world.sh -crl -B src/bootfiles/20a/boot-2010-08-1.lisp target/ cross src/tools/cross-scripts/cross-x86-x86.lisp <20b/bin/lisp> + +(in-package "STREAM") + +(ext:without-package-locks + + (handler-bind ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'kernel::continue)))) + (vm::defenum (:prefix "+EF-" :suffix "+" :start 1) + str ; string length + cin ; input a character + cout ; output a character + sin ; input string + sout ; output string + os ; octets to string + so ; string to octets + en ; encode + de ; decode + flush ; flush state + copy-state ; copy state + osc + max))) \ No newline at end of file diff --git a/code/extfmts.lisp b/code/extfmts.lisp index 214bdb2e5617b64da586dc0f7f039840f66747a1..60378d71893aaef49a1bce6d31f653cac3f6b25a 100644 --- a/code/extfmts.lisp +++ b/code/extfmts.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.39 2010/09/04 01:03:12 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.40 2010/09/06 19:01:56 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -35,6 +35,9 @@ "Hash table mapping an external format alias to the actual external format implementation") +;; Each time DEF-EF-MACRO is used to define a new external format +;; macro, a unique value must be used for the index. The mapping +;; between the macro and the index is here. (vm::defenum (:prefix "+EF-" :suffix "+" :start 1) str ; string length cin ; input a character @@ -47,6 +50,7 @@ de ; decode flush ; flush state copy-state ; copy state + osc ; octets to string, counted max) ;; Unicode replacement character U+FFFD @@ -685,7 +689,7 @@ character and illegal outputs are replaced by a question mark.") (defun ensure-cache (ef id reqd) (let ((base (or (getf *ef-extensions* id) (setf (getf *ef-extensions* id) - (prog1 *ef-base* (incf *ef-base* reqd)))))) + (prog1 *ef-base* (incf *ef-base* reqd)))))) (when (< (length (ef-cache ef)) (+ base reqd)) (setf (efx-cache (ef-efx ef)) (adjust-array (ef-cache ef) (+ base reqd) :initial-element nil))) @@ -693,7 +697,27 @@ character and illegal outputs are replaced by a question mark.") ;;; DEF-EF-MACRO -- Public ;;; -;;; +;;; Create an ef-macro (external-format macro). This creates a +;;; function named Name that will process an external format in the +;;; desired way. +;;; +;;; Paul Foley says: +;;; All the existing ef-macros are provided with the implementation, +;;; so they all use lisp::lisp as the id; it's intended for people +;;; who want to write their own macros~there are some number of +;;; slots (+ef-max+) used by the implementation; the idea is that +;;; you can write something like (def-ef-macro foo (ef my-tag 4 1) +;;; ...) to implement 1 of a total of 4 new macros in your own +;;; "namespace", without having to know how many are implemented by +;;; others (e.g., the 10 used by the base implementation...which +;;; could change with the next release -- and if several libraries +;;; each add their own, the total number, and the position of each +;;; one's slots within that total, may change depending on load +;;; order, etc.) When you write the above, it allocates 4 new +;;; places and associates the base index with "my-tag", then the +;;; "idx" value is relative to that base. The id lisp:lisp always +;;; has its base at 0, so it doesn't need to go through ensure-cache +;;; to find that out. (defmacro def-ef-macro (name (ef id reqd idx) body) (let* ((tmp1 (gensym)) (tmp2 (gensym)) @@ -921,7 +945,7 @@ character and illegal outputs are replaced by a question mark.") (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state)))) -(def-ef-macro ef-octets-to-string-counted (extfmt lisp::lisp +ef-max+ +ef-os+) +(def-ef-macro ef-octets-to-string-counted (extfmt lisp::lisp +ef-max+ +ef-osc+) `(lambda (octets ptr end state ocount string s-start s-end error &aux (pos s-start) (last-octet 0)) (declare (optimize (speed 3) (safety 0) #|(space 0) (debug 0)|#) diff --git a/code/fd-stream-extfmt.lisp b/code/fd-stream-extfmt.lisp index 6f27ce37dbd8f74122993a55280f5d66fea04d62..dfc8fa7962bd9d5b097ee4e6c6d479612f248d27 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.10 2010/07/20 21:34:29 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.11 2010/09/06 19:01:56 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -76,6 +76,11 @@ (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 @@ -83,7 +88,7 @@ ;; 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 (1- (lisp-stream-string-index 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. @@ -93,29 +98,43 @@ (octets-to-string ibuf :start 0 :external-format old-format - :string (make-string sindex) + :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. + ;; 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 1 + :s-start sindex :state state :error (fd-stream-octets-to-char-error stream)) - (declare (ignore s)) - (setf (lisp-stream-string-index stream) 1) - (setf (lisp-stream-string-buffer-len stream) pos) - (setf (lisp-stream-in-index stream) (+ index count)) - (setf (fd-stream-oc-state stream) new-state)))) + (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)))))) extfmt)) diff --git a/code/stream.lisp b/code/stream.lisp index b6550b172e430d30907623802166ae3fb9cf816d..7af575fa792459dbd63d40ff1651c85d323748c6 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.97 2010/09/04 01:03:12 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.98 2010/09/06 19:01:56 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -763,126 +763,122 @@ #+(or debug-frc-sr) (format t "ibuf after = ~A~%" ibuf) - - (let ((count (funcall (lisp-stream-n-bin stream) stream - ibuf index - (- in-buffer-length index) - nil))) - (declare (type (integer 0 #.in-buffer-length) count)) - #+(or debug-frc-sr) - (progn - (format t "count = ~D~%" count) - (format t "new ibuf = ~A~%" ibuf)) + (flet + ((get-octets (start) + (funcall (lisp-stream-n-bin stream) stream + ibuf start + (- in-buffer-length start) + nil)) + (handle-eof () + ;; Nothing left in the stream, so update our pointers to + ;; indicate we've read everything and call the stream-in + ;; function so that we do the right thing for eof. + (setf (lisp-stream-in-index stream) in-buffer-length) + (setf (lisp-stream-string-index stream) + (lisp-stream-string-buffer-len stream)) + (funcall (lisp-stream-in stream) stream eof-errorp eof-value))) + (let ((count (get-octets index))) + (declare (type (integer 0 #.in-buffer-length) count)) + + #+(or debug-frc-sr) + (progn + (format t "count = ~D~%" count) + (format t "new ibuf = ~A~%" ibuf)) - (cond ((zerop count) - ;; Nothing left in the stream, so update our pointers to - ;; indicate we've read everything and call the stream-in - ;; function so that we do the right thing for eof. - (setf (lisp-stream-in-index stream) in-buffer-length) - (setf (lisp-stream-string-index stream) - (lisp-stream-string-buffer-len stream)) - (funcall (lisp-stream-in stream) stream eof-errorp eof-value)) - (t - (let ((sbuf (lisp-stream-string-buffer stream)) - (slen (lisp-stream-string-buffer-len stream))) - (declare (simple-string sbuf) - (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. - (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) - - ;; Copy the last read character to the beginning of the - ;; buffer to support unreading. - (when (plusp slen) - (setf (schar sbuf 0) (schar sbuf (1- slen)))) - - #+(or debug-frc-sr) - (progn - (format t "sbuf[0] = ~S~%" (schar sbuf 0)) - (format t "index = ~S~%" index)) - - - ;; Convert all the octets, including the ones that we - ;; haven't processed yet and the ones we just read in. - (flet - ((convert-buffer () - (multiple-value-bind (s char-count octet-count new-state) - (stream::octets-to-string-counted - ibuf - (fd-stream-octet-count stream) - :start 0 - :end (fd-stream-in-length stream) - :state (fd-stream-oc-state stream) - :string sbuf - :s-start 1 - :external-format (fd-stream-external-format stream) - :error (fd-stream-octets-to-char-error stream)) - (declare (ignore s) - (type (integer 0 #.in-buffer-length) char-count octet-count)) - #+(or debug-frc-sr) - (progn - (format t "char-count = ~A~%" char-count) - (format t "octet-count = ~A~%" octet-count) - (format t "in-index = ~A~%" (lisp-stream-in-index stream))) - (when (> char-count 0) - (setf (fd-stream-oc-state stream) new-state) - (setf (lisp-stream-string-buffer-len stream) (1+ char-count)) - (setf (lisp-stream-string-index stream) 2) - (setf (lisp-stream-in-index stream) octet-count) + (cond ((zerop count) + (handle-eof)) + (t + (let ((sbuf (lisp-stream-string-buffer stream)) + (slen (lisp-stream-string-buffer-len stream))) + (declare (simple-string sbuf) + (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. + (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) + + ;; Copy the last read character to the beginning of the + ;; buffer to support unreading. + (when (plusp slen) + (setf (schar sbuf 0) (schar sbuf (1- slen)))) + + #+(or debug-frc-sr) + (progn + (format t "sbuf[0] = ~S~%" (schar sbuf 0)) + (format t "index = ~S~%" index)) + + + ;; Convert all the octets, including the ones that we + ;; haven't processed yet and the ones we just read in. + (flet + ((convert-buffer () + (multiple-value-bind (s char-count octet-count new-state) + (stream::octets-to-string-counted + ibuf + (fd-stream-octet-count stream) + :start 0 + :end (fd-stream-in-length stream) + :state (fd-stream-oc-state stream) + :string sbuf + :s-start 1 + :external-format (fd-stream-external-format stream) + :error (fd-stream-octets-to-char-error stream)) + (declare (ignore s) + (type (integer 0 #.in-buffer-length) char-count octet-count)) #+(or debug-frc-sr) (progn - (format t "new in-index = ~A~%" (lisp-stream-in-index stream)) - (format t "new sbuf = ~S~%" - (subseq sbuf 0 (1+ char-count)))) - (schar sbuf 1))))) - (let ((out (convert-buffer))) - (or out - ;; There weren't enough octets to convert at - ;; least one character. Try to read some more - ;; octets and try again. (If we still fail, - ;; what should we do then? Currently, just - ;; just return NIL and let other parts of Lisp - ;; catch that.) - ;; - ;; The in buffer holds unread octets up to - ;; index in-length. So start reading octets there. - (let* ((index (fd-stream-in-length stream)) - (count (funcall (lisp-stream-n-bin stream) stream - ibuf index - (- in-buffer-length index) - nil))) - (declare (type (integer 0 #.in-buffer-length) count index)) - (cond ((zerop count) - ;; Nothing left in the stream, so update our pointers to - ;; indicate we've read everything and call the stream-in - ;; function so that we do the right thing for eof. - (setf (lisp-stream-in-index stream) in-buffer-length) - (setf (lisp-stream-string-index stream) - (lisp-stream-string-buffer-len stream)) - (funcall (lisp-stream-in stream) stream eof-errorp eof-value)) - (t - ;; Adjust in-length to the total - ;; number of octets that are now in - ;; the buffer. - (setf (fd-stream-in-length stream) (+ count index)) - (convert-buffer))))))))))))) + (format t "char-count = ~A~%" char-count) + (format t "octet-count = ~A~%" octet-count) + (format t "in-index = ~A~%" (lisp-stream-in-index stream))) + (when (> char-count 0) + (setf (fd-stream-oc-state stream) new-state) + (setf (lisp-stream-string-buffer-len stream) (1+ char-count)) + (setf (lisp-stream-string-index stream) 2) + (setf (lisp-stream-in-index stream) octet-count) + #+(or debug-frc-sr) + (progn + (format t "new in-index = ~A~%" (lisp-stream-in-index stream)) + (format t "new sbuf = ~S~%" + (subseq sbuf 0 (1+ char-count)))) + (schar sbuf 1))))) + (let ((out (convert-buffer))) + (or out + ;; There weren't enough octets to convert at + ;; least one character. Try to read some more + ;; octets and try again. (If we still fail, + ;; what should we do then? Currently, just + ;; just return NIL and let other parts of Lisp + ;; catch that.) + ;; + ;; The in buffer holds unread octets up to + ;; index in-length. So start reading octets there. + (let* ((index (fd-stream-in-length stream)) + (count (get-octets index))) + (declare (type (integer 0 #.in-buffer-length) count index)) + (cond ((zerop count) + (handle-eof)) + (t + ;; Adjust in-length to the total + ;; number of octets that are now in + ;; the buffer. + (setf (fd-stream-in-length stream) (+ count index)) + (convert-buffer)))))))))))))) ;;; FAST-READ-BYTE-REFILL -- Interface ;;;