From d689646f5534ac1ba2313d5505ba19b8f0416078 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sun, 15 Aug 2010 12:04:44 +0000 Subject: [PATCH] Fix file-position bug in trac #36. We add an array to keep track of the octets consumed for each character. This array is used to figure out the file position. Some tests comparing this scheme indicates a very small slowdown of about 1%, so this seems not to hurt. Use a cross-compile using the 2010-07 snapshot to build this. (Same procedure as used to build the 20b-pre1 release.) struct.lisp: o Add new slot OCTET-COUNT to LISP-STREAM to hold the array of octets per character. extfmts.lisp: o Add OCTETS-TO-STRING-COUNTED, which is like OCTETS-TO-STRING, except we need an array in which to store the number of octets consumed for each character processed. fd-stream.lisp: o Create the octet-count array creating the lisp stream string buffer. o In FD-STREAM-FILE-POSITION, use the octet count to count the number of octets that have been read but not yet returned to the user. stream.lisp: o Use OCTETS-TO-STRING-COUNTED instead of OCTETS-TO-STRING so we keep track of octet length of each character processed. --- code/extfmts.lisp | 71 ++++++++++++++++++++++++++++++++++++++++++++- code/fd-stream.lisp | 23 ++++++++++----- code/stream.lisp | 20 +++++++------ code/struct.lisp | 16 +++++++--- 4 files changed, 108 insertions(+), 22 deletions(-) diff --git a/code/extfmts.lisp b/code/extfmts.lisp index f99be449d..564865c30 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.37 2010/08/14 23:18:03 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.38 2010/08/15 12:04:43 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -920,6 +920,75 @@ character and illegal outputs are replaced by a question mark.") error) (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+) + `(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)|#) + (type (simple-array (unsigned-byte 8) (*)) octets ocount) + (type kernel:index pos end last-octet s-start s-end) + (type (integer -1 (#.array-dimension-limit)) ptr) + (type simple-string string) + (ignorable state)) + (catch 'end-of-octets + (loop for k of-type fixnum from 0 + while (< pos s-end) + do (setf (schar string pos) + (octets-to-char ,extfmt state (aref ocount k) + (if (>= ptr end) + (throw 'end-of-octets nil) + (aref octets (incf ptr))) + (lambda (n) (decf ptr n)) + error)) + (incf pos) + (incf last-octet (aref ocount k)))) + (values string pos last-octet state))) + +;; Like OCTETS-TO-STRING, but we take an extra argument which is an +;; array which will contain the number of octets read for each +;; character placed in the output string. +(defun octets-to-string-counted (octets ocount + &key (start 0) end (external-format :default) + (string nil stringp) + (s-start 0) (s-end nil s-end-p) + (state nil) + error) + "Octets-to-string converts an array of octets in Octets to a string + according to the specified External-format. The array of octets is + bounded by Start (defaulting ot 0) and End (defaulting to the end of + the array. If String is not given, a new string is created. If + String is given, the converted octets are stored in String, starting + at S-Start (defaulting to the 0) and ending at S-End (defaulting to + the length of String). If the string is not large enough to hold + all of characters, then some octets will not be converted. A State + may also be specified; this is used as the state of the external + format. + + In Ocount, the number of octets read for each character in the + string is saved + + Four values are returned: the string, the number of characters read, + the number of octets actually consumed and the new state of the + external format." + (declare (type (simple-array (unsigned-byte 8) (*)) octets ocount) + (type kernel:index start s-start) + (type (or kernel:index null) end) + (type (or simple-string null) string)) + (let ((s-end (if s-end-p + s-end + (if stringp + (length string) + (length octets))))) + (multiple-value-bind (string pos last-octet new-state) + (funcall (ef-octets-to-string-counted external-format) + octets (1- start) (1- (or end (length octets))) + state + ocount + (or string (make-string (length octets))) + s-start s-end + error) + (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state)))) + (def-ef-macro ef-encode (extfmt lisp::lisp +ef-max+ +ef-en+) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index b82d6f343..6c5a8a06d 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.115 2010/08/04 03:37:51 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.116 2010/08/15 12:04:43 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1450,6 +1450,8 @@ ;; FAST-READ-CHAR.) (setf (lisp-stream-string-buffer stream) (make-string (1+ in-buffer-length))) + (setf (fd-stream-octet-count stream) + (make-array in-buffer-length :element-type '(unsigned-byte 8))) (setf (lisp-stream-string-buffer-len stream) 0) (setf (lisp-stream-string-index stream) 0))))) (setf input-size size) @@ -1706,13 +1708,18 @@ ;; The string buffer contains Lisp characters, ;; not octets! To figure out how many octets ;; have not been already supplied, we need to - ;; convert them back to the encoded format and - ;; count the number of octets. - (decf posn - (length (string-encode (fd-stream-string-buffer stream) - (fd-stream-external-format stream) - (fd-stream-string-index stream) - (fd-stream-string-buffer-len stream)))) + ;; count how many octets were consumed for all + ;; the characters in the string bbuffer that have + ;; not been supplied. + (let ((ocount (fd-stream-octet-count stream))) + (when ocount + ;; Note: string-index starts at 1 (because + ;; index 0 is for the unread-char), but + ;; octet-count doesn't use that. Hence, + ;; subtract one from string-index. + (loop for k of-type fixnum from (1- (fd-stream-string-index stream)) + below (fd-stream-string-buffer-len stream) + do (decf posn (aref ocount k))))) (decf posn (- (fd-stream-ibuf-tail stream) (fd-stream-ibuf-head stream)))) (when (fd-stream-unread stream) ;;@@ diff --git a/code/stream.lisp b/code/stream.lisp index e80639314..f24052bf6 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.95 2010/08/09 22:45:14 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.96 2010/08/15 12:04:43 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -802,14 +802,16 @@ ;; Convert all the octets, including the ones that we ;; haven't processed yet and the ones we just read in. (multiple-value-bind (s char-count octet-count new-state) - (octets-to-string ibuf - :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)) + (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)) (setf (fd-stream-oc-state stream) new-state) (setf (lisp-stream-string-buffer-len stream) char-count) diff --git a/code/struct.lisp b/code/struct.lisp index c0722336f..4f3b1debd 100644 --- a/code/struct.lisp +++ b/code/struct.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/struct.lisp,v 1.24 2010/04/19 02:18:04 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/struct.lisp,v 1.25 2010/08/15 12:04:44 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -41,11 +41,13 @@ (misc #'do-nothing :type function) ; Less used methods ;; ;; A string to hold characters that have been converted from - ;; in-buffer. + ;; in-buffer. The very first character is for unreading. New + ;; characters are stored starting at index 1. #+unicode (string-buffer nil :type (or null simple-string)) ;; - ;; Index into string-buffer where the next character should be read from + ;; Index into string-buffer where the next character should be read + ;; from. #+unicode (string-index 0 :type index) ;; @@ -53,7 +55,13 @@ ;; string-buffer, but the number of characters in the buffer, since ;; many octets may be consumed to produce one character.) #+unicode - (string-buffer-len 0 :type index)) + (string-buffer-len 0 :type index) + ;; + ;; An array holding the number of octets consumed for each character + ;; 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) (*))))) (declaim (inline streamp)) (defun streamp (stream) -- GitLab