From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 9 May 2018 04:54:21 +0000 (-0700)
Subject: Provide access to the channels in a binary port.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~71
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=413b43c421e0aabef510b6dbfd204f63a64050f1;p=mit-scheme.git

Provide access to the channels in a binary port.
---

diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm
index 40113adca..0c709420b 100644
--- a/src/runtime/binary-port.scm
+++ b/src/runtime/binary-port.scm
@@ -59,6 +59,16 @@ USA.
     (and buffer
 	 (buffer-source/sink buffer))))
 
+(define (binary-port-input-channel port)
+  (let ((buffer (port-input-buffer port)))
+    (and buffer
+	 (buffer-channel buffer))))
+
+(define (binary-port-output-channel port)
+  (let ((buffer (port-output-buffer port)))
+    (and buffer
+	 (buffer-channel buffer))))
+
 (define (binary-input-port? object)
   (and (binary-port? object)
        (port-input-buffer object)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 787bcdbad..b94da19af 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2567,6 +2567,8 @@ USA.
 	  write-bytevector
 	  write-u8)
   (export (runtime)
+	  binary-port-input-channel
+	  binary-port-output-channel
 	  binary-port-sink
 	  binary-port-source
 	  input-source-channel