Fix bug in textual->binary-port.

diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm
index 10edd2410f88e6dbf4e8caa3f253022918ce27e0..dc8d16b4f98cf4cd2cf06374bfa40de158d6332f 100644 (file)
--- a/src/runtime/binary-port.scm
+++ b/src/runtime/binary-port.scm
@@ -201,15 +201,17 @@ USA.
           (lambda (bv bs be)
             (let loop ((bi bs))
               (if (fix:< bi be)
-                  (let ((char (peek-char textual-port)))
-                    (if (or (not char) (eof-object? char))
-                        (if (fix:> bi bs)
-                            (fix:- bi bs)
-                            char)
-                        (let ((bi* ((char-codec-encoder codec) bv bi be char)))
-                          (if bi*
-                              (loop bi*)
-                              (fix:- bi bs)))))
+                  (let ((char (read-char textual-port)))
+                    (cond ((not char) (if (fix:> bi bs) (fix:- bi bs) #f))
+                          ((eof-object? char) (fix:- bi bs))
+                          (else
+                           (let ((bi*
+                                  ((char-codec-encoder codec) bv bi be char)))
+                             (if bi*
+                                 (loop bi*)
+                                 (begin
+                                   (unread-char char textual-port)
+                                   (fix:- bi bs)))))))
                   (fix:- bi bs))))
           (lambda ()
             (close-input-port textual-port))))
@@ -228,7 +230,7 @@ USA.
                   (fix:- bi bs))))
           (lambda ()
             (close-output-port textual-port))))
-     'textual-port->binary)))
+     'textual->binary-port)))
 \f
 ;;;; Closing operations