[flexi-streams-cvs] r41 - in branches/edi: . doc
eweitz at common-lisp.net
eweitz at common-lisp.net
Wed May 21 01:18:59 UTC 2008
Author: eweitz
Date: Tue May 20 21:18:58 2008
New Revision: 41
Modified:
branches/edi/CHANGELOG
branches/edi/doc/index.html
branches/edi/output.lisp
Log:
write-sequence
Modified: branches/edi/CHANGELOG
==============================================================================
--- branches/edi/CHANGELOG (original)
+++ branches/edi/CHANGELOG Tue May 20 21:18:58 2008
@@ -1,3 +1,5 @@
+Complete redesign, various additions, bugfixes, performance improvements (with the help of Hans Hübner)
+
Version 0.14.0
2007-12-30
Some fixes for LispWorks (when the underlying stream is a character stream)
Modified: branches/edi/doc/index.html
==============================================================================
--- branches/edi/doc/index.html (original)
+++ branches/edi/doc/index.html Tue May 20 21:18:58 2008
@@ -1037,10 +1037,12 @@
Thanks to David Lichteblau for numerous portability patches. Thanks
to Igor Plekhov for the KOI8-R code. Thanks to Anton Vodonosov for
-numerous patches and additions.
+numerous patches and additions. Thanks
+to <a href="http://netzhansa.blogspot.com/">Hans Hübner</a> for
+his work on making FLEXI-STREAMS faster.
<p>
-$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.105 2008/05/20 23:44:47 edi Exp $
+$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.106 2008/05/21 01:06:45 edi Exp $
<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
</body>
Modified: branches/edi/output.lisp
==============================================================================
--- branches/edi/output.lisp (original)
+++ branches/edi/output.lisp Tue May 20 21:18:58 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.57 2008/05/21 00:04:58 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.59 2008/05/21 01:17:45 edi Exp $
;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
@@ -129,66 +129,71 @@
;; needed for AllegroCL - grrr...
(stream-write-char stream #\Newline))
-(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
-characters. Characters are output according to the current
-encoding \(external format) of the FLEXI-OUTPUT-STREAM object
-STREAM."
- (declare #.*standard-optimize-settings*)
+(defmethod stream-write-sequence ((stream flexi-output-stream) sequence start end &key)
+; (declare #.*standard-optimize-settings*)
(declare (fixnum start end))
- (with-accessors ((stream flexi-stream-stream)
- (column flexi-stream-column))
- flexi-output-stream
- (cond ((and (arrayp sequence)
- (subtypep (array-element-type sequence) 'octet))
- ;; set column to NIL because we don't know how to handle binary
- ;; output mixed with character output
- (setq column nil)
- (write-sequence sequence stream :start start :end end))
- (t (loop for index from start below end
- for element = (elt sequence index)
- when (characterp element) do
- (stream-write-char flexi-output-stream element)
- else do
- (stream-write-byte flexi-output-stream element))
- sequence))))
-
-(defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key)
- "Optimized method for the cases where SEQUENCE is a string. Fills
-an internal buffer and uses repeated calls to WRITE-SEQUENCE to write
-to the underlying stream."
- (declare #.*standard-optimize-settings*)
- (declare (fixnum start end))
- ;; don't use this optimized method for bivalent character streams on
- ;; LispWorks, as it currently gets confused by the fill pointer
- #+:lispworks
- (unless (typep stream 'flexi-binary-output-stream)
- (return-from stream-write-sequence
- (call-next-method)))
- (let ((buffer (make-array (+ +buffer-size+ 20)
- :element-type 'octet
- :fill-pointer 0))
- (last-newline-pos (position #\Newline sequence
- :test #'char=
- :start start
- :end end
- :from-end t)))
- (loop with format = (flexi-stream-external-format stream)
- for index from start below end
- do (char-to-octets format
- (aref sequence index)
- (lambda (octet)
- (vector-push octet buffer)))
- when (>= (fill-pointer buffer) +buffer-size+) do
- (write-sequence buffer (flexi-stream-stream stream))
- (setf (fill-pointer buffer) 0)
- finally (when (>= (fill-pointer buffer) 0)
- (write-sequence buffer (flexi-stream-stream stream))))
- (setf (flexi-stream-column stream)
- (cond (last-newline-pos (- end last-newline-pos 1))
- ((flexi-stream-column stream)
- (+ (flexi-stream-column stream) (- end start))))))
+ (with-accessors ((column flexi-stream-column)
+ (external-format flexi-stream-external-format)
+ (stream flexi-stream-stream))
+ stream
+ (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))
+ (buffer-size (min +buffer-size+ (ceiling (* factor (- end start)))))
+ (buffer (make-octet-buffer buffer-size)))
+ (declare (fixnum buffer-pos buffer-size)
+ (boolean octet-seen-p)
+ (type (array octet *) buffer))
+ (labels ((flush-buffer ()
+ (write-sequence buffer stream :end buffer-pos)
+ (setq buffer-pos 0))
+ (write-octet (octet)
+ (declare (octet octet))
+ (when (>= buffer-pos buffer-size)
+ (flush-buffer))
+ (setf (aref buffer buffer-pos) octet)
+ (incf buffer-pos))
+ (write-character (char)
+ (char-to-octets external-format char #'write-octet))
+ (write-object (object)
+ (etypecase object
+ (octet (setq octet-seen-p t)
+ (write-octet object))
+ (character (write-character object)))))
+ (declare (dynamic-extent (function write-octet)))
+ (macrolet ((iterate (octets-p output-form)
+ `(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))))))
+ (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)))))
+ (setq column
+ (cond (octet-seen-p nil)
+ (t (let ((last-newline-pos (position #\Newline sequence
+ :test #'char=
+ :start start
+ :end end
+ :from-end t)))
+ (cond (last-newline-pos (- end last-newline-pos 1))
+ (column (+ column (- end start))))))))))))
+
sequence)
(defmethod stream-write-string ((stream flexi-output-stream) string
More information about the Flexi-streams-cvs
mailing list