From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Oct 1997 05:16:01 +0000 (+0000)
Subject: Change MAKE-SUBPROCESS to define new interface to allow OS-specific
X-Git-Tag: 20090517-FFI~4986
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b5ebd0a881660d91ab10b136111251c59a49ca59;p=mit-scheme.git

Change MAKE-SUBPROCESS to define new interface to allow OS-specific
code to do the work of starting the subprocess.
---

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index 321ea5821..d0ad34721 100644
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.29 1996/05/03 07:40:33 cph Exp $
+$Id: os2prm.scm,v 1.30 1997/10/22 05:16:01 cph Exp $
 
-Copyright (c) 1994-96 Massachusetts Institute of Technology
+Copyright (c) 1994-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -415,4 +415,10 @@ MIT in each case. |#
 	    (vector-ref os2/select-result-values result))))))
 
 (define os2/select-result-values
-  '#(INPUT-AVAILABLE #F INTERRUPT PROCESS-STATUS-CHANGE))
\ No newline at end of file
+  '#(INPUT-AVAILABLE #F INTERRUPT PROCESS-STATUS-CHANGE))
+
+(define (os/make-subprocess filename arguments environment working-directory
+			    ctty stdin stdout stderr)
+  ((ucode-primitive make-subprocess 7) filename arguments
+				       (cons environment working-directory)
+				       ctty stdin stdout stderr))
\ No newline at end of file
diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm
index 9b108f0c2..46f732aa3 100644
--- a/v7/src/runtime/process.scm
+++ b/v7/src/runtime/process.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: process.scm,v 1.18 1995/09/13 21:25:13 cph Exp $
+$Id: process.scm,v 1.19 1997/10/22 05:15:41 cph Exp $
 
-Copyright (c) 1989-95 Massachusetts Institute of Technology
+Copyright (c) 1989-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -141,7 +141,8 @@ MIT in each case. |#
 		   (else
 		    (error:wrong-type-argument stdio "process I/O channel"
 					       'MAKE-SUBPROCESS))))
-	   (let ((ctty
+	   (let ((working-directory #f)
+		 (ctty
 		  (cond ((eq? ctty 'BACKGROUND) -1)
 			((eq? ctty 'FOREGROUND) -2)
 			((or (not ctty) (string? ctty)) ctty)
@@ -153,12 +154,16 @@ MIT in each case. |#
 		 (stdin (convert-stdio-arg stdin))
 		 (stdout (convert-stdio-arg stdout))
 		 (stderr (convert-stdio-arg stderr)))
+	     (if (pair? environment)
+		 (begin
+		   (set! working-directory (cdr environment))
+		   (set! environment (car environment))))
 	     (without-interrupts
 	      (lambda ()
 		(let ((index
-		       ((ucode-primitive make-subprocess 7)
-			filename arguments environment
-			ctty stdin stdout stderr)))
+		       (os/make-subprocess filename arguments environment
+					   working-directory ctty
+					   stdin stdout stderr)))
 		  (let ((process
 			 (%make-subprocess filename arguments index pty-master
 					   input-channel output-channel)))
diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 2a1794eaf..25cc72aa1 100644
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.46 1996/10/07 18:13:40 cph Exp $
+$Id: unxprm.scm,v 1.47 1997/10/22 05:15:55 cph Exp $
 
-Copyright (c) 1988-96 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -462,4 +462,10 @@ MIT in each case. |#
 	     (loop (cdr rv)))
 	    (else
 	     (set-car! rv v))))
-    (set-interrupt-enables! interrupt-mask)))
\ No newline at end of file
+    (set-interrupt-enables! interrupt-mask)))
+
+(define (os/make-subprocess filename arguments environment working-directory
+			    ctty stdin stdout stderr)
+  ((ucode-primitive make-subprocess 7) filename arguments
+				       (cons environment working-directory)
+				       ctty stdin stdout stderr))
\ No newline at end of file