From afc3a9684b1c11ac87b987886dc8cf76f3bce77c Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 24 Apr 2017 00:23:47 -0700
Subject: [PATCH] Update MIME codecs to use bytevectors rather than legacy
 strings.

**** NOTE ****
Although I modified the tests to pass, they don't test all the codecs.  Please
let me know if I broken something.
---
 src/runtime/mime-codec.scm        | 707 +++++++++++++++---------------
 tests/runtime/test-mime-codec.scm | 255 +++++++----
 2 files changed, 502 insertions(+), 460 deletions(-)

diff --git a/src/runtime/mime-codec.scm b/src/runtime/mime-codec.scm
index 2be3278bb..6bc89d526 100644
--- a/src/runtime/mime-codec.scm
+++ b/src/runtime/mime-codec.scm
@@ -30,25 +30,24 @@ USA.
 
 (define (make-decoding-port-type update finalize)
   (make-textual-port-type
-   `((WRITE-CHAR
+   `((write-char
       ,(lambda (port char)
-	 (guarantee 8-bit-char? char)
 	 (update (textual-port-state port) (string char) 0 1)
 	 1))
-     (WRITE-SUBSTRING
+     (write-substring
       ,(lambda (port string start end)
 	 (if (string? string)
 	     (begin
 	       (update (textual-port-state port) string start end)
 	       (fix:- end start))
 	     (generic-port-operation:write-substring port string start end))))
-     (CLOSE-OUTPUT
+     (close-output
       ,(lambda (port)
 	 (finalize (textual-port-state port)))))
    #f))
 
 (define condition-type:decode-mime
-  (make-condition-type 'DECODE-MIME condition-type:simple-error '() #f))
+  (make-condition-type 'decode-mime condition-type:simple-error '() #f))
 
 ;;;; Encode quoted-printable
 
@@ -73,19 +72,22 @@ USA.
   (pending-output #f))
 
 (define (encode-quoted-printable:finalize context)
-  (encode-qp-pending-lwsp context #f 'INPUT-END)
+  (encode-qp-pending-lwsp context #f 'input-end)
   (write-qp-pending-output context #t))
 
-(define (encode-quoted-printable:update context string start end)
-  (if (qp-encoding-context/text? context)
-      (let loop ((start start))
-	(let ((i (substring-find-next-char string start end #\newline)))
-	  (if i
-	      (begin
-		(encode-qp context string start i 'LINE-END)
-		(loop (fix:+ i 1)))
-	      (encode-qp context string start end 'PARTIAL))))
-      (encode-qp context string start end 'PARTIAL)))
+(define (encode-quoted-printable:update context string #!optional start end)
+  (let* ((caller 'encode-quoted-printable:update)
+	 (end (fix:end-index end (string-length string) caller))
+	 (start (fix:start-index start end caller)))
+    (if (qp-encoding-context/text? context)
+	(let loop ((start start))
+	  (let ((i (substring-find-next-char string start end #\newline)))
+	    (if i
+		(begin
+		  (encode-qp context string start i 'line-end)
+		  (loop (fix:+ i 1)))
+		(encode-qp context string start end 'partial))))
+	(encode-qp context string start end 'partial))))
 
 (define (encode-qp context string start end type)
   (encode-qp-pending-lwsp context (fix:< start end) type)
@@ -98,7 +100,7 @@ USA.
 			(write-qp-encoded context char)
 			(write-qp-clear context char))
 		    (loop start))
-		   ((and (eq? type 'PARTIAL)
+		   ((and (eq? type 'partial)
 			 (not (fix:< start end)))
 		    (set-qp-encoding-context/pending-lwsp! context char))
 		   (else
@@ -106,7 +108,7 @@ USA.
 			(write-qp-clear context char)
 			(write-qp-encoded context char))
 		    (loop start)))))
-	  ((eq? type 'LINE-END)
+	  ((eq? type 'line-end)
 	   (write-qp-hard-break context)))))
 
 (define (encode-qp-pending-lwsp context packet-not-empty? type)
@@ -115,7 +117,7 @@ USA.
 	(cond (packet-not-empty?
 	       (set-qp-encoding-context/pending-lwsp! context #f)
 	       (write-qp-clear context pending))
-	      ((not (eq? type 'PARTIAL))
+	      ((not (eq? type 'partial))
 	       (set-qp-encoding-context/pending-lwsp! context #f)
 	       (write-qp-encoded context pending))))))
 
@@ -138,8 +140,8 @@ USA.
   (let ((port (qp-encoding-context/port context))
 	(column (qp-encoding-context/column context))
 	(d (char->integer char)))
-    (let ((c1 (hex-digit->char (fix:lsh d -4)))
-	  (c2 (hex-digit->char (fix:and d #x0F))))
+    (let ((c1 (digit->char (fix:lsh d -4) 16))
+	  (c2 (digit->char (fix:and d #x0F) 16)))
       (if (fix:= column 73)
 	  (set-qp-encoding-context/pending-output! context (string #\= c1 c2))
 	  (begin
@@ -207,18 +209,21 @@ USA.
   (pending #f))
 
 (define (decode-quoted-printable:finalize context)
-  (decode-qp context "" 0 0 'INPUT-END))
+  (decode-qp context "" 0 0 'input-end))
 
-(define (decode-quoted-printable:update context string start end)
-  (let loop ((start start))
-    (let ((i (substring-find-next-char string start end #\newline)))
-      (if i
-	  (begin
-	    (decode-qp context
-		       string start (skip-lwsp-backwards string start i)
-		       'LINE-END)
-	    (loop (fix:+ i 1)))
-	  (decode-qp context string start end 'PARTIAL)))))
+(define (decode-quoted-printable:update context string #!optional start end)
+  (let* ((caller 'decode-quoted-printable:update)
+	 (end (fix:end-index end (string-length string) caller))
+	 (start (fix:start-index start end caller)))
+    (let loop ((start start))
+      (let ((i (substring-find-next-char string start end #\newline)))
+	(if i
+	    (begin
+	      (decode-qp context
+			 string start (skip-lwsp-backwards string start i)
+			 'line-end)
+	      (loop (fix:+ i 1)))
+	    (decode-qp context string start end 'partial))))))
 
 (define (call-with-decode-quoted-printable-output-port port text? generator)
   (let ((port (make-decode-quoted-printable-port port text?)))
@@ -244,13 +249,13 @@ USA.
 					      char-set:qp-encoded)))
 	(if i
 	    (begin
-	      (write-substring string start i port)
+	      (write-string string port start i)
 	      (if (char=? (string-ref string i) #\=)
 		  (handle-equals (fix:+ i 1))
 		  ;; RFC 2045 recommends dropping illegal encoded char.
 		  (loop (fix:+ i 1))))
 	    (begin
-	      (write-substring string start end* port)
+	      (write-string string port start end*)
 	      (finish)))))
 
     (define (handle-equals start)
@@ -262,7 +267,7 @@ USA.
 	  (begin
 	    (if (fix:< start end*)
 		(let ((char (string-ref string start)))
-		  (if (char-hex-digit? char)
+		  (if (char->digit char 16)
 		      (set-qp-decoding-context/pending! context char)
 		      ;; Illegal: RFC 2045 recommends leaving as is.
 		      (begin
@@ -274,16 +279,16 @@ USA.
     (define (finish)
       (let ((pending (qp-decoding-context/pending context)))
 	(set-qp-decoding-context/pending! context #f)
-	(cond ((eq? type 'PARTIAL)
+	(cond ((eq? type 'partial)
 	       (set-qp-decoding-context/pending!
 		context
 		(decode-qp-pending-string pending string end* end)))
 	      ((not pending)
-	       (if (eq? type 'LINE-END)
+	       (if (eq? type 'line-end)
 		   ;; Hard line break.
 		   (newline port)))
 	      ((eqv? pending #\=)
-	       (if (eq? type 'LINE-END)
+	       (if (eq? type 'line-end)
 		   unspecific		; Soft line break.
 		   ;; Illegal: RFC 2045 recommends leaving as is.
 		   (write-char #\= port)))
@@ -316,12 +321,7 @@ USA.
 (define (decode-qp-pending-string pending string start end)
   (if (fix:< start end)
       (if pending
-	  (let ((s
-		 (make-legacy-string
-		  (fix:+ (string-length pending) (fix:- end start)))))
-	    (substring-move! string start end
-			     s (string-move! pending s 0))
-	    s)
+	  (string-append pending (substring string start end))
 	  (substring string start end))
       pending))
 
@@ -345,8 +345,8 @@ USA.
 (define (decode-qp-hex context c1 c2 start)
   (let ((port (qp-decoding-context/port context)))
     (let ((char
-	   (let ((d1 (char->hex-digit c1))
-		 (d2 (char->hex-digit c2)))
+	   (let ((d1 (char->digit c1 16))
+		 (d2 (char->digit c2 16)))
 	     (and (fix:< d1 #x10)
 		  (fix:< d2 #x10)
 		  (integer->char (fix:or (fix:lsh d1 4) d2))))))
@@ -360,33 +360,6 @@ USA.
 	    (write-char #\= port)
 	    (write-char c1 port)
 	    (fix:- start 1))))))
-
-(define-integrable (char-hex-digit? char)
-  (fix:< (char->hex-digit char) #x10))
-
-(define-integrable (char->hex-digit char)
-  (vector-8b-ref hex-char-table (char->integer char)))
-
-(define-integrable (hex-digit->char digit)
-  (string-ref hex-digit-table digit))
-
-(define hex-char-table)
-(define hex-digit-table)
-(let ((char-table (make-legacy-string 256 (integer->char #xff)))
-      (digit-table (make-legacy-string 16)))
-  (define (do-range low high value)
-    (do-char low value)
-    (if (fix:< low high)
-	(do-range (fix:+ low 1) high (fix:+ value 1))))
-  (define (do-char code value)
-    (vector-8b-set! char-table code value)
-    (vector-8b-set! digit-table value code))
-  (do-range (char->integer #\0) (char->integer #\9) 0)
-  (do-range (char->integer #\a) (char->integer #\f) 10)
-  (do-range (char->integer #\A) (char->integer #\F) 10)
-  (set! hex-char-table char-table)
-  (set! hex-digit-table digit-table)
-  unspecific)
 
 ;;;; Encode BASE64
 
@@ -395,31 +368,39 @@ USA.
 		   (constructor encode-base64:initialize (port text?)))
   (port #f read-only #t)
   (text? #f read-only #t)
-  (buffer (make-legacy-string 48) read-only #t)
+  (buffer (make-bytevector 48) read-only #t)
   (index 0))
 
 (define (encode-base64:finalize context)
   (write-base64-line context))
 
-(define (encode-base64:update context string start end)
-  (if (base64-encoding-context/text? context)
-      (let loop ((start start))
-	(let ((index (substring-find-next-char string start end #\newline)))
-	  (if index
-	      (begin
-		(encode-base64 context string start index)
-		(encode-base64 context "\r\n" 0 2)
-		(loop (fix:+ index 1)))
-	      (encode-base64 context string start end))))
-      (encode-base64 context string start end)))
-
-(define (encode-base64 context string start end)
+(define (encode-base64:update context bytes #!optional start end)
+  (let* ((caller 'encode-base64:update)
+	 (end (fix:end-index end (bytevector-length bytes) caller))
+	 (start (fix:start-index start end caller)))
+    (if (base64-encoding-context/text? context)
+	(let loop ((start start))
+	  (let ((index
+		 (let find-newline ((index start))
+		   (and (fix:< index end)
+			(if (fix:= cp:newline (bytevector-u8-ref bytes index))
+			    index
+			    (find-newline (fix:+ index 1)))))))
+	    (if index
+		(begin
+		  (encode-base64 context bytes start index)
+		  (encode-base64 context bv:crlf 0 2)
+		  (loop (fix:+ index 1)))
+		(encode-base64 context bytes start end))))
+	(encode-base64 context bytes start end))))
+
+(define (encode-base64 context bytes start end)
   (let ((buffer (base64-encoding-context/buffer context)))
     (let loop ((start start))
       (if (fix:< start end)
 	  (let ((i (base64-encoding-context/index context)))
 	    (let ((start* (fix:min end (fix:+ start (fix:- 48 i)))))
-	      (let ((i (substring-move! string start start* buffer i)))
+	      (let ((i (bytevector-copy! buffer i bytes start start*)))
 		(set-base64-encoding-context/index! context i)
 		(if (fix:= i 48)
 		    (write-base64-line context)))
@@ -433,28 +414,27 @@ USA.
 	(begin
 	  (let ((write-digit
 		 (lambda (d)
-		   (write-char (string-ref base64-digit-table (fix:and #x3F d))
-			       port))))
+		   (write-char (base64:digit->char (fix:and #x3F d)) port))))
 	    (let loop ((start 0))
 	      (let ((n (fix:- end start)))
 		(cond ((fix:>= n 3)
-		       (let ((d1 (vector-8b-ref buffer start))
-			     (d2 (vector-8b-ref buffer (fix:+ start 1)))
-			     (d3 (vector-8b-ref buffer (fix:+ start 2))))
+		       (let ((d1 (bytevector-u8-ref buffer start))
+			     (d2 (bytevector-u8-ref buffer (fix:+ start 1)))
+			     (d3 (bytevector-u8-ref buffer (fix:+ start 2))))
 			 (write-digit (fix:lsh d1 -2))
 			 (write-digit (fix:or (fix:lsh d1 4) (fix:lsh d2 -4)))
 			 (write-digit (fix:or (fix:lsh d2 2) (fix:lsh d3 -6)))
 			 (write-digit d3))
 		       (loop (fix:+ start 3)))
 		      ((fix:= n 2)
-		       (let ((d1 (vector-8b-ref buffer start))
-			     (d2 (vector-8b-ref buffer (fix:+ start 1))))
+		       (let ((d1 (bytevector-u8-ref buffer start))
+			     (d2 (bytevector-u8-ref buffer (fix:+ start 1))))
 			 (write-digit (fix:lsh d1 -2))
 			 (write-digit (fix:or (fix:lsh d1 4) (fix:lsh d2 -4)))
 			 (write-digit (fix:lsh d2 2)))
 		       (write-char #\= port))
 		      ((fix:= n 1)
-		       (let ((d1 (vector-8b-ref buffer start)))
+		       (let ((d1 (bytevector-u8-ref buffer start)))
 			 (write-digit (fix:lsh d1 -2))
 			 (write-digit (fix:lsh d1 4)))
 		       (write-char #\= port)
@@ -469,57 +449,58 @@ USA.
 		   (constructor decode-base64:initialize (port text?)))
   (port #f read-only #t)
   (text? #f read-only #t)
-  (input-buffer (make-legacy-string 4) read-only #t)
+  (input-buffer (make-string 4) read-only #t)
   (input-index 0)
   ;; Ugh bletch.  Add state to look for line starting with NON-BASE64
   ;; character, and stop decoding there.  This works around problem
   ;; that arises when mail-processing agents randomly glue text on the
   ;; end of a MIME message.
-  (input-state 'LINE-START)
-  (output-buffer (make-legacy-string 3) read-only #t)
+  (input-state 'line-start)
+  (output-buffer (make-bytevector 3) read-only #t)
   (pending-return? #f))
 
 (define (decode-base64:finalize context)
   (if (fix:> (base64-decoding-context/input-index context) 0)
       (error:decode-base64 "BASE64 input length is not a multiple of 4."))
   (if (base64-decoding-context/pending-return? context)
-      (write-char #\return (base64-decoding-context/port context))))
-
-(define (decode-base64:update context string start end)
-  (if (not (eq? 'FINISHED (base64-decoding-context/input-state context)))
-      (let ((buffer (base64-decoding-context/input-buffer context)))
-	(let loop
-	    ((start start)
-	     (index (base64-decoding-context/input-index context))
-	     (state (base64-decoding-context/input-state context)))
-	  (let ((done
-		 (lambda (state)
-		   (set-base64-decoding-context/input-index! context index)
-		   (set-base64-decoding-context/input-state! context state))))
-	    (if (fix:< start end)
-		(let* ((char (string-ref string start))
-		       (continue
-			(lambda (index)
-			  (loop (fix:+ start 1)
-				index
-				(if (char=? char #\newline)
-				    'LINE-START
-				    'IN-LINE)))))
-		  (if (or (char=? char #\=)
-			  (fix:< (vector-8b-ref base64-char-table
-						(char->integer char))
-				 #x40))
-		      (begin
-			(string-set! buffer index char)
-			(if (fix:< index 3)
-			    (continue (fix:+ index 1))
-			    (begin
-			      (decode-base64-quantum context)
-			      (continue 0))))
-		      (if (eq? state 'LINE-START)
-			  (done 'FINISHED)
-			  (continue index))))
-		(done state)))))))
+      (write-u8 cp:return (base64-decoding-context/port context))))
+
+(define (decode-base64:update context string #!optional start end)
+  (let* ((caller 'decode-base64:update)
+	 (end (fix:end-index end (string-length string) caller))
+	 (start (fix:start-index start end caller)))
+    (if (not (eq? 'finished (base64-decoding-context/input-state context)))
+	(let ((buffer (base64-decoding-context/input-buffer context)))
+	  (let loop
+	      ((start start)
+	       (index (base64-decoding-context/input-index context))
+	       (state (base64-decoding-context/input-state context)))
+	    (let ((done
+		   (lambda (state)
+		     (set-base64-decoding-context/input-index! context index)
+		     (set-base64-decoding-context/input-state! context state))))
+	      (if (fix:< start end)
+		  (let* ((char (string-ref string start))
+			 (continue
+			  (lambda (index)
+			    (loop (fix:+ start 1)
+				  index
+				  (if (char=? char #\newline)
+				      'line-start
+				      'in-line)))))
+		    (if (or (char=? char #\=)
+			    (fix:< (base64:char->digit char) #x40))
+			(begin
+			  (string-set! buffer index char)
+			  (if (fix:< index 3)
+			      (continue (fix:+ index 1))
+			      (begin
+				(decode-base64-quantum context)
+				(continue 0))))
+			(if (eq? state 'line-start)
+			    (done 'finished)
+			    (continue index))))
+		  (done state))))))))
 
 (define (call-with-decode-base64-output-port port text? generator)
   (let ((port (make-decode-base64-port port text?)))
@@ -544,23 +525,23 @@ USA.
 	      ((index 0)
 	       (pending? (base64-decoding-context/pending-return? context)))
 	    (if (fix:< index n)
-		(let ((char (string-ref output index)))
+		(let ((u8 (bytevector-u8-ref output index)))
 		  (if pending?
-		      (if (char=? char #\linefeed)
+		      (if (fix:= cp:newline u8)
 			  (begin
-			    (newline port)
+			    (write-u8 u8 port)
 			    (loop (fix:+ index 1) #f))
 			  (begin
-			    (write-char #\return port)
+			    (write-u8 cp:return port)
 			    (loop index #f)))
-		      (if (char=? char #\return)
+		      (if (fix:= cp:return u8)
 			  (loop (fix:+ index 1) #t)
 			  (begin
-			    (write-char char port)
+			    (write-u8 u8 port)
 			    (loop (fix:+ index 1) #f)))))
 		(set-base64-decoding-context/pending-return?! context
 							      pending?)))
-	  (write-substring output 0 n port)))))
+	  (write-bytevector output port 0 n)))))
 
 (define (decode-base64-quantum-1 input output)
   (let ((d1 (decode-base64-char input 0))
@@ -571,57 +552,78 @@ USA.
 				(fix:lsh d2 12))
 			 (fix:+ (fix:lsh (decode-base64-char input 2) 6)
 				(decode-base64-char input 3)))))
-	     (vector-8b-set! output 0 (fix:lsh n -16))
-	     (vector-8b-set! output 1 (fix:and #xFF (fix:lsh n -8)))
-	     (vector-8b-set! output 2 (fix:and #xFF n))
+	     (bytevector-u8-set! output 0 (fix:lsh n -16))
+	     (bytevector-u8-set! output 1 (fix:and #xFF (fix:lsh n -8)))
+	     (bytevector-u8-set! output 2 (fix:and #xFF n))
 	     3))
 	  ((not (char=? (string-ref input 2) #\=))
 	   (let ((n
 		  (fix:+ (fix:+ (fix:lsh d1 10) (fix:lsh d2 4))
 			 (fix:lsh (decode-base64-char input 2) -2))))
-	     (vector-8b-set! output 0 (fix:lsh n -8))
-	     (vector-8b-set! output 1 (fix:and #xFF n)))
+	     (bytevector-u8-set! output 0 (fix:lsh n -8))
+	     (bytevector-u8-set! output 1 (fix:and #xFF n)))
 	   2)
 	  (else
-	   (vector-8b-set! output 0 (fix:+ (fix:lsh d1 2) (fix:lsh d2 -4)))
+	   (bytevector-u8-set! output 0 (fix:+ (fix:lsh d1 2) (fix:lsh d2 -4)))
 	   1))))
 
 (define (decode-base64-char input index)
-  (let ((digit (vector-8b-ref base64-char-table (vector-8b-ref input index))))
+  (let ((digit (base64:char->digit (string-ref input index))))
     (if (fix:> digit #x40)
 	(error:decode-base64 "Misplaced #\\= in BASE64 input."))
     digit))
 
-(define base64-char-table)
-(define base64-digit-table)
-(let ((char-table (make-legacy-string 256 (integer->char #xff)))
-      (digit-table (make-legacy-string 64)))
+(define (base64:char->digit char)
+  (let ((cp (char->integer char)))
+    (if (fix:< cp #x80)
+	(bytevector-u8-ref base64:char->digit-table cp)
+	#xFF)))
+
+(define (base64:digit->char digit)
+  (string-ref base64:digit->char-table digit))
+
+(define base64:char->digit-table)
+(define base64:digit->char-table)
+(let ((char-table (make-bytevector #x80 #xFF))
+      (digit-table (make-string #x40)))
+
   (define (do-range low high value)
     (do-char low value)
     (if (fix:< low high)
 	(do-range (fix:+ low 1) high (fix:+ value 1))))
+
   (define (do-char code value)
-    (vector-8b-set! char-table code value)
-    (vector-8b-set! digit-table value code))
+    (bytevector-u8-set! char-table code value)
+    (string-set! digit-table value (integer->char code)))
+
   (do-range (char->integer #\A) (char->integer #\Z) 0)
   (do-range (char->integer #\a) (char->integer #\z) 26)
   (do-range (char->integer #\0) (char->integer #\9) 52)
   (do-char (char->integer #\+) 62)
   (do-char (char->integer #\/) 63)
-  (set! base64-char-table char-table)
-  (set! base64-digit-table digit-table)
+  (set! base64:char->digit-table char-table)
+  (set! base64:digit->char-table digit-table)
   unspecific)
 
 (define condition-type:decode-base64
-  (make-condition-type 'DECODE-BASE64 condition-type:decode-mime '() #f))
+  (make-condition-type 'decode-base64 condition-type:decode-mime '() #f))
 
 (define error:decode-base64
   (let ((signal
 	 (condition-signaller condition-type:decode-base64
-			      '(MESSAGE IRRITANTS)
+			      '(message irritants)
 			      standard-error-handler)))
     (lambda (message . irritants)
       (signal message irritants))))
+
+(define-integrable cp:newline (char->integer #\newline))
+(define-integrable cp:return (char->integer #\return))
+
+(define bv:crlf
+  (let ((bv (make-bytevector 2)))
+    (bytevector-u8-set! bv 0 cp:return)
+    (bytevector-u8-set! bv 1 cp:newline)
+    bv))
 
 ;;;; Decode BinHex 4.0
 
@@ -629,11 +631,11 @@ USA.
 		   (conc-name binhex40-decoding-context/)
 		   (constructor make-binhex40-decoding-context (port)))
   (port #f read-only #t)
-  (state 'SEEKING-COMMENT)
+  (state 'seeking-comment)
   (line-buffer "")
-  (input-buffer (make-legacy-string 4) read-only #t)
+  (input-buffer (make-string 4) read-only #t)
   (input-index 0)
-  (output-buffer (make-legacy-string 3) read-only #t))
+  (output-buffer (make-bytevector 3) read-only #t))
 
 (define (decode-binhex40:initialize port text?)
   text?					;ignored
@@ -641,26 +643,29 @@ USA.
    (make-binhex40-run-length-decoding-port
     (make-binhex40-deconstructing-port port))))
 
-(define (decode-binhex40:update context string start end)
-  (let ((state (binhex40-decoding-context/state context)))
-    (case (binhex40-decoding-context/state context)
-      ((SEEKING-COMMENT)
-       (decode-binhex40-seeking-comment context string start end))
-      ((DECODING)
-       (decode-binhex40-decoding context string start end))
-      ((IGNORING)
-       unspecific)
-      (else
-       (error "Illegal decoder state:" state)))))
+(define (decode-binhex40:update context string #!optional start end)
+  (let* ((caller 'decode-binhex40:update)
+	 (end (fix:end-index end (string-length string) caller))
+	 (start (fix:start-index start end caller)))
+    (let ((state (binhex40-decoding-context/state context)))
+      (case (binhex40-decoding-context/state context)
+	((seeking-comment)
+	 (decode-binhex40-seeking-comment context string start end))
+	((decoding)
+	 (decode-binhex40-decoding context string start end))
+	((ignoring)
+	 unspecific)
+	(else
+	 (error "Illegal decoder state:" state))))))
 
 (define (decode-binhex40:finalize context)
   (let ((state (binhex40-decoding-context/state context)))
     (case (binhex40-decoding-context/state context)
-      ((SEEKING-COMMENT)
+      ((seeking-comment)
        (error:decode-binhex40 "Missing BinHex 4.0 initial comment line."))
-      ((DECODING)
+      ((decoding)
        (error:decode-binhex40 "Missing BinHex 4.0 terminating character."))
-      ((IGNORING)
+      ((ignoring)
        (close-output-port (binhex40-decoding-context/port context)))
       (else
        (error "Illegal decoder state:" state)))))
@@ -679,12 +684,12 @@ USA.
   (make-decoding-port-type decode-binhex40:update decode-binhex40:finalize))
 
 (define condition-type:decode-binhex40
-  (make-condition-type 'DECODE-BINHEX40 condition-type:decode-mime '() #f))
+  (make-condition-type 'decode-binhex40 condition-type:decode-mime '() #f))
 
 (define error:decode-binhex40
   (let ((signal
 	 (condition-signaller condition-type:decode-binhex40
-			      '(MESSAGE IRRITANTS)
+			      '(message irritants)
 			      standard-error-handler)))
     (lambda (message . irritants)
       (signal message irritants))))
@@ -697,11 +702,9 @@ USA.
     (let ((regs (re-string-match binhex40-header-regexp s)))
       (if regs
 	  (begin
-	    (set-binhex40-decoding-context/state! context 'DECODING)
+	    (set-binhex40-decoding-context/state! context 'decoding)
 	    (set-binhex40-decoding-context/line-buffer! context #f)
-	    (decode-binhex40:update context s
-				    (re-match-end-index 0 regs)
-				    (string-length s)))
+	    (decode-binhex40:update context s (re-match-end-index 0 regs)))
 	  (set-binhex40-decoding-context/line-buffer! context s)))))
 
 (define binhex40-header-regexp
@@ -720,10 +723,8 @@ USA.
 		       (begin
 			 (string-set! buffer index char)
 			 (decode-binhex40-quantum context)))
-		   (set-binhex40-decoding-context/state! context 'IGNORING))
-		  ((fix:< (vector-8b-ref binhex40-char-table
-					 (char->integer char))
-			  #x40)
+		   (set-binhex40-decoding-context/state! context 'ignoring))
+		  ((fix:< (binhex40:char->digit char) #x40)
 		   (string-set! buffer index char)
 		   (if (fix:< index 3)
 		       (loop start (fix:+ index 1))
@@ -738,22 +739,23 @@ USA.
   (let ((input (binhex40-decoding-context/input-buffer context))
 	(output (binhex40-decoding-context/output-buffer context))
 	(port (binhex40-decoding-context/port context)))
-    (write-substring output 0
-		     (decode-binhex40-quantum-1 input output)
-		     port)))
+    (write-bytevector output
+		      0
+		      (decode-binhex40-quantum-1 input output)
+		      port)))
 
 (define (decode-binhex40-quantum-1 input output)
   (let ((d1 (decode-binhex40-char input 0))
 	(d2 (decode-binhex40-char input 1)))
     (cond ((char=? (string-ref input 2) #\:)
-	   (vector-8b-set! output 0 (fix:+ (fix:lsh d1 2) (fix:lsh d2 -4)))
+	   (bytevector-u8-set! output 0 (fix:+ (fix:lsh d1 2) (fix:lsh d2 -4)))
 	   1)
 	  ((char=? (string-ref input 3) #\:)
 	   (let ((n
 		  (fix:+ (fix:+ (fix:lsh d1 10) (fix:lsh d2 4))
 			 (fix:lsh (decode-binhex40-char input 2) -2))))
-	     (vector-8b-set! output 0 (fix:lsh n -8))
-	     (vector-8b-set! output 1 (fix:and #xFF n)))
+	     (bytevector-u8-set! output 0 (fix:lsh n -8))
+	     (bytevector-u8-set! output 1 (fix:and #xFF n)))
 	   2)
 	  (else
 	   (let ((n
@@ -761,186 +763,158 @@ USA.
 				(fix:lsh d2 12))
 			 (fix:+ (fix:lsh (decode-binhex40-char input 2) 6)
 				(decode-binhex40-char input 3)))))
-	     (vector-8b-set! output 0 (fix:lsh n -16))
-	     (vector-8b-set! output 1 (fix:and #xFF (fix:lsh n -8)))
-	     (vector-8b-set! output 2 (fix:and #xFF n))
+	     (bytevector-u8-set! output 0 (fix:lsh n -16))
+	     (bytevector-u8-set! output 1 (fix:and #xFF (fix:lsh n -8)))
+	     (bytevector-u8-set! output 2 (fix:and #xFF n))
 	     3)))))
 
 (define (decode-binhex40-char input index)
-  (let ((digit
-	 (vector-8b-ref binhex40-char-table (vector-8b-ref input index))))
-    (if (fix:> digit #x40)
+  (let ((digit (binhex40:char->digit (string-ref input index))))
+    (if (fix:>= digit #x40)
 	(error:decode-binhex40 "Illegal character in BinHex 4.0 input stream:"
 			       (string-ref input index)))
     digit))
 
-(define binhex40-digit-table
-  "!\"#$%&\'()*+,-012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr")
+(define (binhex40:char->digit char)
+  (let ((cp (char->integer char)))
+    (if (fix:< cp #x80)
+	(bytevector-u8-ref binhex40:char->digit-table cp)
+	#xFF)))
 
-(define binhex40-char-table
-  (make-legacy-string 256 (integer->char #xff)))
+(define binhex40:digit->char-table
+  "!\"#$%&\'()*+,-012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr")
 
-(do ((code 0 (fix:+ code 1)))
-    ((fix:= code 64))
-  (vector-8b-set! binhex40-char-table
-		  (vector-8b-ref binhex40-digit-table code)
-		  code))
+(define-deferred binhex40:char->digit-table
+  (let ((table (make-bytevector #x80 #xFF)))
+    (do ((digit 0 (fix:+ digit 1)))
+	((not (fix:< digit #x40)))
+      (bytevector-u8-set! table
+			  (char->integer
+			   (string-ref binhex40:digit->char-table digit))
+			  digit))
+    table))
 
 ;;;; BinHex 4.0 run-length decoding
 
 (define (make-binhex40-run-length-decoding-port port)
-  (make-textual-port binhex40-run-length-decoding-port-type
-		     (make-binhex40-rld-state port)))
-
-(define binhex40-run-length-decoding-port-type
-  (make-textual-port-type
-   `((WRITE-CHAR
-      ,(lambda (port char)
-	 (guarantee 8-bit-char? char)
-	 (let ((state (textual-port-state port)))
-	   (let ((port (binhex40-rld-state/port state))
-		 (char* (binhex40-rld-state/char state)))
-	     (cond ((binhex40-rld-state/marker-seen? state)
-		    (let ((n (char->integer char)))
-		      (cond ((fix:= n 0)
-			     (if char* (write-char char* port))
-			     (set-binhex40-rld-state/char!
-			      state binhex40-rld-marker))
-			    (char*
-			     (do ((i 0 (fix:+ i 1)))
-				 ((fix:= i n))
-			       (write-char char* port))
-			     (set-binhex40-rld-state/char! state #f))))
-		    (set-binhex40-rld-state/marker-seen?! state #f))
-		   ((char=? char binhex40-rld-marker)
-		    (set-binhex40-rld-state/marker-seen?! state #t))
-		   (else
-		    (if char* (write-char char* port))
-		    (set-binhex40-rld-state/char! state char)))))
-	 1))
-     (CLOSE-OUTPUT
-      ,(lambda (port)
-	 (let ((state (textual-port-state port)))
-	   (let ((port (binhex40-rld-state/port state))
-		 (char* (binhex40-rld-state/char state)))
-	     (if char*
-		 (begin
-		   (write-char char* port)
-		   (set-binhex40-rld-state/char! state #f)))
-	     (if (binhex40-rld-state/marker-seen? state)
-		 (begin
-		   (write-char binhex40-rld-marker port)
-		   (set-binhex40-rld-state/marker-seen?! state #f)))
-	     (close-output-port port))))))
-   #f))
-
-(define-structure (binhex40-rld-state
-		   (conc-name binhex40-rld-state/)
-		   (constructor make-binhex40-rld-state (port)))
-  (port #f read-only #t)
-  (char #f)
-  (marker-seen? #f))
+  (make-binary-port #f (make-binhex-run-length-decoding-sink port)))
+
+(define (make-binhex-run-length-decoding-sink port)
+  (let ((marker #x90)
+	(marker-seen? #f)
+	(byte* #f))
+
+    (define (write-bytes bytes start end)
+      (do ((i start (fix:+ i 1)))
+	  ((not (fix:< i end)))
+	(write-byte (bytevector-u8-ref bytes i))))
+
+    (define (write-byte byte)
+      (cond (marker-seen?
+	     (cond ((fix:= byte 0)
+		    (if byte* (write-u8 byte* port))
+		    (set! byte* marker))
+		   (byte*
+		    (do ((i 0 (fix:+ i 1)))
+			((not (fix:< i byte)))
+		      (write-u8 byte* port))
+		    (set! byte* #f)))
+	     (set! marker-seen? #f))
+	    ((fix:= byte marker)
+	     (set! marker-seen? #t))
+	    (else
+	     (if byte* (write-u8 byte* port))
+	     (set! byte* byte)))
+      unspecific)
+
+    (define (close)
+      (if byte*
+	  (begin
+	    (write-u8 byte* port)
+	    (set! byte* #f)))
+      (if marker-seen?
+	  (begin
+	    (write-u8 marker port)
+	    (set! marker-seen? #f)))
+      (close-output-port port))
 
-(define-integrable binhex40-rld-marker
-  (integer->char #x90))
+    (make-non-channel-output-sink write-bytes close)))
 
 ;;;; BinHex 4.0 deconstruction
 
 (define (make-binhex40-deconstructing-port port)
-  (make-textual-port binhex40-deconstructing-port-type
-		     (make-binhex40-decon port)))
-
-(define binhex40-deconstructing-port-type
-  (make-textual-port-type
-   `((WRITE-CHAR
-      ,(lambda (port char)
-	 (guarantee 8-bit-char? char)
-	 (case (binhex40-decon/state (textual-port-state port))
-	   ((READING-HEADER) (binhex40-decon-reading-header port char))
-	   ((COPYING-DATA) (binhex40-decon-copying-data port char))
-	   ((SKIPPING-TAIL) (binhex40-decon-skipping-tail port))
-	   ((FINISHED) unspecific)
-	   (else (error "Illegal state in BinHex 4.0 deconstructor.")))
-	 1))
-     (CLOSE-OUTPUT
-      ,(lambda (port)
-	 (if (not (eq? (binhex40-decon/state (textual-port-state port))
-		       'FINISHED))
-	     (error:decode-binhex40 "Premature EOF in BinHex 4.0 stream.")))))
-   #f))
-
-(define (binhex40-decon-reading-header port char)
-  (let ((state (textual-port-state port)))
-    (let ((index (binhex40-decon/index state)))
-      (if (fix:= index 0)
+  (make-binary-port #f (make-binhex40-deconstructing-sink port)))
+
+(define (make-binhex40-deconstructing-sink port)
+  (let ((state 'reading-header)
+	(header-length)
+	(header #f)
+	(index 0)
+	(data-length))
+
+    (define (write-bytes bytes start end)
+      (do ((i start (fix:+ i 1)))
+	  ((not (fix:< i end)))
+	(case state
+	  ((reading-header) (reading-header (bytevector-u8-ref bytes i)))
+	  ((copying-data) (copying-data (bytevector-u8-ref bytes i)))
+	  ((skipping-tail) (skipping-tail)))))
+
+    (define (reading-header byte)
+      (cond ((= index 0)
+	     (set! header-length (+ 22 byte))
+	     (set! header (make-bytevector header-length))
+	     (set! index 1))
+	    ((< index header-length)
+	     (bytevector-u8-set! header index byte)
+	     (set! index (+ index 1)))
+	    (else
+	     (set! data-length (read-data-length (fix:- header-length 10)))
+	     (set! index 0)
+	     (set! state 'copying-data))))
+
+    (define (copying-data byte)
+      (if (< index data-length)
 	  (begin
-	    (set-binhex40-decon/header!
-	     state (make-legacy-string (fix:+ 22 (char->integer char))))
-	    (set-binhex40-decon/index! state 1))
-	  (let ((header (binhex40-decon/header state)))
-	    (string-set! header index char)
-	    (let ((index (fix:+ index 1)))
-	      (if (fix:< index (string-length header))
-		  (set-binhex40-decon/index! state index)
-		  (begin
-		    (set-binhex40-decon/data-length!
-		     state
-		     (binhex40-4byte header (fix:- (string-length header) 10)))
-		    (set-binhex40-decon/index! state 0)
-		    (set-binhex40-decon/state! state 'COPYING-DATA)))))))))
-
-(define (binhex40-decon-copying-data port char)
-  (let ((state (textual-port-state port)))
-    (write-char char (binhex40-decon/port state))
-    (let ((index (+ (binhex40-decon/index state) 1)))
-      (if (< index (binhex40-decon/data-length state))
-	  (set-binhex40-decon/index! state index)
+	    (write-u8 byte port)
+	    (set! index (+ index 1)))
 	  (begin
-	    (set-binhex40-decon/index! state 0)
-	    (set-binhex40-decon/data-length!
-	     state
-	     (+ (let ((header (binhex40-decon/header state)))
-		  (binhex40-4byte header (fix:- (string-length header) 6)))
-		4))
-	    (set-binhex40-decon/state! state 'SKIPPING-TAIL))))))
-
-(define (binhex40-decon-skipping-tail port)
-  (let ((state (textual-port-state port)))
-    (let ((index (+ (binhex40-decon/index state) 1)))
-      (set-binhex40-decon/index! state index)
-      (if (>= index (binhex40-decon/data-length state))
-	  (set-binhex40-decon/state! state 'FINISHED)))))
-
-(define-structure (binhex40-decon (conc-name binhex40-decon/)
-				  (constructor make-binhex40-decon (port)))
-  (port #f read-only #t)
-  (state 'READING-HEADER)
-  (header #f)
-  (index 0)
-  (data-length))
-
-(define (binhex40-4byte string index)
-  (+ (* (vector-8b-ref string index) #x1000000)
-     (* (vector-8b-ref string (fix:+ index 1)) #x10000)
-     (* (vector-8b-ref string (fix:+ index 2)) #x100)
-     (vector-8b-ref string (fix:+ index 3))))
+	    (set! index 0)
+	    (set! data-length (+ (read-data-length (fix:- header-length 6)) 4))
+	    (set! state 'skipping-tail))))
+
+    (define (skipping-tail)
+      (if (< index data-length)
+	  (set! index (+ index 1))
+	  (set! state 'finished)))
+
+    (define (read-data-length index)
+      (+ (* (bytevector-u8-ref header index) #x1000000)
+	 (* (bytevector-u8-ref header (+ index 1)) #x10000)
+	 (* (bytevector-u8-ref header (+ index 2)) #x100)
+	 (bytevector-u8-ref header (+ index 3))))
+
+    (define (close)
+      (close-output-port port))
+
+    (make-non-channel-output-sink write-bytes close)))
 
 ;;;; Decode uuencode
 
 (define (decode-uue:initialize port text?)
   text?
-  (let ((state 'BEGIN)
+  (let ((state 'begin)
 	(builder (string-builder))
-	(output-buffer (make-legacy-string 3)))
+	(output-buffer (make-bytevector 3)))
 
     (define (update string start end)
-      (if (and (not (eq? state 'FINISHED))
+      (if (and (not (eq? state 'finished))
 	       (fix:< start end))
 	  (let ((nl (substring-find-next-char string start end #\newline)))
 	    (if nl
 		(begin
 		  (builder (string-slice string start nl))
-		  (let ((line (builder)))
+		  (let ((line (builder 'immutable)))
 		    (builder 'reset!)
 		    (process-line line))
 		  (update string (fix:+ nl 1) end))
@@ -950,16 +924,16 @@ USA.
       (if (not (fix:> (string-length line) 0))
 	  (error:decode-uue "Empty line not allowed."))
       (case state
-	((BEGIN) (process-begin-line line))
-	((NORMAL) (process-normal-line line))
-	((ZERO) (process-zero-line line))
-	((END) (process-end-line line))
+	((begin) (process-begin-line line))
+	((normal) (process-normal-line line))
+	((zero) (process-zero-line line))
+	((end) (process-end-line line))
 	(else (error "Illegal state in uuencode decoder:" state))))
 
     (define (process-begin-line line)
       (if (not (re-string-match "^begin +[0-7]+ +.+$" line))
 	  (error:decode-uue "Malformed \"begin\" line:" line))
-      (set! state 'NORMAL))
+      (set! state 'normal))
 
     (define (process-normal-line line)
       (let ((n (uudecode-char (string-ref line 0))))
@@ -974,31 +948,34 @@ USA.
 		(uudecode-quantum line start output-buffer)
 		(if (fix:<= i* n)
 		    (begin
-		      (write-string output-buffer port)
+		      (write-bytevector output-buffer port)
 		      (per-quantum i* (fix:+ start 4)))
-		    (write-substring output-buffer 0 (fix:- n i) port)))))
-	(cond ((fix:= n 0) (set! state 'END))
-	      ((fix:< n 45) (set! state 'ZERO)))))
+		    (write-bytevector output-buffer port 0 (fix:- n i))))))
+	(cond ((fix:= n 0) (set! state 'end))
+	      ((fix:< n 45) (set! state 'zero)))))
 
     (define (process-zero-line line)
       (let ((n (uudecode-char (string-ref line 0))))
 	(if (not (fix:= n 0))
 	    (error:decode-uue "Expected zero-length line:" n)))
-      (set! state 'END))
+      (set! state 'end))
 
     (define (process-end-line line)
       (if (not (string=? line "end"))
 	  (error:decode-uue "Malformed \"end\" line:" line))
-      (set! state 'FINISHED))
+      (set! state 'finished))
 
     (define (finalize)
-      (if (not (eq? state 'FINISHED))
+      (if (not (eq? state 'finished))
 	  (error:decode-uue "Can't finalize unfinished decoding.")))
 
     (make-uudecode-ctx update finalize)))
 
-(define (decode-uue:update context string start end)
-  ((uudecode-ctx-update context) string start end))
+(define (decode-uue:update context string #!optional start end)
+  (let* ((caller 'decode-uu3:update)
+	 (end (fix:end-index end (string-length string) caller))
+	 (start (fix:start-index start end caller)))
+    ((uudecode-ctx-update context) string start end)))
 
 (define (decode-uue:finalize context)
   ((uudecode-ctx-finalize context)))
@@ -1014,15 +991,15 @@ USA.
 	(n1 (uudecode-char (string-ref string (fix:+ start 1))))
 	(n2 (uudecode-char (string-ref string (fix:+ start 2))))
 	(n3 (uudecode-char (string-ref string (fix:+ start 3)))))
-    (vector-8b-set! buffer 0
-		    (fix:or (fix:lsh n0 2)
-			    (fix:lsh n1 -4)))
-    (vector-8b-set! buffer 1
-		    (fix:or (fix:lsh (fix:and n1 #x0F) 4)
-			    (fix:lsh n2 -2)))
-    (vector-8b-set! buffer 2
-		    (fix:or (fix:lsh (fix:and n2 #x03) 6)
-			    n3))))
+    (bytevector-u8-set! buffer 0
+			(fix:or (fix:lsh n0 2)
+				(fix:lsh n1 -4)))
+    (bytevector-u8-set! buffer 1
+			(fix:or (fix:lsh (fix:and n1 #x0F) 4)
+				(fix:lsh n2 -2)))
+    (bytevector-u8-set! buffer 2
+			(fix:or (fix:lsh (fix:and n2 #x03) 6)
+				n3))))
 
 (define (uudecode-char char)
   (let ((n (char->integer char)))
@@ -1043,12 +1020,12 @@ USA.
   (make-decoding-port-type decode-uue:update decode-uue:finalize))
 
 (define condition-type:decode-uue
-  (make-condition-type 'DECODE-UUE condition-type:decode-mime '() #f))
+  (make-condition-type 'decode-uue condition-type:decode-mime '() #f))
 
 (define error:decode-uue
   (let ((signal
 	 (condition-signaller condition-type:decode-uue
-			      '(MESSAGE IRRITANTS)
+			      '(message irritants)
 			      standard-error-handler)))
     (lambda (message . irritants)
       (signal message irritants))))
\ No newline at end of file
diff --git a/tests/runtime/test-mime-codec.scm b/tests/runtime/test-mime-codec.scm
index 829da4e8c..bea2e6664 100644
--- a/tests/runtime/test-mime-codec.scm
+++ b/tests/runtime/test-mime-codec.scm
@@ -31,7 +31,7 @@ USA.
 (load-option 'mime-codec)
 
 (define (test-encoder n-packets packet-length text? filename
-		      initialize finalize update)
+		      binary-codec? initialize finalize update)
   (call-with-output-file filename
     (lambda (port)
       (let ((context (initialize port text?))
@@ -43,128 +43,189 @@ USA.
 	    (write-char #\space port)
 	    (write packet-length port)
 	    (write-char #\space port)
-	    (let ((packet
-		   (if text?
-		       (random-text-string packet-length)
-		       (random-byte-vector packet-length))))
+	    (let ((packet (make-test-packet packet-length text? binary-codec?)))
 	      (write packet port)
 	      (newline port)
 	      (update context packet 0 packet-length))))
 	(finalize context)))))
 
+(define (make-test-packet packet-length text? binary-codec?)
+  (cond (binary-codec? (random-bytevector packet-length))
+	(text? (random-text-string packet-length))
+	(else (random-byte-vector packet-length))))
+
 (define (random-text-string length)
-  (let ((string (make-string length))
+  (let ((builder (string-builder))
 	(n-text (string-length text-characters)))
     (do ((i 0 (fix:+ i 1)))
-	((fix:= i length))
-      (string-set! string i (string-ref text-characters (random n-text))))
-    string))
+	((not (fix:< i length)))
+      (builder (string-ref text-characters (random n-text))))
+    (builder 'immutable)))
 
 (define (random-byte-vector length)
-  (object-new-type (microcode-type 'string)
-		   (random-bytevector length)))
+  (let ((bv (random-bytevector length))
+	(builder (string-builder)))
+    (do ((i 0 (fix:+ i 1)))
+	((not (fix:< i length)))
+      (builder (integer->char (bytevector-u8-ref bv i))))
+    (builder 'immutable)))
 
 (define text-characters
   (list->string
    (append '(#\tab #\newline)
 	   (char-set-members char-set:graphic))))
 
-(define (test-codec n-packets packet-length text? filename
-		      encode:initialize encode:finalize encode:update
-		      decode:initialize decode:finalize decode:update)
-  (let ((packets (make-test-vector n-packets packet-length text?)))
-    (let ((n-packets (vector-length packets)))
-      (call-with-output-file (pathname-new-type filename "clear1")
-	(lambda (port)
-	  (do ((i 0 (+ i 1)))
-	      ((= i n-packets))
-	    (write-string (vector-ref packets i) port))))
-      (call-with-output-file (pathname-new-type filename "encoded")
-	(lambda (port)
-	  (let ((context (encode:initialize port text?)))
-	    (do ((i 0 (+ i 1)))
-		((= i n-packets))
-	      (let ((packet (vector-ref packets i)))
-		(encode:update context packet 0 (string-length packet))))
-	    (encode:finalize context))))))
-  (retest-decoder text? filename
+(define (test-codec n-packets packet-length text? filename binary-codec?
+		    encode:initialize encode:finalize encode:update
+		    decode:initialize decode:finalize decode:update)
+  (let ((packets
+	 (make-test-vector n-packets packet-length text? binary-codec?)))
+    (if binary-codec?
+	(begin
+	  (call-with-binary-output-file (pathname-new-type filename "clear1")
+	    (lambda (port)
+	      (vector-for-each (lambda (packet)
+				 (write-bytevector packet port))
+			       packets)))
+	  (call-with-output-file (pathname-new-type filename "encoded")
+	    (lambda (port)
+	      (let ((context (encode:initialize port text?)))
+		(vector-for-each (lambda (packet)
+				   (encode:update context packet))
+				 packets)
+		(encode:finalize context)))))
+	(begin
+	  (call-with-output-file (pathname-new-type filename "clear1")
+	    (lambda (port)
+	      (vector-for-each (lambda (packet)
+				 (write-string packet port))
+			       packets)))
+	  (call-with-output-file (pathname-new-type filename "encoded")
+	    (lambda (port)
+	      (let ((context (encode:initialize port text?)))
+		(vector-for-each (lambda (packet)
+				   (encode:update context packet))
+				 packets)
+		(encode:finalize context)))))))
+  (retest-decoder text? filename binary-codec?
 		  decode:initialize decode:finalize decode:update))
 
-(define (make-test-vector n-packets packet-length text?)
-  (let ((n-packets (random n-packets)))
-    (let ((packets (make-vector n-packets)))
-      (do ((i 0 (+ i 1)))
-	  ((= i n-packets))
-	(vector-set! packets i
-		     (let ((packet-length (random packet-length)))
-		       (if text?
-			   (random-text-string packet-length)
-			   (random-byte-vector packet-length)))))
-      packets)))
-
-(define (retest-codec text? filename
+(define (make-test-vector n-packets packet-length text? binary-codec?)
+  (let ((n-packets (random n-packets))
+	(builder (vector-builder)))
+    (do ((i 0 (fix:+ i 1)))
+	((not (fix:< i n-packets)))
+      (builder
+       (make-test-packet (random packet-length)
+			 text?
+			 binary-codec?)))
+    (builder)))
+
+(define (retest-codec text? filename binary-codec?
 		      encode:initialize encode:finalize encode:update
 		      decode:initialize decode:finalize decode:update)
-  (call-with-input-file (pathname-new-type filename "clear1")
-    (lambda (input-port)
-      (call-with-output-file (pathname-new-type filename "encoded")
-	(lambda (output-port)
-	  (let ((context (encode:initialize output-port text?))
-		(buffer (make-string 37)))
-	    (let loop ()
-	      (let ((n-read (read-string! buffer input-port)))
-		(if (fix:> n-read 0)
-		    (begin
-		      (encode:update context buffer 0 n-read)
-		      (loop)))))
-	    (encode:finalize context))))))
-  (retest-decoder text? filename
+  (if binary-codec?
+      (call-with-binary-input-file (pathname-new-type filename "clear1")
+	(lambda (input-port)
+	  (call-with-output-file (pathname-new-type filename "encoded")
+	    (lambda (output-port)
+	      (let ((context (encode:initialize output-port text?)))
+		(let loop ()
+		  (let ((bv (read-bytevector 37 input-port)))
+		    (if (not (eof-object? bv))
+			(begin
+			  (encode:update context bv)
+			  (loop)))))
+		(encode:finalize context))))))
+      (call-with-input-file (pathname-new-type filename "clear1")
+	(lambda (input-port)
+	  (call-with-output-file (pathname-new-type filename "encoded")
+	    (lambda (output-port)
+	      (let ((context (encode:initialize output-port text?)))
+		(let loop ()
+		  (let ((string (read-string 37 input-port)))
+		    (if (not (eof-object? string))
+			(begin
+			  (encode:update context string)
+			  (loop)))))
+		(encode:finalize context)))))))
+  (retest-decoder text? filename binary-codec?
 		  decode:initialize decode:finalize decode:update))
-
-(define (retest-decoder text? filename
+
+(define (retest-decoder text? filename binary-codec?
 			decode:initialize decode:finalize decode:update)
   (let ((pn3 (pathname-new-type filename "clear2")))
-    (call-with-input-file (pathname-new-type filename "encoded")
-      (lambda (input-port)
-	(call-with-output-file pn3
-	  (lambda (output-port)
-	    (let ((context (decode:initialize output-port text?))
-		  (buffer (make-string 41)))
-	      (let loop ()
-		(let ((n-read (read-string! buffer input-port)))
-		  (if (fix:> n-read 0)
-		      (begin
-			(decode:update context buffer 0 n-read)
-			(loop)))))
-	      (decode:finalize context))))))
-    (call-with-input-file (pathname-new-type filename "clear1")
-      (lambda (p1)
-	(call-with-input-file pn3
-	  (lambda (p3)
-	    (let loop ()
-	      (let ((c1 (read-char p1))
-		    (c3 (read-char p3)))
-		(if (eof-object? c1)
-		    (if (eof-object? c3)
-			unspecific
-			(error "Output file longer."))
-		    (if (eof-object? c3)
-			(error "Output file shorter.")
-			(if (char=? c1 c3)
-			    (loop)
-			    (error "Files don't match."))))))))))))
+    (if binary-codec?
+	(begin
+	  (call-with-input-file (pathname-new-type filename "encoded")
+	    (lambda (input-port)
+	      (call-with-binary-output-file pn3
+		(lambda (output-port)
+		  (let ((context (decode:initialize output-port text?)))
+		    (let loop ()
+		      (let ((string (read-string 41 input-port)))
+			(if (not (eof-object? string))
+			    (begin
+			      (decode:update context string)
+			      (loop)))))
+		    (decode:finalize context))))))
+	  (call-with-binary-input-file (pathname-new-type filename "clear1")
+	    (lambda (p1)
+	      (call-with-binary-input-file pn3
+		(lambda (p3)
+		  (let loop ()
+		    (let ((b1 (read-u8 p1))
+			  (b3 (read-u8 p3)))
+		      (if (eof-object? b1)
+			  (if (eof-object? b3)
+			      unspecific
+			      (error "Output file longer."))
+			  (if (eof-object? b3)
+			      (error "Output file shorter.")
+			      (if (fix:= b1 b3)
+				  (loop)
+				  (error "Files don't match.")))))))))))
+	(begin
+	  (call-with-input-file (pathname-new-type filename "encoded")
+	    (lambda (input-port)
+	      (call-with-output-file pn3
+		(lambda (output-port)
+		  (let ((context (decode:initialize output-port text?)))
+		    (let loop ()
+		      (let ((string (read-string 41 input-port)))
+			(if (not (eof-object? string))
+			    (begin
+			      (decode:update context string)
+			      (loop)))))
+		    (decode:finalize context))))))
+	  (call-with-input-file (pathname-new-type filename "clear1")
+	    (lambda (p1)
+	      (call-with-input-file pn3
+		(lambda (p3)
+		  (let loop ()
+		    (let ((c1 (read-char p1))
+			  (c3 (read-char p3)))
+		      (if (eof-object? c1)
+			  (if (eof-object? c3)
+			      unspecific
+			      (error "Output file longer."))
+			  (if (eof-object? c3)
+			      (error "Output file shorter.")
+			      (if (char=? c1 c3)
+				  (loop)
+				  (error "Files don't match."))))))))))))))
 
 (define (for-each-setting procedure)
   (procedure 20 1024 #t)
   (procedure 20 1024 #f))
 
-(define (define-mime-codec-tests name
+(define (define-mime-codec-tests name binary-codec?
 	  encode:initialize encode:finalize encode:update
 	  decode:initialize decode:finalize decode:update)
   (for-each-setting
    (lambda (n-packets packet-length text?)
-     (define-test (symbol 'ENCODE '- name
-			  '/ (if text? 'TEXT 'BINARY)
+     (define-test (symbol 'encode '- name
+			  '/ (if text? 'text 'binary)
 			  '/ n-packets
 			  '/ packet-length)
        (lambda ()
@@ -172,20 +233,21 @@ USA.
 	   (lambda (pathname)
 	     (test-encoder
 	      n-packets packet-length text? pathname
-	      encode:initialize encode:finalize encode:update)))))
-     (define-test (symbol 'CODEC '- name
-			  '/ (if text? 'TEXT 'BINARY)
+	      binary-codec? encode:initialize encode:finalize encode:update)))))
+     (define-test (symbol 'codec '- name
+			  '/ (if text? 'text 'binary)
 			  '/ n-packets
 			  '/ packet-length)
        (lambda ()
 	 (call-with-temporary-file-pathname
 	   (lambda (pathname)
 	     (test-codec
-	      n-packets packet-length text? pathname
+	      n-packets packet-length text? pathname binary-codec?
 	      encode:initialize encode:finalize encode:update
 	      decode:initialize decode:finalize decode:update))))))))
 
 (define-mime-codec-tests 'BASE64
+  #t
   encode-base64:initialize
   encode-base64:finalize
   encode-base64:update
@@ -195,6 +257,7 @@ USA.
 
 #;
 (define-mime-codec-tests 'BINHEX40
+  #t
   encode-binhex40:initialize
   encode-binhex40:finalize
   encode-binhex40:update
@@ -203,6 +266,7 @@ USA.
   decode-binhex40:update)
 
 (define-mime-codec-tests 'QUOTED-PRINTABLE
+  #f
   encode-quoted-printable:initialize
   encode-quoted-printable:finalize
   encode-quoted-printable:update
@@ -212,6 +276,7 @@ USA.
 
 #;
 (define-mime-codec-tests 'UUE
+  #t
   encode-uue:initialize
   encode-uue:finalize
   encode-uue:update
-- 
2.25.1