Add means to control line translation in subprocess port. This is

useful when communicating with a TCP stream relay subprocess, in which
case the line terminators are defined by the network protocol rather
than by the operating system.

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index c3ba6ee9d50b731e62e99460532c82ed4f3a150e..e5f0a0c8e70389279b30f3689dfdcfe67322fdc7 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.3 1993/10/21 14:52:37 cph Exp $
+$Id: genio.scm,v 1.4 1995/04/14 19:06:09 cph Exp $
 
-Copyright (c) 1991-93 Massachusetts Institute of Technology
+Copyright (c) 1991-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -92,21 +92,44 @@ MIT in each case. |#
 (define generic-output-template)
 (define generic-i/o-template)
 \f
-(define (make-generic-input-port input-channel input-buffer-size)
-  (make-generic-port generic-input-template
-                    (make-input-buffer input-channel input-buffer-size)
-                    false))
-
-(define (make-generic-output-port output-channel output-buffer-size)
-  (make-generic-port generic-output-template
-                    false
-                    (make-output-buffer output-channel output-buffer-size)))
+(define (make-generic-input-port input-channel input-buffer-size
+                                #!optional line-translation)
+  (let ((line-translation
+        (if (default-object? line-translation)
+            'DEFAULT
+            line-translation)))
+    (make-generic-port generic-input-template
+                      (make-input-buffer input-channel
+                                         input-buffer-size
+                                         line-translation)
+                      #f)))
+
+(define (make-generic-output-port output-channel output-buffer-size
+                                 #!optional line-translation)
+  (let ((line-translation
+        (if (default-object? line-translation)
+            'DEFAULT
+            line-translation)))
+    (make-generic-port generic-output-template
+                      #f
+                      (make-output-buffer output-channel
+                                          output-buffer-size
+                                          line-translation))))
 
 (define (make-generic-i/o-port input-channel output-channel
-                              input-buffer-size output-buffer-size)
-  (make-generic-port generic-i/o-template
-                    (make-input-buffer input-channel input-buffer-size)
-                    (make-output-buffer output-channel output-buffer-size)))
+                              input-buffer-size output-buffer-size
+                              #!optional line-translation)
+  (let ((line-translation
+        (if (default-object? line-translation)
+            'DEFAULT
+            line-translation)))
+    (make-generic-port generic-i/o-template
+                      (make-input-buffer input-channel
+                                         input-buffer-size
+                                         line-translation)
+                      (make-output-buffer output-channel
+                                          output-buffer-size
+                                          line-translation))))
 
 (define (make-generic-port template input-buffer output-buffer)
   (let ((port (port/copy template (vector input-buffer output-buffer))))

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 45e8d37a2a1bed3a655f0ffbbdaf276835f6869f..b2e971b089cae24055ae04506d0af570af719c61 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.42 1995/01/31 19:34:41 cph Exp $
+$Id: io.scm,v 14.43 1995/04/14 19:06:15 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -574,7 +574,9 @@ MIT in each case. |#
 
 (define (make-output-buffer channel buffer-size #!optional line-translation)
   (let ((translation
-        (if (default-object? line-translation)
+        (if (or (default-object? line-translation)
+                ;; Kludge because of DEFAULT-OBJECT?:
+                (eq? 'DEFAULT line-translation))
             (os/default-end-of-line-translation)
             line-translation)))
     (with-values (lambda () (output-buffer-sizes translation buffer-size))
@@ -768,7 +770,9 @@ MIT in each case. |#
 
 (define (make-input-buffer channel buffer-size #!optional line-translation)
   (let* ((translation
-         (if (default-object? line-translation)
+         (if (or (default-object? line-translation)
+                 ;; Kludge because of DEFAULT-OBJECT?:
+                 (eq? 'DEFAULT line-translation))
              (os/default-end-of-line-translation)
              line-translation))
         (string-size (input-buffer-size translation buffer-size)))

diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm
index be44469f6c59da41e0514c62e5372ed702536970..e84c808d7380eab3deaf4478dc4b838fe7b79b96 100644 (file)
--- a/v7/src/runtime/process.scm
+++ b/v7/src/runtime/process.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.15 1992/03/24 23:30:08 cph Exp $
+$Id: process.scm,v 1.16 1995/04/14 19:06:04 cph Exp $
 
-Copyright (c) 1989-92 Massachusetts Institute of Technology
+Copyright (c) 1989-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -84,24 +84,33 @@ MIT in each case. |#
 
 (define (subprocess-remove! process key)
   (1d-table/remove! (subprocess-properties process) key))
-
-(define (subprocess-i/o-port process)
-  (without-interrupts
-   (lambda ()
-     (or (subprocess-%i/o-port process)
-        (let ((port
-               (let ((input-channel (subprocess-input-channel process))
-                     (output-channel (subprocess-output-channel process)))
-                 (if input-channel
-                     (if output-channel
-                         (make-generic-i/o-port input-channel output-channel
-                                                512 512)
-                         (make-generic-input-port input-channel 512))
-                     (if output-channel
-                         (make-generic-output-port output-channel 512)
-                         false)))))
-          (set-subprocess-%i/o-port! process port)
-          port)))))
+\f
+(define (subprocess-i/o-port process #!optional line-translation)
+  (let ((line-translation
+        (if (default-object? line-translation)
+            'DEFAULT
+            line-translation)))
+    (without-interrupts
+     (lambda ()
+       (or (subprocess-%i/o-port process)
+          (let ((port
+                 (let ((input-channel (subprocess-input-channel process))
+                       (output-channel (subprocess-output-channel process)))
+                   (if input-channel
+                       (if output-channel
+                           (make-generic-i/o-port input-channel output-channel
+                                                  512 512
+                                                  line-translation)
+                           (make-generic-input-port input-channel
+                                                    512
+                                                    line-translation))
+                       (if output-channel
+                           (make-generic-output-port output-channel
+                                                     512
+                                                     line-translation)
+                           false)))))
+            (set-subprocess-%i/o-port! process port)
+            port))))))
 
 (define (subprocess-input-port process)
   (let ((port (subprocess-i/o-port process)))