Author: eweitz Date: Tue May 20 20:19:12 2008 New Revision: 40

Modified: branches/edi/conditions.lisp branches/edi/input.lisp branches/edi/output.lisp Log: read-sequence slightly improved for file streams

Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Tue May 20 20:19:12 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.6 2008/05/20 23:44:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.7 2008/05/21 00:05:42 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -51,6 +51,7 @@ (define-condition flexi-stream-out-of-sync-error (flexi-stream-error) () (:report (lambda (condition stream) + (declare (ignore condition)) (format stream "Stream out of sync from previous lookahead, couldn't rewind."))) (:documentation "This can happen if you're trying to write to an IO

Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Tue May 20 20:19:12 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.68 2008/05/20 23:01:51 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.70 2008/05/21 00:18:35 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -217,23 +217,32 @@ (buffer-pos 0) (buffer-end 0) (index start) + ;; whether we will deliver characters and thus the number + ;; of octets to read might not be equal to the number of + ;; sequence elements to fill (want-chars-p (or (stringp sequence) (and (vectorp sequence) (not (subtypep (array-element-type sequence) 'integer))) - (type-equal element-type 'octet))) + (not (type-equal element-type 'octet)))) + ;; whether we will later be able to rewind the stream if + ;; needed (to get rid of unused octets in the buffer) + (can-rewind-p (and want-chars-p (maybe-rewind stream 0))) (factor (if want-chars-p (encoding-factor external-format) 1)) (integer-factor (floor factor)) ;; it's an interesting question whether it makes sense ;; performance-wise to make RESERVE significantly bigger ;; (and thus put potentially a lot more octets into ;; OCTET-STACK), especially for UTF-8 - (reserve (if (floatp factor) (* 2 integer-factor) 0))) + (reserve (cond ((not (floatp factor)) 0) + ((not can-rewind-p) (* 2 integer-factor)) + (t (ceiling (* (- factor integer-factor) (- end start))))))) (declare (fixnum buffer-pos buffer-end index integer-factor reserve) - (boolean want-chars-p)) - (flet ((compute-minimum () - "Computes the minimum amount of octets we can savely -read into the buffer without violating the stream's bound (if there -is one) and without potentially reading much more than we need." + (boolean want-chars-p can-rewind-p)) + (flet ((compute-fill-amount () + "Computes the amount of octets we can savely read into +the buffer without violating the stream's bound (if there is one) and +without potentially reading much more than we need (unless we can +rewind afterwards)." (let ((minimum (min (the fixnum (+ (the fixnum (* integer-factor (the fixnum (- end index)))) reserve)) @@ -261,7 +270,7 @@ ;; compare with BUFFER-POS (unless (zerop buffer-end) (incf position buffer-end)))) - (let ((minimum (compute-minimum))) + (let ((minimum (compute-fill-amount))) (declare (fixnum minimum)) (setq buffer (make-octet-buffer minimum)) ;; fill buffer for the first time or return immediately if @@ -275,7 +284,7 @@ stream." (when (>= buffer-pos buffer-end) (setq buffer-pos 0) - (unless (fill-buffer (compute-minimum)) + (unless (fill-buffer (compute-fill-amount)) (return-from next-octet))) (prog1 (aref (the (array octet *) buffer) buffer-pos) @@ -306,12 +315,17 @@ (when (>= index end) ;; check if there are octets in the ;; buffer we didn't use - see - ;; COMPUTE-MINIMUM above - (loop - (when (>= buffer-pos buffer-end) - (return)) - (decf buffer-end) - (push (aref (the (array octet *) buffer) buffer-end) octet-stack)) + ;; COMPUTE-FILL-AMOUNT above + (let ((rest (- buffer-end buffer-pos))) + (when (plusp rest) + (or (and can-rewind-p + (maybe-rewind stream rest)) + (loop + (when (>= buffer-pos buffer-end) + (return)) + (decf buffer-end) + (push (aref (the (array octet *) buffer) buffer-end) + octet-stack))))) (leave)) (let ((next-thing ,(if octetp '(next-octet)

Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Tue May 20 20:19:12 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.56 2008/05/20 23:44:45 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.57 2008/05/21 00:04:58 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -129,19 +129,6 @@ ;; needed for AllegroCL - grrr... (stream-write-char stream #\Newline))

-;; TODO: file-position -> octet-stack (and others?) - -;; other way around: function "resync" trying to use File-position? - -;; "resync" independent function to empty octet-stack? -;; (decrement-file-position) => success -;; (resync ... &optional how-much (length octet-stack)) => success - -;; in stream-read-sequence: if file stream, read more into buffer, -;; then resync with file-position? - -;; TODO: interaction between read and write - (defmethod stream-write-sequence ((flexi-output-stream flexi-output-stream) sequence start end &key) "Writes all elements of the sequence SEQUENCE from START to END to the underlying stream. The elements can be either octets or