CMUCL commit: src (4 files)
Raymond Toy
rtoy at common-lisp.net
Mon Sep 6 21:01:56 CEST 2010
Date: Monday, September 6, 2010 @ 15:01:56
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: bootfiles/20a/boot-2010-08-1.lisp code/extfmts.lisp
code/fd-stream-extfmt.lisp code/stream.lisp
Merge changes from 20b-pre2.
-----------------------------------+
bootfiles/20a/boot-2010-08-1.lisp | 28 ++++
code/extfmts.lisp | 32 ++++-
code/fd-stream-extfmt.lisp | 41 ++++--
code/stream.lisp | 230 +++++++++++++++++-------------------
4 files changed, 199 insertions(+), 132 deletions(-)
Index: src/bootfiles/20a/boot-2010-08-1.lisp
diff -u /dev/null src/bootfiles/20a/boot-2010-08-1.lisp:1.2
--- /dev/null Mon Sep 6 15:01:56 2010
+++ src/bootfiles/20a/boot-2010-08-1.lisp Mon Sep 6 15:01:56 2010
@@ -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
Index: src/code/extfmts.lisp
diff -u src/code/extfmts.lisp:1.39 src/code/extfmts.lisp:1.40
--- src/code/extfmts.lisp:1.39 Fri Sep 3 21:03:12 2010
+++ src/code/extfmts.lisp Mon Sep 6 15:01:56 2010
@@ -5,7 +5,7 @@
;;; domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.39 2010-09-04 01:03:12 rtoy Exp $")
+ "$Header: /project/cmucl/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 @@
(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 @@
;;; 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 @@
(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)|#)
Index: src/code/fd-stream-extfmt.lisp
diff -u src/code/fd-stream-extfmt.lisp:1.10 src/code/fd-stream-extfmt.lisp:1.11
--- src/code/fd-stream-extfmt.lisp:1.10 Tue Jul 20 17:34:29 2010
+++ src/code/fd-stream-extfmt.lisp Mon Sep 6 15:01:56 2010
@@ -5,7 +5,7 @@
;;; domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.10 2010-07-20 21:34:29 rtoy Exp $")
+ "$Header: /project/cmucl/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))
Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.97 src/code/stream.lisp:1.98
--- src/code/stream.lisp:1.97 Fri Sep 3 21:03:12 2010
+++ src/code/stream.lisp Mon Sep 6 15:01:56 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.97 2010-09-04 01:03:12 rtoy Exp $")
+ "$Header: /project/cmucl/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
;;;
More information about the cmucl-commit
mailing list