From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 9 May 2018 04:56:42 +0000 (-0700)
Subject: Implement replace-binary-port! on generic I/O ports.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~70
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e3553c49506965be4c1d1c9d7e2e5be6bb6525a7;p=mit-scheme.git

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

diff --git a/src/runtime/generic-io.scm b/src/runtime/generic-io.scm
index 21e56c92d..1d8b6d9df 100644
--- 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)))))
 
 (define generic-type00)
 (define generic-type10)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b94da19af..fbae99218 100644
--- 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