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 5938ffd4774159a0282bb5504fa347060a3b4648..15f81ea36d419c71187bf3de5be5497ea8598785 100644 (file)
--- 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 ad30ab86bb1550e5469502f9719d5f06da907ff4..f5a2e8f90a440636e6d3c24c23cc4fe971a3dc25 100644 (file)
--- 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 a5166fe77525043c70cbb2dcf774f16b3765a09f..40287c782898acb6f32531a4faeb1feb07983c43 100644 (file)
--- 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);