[flexi-streams-cvs] r40 - branches/edi

eweitz at common-lisp.net eweitz at common-lisp.net
Wed May 21 00:19:12 UTC 2008


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



More information about the Flexi-streams-cvs mailing list