Add subprocess-binary-i/o-port.

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index 45e0b454d637d6ec2140918d820a0806feecb7ef..ff1aa64d50308bc5a1dc75ea2a2fa2ee8efea5f2 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -79,6 +79,9 @@ USA.
 (define (subprocess-remove! process key)
   (1d-table/remove! (subprocess-properties process) key))
 \f
+(define (subprocess-binary-i/o-port process)
+  (%subprocess-binary-i/o-port process 'subprocess-binary-i/o-port))
+
 (define (subprocess-i/o-port process)
   (%subprocess-i/o-port process 'subprocess-i/o-port))
 
@@ -93,6 +96,17 @@ USA.
         port)))
 
 (define (%subprocess-i/o-port process caller)
+  (without-interruption
+   (lambda ()
+     (or (subprocess-%i/o-port process)
+        (let* ((binary-port (%subprocess-binary-i/o-port process caller))
+               (port (and binary-port
+                          (make-generic-i/o-port binary-port (default-object)
+                                                 caller))))
+          (set-subprocess-%i/o-port! process port)
+          port)))))
+
+(define (%subprocess-binary-i/o-port process caller)
   (without-interruption
    (lambda ()
      (or (subprocess-%i/o-port process)
@@ -100,14 +114,11 @@ USA.
                (let ((input-channel (subprocess-input-channel process))
                      (output-channel (subprocess-output-channel process)))
                  (and (or input-channel output-channel)
-                      (make-generic-i/o-port
-                       (make-binary-port
-                        (and input-channel
-                             (make-channel-input-source input-channel))
-                        (and output-channel
-                             (make-channel-output-sink output-channel))
-                        caller)
-                       (default-object)
+                      (make-binary-port
+                       (and input-channel
+                            (make-channel-input-source input-channel))
+                       (and output-channel
+                            (make-channel-output-sink output-channel))
                        caller)))))
           (set-subprocess-%i/o-port! process port)
           port)))))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 8aee738937f0a07c738308902831a9625c203be9..028eb888ddf0042034f415332efddbc712960195 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4289,6 +4289,7 @@ USA.
          start-pty-subprocess
          start-subprocess-in-background
          subprocess-arguments
+         subprocess-binary-i/o-port
          subprocess-continue-background
          subprocess-continue-foreground
          subprocess-delete