Author: hhubner Date: Thu May 1 09:41:05 2008 New Revision: 5
Added: branches/hans/test-speed.lisp Modified: branches/hans/flexi-streams.asd branches/hans/input.lisp branches/hans/stream.lisp branches/hans/strings.lisp Log: Speed up string-to-octets by shortcutting through the streams mechanic.
Modified: branches/hans/flexi-streams.asd ============================================================================== --- branches/hans/flexi-streams.asd (original) +++ branches/hans/flexi-streams.asd Thu May 1 09:41:05 2008 @@ -49,8 +49,8 @@ (:file "stream") #+:lispworks (:file "lw-binary-stream") (:file "output") - (:file "input") - (:file "strings")) + (:file "strings") + (:file "input")) :depends-on (:trivial-gray-streams))
(defsystem :flexi-streams-test
Modified: branches/hans/input.lisp ============================================================================== --- branches/hans/input.lisp (original) +++ branches/hans/input.lisp Thu May 1 09:41:05 2008 @@ -43,8 +43,8 @@ (octet-stack flexi-stream-octet-stack) (s flexi-stream-stream)) flexi-input-stream - (declare (integer position) - (type (or null integer) bound)) + (declare (fixnum position) + (type (or null fixnum) bound)) (when (and bound (>= position bound)) (return-from read-byte* nil)) @@ -290,9 +290,6 @@ (defmethod stream-read-char ((,stream-var ,stream-class)) "This method was generated with the DEFINE-CHAR-READER macro." (declare (optimize speed)) - ;; note that we do nothing for the :LF EOL style because we - ;; assume that #\Newline is the same as #\Linefeed in all - ;; Lisps which will use this library (with-accessors ((last-octet flexi-stream-last-octet) (last-char-code flexi-stream-last-char-code)) ,stream-var @@ -507,6 +504,9 @@ stream (when (eql char #\Return) (case (external-format-eol-style external-format) + ;; note that we do nothing for the :LF EOL style because we + ;; assume that #\Newline is the same as #\Linefeed in all + ;; Lisps which will use this library (:cr (setq char #\Newline last-char-code #.(char-code #\Newline))) ;; in the case :CRLF we have to look ahead one character @@ -627,3 +627,14 @@ finally (unless (eql octet eof-value) (unread-byte octet flexi-input-stream)) (return octet))) + +(defun test-buffer-code-char () + (let* ((vector (make-array 2 :element-type '(unsigned-byte 8) :initial-element (char-code #\F))) + (buffer (make-to-string-conversion-buffer :vector vector + :position 0 + :end 2 + :eol-style :nl)) + (dummy-stream (make-flexi-stream (make-string-input-stream "") :external-format (make-external-format :ascii)))) + (dotimes (i 1000000) + (null (buffer-read-char buffer dummy-stream)) + (setf (tscb-position buffer) 0)))) \ No newline at end of file
Modified: branches/hans/stream.lisp ============================================================================== --- branches/hans/stream.lisp (original) +++ branches/hans/stream.lisp Thu May 1 09:41:05 2008 @@ -170,6 +170,12 @@ MAKE-INSTANCE to create a new FLEXI-OUTPUT-STREAM but use MAKE-FLEXI-STREAM instead."))
+(defgeneric flexi-stream-output-size-factor (stream) + (:documentation "The factor to determine the size of the output +buffer when converting strings to octets for this format. The size of +the buffer allocated will be the number of characters in the string to +convert multiplied by this factor.")) + #+:cmu (defmethod input-stream-p ((stream flexi-output-stream)) "Explicitly states whether this is an input stream." @@ -197,7 +203,7 @@ look ahead for a CR/LF line ending.") (position :initform 0 :initarg :position - :type integer + :type fixnum :accessor flexi-stream-position :documentation "The position within the stream where each octet read counts as one.") @@ -327,6 +333,9 @@ (:documentation "The class for all flexi output streams which use an 8-bit encoding."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-8-bit-output-stream)) + 1) + (defclass flexi-cr-8-bit-output-stream (flexi-cr-mixin flexi-8-bit-output-stream) () (:documentation "The class for all flexi output streams which @@ -357,6 +366,9 @@ (:documentation "Special class for flexi output streams which use the UTF-32 encoding with little-endian byte ordering."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-utf-32-le-output-stream)) + 4) + (defclass flexi-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-utf-32-le-output-stream) () (:documentation "Special class for flexi output streams which @@ -368,6 +380,9 @@ (:documentation "Special class for flexi output streams which use the UTF-32 encoding with big-endian byte ordering."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-utf-32-be-output-stream)) + 4) + (defclass flexi-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-utf-32-be-output-stream) () (:documentation "Special class for flexi output streams which @@ -379,6 +394,9 @@ (:documentation "Special class for flexi output streams which use the UTF-16 encoding with little-endian byte ordering."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-utf-16-le-output-stream)) + 2) + (defclass flexi-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-utf-16-le-output-stream) () (:documentation "Special class for flexi output streams which @@ -390,6 +408,9 @@ (:documentation "Special class for flexi output streams which use the UTF-16 encoding with big-endian byte ordering."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-utf-16-be-output-stream)) + 2) + (defclass flexi-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-utf-16-be-output-stream) () (:documentation "Special class for flexi output streams which @@ -401,6 +422,9 @@ (:documentation "Special class for flexi output streams which use the UTF-8 encoding."))
+(defmethod flexi-stream-output-size-factor ((stream flexi-utf-8-output-stream)) + 1.25) + (defclass flexi-cr-utf-8-output-stream (flexi-cr-mixin flexi-utf-8-output-stream) () (:documentation "Special class for flexi output streams which
Modified: branches/hans/strings.lisp ============================================================================== --- branches/hans/strings.lisp (original) +++ branches/hans/strings.lisp Thu May 1 09:41:05 2008 @@ -29,11 +29,31 @@
(in-package :flexi-streams)
+(defmethod write-byte* (byte (array array)) + (vector-push-extend byte array)) + (defun string-to-octets (string &key (external-format (make-external-format :latin1)) - (start 0) end) + (start 0) (end (length string))) "Converts the Lisp string STRING from START to END to an array of octets corresponding to the external format EXTERNAL-FORMAT." (declare (optimize speed)) + (declare (type (array character (*)) string)) + (declare (fixnum start end)) + (let* ((dummy-stream (make-flexi-stream (make-broadcast-stream) :external-format external-format)) + (octets (make-array (truncate (* (float (- end start)) (flexi-stream-output-size-factor dummy-stream))) + :adjustable t :fill-pointer 0 :element-type '(unsigned-byte 8)))) + (loop + for i of-type fixnum from start below end + do (char-to-octets dummy-stream (aref string i) octets)) + octets)) + +(defun string-to-octets* (string &key (external-format (make-external-format :latin1)) + (start 0) end) + "Converts the Lisp string STRING from START to END to an array of +octets corresponding to the external format EXTERNAL-FORMAT. This +version of STRING-TO-OCTETS is kept around for performance +comparisons." + (declare (optimize speed)) (with-output-to-sequence (out) (let ((flexi (make-flexi-stream out :external-format external-format))) (write-string string flexi :start start :end end)))) @@ -83,6 +103,8 @@ ;; This version of OCTETS-TO-STRING is here so that one can do speed ;; comparisons. It should be significantly slower than the version ;; above. + (declare (type (simple-array (unsigned-byte 8) *) vector)) + (declare (type (integer 0 *) start end)) (declare (optimize speed)) (with-input-from-sequence (in vector :start start :end end) (let ((flexi (make-flexi-stream in :external-format external-format))
Added: branches/hans/test-speed.lisp ============================================================================== --- (empty file) +++ branches/hans/test-speed.lisp Thu May 1 09:41:05 2008 @@ -0,0 +1,92 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.51 2007/12/29 22:58:43 edi Exp $ + +;;; Copyright (c) 2005-2007, 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) + +(defmacro without-gcing (&body body) + `(#+openmcl ccl::without-gcing + #+sbcl sb-sys:without-gcing + #-(or openmcl sbcl) + progn + ,@body)) + +(defun test-speed () + (without-gcing + (let* ((character-count 10000) + (octets (make-array character-count :element-type '(unsigned-byte 8)))) + (dotimes (i character-count) + (setf (aref octets i) (+ 32 (random 96)))) + (format t "testing with latin-1 encoding, streams based~%") + (time (dotimes (i 10) + (null (octets-to-string* octets :external-format (make-external-format :latin-1))))) + (format t "testing with utf-8 encoding, streams based~%") + (time (dotimes (i 10) + (null (octets-to-string* octets :external-format (make-external-format :utf-8))))) + (format t "testing with latin-1 encoding, optimized~%") + (time (dotimes (i 10) + (null (octets-to-string octets :external-format (make-external-format :latin-1))))) + (format t "testing with utf-8 encoding, optimized~%") + (time (dotimes (i 10) + (null (octets-to-string octets :external-format (make-external-format :utf-8)))))))) + +(defmacro profile (&body body) + #+sbcl + `(progn + (sb-profile:reset) + (progn + ,@body) + (sb-profile:report))) + + +(defun profile-speed () + #+sbcl + (sb-profile:profile "FLEX") + (without-gcing + (let* ((character-count 1000) + (octets (make-array character-count :element-type '(unsigned-byte 8)))) + (dotimes (i character-count) + (setf (aref octets i) (+ 32 (random 96)))) + (format t "profiling with latin-1 encoding, streams based~%") + (profile (dotimes (i 10) + (null (octets-to-string* octets :external-format (make-external-format :latin-1))))) + (format t "profiling with utf-8 encoding, streams based~%") + (profile (dotimes (i 10) + (null (octets-to-string* octets :external-format (make-external-format :utf-8))))) + (format t "profiling with latin-1 encoding, optimized~%") + (profile (dotimes (i 10) + (null (octets-to-string octets :external-format (make-external-format :latin-1))))) + (format t "profiling with utf-8 encoding, optimized~%") + (profile (dotimes (i 10) + (null (octets-to-string octets :external-format (make-external-format :utf-8)))))))) + +(defun fixnum-or-nil (i) + (and (oddp i) #.(char-code #\f))) + +(defun fixnum-and-nil (i) + (values #.(char-code #\f) (oddp i))) \ No newline at end of file