[flexi-streams-cvs] r9 - branches/hans
hhubner at common-lisp.net
hhubner at common-lisp.net
Thu May 1 16:26:48 UTC 2008
Author: hhubner
Date: Thu May 1 12:26:47 2008
New Revision: 9
Modified:
branches/hans/input.lisp
branches/hans/output.lisp
branches/hans/strings.lisp
Log:
Checkpoint fast STRING-TO-OCTETS implpementation
Modified: branches/hans/input.lisp
==============================================================================
--- branches/hans/input.lisp (original)
+++ branches/hans/input.lisp Thu May 1 12:26:47 2008
@@ -309,6 +309,16 @@
save-position
(eol-style (external-format-eol-style (flexi-stream-external-format ,stream-var)))
(string (make-array (- end start) :element-type 'character :fill-pointer 0)))
+ ;; High-speed version of OCTETS-TO-STRING: We need to
+ ;; implement this as a macro as we want to stay with the
+ ;; old "inner" API for bodies of character readers. In
+ ;; particular, they shall be able to call (READ-BYTE*
+ ;; STREAM) as before. To achive this, we create a local
+ ;; function READ-BYTE* that gets the next byte from the
+ ;; input vector. Additionally, we create local functions
+ ;; for reading characters in a loop and for unreading a
+ ;; character that is used by the newline processing
+ ;; function CODE-CHAR-WITH-NEWLINE-PROCESSING.
(labels ((read-byte* (stream)
(declare (ignore stream))
(if (< position end)
Modified: branches/hans/output.lisp
==============================================================================
--- branches/hans/output.lisp (original)
+++ branches/hans/output.lisp Thu May 1 12:26:47 2008
@@ -78,17 +78,35 @@
(declare (optimize speed))
(char-to-octets stream char stream))
-(defmethod char-to-octets ((stream flexi-latin-1-output-stream) char sink)
- (declare (optimize speed))
+(defmacro define-char-writer (((stream-var stream-class) char-var sink-var) &body body)
+ (let ((body body))
+ (with-unique-names (string-var start-var end-var dummy-sink-var byte-var i-var)
+ `(progn
+ (defmethod char-to-octets ((,stream-var ,stream-class) ,char-var ,sink-var)
+ (declare (optimize speed))
+ , at body)
+ (defmethod string-to-octets% ((,stream-var ,stream-class) ,string-var ,start-var ,end-var)
+ (declare (optimize speed))
+ (let ((,sink-var (make-array (truncate (* (float (- ,end-var ,start-var))
+ (flexi-stream-output-size-factor ,stream-var)))
+ :adjustable t :fill-pointer 0 :element-type '(unsigned-byte 8))))
+ (loop
+ for ,i-var of-type fixnum from ,start-var below ,end-var
+ for ,char-var of-type character = (aref ,string-var ,i-var)
+ do (flet ((write-byte* (,byte-var ,dummy-sink-var)
+ (declare (ignore ,dummy-sink-var))
+ (vector-push-extend ,byte-var ,sink-var)))
+ , at body))
+ ,sink-var))))))
+
+(define-char-writer ((stream flexi-latin-1-output-stream) char sink)
(let ((octet (char-code char)))
(when (> octet 255)
(signal-encoding-error stream "~S is not a LATIN-1 character." char))
(write-byte* octet sink))
char)
-(defmethod char-to-octets ((stream flexi-ascii-output-stream) char sink)
- (declare (optimize speed))
- (declare (type character char))
+(define-char-writer ((stream flexi-ascii-output-stream) char sink)
(let ((octet (char-code char)))
(declare (type fixnum char-code))
(when (> octet 127)
@@ -96,8 +114,7 @@
(write-byte* octet sink))
char)
-(defmethod char-to-octets ((stream flexi-8-bit-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-8-bit-output-stream) char sink)
(with-accessors ((encoding-hash flexi-stream-encoding-hash))
stream
(let ((octet (gethash (char-code char) encoding-hash)))
@@ -106,8 +123,7 @@
(write-byte* octet sink))
char))
-(defmethod char-to-octets ((stream flexi-utf-8-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-utf-8-output-stream) char sink)
(let ((char-code (char-code char)))
(tagbody
(cond ((< char-code #x80)
@@ -138,8 +154,7 @@
zero))
char)
-(defmethod char-to-octets ((stream flexi-utf-16-le-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-utf-16-le-output-stream) char sink)
(flet ((write-word (word)
(write-byte* (ldb (byte 8 0) word) sink)
(write-byte* (ldb (byte 8 8) word) sink)))
@@ -152,8 +167,7 @@
(write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
char)
-(defmethod char-to-octets ((stream flexi-utf-16-be-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-utf-16-be-output-stream) char sink)
(flet ((write-word (word)
(write-byte* (ldb (byte 8 8) word) sink)
(write-byte* (ldb (byte 8 0) word) sink)))
@@ -166,25 +180,22 @@
(write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
char)
-(defmethod char-to-octets ((stream flexi-utf-32-le-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-utf-32-le-output-stream) char sink)
(loop with char-code = (char-code char)
for position in '(0 8 16 24) do
(write-byte* (ldb (byte 8 position) char-code) sink))
char)
-(defmethod char-to-octets ((stream flexi-utf-32-be-output-stream) char sink)
- (declare (optimize speed))
+(define-char-writer ((stream flexi-utf-32-be-output-stream) char sink)
(loop with char-code = (char-code char)
for position in '(24 16 8 0) do
(write-byte* (ldb (byte 8 position) char-code) sink))
char)
-(defmethod char-to-octets ((stream flexi-cr-mixin) char sink)
+(define-char-writer ((stream flexi-cr-mixin) char sink)
"The `base' method for all streams which need end-of-line
conversion. Uses CALL-NEXT-METHOD to do the actual work of sending
one or more characters to SINK."
- (declare (optimize speed))
(with-accessors ((external-format flexi-stream-external-format))
stream
(case char
Modified: branches/hans/strings.lisp
==============================================================================
--- branches/hans/strings.lisp (original)
+++ branches/hans/strings.lisp Thu May 1 12:26:47 2008
@@ -39,13 +39,8 @@
(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))
+ (string-to-octets% (make-flexi-stream (make-broadcast-stream) :external-format external-format)
+ string start end))
(defun string-to-octets* (string &key (external-format (make-external-format :latin1))
(start 0) end)
More information about the Flexi-streams-cvs
mailing list