--- flexi-streams-0.11.2.original/output.lisp	2007-04-06 02:43:24.000000000 +0300
+++ flexi-streams-0.11.2/output.lisp	2007-04-29 21:39:48.735625000 +0300
@@ -57,129 +57,137 @@
   "Writes one byte \(octet) to the underlying stream of
 FLEXI-OUTPUT-STREAM.  Optimized version \(only needed for LispWorks)
 in case the underlying stream is binary."
   (declare (optimize speed))
   (with-accessors ((stream flexi-stream-stream))
       flexi-output-stream
     (write-byte byte stream)))
             
-(defmethod stream-write-char ((stream flexi-latin-1-output-stream) char)
+(defgeneric char-to-octets (stream char octet-sink)
+  (:documentation "Converts character CHAR to sequence of octets.
+Octets are yeld by calling (OCTET-SINK <octet> STREAM)."))
+
+(defmethod stream-write-char ((stream flexi-output-stream) char)
+  (declare (optimize speed))
+  (char-to-octets stream char #'write-byte*))
+
+(defmethod char-to-octets ((stream flexi-latin-1-output-stream) char octet-sink)
   (declare (optimize speed))
   (let ((octet (char-code char)))
     (when (> octet 255)
       (signal-encoding-error stream "~S is not a LATIN-1 character." char))
-    (write-byte* octet stream))
+    (funcall octet-sink octet stream))
   char)
 
-(defmethod stream-write-char ((stream flexi-ascii-output-stream) char)
+(defmethod char-to-octets ((stream flexi-ascii-output-stream) char octet-sink)
   (declare (optimize speed))
   (let ((octet (char-code char)))
     (when (> octet 127)
       (signal-encoding-error stream "~S is not an ASCII character." char))
-    (write-byte* octet stream))
+    (funcall octet-sink octet stream))
   char)
 
-(defmethod stream-write-char ((stream flexi-8-bit-output-stream) char)
+(defmethod char-to-octets ((stream flexi-8-bit-output-stream) char octet-sink)
   (declare (optimize speed))
   (with-accessors ((encoding-hash flexi-stream-encoding-hash))
       stream
     (let ((octet (gethash (char-code char) encoding-hash)))
       (unless octet
         (signal-encoding-error stream "~S is not in this encoding." char))
-      (write-byte* octet stream))
+      (funcall octet-sink octet stream))
     char))
 
-(defmethod stream-write-char ((stream flexi-utf-8-output-stream) char)
+(defmethod char-to-octets ((stream flexi-utf-8-output-stream) char octet-sink)
   (declare (optimize speed))
   (let ((char-code (char-code char)))
     (tagbody
      (cond ((< char-code #x80)
-            (write-byte* char-code stream)
+            (funcall octet-sink char-code stream)
             (go zero))
            ((< char-code #x800)
-            (write-byte* (logior #b11000000 (ldb (byte 5 6) char-code)) stream)
+            (funcall octet-sink (logior #b11000000 (ldb (byte 5 6) char-code)) stream)
             (go one))
            ((< char-code #x10000)
-            (write-byte* (logior #b11100000 (ldb (byte 4 12) char-code)) stream)
+            (funcall octet-sink (logior #b11100000 (ldb (byte 4 12) char-code)) stream)
             (go two))
            ((< char-code #x200000)
-            (write-byte* (logior #b11110000 (ldb (byte 3 18) char-code)) stream)
+            (funcall octet-sink (logior #b11110000 (ldb (byte 3 18) char-code)) stream)
             (go three))
            ((< char-code #x4000000)
-            (write-byte* (logior #b11111000 (ldb (byte 2 24) char-code)) stream)
+            (funcall octet-sink (logior #b11111000 (ldb (byte 2 24) char-code)) stream)
             (go four))
-           (t (write-byte* (logior #b11111100 (ldb (byte 1 30) char-code)) stream)))
-     (write-byte* (logior #b10000000 (ldb (byte 6 24) char-code)) stream)
+           (t (funcall octet-sink (logior #b11111100 (ldb (byte 1 30) char-code)) stream)))
+     (funcall octet-sink (logior #b10000000 (ldb (byte 6 24) char-code)) stream)
      four
-     (write-byte* (logior #b10000000 (ldb (byte 6 18) char-code)) stream)
+     (funcall octet-sink (logior #b10000000 (ldb (byte 6 18) char-code)) stream)
      three
-     (write-byte* (logior #b10000000 (ldb (byte 6 12) char-code)) stream)
+     (funcall octet-sink (logior #b10000000 (ldb (byte 6 12) char-code)) stream)
      two
-     (write-byte* (logior #b10000000 (ldb (byte 6 6) char-code)) stream)
+     (funcall octet-sink (logior #b10000000 (ldb (byte 6 6) char-code)) stream)
      one
-     (write-byte* (logior #b10000000 (ldb (byte 6 0) char-code)) stream)
+     (funcall octet-sink (logior #b10000000 (ldb (byte 6 0) char-code)) stream)
      zero))
   char)
 
-(defmethod stream-write-char ((stream flexi-utf-16-le-output-stream) char)
+(defmethod char-to-octets ((stream flexi-utf-16-le-output-stream) char octet-sink)
   (declare (optimize speed))
   (flet ((write-word (word)
-           (write-byte* (ldb (byte 8 0) word) stream)
-           (write-byte* (ldb (byte 8 8) word) stream)))
+           (funcall octet-sink (ldb (byte 8 0) word) stream)
+           (funcall octet-sink (ldb (byte 8 8) word) stream)))
     (declare (inline write-word) (dynamic-extent (function write-word)))
     (let ((char-code (char-code char)))
       (cond ((< char-code #x10000)
              (write-word char-code))
             (t (decf char-code #x10000)
                (write-word (logior #xd800 (ldb (byte 10 10) char-code)))
                (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
   char)
 
-(defmethod stream-write-char ((stream flexi-utf-16-be-output-stream) char)
+(defmethod char-to-octets ((stream flexi-utf-16-be-output-stream) char octet-sink)
   (declare (optimize speed))
   (flet ((write-word (word)
-           (write-byte* (ldb (byte 8 8) word) stream)
-           (write-byte* (ldb (byte 8 0) word) stream)))
+           (funcall octet-sink (ldb (byte 8 8) word) stream)
+           (funcall octet-sink (ldb (byte 8 0) word) stream)))
     (declare (inline write-word) (dynamic-extent (function write-word)))
     (let ((char-code (char-code char)))
       (cond ((< char-code #x10000)
              (write-word char-code))
             (t (decf char-code #x10000)
                (write-word (logior #xd800 (ldb (byte 10 10) char-code)))
                (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))
   char)
 
-(defmethod stream-write-char ((stream flexi-utf-32-le-output-stream) char)
+(defmethod char-to-octets ((stream flexi-utf-32-le-output-stream) char octet-sink)
   (declare (optimize speed))
   (loop with char-code = (char-code char)
         for position in '(0 8 16 24)
-        do (write-byte* (ldb (byte 8 position) char-code) stream))
+        do (funcall octet-sink (ldb (byte 8 position) char-code) stream))
   char)
 
-(defmethod stream-write-char ((stream flexi-utf-32-be-output-stream) char)
+(defmethod char-to-octets ((stream flexi-utf-32-be-output-stream) char octet-sink)
   (declare (optimize speed))
   (loop with char-code = (char-code char)
         for position in '(24 16 8 0)
-        do (write-byte* (ldb (byte 8 position) char-code) stream))
+        do (funcall octet-sink (ldb (byte 8 position) char-code) stream))
   char)
 
-(defmethod stream-write-char ((stream flexi-cr-mixin) char)
+(defmethod char-to-octets ((stream flexi-cr-mixin) char octet-sink)
   "The `base' method for all streams which need end-of-line
 conversion.  Uses CALL-NEXT-METHOD to do the actual work of
 writing one or more characters to the stream."
   (declare (optimize speed))
   (with-accessors ((external-format flexi-stream-external-format))
       stream
     (case char
       (#\Newline     
        (case (external-format-eol-style external-format)
-         (:cr (call-next-method stream #\Return))
-         (:crlf (call-next-method stream #\Return)
-          (call-next-method stream #\Linefeed))))
+         (:cr (call-next-method stream #\Return octet-sink))
+         (:crlf (call-next-method stream #\Return octet-sink)
+          (call-next-method stream #\Linefeed octet-sink))))
       (otherwise (call-next-method)))
     char))
 
 (defmethod stream-write-char :after ((stream flexi-output-stream) char)
   (declare (optimize speed))
   ;; update the column unless we're in the middle of the line and
   ;; the current value is NIL
   (with-accessors ((column flexi-stream-column))
@@ -255,70 +263,35 @@
           (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))))
 
-(defmacro define-sequence-writer ((char-var stream-var stream-class) &body body)
-  "Helper macro to define methods for STREAM-WRITE-SEQUENCE.  Defines
-an optimized method for the class STREAM-CLASS \(which should use an
-8-bit encoding) and for sequences which are strings using the
-variables STREAM-VAR for the stream and CHAR-VAR for iterating through
-the string.  The code in BODY should return a character code
-corresponding to the character in CHAR-VAR."
-  (with-unique-names (sequence start end buffer index src-ptr dest-ptr)
-    `(defmethod stream-write-sequence ((,stream-var ,stream-class)
-                                       (,sequence string) ,start ,end &key)
-       "This method was generated with the DEFINE-SEQUENCE-WRITER macro."
-       (declare (optimize speed) (type (integer 0 *) ,start ,end))
-       (when (typep ,stream-var 'flexi-cr-mixin)
-         ;; refuse to optimize if line-end encoding is needed
-         (return-from stream-write-sequence (call-next-method)))
-       (let ((,buffer (make-array +buffer-size+ :element-type 'octet)))
+(defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key)
+  (declare (optimize speed) (type (integer 0 *) start end src-ptr))
          ;; use repeated calls to WRITE-SEQUENCE for arrays of octets
-         (loop for ,index from ,start below ,end by +buffer-size+ do
-               (loop for ,src-ptr from ,index below ,end
-                     for ,dest-ptr from 0 below +buffer-size+
-                     for ,char-var = (aref ,sequence ,src-ptr)
-                     do (setf (aref ,buffer ,dest-ptr) (progn ,@body)))
-               (stream-write-sequence ,stream-var
-                                      ,buffer 0 (min +buffer-size+ (- ,end ,index))))
-         ;; find last #\Newline in string
-         (let ((newline-pos (position #\Newline ,sequence
+  (let* ((buffer (make-array (+ +buffer-size+ 20) :element-type '(unsigned-byte 8) :fill-pointer 0))
+	 (last-newline-pos (position #\Newline sequence
                                       :test #'char=
-                                      :start ,start
-                                      :end ,end
+				     :start start
+				     :end end
                                       :from-end t)))
-           (setf (flexi-stream-column ,stream-var)
-                 (cond (newline-pos (- ,end newline-pos))
-                       ((flexi-stream-column ,stream-var)
-                        (+ (flexi-stream-column ,stream-var) (- ,end ,start)))))))
-       ,sequence)))
-
-(define-sequence-writer (char stream flexi-latin-1-output-stream)
-  (let ((octet (char-code char)))
-    (when (> octet 255)
-      (signal-encoding-error (flexi-stream-stream stream)
-                             "~S is not a LATIN-1 character." char))
-    octet))
-
-(define-sequence-writer (char stream flexi-ascii-output-stream)
-  (let ((octet (char-code char)))
-    (when (> octet 127)
-      (signal-encoding-error stream "~S is not an ASCII character." char))
-    octet))
-
-(define-sequence-writer (char stream flexi-8-bit-output-stream)
-  (with-accessors ((encoding-hash flexi-stream-encoding-hash))
-      stream
-    (let ((octet (gethash (char-code char) encoding-hash)))
-      (unless octet
-        (signal-encoding-error stream "~S is not in this encoding." char))
-      octet)))
+    (flet ((byte-writer (octet stream) 
+	     (declare (optimize speed) (ignore stream)) 
+	     (vector-push octet buffer)))
+      (loop for index from start below end      
+	    do (char-to-octets stream (aref sequence index) #'byte-writer)
+	    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))))))
+  sequence)
 
 (defmethod stream-write-string ((stream flexi-8-bit-output-stream) string
                                 &optional (start 0) (end (length string)))
   "Use WRITE-SEQUENCE to output the string in cases where we might
 have an optimized method."
   (stream-write-sequence stream string start (or end (length string))))
