Author: eweitz Date: Fri May 23 11:00:03 2008 New Revision: 50
Added: trunk/lw-char-stream.lisp Removed: trunk/lw-binary-stream.lisp Modified: trunk/CHANGELOG trunk/doc/index.html trunk/flexi-streams.asd trunk/input.lisp trunk/output.lisp Log: Update to 0.15.3
Modified: trunk/CHANGELOG ============================================================================== --- trunk/CHANGELOG (original) +++ trunk/CHANGELOG Fri May 23 11:00:03 2008 @@ -1,3 +1,16 @@ +Version 0.15.3 +2008-05-23 +Avoid CHANGE-CLASS on LispWorks if possible + +Version 0.15.2 +2008-05-22 +Remove debugging remnants (d'ooh!) + +Version 0.15.1 +2008-05-21 +Direct access to underlying stream in case of binary sequence operations +More tests + Version 0.15.0 2008-05-21 Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans H�bner)
Modified: trunk/doc/index.html ============================================================================== --- trunk/doc/index.html (original) +++ trunk/doc/index.html Fri May 23 11:00:03 2008 @@ -224,7 +224,7 @@ <p> FLEXI-STREAMS together with this documentation can be downloaded from <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The -current version is 0.15.0. +current version is 0.15.3. <p> Before you install FLEXI-STREAMS you first need to install the <a @@ -1060,7 +1060,7 @@ his work on making FLEXI-STREAMS faster.
<p> -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.108 2008/05/21 11:53:08 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.111 2008/05/23 14:56:47 edi Exp $ <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: trunk/flexi-streams.asd ============================================================================== --- trunk/flexi-streams.asd (original) +++ trunk/flexi-streams.asd Fri May 23 11:00:03 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.65 2008/05/21 11:53:07 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.69 2008/05/23 14:56:46 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -35,7 +35,7 @@ (in-package :flexi-streams-system)
(defsystem :flexi-streams - :version "0.15.0" + :version "0.15.3" :serial t :components ((:file "packages") (:file "mapping") @@ -51,7 +51,7 @@ (:file "decode") (:file "in-memory") (:file "stream") - #+:lispworks (:file "lw-binary-stream") + #+:lispworks (:file "lw-char-stream") (:file "output") (:file "input") (:file "io")
Modified: trunk/input.lisp ============================================================================== --- trunk/input.lisp (original) +++ trunk/input.lisp Fri May 23 11:00:03 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.70 2008/05/21 00:18:35 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.75 2008/05/23 14:43:09 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -55,9 +55,8 @@
#+:lispworks (defmethod read-byte* ((flexi-input-stream flexi-input-stream)) - "Reads one byte (octet) from the underlying stream of -FLEXI-OUTPUT-STREAM (or from the internal stack if it's not -empty)." + "Reads one byte (octet) from the underlying (binary) stream of +FLEXI-OUTPUT-STREAM (or from the internal stack if it's not empty)." (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) @@ -71,20 +70,14 @@ (return-from read-byte* nil)) (incf position) (or (pop octet-stack) - ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all - ;; bivalent streams in LispWorks - (let* ((buffer (make-array 1 :element-type 'octet)) - (new-position (read-sequence buffer stream))) - (cond ((zerop new-position) - (decf position) nil) - (t (aref buffer 0))))))) + (read-byte stream nil nil) + (progn (decf position) nil))))
#+:lispworks -(defmethod read-byte* ((flexi-input-stream flexi-binary-input-stream)) +(defmethod read-byte* ((flexi-input-stream flexi-char-input-stream)) "Reads one byte (octet) from the underlying stream of FLEXI-OUTPUT-STREAM (or from the internal stack if it's not empty). -Optimized version (only needed for LispWorks) in case the underlying -stream is binary." +Only used for LispWorks bivalent streams which aren't binary." (declare #.*standard-optimize-settings*) (with-accessors ((position flexi-stream-position) (bound flexi-stream-bound) @@ -98,8 +91,13 @@ (return-from read-byte* nil)) (incf position) (or (pop octet-stack) - (read-byte stream nil nil) - (progn (decf position) nil)))) + ;; we use READ-SEQUENCE because READ-BYTE doesn't work with all + ;; bivalent streams in LispWorks + (let* ((buffer (make-array 1 :element-type 'octet)) + (new-position (read-sequence buffer stream))) + (cond ((zerop new-position) + (decf position) nil) + (t (aref buffer 0)))))))
(defmethod stream-clear-input ((flexi-input-stream flexi-input-stream)) "Calls the corresponding method for the underlying input stream @@ -201,7 +199,7 @@ based on the element type of the sequence (which takes precedence) and the element type of the stream. What you'll really get might also depend on your Lisp. Some of the implementations are more picky than -others - see for example FLEXI-STREAMS-TEST:READ-SEQUENCE-TEST." +others - see for example FLEXI-STREAMS-TEST::SEQUENCE-TEST." (declare #.*standard-optimize-settings*) (declare (fixnum start end)) (with-accessors ((position flexi-stream-position) @@ -213,21 +211,37 @@ (element-type flexi-stream-element-type) (stream flexi-stream-stream)) flexi-input-stream + (when (>= start end) + (return-from stream-read-sequence start)) + (when (or (subtypep (etypecase sequence + (vector (array-element-type sequence)) + (list t)) + 'integer) + (and (not (stringp sequence)) + (type-equal element-type 'octet))) + ;; if binary data is requested, just read from the underlying + ;; stream directly and skip the rest (but flush octet stack + ;; first) + (let ((index start)) + (declare (fixnum index)) + (when octet-stack + (replace sequence octet-stack :start1 start :end1 end) + (let ((octets-flushed (min (length octet-stack) (- end start)))) + (incf index octets-flushed) + (setq octet-stack (nthcdr octets-flushed octet-stack)))) + (setq index (read-sequence sequence stream :start index :end end)) + (when (> index start) + (setq last-char-code nil + last-octet (elt sequence (1- index)))) + (return-from stream-read-sequence index))) (let* (buffer (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))) - (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)) + (can-rewind-p (maybe-rewind stream 0)) + (factor (encoding-factor external-format)) (integer-factor (floor factor)) ;; it's an interesting question whether it makes sense ;; performance-wise to make RESERVE significantly bigger @@ -237,7 +251,7 @@ ((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 can-rewind-p)) + (boolean 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 @@ -293,23 +307,17 @@ (unread-char% char flexi-input-stream))) (declare (dynamic-extent (function next-octet) (function unreader))) (let ((*current-unreader* #'unreader)) - (macrolet ((iterate (octetp set-place) + (macrolet ((iterate (set-place) "A very unhygienic macro to implement the actual iteration through the sequence including housekeeping for the -flexi stream. If OCTETP is true, we put octets into the stream, -otherwise characters. SET-PLACE is the place (using the index INDEX) -used to access the sequence." +flexi stream. SET-PLACE is the place (using the index INDEX) used to +access the sequence." `(flet ((leave () "This is the function used to abort the LOOP iteration below." (when (> index start) - ;; if something was read at all, - ;; update LAST-OCTET and - ;; LAST-CHAR-CODE accordingly - (setq ,(if octetp 'last-char-code 'last-octet) - nil - ,(if octetp 'last-octet 'last-char-code) - ,(sublis '((index . (1- index))) set-place))) + (setq last-octet nil + last-char-code ,(sublis '((index . (1- index))) set-place))) (return-from stream-read-sequence index))) (loop (when (>= index end) @@ -327,28 +335,15 @@ (push (aref (the (array octet *) buffer) buffer-end) octet-stack))))) (leave)) - (let ((next-thing ,(if octetp - '(next-octet) - '(octets-to-char-code external-format #'next-octet)))) - (unless next-thing (leave)) - (setf ,set-place ,(if octetp 'next-thing '(code-char next-thing))) + (let ((next-char-code (octets-to-char-code external-format #'next-octet))) + (unless next-char-code + (leave)) + (setf ,set-place (code-char next-char-code)) (incf index)))))) (etypecase sequence - (string (iterate nil (char sequence index))) - (array - (let ((array-element-type (array-element-type sequence))) - (cond ((type-equal array-element-type 'octet) - (iterate t (aref (the (array octet *) sequence) index))) - ((or (subtypep array-element-type 'integer) - (type-equal element-type 'octet)) - (iterate t (aref sequence index))) - (t - (iterate nil (aref sequence index)))))) - (list - (cond ((type-equal element-type 'octet) - (iterate t (nth index sequence))) - (t - (iterate nil (nth index sequence))))))))))))) + (string (iterate (char sequence index))) + (array (iterate (aref sequence index))) + (list (iterate (nth index sequence)))))))))))
(defmethod stream-unread-char ((stream flexi-input-stream) char) "Implements UNREAD-CHAR for streams of type FLEXI-INPUT-STREAM.
Added: trunk/lw-char-stream.lisp ============================================================================== --- (empty file) +++ trunk/lw-char-stream.lisp Fri May 23 11:00:03 2008 @@ -0,0 +1,77 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-char-stream.lisp,v 1.1 2008/05/23 14:43:09 edi Exp $ + +;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :flexi-streams) + +(defclass flexi-char-output-stream (flexi-output-stream) + () + (:documentation "This class is for output streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing output to binary streams on LispWorks. See +WRITE-BYTE*.")) + +(defclass flexi-char-input-stream (flexi-input-stream) + () + (:documentation "This class is for input streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing input to binary streams on LispWorks. See +READ-BYTE*.")) + +(defclass flexi-char-io-stream (flexi-char-input-stream flexi-char-output-stream flexi-io-stream) + () + (:documentation "This class is for bidirectional streams where the +underlying stream is bivalent but not binary. It exists solely for +the purpose of optimizing input and output from/to binary streams on +LispWorks. See READ-BYTE* and WRITE-BYTE*.")) + +(defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) + "Might change the class of FLEXI-STREAM for optimization purposes. +Only needed for LispWorks." + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) + (with-accessors ((stream flexi-stream-stream)) + flexi-stream + (unless (subtypep (stream-element-type stream) 'octet) + (change-class flexi-stream + (typecase flexi-stream + (flexi-io-stream 'flexi-char-io-stream) + (otherwise 'flexi-char-output-stream)))))) + +(defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) + "Might change the class of FLEXI-STREAM for optimization purposes. +Only needed for LispWorks." + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) + (with-accessors ((stream flexi-stream-stream)) + flexi-stream + (unless (subtypep (stream-element-type stream) 'octet) + (change-class flexi-stream + (typecase flexi-stream + (flexi-io-stream 'flexi-char-io-stream) + (otherwise 'flexi-char-input-stream))))))
Modified: trunk/output.lisp ============================================================================== --- trunk/output.lisp (original) +++ trunk/output.lisp Fri May 23 11:00:03 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.60 2008/05/21 01:26:43 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.63 2008/05/23 14:43:09 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -44,6 +44,15 @@ #+:lispworks (defmethod write-byte* (byte (flexi-output-stream flexi-output-stream)) (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + flexi-output-stream + (write-byte byte stream))) + +#+:lispworks +(defmethod write-byte* (byte (flexi-output-stream flexi-char-output-stream)) + "This method is only used for LispWorks bivalent streams which +aren't binary." + (declare #.*standard-optimize-settings*) ;; we use WRITE-SEQUENCE because WRITE-BYTE doesn't work with all ;; bivalent streams in LispWorks (4.4.6) (with-accessors ((stream flexi-stream-stream)) @@ -53,15 +62,6 @@ stream) byte))
-#+:lispworks -(defmethod write-byte* (byte (flexi-output-stream flexi-binary-output-stream)) - "Optimized version (only needed for LispWorks) in case the -underlying stream is binary." - (declare #.*standard-optimize-settings*) - (with-accessors ((stream flexi-stream-stream)) - flexi-output-stream - (write-byte byte stream))) - (defmethod stream-write-char ((stream flexi-output-stream) char) (declare #.*standard-optimize-settings*) (with-accessors ((external-format flexi-stream-external-format)) @@ -142,15 +142,18 @@ (external-format flexi-stream-external-format) (stream flexi-stream-stream)) stream + (when (>= start end) + (return-from stream-write-sequence sequence)) + (when (and (vectorp sequence) + (subtypep (array-element-type sequence) 'integer)) + ;; if this is pure binary output, just send all the stuff to the + ;; underlying stream directly and skip the rest + (setq column nil) + (return-from stream-write-sequence + (write-sequence sequence stream :start start :end end))) (let* ((octet-seen-p nil) (buffer-pos 0) - ;; whether we might receive characters and thus the number - ;; of octets to output might not be equal to the number of - ;; sequence elements to write - (chars-p (or (listp sequence) - (and (vectorp sequence) - (not (subtypep (array-element-type sequence) 'integer))))) - (factor (if chars-p (encoding-factor external-format) 1)) + (factor (encoding-factor external-format)) (buffer-size (min +buffer-size+ (ceiling (* factor (- end start))))) (buffer (make-octet-buffer buffer-size))) (declare (fixnum buffer-pos buffer-size) @@ -178,28 +181,20 @@ (write-octet object)) (character (write-character object))))) (declare (dynamic-extent (function write-octet))) - (macrolet ((iterate (octets-p output-form) + (macrolet ((iterate (output-form) "An unhygienic macro to implement the actual iteration through SEQUENCE. OUTPUT-FORM is the form to retrieve one -sequence element and put its octet representation into the buffer. -OCTETS-P is true if we know in advance that we will send octets." - `(progn - ,@(if octets-p '((setq octet-seen-p t))) - (loop for index of-type fixnum from start below end - do ,output-form - finally (when (plusp buffer-pos) - (flush-buffer)))))) +sequence element and put its octet representation into the buffer." + `(loop for index of-type fixnum from start below end + do ,output-form + finally (when (plusp buffer-pos) + (flush-buffer))))) (etypecase sequence - (string (iterate nil (write-character (char sequence index)))) - (array - (let ((array-element-type (array-element-type sequence))) - (cond ((type-equal array-element-type 'octet) - (iterate t (write-octet (aref (the (array octet *) sequence) index)))) - ((subtypep array-element-type 'integer) - (iterate t (write-octet (aref sequence index)))) - (t (iterate nil (write-object (aref sequence index))))))) - (list (iterate nil (write-object (nth index sequence))))) - ;; update the column slot, setting if to NIL if we sent octets + (string (iterate (write-character (char sequence index)))) + (array (iterate (write-object (aref sequence index)))) + (list (iterate (write-object (nth index sequence))))) + ;; update the column slot, setting it to NIL if we sent + ;; octets (setq column (cond (octet-seen-p nil) (t (let ((last-newline-pos (position #\Newline sequence @@ -208,8 +203,7 @@ :end end :from-end t))) (cond (last-newline-pos (- end last-newline-pos 1)) - (column (+ column (- end start)))))))))))) - + (column (+ column (- end start)))))))))))) sequence)
(defmethod stream-write-string ((stream flexi-output-stream) string