From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Feb 1992 23:01:37 +0000 (+0000)
Subject: Change MAKE-SUBPROCESS primitive to accept a working directory
X-Git-Tag: 20090517-FFI~9799
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5ecbf58fd8ab68f248144cb615118fd581736099;p=mit-scheme.git

Change MAKE-SUBPROCESS primitive to accept a working directory
argument for setting the working directory of the subprocess.
---

diff --git a/v7/src/microcode/osproc.h b/v7/src/microcode/osproc.h
index 5938ffd47..15f81ea36 100644
--- a/v7/src/microcode/osproc.h
+++ b/v7/src/microcode/osproc.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.5 1991/03/14 04:22:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.6 1992/02/11 23:01:04 cph Exp $
 
-Copyright (c) 1990-91 Massachusetts Institute of Technology
+Copyright (c) 1990-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -90,6 +90,7 @@ extern Tprocess EXFUN
    (CONST char * filename,
     CONST char ** argv,
     char ** env,
+    CONST char * working_directory,
     enum process_ctty_type ctty_type,
     char * ctty_name,
     enum process_channel_type channel_in_type,
diff --git a/v7/src/microcode/prosproc.c b/v7/src/microcode/prosproc.c
index ad30ab86b..f5a2e8f90 100644
--- a/v7/src/microcode/prosproc.c
+++ b/v7/src/microcode/prosproc.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.10 1992/01/20 17:30:50 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.11 1992/02/11 23:01:37 cph Exp $
 
-Copyright (c) 1990-1992 Massachusetts Institute of Technology
+Copyright (c) 1990-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -93,15 +93,14 @@ Seventh arg STDERR is the error channel for the subprocess.\n\
 {
   PRIMITIVE_HEADER (7);
   CHECK_ARG (2, string_vector_p);
-  if ((ARG_REF (3)) != SHARP_F)
-    CHECK_ARG (3, string_vector_p);
   {
     PTR position = dstack_position;
     CONST char * filename = (STRING_ARG (1));
     CONST char ** argv =
       ((CONST char **) (convert_string_vector (ARG_REF (2))));
-    char ** env =
-      (((ARG_REF (3)) == SHARP_F) ? 0 : (convert_string_vector (ARG_REF (3))));
+    SCHEME_OBJECT env_object = (ARG_REF (3));
+    char ** env = 0;
+    CONST char * working_directory = 0;
     enum process_ctty_type ctty_type;
     char * ctty_name = 0;
     enum process_channel_type channel_in_type;
@@ -111,6 +110,18 @@ Seventh arg STDERR is the error channel for the subprocess.\n\
     enum process_channel_type channel_err_type;
     Tchannel channel_err;
 
+    if ((PAIR_P (env_object)) && (STRING_P (PAIR_CDR (env_object))))
+      {
+	working_directory =
+	  ((CONST char *) (STRING_LOC ((PAIR_CDR (env_object)), 0)));
+	env_object = (PAIR_CAR (env_object));
+      }
+    if (env_object != SHARP_F)
+      {
+	if (! (string_vector_p (env_object)))
+	  error_wrong_type_arg (3);
+	env = (convert_string_vector (env_object));
+      }
     if ((ARG_REF (4)) == SHARP_F)
       ctty_type = process_ctty_type_none;
     else if ((ARG_REF (4)) == (LONG_TO_FIXNUM (-1)))
@@ -128,7 +139,7 @@ Seventh arg STDERR is the error channel for the subprocess.\n\
     {
       Tprocess process =
 	(OS_make_subprocess
-	 (filename, argv, env,
+	 (filename, argv, env, working_directory,
 	  ctty_type, ctty_name,
 	  channel_in_type, channel_in,
 	  channel_out_type, channel_out,
diff --git a/v7/src/microcode/uxproc.c b/v7/src/microcode/uxproc.c
index a5166fe77..40287c782 100644
--- a/v7/src/microcode/uxproc.c
+++ b/v7/src/microcode/uxproc.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.11 1991/06/15 00:40:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.12 1992/02/11 23:01:17 cph Exp $
 
-Copyright (c) 1990-91 Massachusetts Institute of Technology
+Copyright (c) 1990-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -241,6 +241,7 @@ DEFUN (OS_make_subprocess,
        CONST char * filename AND
        CONST char ** argv AND
        char ** envp AND
+       CONST char * working_directory AND
        enum process_ctty_type ctty_type AND
        char * ctty_name AND
        enum process_channel_type channel_in_type AND
@@ -308,6 +309,8 @@ DEFUN (OS_make_subprocess,
   /* Don't do `transaction_commit ()' here.  Because we used `vfork'
      to spawn the child, the side-effects that are performed by
      `transaction_commit' will occur in the parent as well. */
+  if (working_directory != 0)
+    UX_chdir (working_directory);
   {
     int in_fd = (-1);
     int out_fd = (-1);