Implement replace-binary-port! on generic I/O ports.

diff --git a/src/runtime/generic-io.scm b/src/runtime/generic-io.scm
index 21e56c92d9cc093ddb26bd2bf478a2eba33e9735..1d8b6d9df05328af96b3e0ff82409ef294b63fa1 100644 (file)
--- a/src/runtime/generic-io.scm
+++ b/src/runtime/generic-io.scm
@@ -107,8 +107,8 @@ USA.
 (define-record-type <gstate>
     (%make-gstate input-buffer output-buffer coder-name normalizer-name extra)
     gstate?
-  (input-buffer gstate-input-buffer)
-  (output-buffer gstate-output-buffer)
+  (input-buffer gstate-input-buffer set-gstate-input-buffer!)
+  (output-buffer gstate-output-buffer set-gstate-output-buffer!)
   (coder-name gstate-coder-name
              set-gstate-coder-name!)
   (normalizer-name gstate-normalizer-name
@@ -130,6 +130,30 @@ USA.
   (guarantee index-fixnum? index 'generic-i/o-port-modifier)
   (lambda (port object)
     (vector-set! (gstate-extra (textual-port-state port)) index object)))
+
+(define (replace-binary-port! port binary-port)
+  (let ((gstate (textual-port-state port)))
+    (set-gstate-input-buffer!
+     gstate
+     (and (binary-input-port? binary-port)
+         (let ((buffer
+                (make-input-buffer binary-port
+                                   (gstate-coder-name gstate)
+                                   (gstate-normalizer-name gstate)
+                                   'replace-binary-port!)))
+
+           (set-input-buffer-port! buffer port)
+           buffer)))
+    (set-gstate-output-buffer!
+     gstate
+     (and (binary-output-port? binary-port)
+         (let ((buffer
+                (make-output-buffer binary-port
+                                    (gstate-coder-name gstate)
+                                    (gstate-normalizer-name gstate)
+                                    'gstate-replace-binary-port!)))
+           (set-output-buffer-port! buffer port)
+           buffer)))))
 \f
 (define generic-type00)
 (define generic-type10)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b94da19afd43cd6551cec43aa137686bdb93a9ae..fbae99218980b9483880e863c36573fea15c0ee8 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2335,7 +2335,8 @@ USA.
          generic-io/set-buffer-contents
          generic-io/unread-char
          make-generic-i/o-port
-         make-gstate)
+         make-gstate
+         replace-binary-port!)
   (export (runtime file-i/o-port)
          generic-i/o-port->binary-port
          generic-i/o-port-type