From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 14 Apr 1995 19:06:15 +0000 (+0000)
Subject: Add means to control line translation in subprocess port.  This is
X-Git-Tag: 20090517-FFI~6454
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=04d1960795b8adedc473e3059a393a637b06aa4b;p=mit-scheme.git

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 c3ba6ee9d..e5f0a0c8e 100644
--- 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)
 
-(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 45e8d37a2..b2e971b08 100644
--- 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 be44469f6..e84c808d7 100644
--- 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)))))
+
+(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)))