Skip to content
Snippets Groups Projects
Commit 6d513f3f authored by rtoy's avatar rtoy
Browse files

Merge changes from 20b-pre2.

parent 9163106c
No related branches found
No related tags found
No related merge requests found
;; 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
......@@ -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)|#)
......
......@@ -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))
......
......@@ -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
;;;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment