Mercurial > emacs

changeset 934:1e2e41fd188b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
entered into RCS
author Richard M. Stallman <rms@gnu.org>
date Tue, 04 Aug 1992 21:22:43 +0000
parents bf0e6122c2a9
children 7aa20c8e89b7
files src/bytecode.c src/callproc.c
diffstat 2 files changed, 182 insertions(+), 364 deletions(-) [+]
line wrap: on
line diff
--- a/src/bytecode.c	Tue Aug 04 21:22:32 1992 +0000
+++ b/src/bytecode.c	Tue Aug 04 21:22:43 1992 +0000
@@ -1,11 +1,11 @@
 /* Execution of byte code produced by bytecomp.el.
-   Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 1, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -17,12 +17,14 @@
 along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-hacked on by jwz@lucid.com 17-jun-91
+hacked on by jwz 17-jun-91
   o  added a compile-time switch to turn on simple sanity checking;
   o  put back the obsolete byte-codes for error-detection;
+  o  put back fset, symbol-function, and read-char because I don't
+     see any reason for them to have been removed;
   o  added a new instruction, unbind_all, which I will use for 
      tail-recursion elimination;
-  o  made temp_output_buffer_show be called with the right number
+  o  made temp_output_buffer_show() be called with the right number
      of args;
   o  made the new bytecodes be called with args in the right order;
   o  added metering support.
@@ -32,49 +34,48 @@
   o  all conditionals now only do QUIT if they jump.
  */
 
+
 #include "config.h"
 #include "lisp.h"
 #include "buffer.h"
 #include "syntax.h"
 
-/*
- * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
- * debugging the byte compiler...)
- *
- * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
+/* Define this to enable some minor sanity checking
+   (useful for debugging the byte compiler...)
  */
-/* #define BYTE_CODE_SAFE */
-/* #define BYTE_CODE_METER */
+#define BYTE_CODE_SAFE
+
+/* Define this to enable generation of a histogram of byte-op usage.
+ */
+#define BYTE_CODE_METER
 
 
 #ifdef BYTE_CODE_METER
 
-Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
+Lisp_Object Vbyte_code_meter;
 int byte_metering_on;
 
-#define METER_2(code1, code2) \
+# define METER_2(code1,code2) \
   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
 	    ->contents[(code2)])
 
-#define METER_1(code) METER_2 (0, (code))
+# define METER_1(code) METER_2 (0,(code))
 
-#define METER_CODE(last_code, this_code)			\
-{								\
-  if (byte_metering_on)						\
-    {								\
-      if (METER_1 (this_code) != ((1<<VALBITS)-1))		\
-        METER_1 (this_code)++;					\
-      if (last_code						\
-          && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))	\
-        METER_2 (last_code, this_code)++;			\
-    }								\
-}
+# define METER_CODE(last_code, this_code) {			\
+  if (byte_metering_on) {					\
+     if (METER_1 (this_code) != ((1<<VALBITS)-1))		\
+        METER_1 (this_code) ++;					\
+     if (last_code &&						\
+        METER_2 (last_code,this_code) != ((1<<VALBITS)-1))	\
+        METER_2 (last_code,this_code) ++;			\
+  }								\
+ }
 
-#else /* no BYTE_CODE_METER */
+#else /* ! BYTE_CODE_METER */
 
-#define METER_CODE(last_code, this_code)
+# define meter_code(last_code, this_code)
 
-#endif /* no BYTE_CODE_METER */
+#endif
 
 
 Lisp_Object Qbytecode;
@@ -146,7 +147,7 @@
 #define Bbobp 0157
 #define Bcurrent_buffer 0160
 #define Bset_buffer 0161
-#define Bread_char 0162 /* No longer generated as of v19 */
+#define Bread_char 0162
 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
 
@@ -160,7 +161,6 @@
 #define Bdelete_region 0174
 #define Bnarrow_to_region 0175
 #define Bwiden 0176
-#define Bend_of_line 0177
 
 #define Bconstant2 0201
 #define Bgoto 0202
@@ -184,12 +184,6 @@
 
 #define Bunbind_all 0222
 
-#define Bset_marker 0223
-#define Bmatch_beginning 0224
-#define Bmatch_end 0225
-#define Bupcase 0226
-#define Bdowncase 0227
-
 #define Bstringeqlsign 0230
 #define Bstringlss 0231
 #define Bequal 0232
@@ -208,16 +202,6 @@
 #define Bnumberp 0247
 #define Bintegerp 0250
 
-#define BRgoto 0252
-#define BRgotoifnil 0253
-#define BRgotoifnonnil 0254
-#define BRgotoifnilelsepop 0255
-#define BRgotoifnonnilelsepop 0256
-
-#define BlistN 0257
-#define BconcatN 0260
-#define BinsertN 0261
-
 #define Bconstant 0300
 #define CONSTANTLIM 0100
 
@@ -301,10 +285,11 @@
     {
 #ifdef BYTE_CODE_SAFE
       if (stackp > stacke)
-	error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
+	error (
+     "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d",
 	       pc - XSTRING (string_saved)->data, stacke - stackp);
       if (stackp < stack)
-	error ("Byte code stack underflow (byte compiler bug), pc %d",
+	error ("Stack underflow in byte code (byte compiler bug), pc = %d",
 	       pc - XSTRING (string_saved)->data);
 #endif
 
@@ -405,19 +390,7 @@
 	case Bcall+4: case Bcall+5:
 	  op -= Bcall;
 	docall:
-	  DISCARD (op);
-#ifdef BYTE_CODE_METER
-	  if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
-	    {
-	      v1 = TOP;
-	      v2 = Fget (v1, Qbyte_code_meter);
-	      if (XTYPE (v2) == Lisp_Int)
-		{
-		  XSETINT (v2, XINT (v2) + 1);
-		  Fput (v1, Qbyte_code_meter, v2);
-		}
-	    }
-#endif
+	  DISCARD(op);
 	  TOP = Ffuncall (op + 1, &TOP);
 	  break;
 
@@ -438,7 +411,8 @@
 
 	case Bunbind_all:
 	  /* To unbind back to the beginning of this frame.  Not used yet,
-	     but will be needed for tail-recursion elimination.  */
+	     but wil be needed for tail-recursion elimination.
+	   */
 	  unbind_to (count, Qnil);
 	  break;
 
@@ -450,7 +424,7 @@
 
 	case Bgotoifnil:
 	  op = FETCH2;
-	  if (NILP (POP))
+	  if (NULL (POP))
 	    {
 	      QUIT;
 	      pc = XSTRING (string_saved)->data + op;
@@ -459,7 +433,7 @@
 
 	case Bgotoifnonnil:
 	  op = FETCH2;
-	  if (!NILP (POP))
+	  if (!NULL (POP))
 	    {
 	      QUIT;
 	      pc = XSTRING (string_saved)->data + op;
@@ -468,65 +442,22 @@
 
 	case Bgotoifnilelsepop:
 	  op = FETCH2;
-	  if (NILP (TOP))
-	    {
-	      QUIT;
-	      pc = XSTRING (string_saved)->data + op;
-	    }
-	  else DISCARD (1);
-	  break;
-
-	case Bgotoifnonnilelsepop:
-	  op = FETCH2;
-	  if (!NILP (TOP))
+	  if (NULL (TOP))
 	    {
 	      QUIT;
 	      pc = XSTRING (string_saved)->data + op;
 	    }
-	  else DISCARD (1);
-	  break;
-
-	case BRgoto:
-	  QUIT;
-	  pc += *pc - 127;
+	  else DISCARD(1);
 	  break;
 
-	case BRgotoifnil:
-	  if (NILP (POP))
-	    {
-	      QUIT;
-	      pc += *pc - 128;
-	    }
-	  pc++;
-	  break;
-
-	case BRgotoifnonnil:
-	  if (!NILP (POP))
+	case Bgotoifnonnilelsepop:
+	  op = FETCH2;
+	  if (!NULL (TOP))
 	    {
 	      QUIT;
-	      pc += *pc - 128;
-	    }
-	  pc++;
-	  break;
-
-	case BRgotoifnilelsepop:
-	  op = *pc++;
-	  if (NILP (TOP))
-	    {
-	      QUIT;
-	      pc += op - 128;
+	      pc = XSTRING (string_saved)->data + op;
 	    }
-	  else DISCARD (1);
-	  break;
-
-	case BRgotoifnonnilelsepop:
-	  op = *pc++;
-	  if (!NILP (TOP))
-	    {
-	      QUIT;
-	      pc += op - 128;
-	    }
-	  else DISCARD (1);
+	  else DISCARD(1);
 	  break;
 
 	case Breturn:
@@ -534,7 +465,7 @@
 	  goto exit;
 
 	case Bdiscard:
-	  DISCARD (1);
+	  DISCARD(1);
 	  break;
 
 	case Bdup:
@@ -598,7 +529,7 @@
 	    {
 	      if (CONSP (v1))
 		v1 = XCONS (v1)->cdr;
-	      else if (!NILP (v1))
+	      else if (!NULL (v1))
 		{
 		  immediate_quit = 0;
 		  v1 = wrong_type_argument (Qlistp, v1);
@@ -622,7 +553,7 @@
 	  break;
 
 	case Blistp:
-	  TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
+	  TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil;
 	  break;
 
 	case Beq:
@@ -636,21 +567,21 @@
 	  break;
 
 	case Bnot:
-	  TOP = NILP (TOP) ? Qt : Qnil;
+	  TOP = NULL (TOP) ? Qt : Qnil;
 	  break;
 
 	case Bcar:
 	  v1 = TOP;
 	docar:
 	  if (CONSP (v1)) TOP = XCONS (v1)->car;
-	  else if (NILP (v1)) TOP = Qnil;
+	  else if (NULL (v1)) TOP = Qnil;
 	  else Fcar (wrong_type_argument (Qlistp, v1));
 	  break;
 
 	case Bcdr:
 	  v1 = TOP;
 	  if (CONSP (v1)) TOP = XCONS (v1)->cdr;
-	  else if (NILP (v1)) TOP = Qnil;
+	  else if (NULL (v1)) TOP = Qnil;
 	  else Fcdr (wrong_type_argument (Qlistp, v1));
 	  break;
 
@@ -669,21 +600,15 @@
 	  break;
 
 	case Blist3:
-	  DISCARD (2);
+	  DISCARD(2);
 	  TOP = Flist (3, &TOP);
 	  break;
 
 	case Blist4:
-	  DISCARD (3);
+	  DISCARD(3);
 	  TOP = Flist (4, &TOP);
 	  break;
 
-	case BlistN:
-	  op = FETCH;
-	  DISCARD (op - 1);
-	  TOP = Flist (op, &TOP);
-	  break;
-
 	case Blength:
 	  TOP = Flength (TOP);
 	  break;
@@ -727,26 +652,20 @@
 	  break;
 
 	case Bconcat2:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fconcat (2, &TOP);
 	  break;
 
 	case Bconcat3:
-	  DISCARD (2);
+	  DISCARD(2);
 	  TOP = Fconcat (3, &TOP);
 	  break;
 
 	case Bconcat4:
-	  DISCARD (3);
+	  DISCARD(3);
 	  TOP = Fconcat (4, &TOP);
 	  break;
 
-	case BconcatN:
-	  op = FETCH;
-	  DISCARD (op - 1);
-	  TOP = Fconcat (op, &TOP);
-	  break;
-
 	case Bsub1:
 	  v1 = TOP;
 	  if (XTYPE (v1) == Lisp_Int)
@@ -797,7 +716,7 @@
 	  break;
 
 	case Bdiff:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fminus (2, &TOP);
 	  break;
 
@@ -813,32 +732,33 @@
 	  break;
 
 	case Bplus:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fplus (2, &TOP);
 	  break;
 
 	case Bmax:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fmax (2, &TOP);
 	  break;
 
 	case Bmin:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fmin (2, &TOP);
 	  break;
 
 	case Bmult:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Ftimes (2, &TOP);
 	  break;
 
 	case Bquo:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fquo (2, &TOP);
 	  break;
 
 	case Brem:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Frem (TOP, v1);
 	  break;
 
@@ -855,12 +775,6 @@
 	  TOP = Finsert (1, &TOP);
 	  break;
 
-	case BinsertN:
-	  op = FETCH;
-	  DISCARD (op - 1);
-	  TOP = Finsert (op, &TOP);
-	  break;
-
 	case Bpoint_max:
 	  XFASTINT (v1) = ZV;
 	  PUSH (v1);
@@ -928,24 +842,29 @@
 	  break;
 
 	case Bforward_char:
+	  /* This was wrong!  --jwz */
 	  TOP = Fforward_char (TOP);
 	  break;
 
 	case Bforward_word:
+	  /* This was wrong!  --jwz */
 	  TOP = Fforward_word (TOP);
 	  break;
 
 	case Bskip_chars_forward:
+	  /* This was wrong!  --jwz */
 	  v1 = POP;
 	  TOP = Fskip_chars_forward (TOP, v1);
 	  break;
 
 	case Bskip_chars_backward:
+	  /* This was wrong!  --jwz */
 	  v1 = POP;
 	  TOP = Fskip_chars_backward (TOP, v1);
 	  break;
 
 	case Bforward_line:
+	  /* This was wrong!  --jwz */
 	  TOP = Fforward_line (TOP);
 	  break;
 
@@ -961,11 +880,13 @@
 
 	case Bdelete_region:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fdelete_region (TOP, v1);
 	  break;
 
 	case Bnarrow_to_region:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fnarrow_to_region (TOP, v1);
 	  break;
 
@@ -973,49 +894,27 @@
 	  PUSH (Fwiden ());
 	  break;
 
-	case Bend_of_line:
-	  TOP = Fend_of_line (TOP);
-	  break;
-
-	case Bset_marker:
-	  v1 = POP;
-	  v2 = POP;
-	  TOP = Fset_marker (TOP, v2, v1);
-	  break;
-
-	case Bmatch_beginning:
-	  TOP = Fmatch_beginning (TOP);
-	  break;
-
-	case Bmatch_end:
-	  TOP = Fmatch_end (TOP);
-	  break;
-
-	case Bupcase:
-	  TOP = Fupcase (TOP);
-	  break;
-
-	case Bdowncase:
-	  TOP = Fdowncase (TOP);
-	break;
-
 	case Bstringeqlsign:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fstring_equal (TOP, v1);
 	  break;
 
 	case Bstringlss:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fstring_lessp (TOP, v1);
 	  break;
 
 	case Bequal:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fequal (TOP, v1);
 	  break;
 
 	case Bnthcdr:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fnthcdr (TOP, v1);
 	  break;
 
@@ -1033,11 +932,13 @@
 
 	case Bmember:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fmember (TOP, v1);
 	  break;
 
 	case Bassq:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fassq (TOP, v1);
 	  break;
 
@@ -1047,11 +948,13 @@
 
 	case Bsetcar:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fsetcar (TOP, v1);
 	  break;
 
 	case Bsetcdr:
 	  v1 = POP;
+	  /* This had args in the wrong order.  -- jwz */
 	  TOP = Fsetcdr (TOP, v1);
 	  break;
 
@@ -1072,12 +975,13 @@
 	  break;
 
 	case Bnconc:
-	  DISCARD (1);
+	  DISCARD(1);
 	  TOP = Fnconc (2, &TOP);
 	  break;
 
 	case Bnumberp:
-	  TOP = (NUMBERP (TOP) ? Qt : Qnil);
+	  TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float
+		 ? Qt : Qnil);
 	  break;
 
 	case Bintegerp:
@@ -1092,7 +996,7 @@
 	  error ("scan-buffer is an obsolete bytecode");
 	  break;
 	case Bmark:
-	  error ("mark is an obsolete bytecode");
+	  error("mark is an obsolete bytecode");
 	  break;
 #endif
 
@@ -1131,18 +1035,17 @@
 #ifdef BYTE_CODE_METER
 
   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
-   "A vector of vectors which holds a histogram of byte-code usage.");
+   "a vector of vectors which holds a histogram of byte-code usage.");
   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "");
 
   byte_metering_on = 0;
-  Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
-  Qbyte_code_meter = intern ("byte-code-meter");
-  staticpro (&Qbyte_code_meter);
+  Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0));
+
   {
     int i = 256;
     while (i--)
-      XVECTOR (Vbyte_code_meter)->contents[i] =
-	Fmake_vector (make_number (256), make_number (0));
+      XVECTOR(Vbyte_code_meter)->contents[i] =
+	Fmake_vector(make_number(256), make_number(0));
   }
 #endif
 }
--- a/src/callproc.c	Tue Aug 04 21:22:32 1992 +0000
+++ b/src/callproc.c	Tue Aug 04 21:22:43 1992 +0000
@@ -1,5 +1,5 @@
 /* Synchronous subprocess invocation for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -19,7 +19,6 @@
 
 
 #include <signal.h>
-#include <errno.h>
 
 #include "config.h"
 
@@ -58,11 +57,16 @@
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
 
-Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
+Lisp_Object Vexec_path, Vexec_directory;
 
 Lisp_Object Vshell_file_name;
 
+#ifndef MAINTAIN_ENVIRONMENT
+/* List of strings to append to front of environment of
+   all subprocesses when they are started.  */
+
 Lisp_Object Vprocess_environment;
+#endif
 
 /* True iff we are about to fork off a synchronous process or if we
    are waiting for it.  */
@@ -99,13 +103,13 @@
 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 If BUFFER is nil or 0, returns immediately with value nil.\n\
 Otherwise waits for PROGRAM to terminate\n\
-and returns a numeric exit status or a signal description string.\n\
+and returns a numeric exit status or a signal name as a string.\n\
 If you quit, the process is killed with SIGKILL.")
   (nargs, args)
      int nargs;
      register Lisp_Object *args;
 {
-  Lisp_Object display, infile, buffer, path, current_dir;
+  Lisp_Object display, buffer, path;
   int fd[2];
   int filefd;
   register int pid;
@@ -117,37 +121,34 @@
 #if 0
   int mask;
 #endif
+  struct gcpro gcpro1;
+
+  GCPRO1 (*args);
+  gcpro1.nvars = nargs;
+
   CHECK_STRING (args[0], 0);
 
-  if (nargs >= 2 && ! NILP (args[1]))
-    {
-      infile = Fexpand_file_name (args[1], current_buffer->directory);
-      CHECK_STRING (infile, 1);
-    }
+  if (nargs <= 1 || NULL (args[1]))
+    args[1] = build_string ("/dev/null");
   else
-#ifdef VMS
-    infile = build_string ("NLA0:");
-#else
-    infile = build_string ("/dev/null");
-#endif /* not VMS */
+    args[1] = Fexpand_file_name (args[1], current_buffer->directory);
+
+  CHECK_STRING (args[1], 1);
 
-  if (nargs >= 3)
-    {
-      register Lisp_Object tem;
+  {
+    register Lisp_Object tem;
+    buffer = tem = args[2];
+    if (nargs <= 2)
+      buffer = Qnil;
+    else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
+	       || XFASTINT (tem) == 0))
+      {
+	buffer = Fget_buffer (tem);
+	CHECK_BUFFER (buffer, 2);
+      }
+  }
 
-      buffer = tem = args[2];
-      if (!(EQ (tem, Qnil)
-	    || EQ (tem, Qt)
-	    || XFASTINT (tem) == 0))
-	{
-	  buffer = Fget_buffer (tem);
-	  CHECK_BUFFER (buffer, 2);
-	}
-    }
-  else 
-    buffer = Qnil;
-
-  display = nargs >= 4 ? args[3] : Qnil;
+  display = nargs >= 3 ? args[3] : Qnil;
 
   {
     register int i;
@@ -161,14 +162,14 @@
     new_argv[i - 3] = 0;
   }
 
-  filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
+  filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
   if (filefd < 0)
     {
-      report_file_error ("Opening process input file", Fcons (infile, Qnil));
+      report_file_error ("Opening process input file", Fcons (args[1], Qnil));
     }
   /* Search for program; barf if not found.  */
   openp (Vexec_path, args[0], "", &path, 1);
-  if (NILP (path))
+  if (NULL (path))
     {
       close (filefd);
       report_file_error ("Searching for program", Fcons (args[0], Qnil));
@@ -186,19 +187,19 @@
 #endif
     }
 
-  /* Make sure that the child will be able to chdir to the current
-     buffer's current directory.  We can't just have the child check
-     for an error when it does the chdir, since it's in a vfork.  */
-  current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
-  if (NILP (Ffile_accessible_directory_p (current_dir)))
-    report_file_error ("Setting current directory",
-		       Fcons (current_buffer->directory, Qnil));
-
   {
     /* child_setup must clobber environ in systems with true vfork.
        Protect it from permanent change.  */
     register char **save_environ = environ;
     register int fd1 = fd[1];
+    char **env;
+
+#ifdef MAINTAIN_ENVIRONMENT
+    env = (char **) alloca (size_of_current_environ ());
+    get_current_environ (env);
+#else
+    env = environ;
+#endif /* MAINTAIN_ENVIRONMENT */
 
 #if 0  /* Some systems don't have sigblock.  */
     mask = sigblock (sigmask (SIGCHLD));
@@ -218,7 +219,7 @@
 #else
         setpgrp (pid, pid);
 #endif /* USG */
-	child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
+	child_setup (filefd, fd1, fd1, new_argv, env, 0);
       }
 
 #if 0
@@ -243,17 +244,13 @@
   if (XTYPE (buffer) == Lisp_Int)
     {
 #ifndef subprocesses
-      /* If Emacs has been built with asynchronous subprocess support,
-	 we don't need to do this, I think because it will then have
-	 the facilities for handling SIGCHLD.  */
       wait_without_blocking ();
 #endif /* subprocesses */
+
+      UNGCPRO;
       return Qnil;
     }
 
-  synch_process_death = 0;
-  synch_process_retcode = 0;
-
   record_unwind_protect (call_process_cleanup,
 			 Fcons (make_number (fd[0]), make_number (pid)));
 
@@ -270,9 +267,9 @@
     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
       {
 	immediate_quit = 0;
-	if (!NILP (buffer))
+	if (!NULL (buffer))
 	  insert (buf, nread);
-	if (!NILP (display) && INTERACTIVE)
+	if (!NULL (display) && INTERACTIVE)
 	  redisplay_preserve_echo_area ();
 	immediate_quit = 1;
 	QUIT;
@@ -288,6 +285,8 @@
 
   unbind_to (count, Qnil);
 
+  UNGCPRO;
+
   if (synch_process_death)
     return build_string (synch_process_death);
   return make_number (synch_process_retcode);
@@ -311,7 +310,7 @@
 Remaining args are passed to PROGRAM at startup as command args.\n\
 If BUFFER is nil, returns immediately with value nil.\n\
 Otherwise waits for PROGRAM to terminate\n\
-and returns a numeric exit status or a signal description string.\n\
+and returns a numeric exit status or a signal name as a string.\n\
 If you quit, the process is killed with SIGKILL.")
   (nargs, args)
      int nargs;
@@ -320,6 +319,10 @@
   register Lisp_Object filename_string, start, end;
   char tempfile[20];
   int count = specpdl_ptr - specpdl;
+  struct gcpro gcpro1;
+
+  GCPRO1 (*args);
+  gcpro1.nvars = 2;
 
 #ifdef VMS
   strcpy (tempfile, "tmp:emacsXXXXXX.");
@@ -334,12 +337,13 @@
   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
   record_unwind_protect (delete_temp_file, filename_string);
 
-  if (!NILP (args[3]))
+  if (!NULL (args[3]))
     Fdelete_region (start, end);
 
   args[3] = filename_string;
   Fcall_process (nargs - 2, args + 2);
 
+  UNGCPRO;
   return unbind_to (count, Qnil);
 }
 
@@ -358,21 +362,14 @@
    ENV is the environment for the subprocess.
 
    SET_PGRP is nonzero if we should put the subprocess into a separate
-   process group.  
+   process group.  */
 
-   CURRENT_DIR is an elisp string giving the path of the current
-   directory the subprocess should have.  Since we can't really signal
-   a decent error from within the child, this should be verified as an
-   executable directory by the parent.  */
-
-child_setup (in, out, err, new_argv, set_pgrp, current_dir)
+child_setup (in, out, err, new_argv, env, set_pgrp)
      int in, out, err;
      register char **new_argv;
+     char **env;
      int set_pgrp;
-     Lisp_Object current_dir;
 {
-  char **env;
-
   register int pid = getpid();
 
   setpriority (PRIO_PROCESS, pid, 0);
@@ -387,25 +384,24 @@
      If using vfork and C_ALLOCA it is safe because that changes
      the superior's static variables as if the superior had done alloca
      and will be cleaned up in the usual way.  */
-  {
-    register unsigned char *temp;
-    register int i;
 
-    i = XSTRING (current_dir)->size;
-    temp = (unsigned char *) alloca (i + 2);
-    bcopy (XSTRING (current_dir)->data, temp, i);
-    if (temp[i - 1] != '/') temp[i++] = '/';
-    temp[i] = 0;
+  if (XTYPE (current_buffer->directory) == Lisp_String)
+    {
+      register unsigned char *temp;
+      register int i;
 
-    /* We can't signal an Elisp error here; we're in a vfork.  Since
-       the callers check the current directory before forking, this
-       should only return an error if the directory's permissions
-       are changed between the check and this chdir, but we should
-       at least check.  */
-    if (chdir (temp) < 0)
-      exit (errno);
-  }
+      i = XSTRING (current_buffer->directory)->size;
+      temp = (unsigned char *) alloca (i + 2);
+      bcopy (XSTRING (current_buffer->directory)->data, temp, i);
+      if (temp[i - 1] != '/') temp[i++] = '/';
+      temp[i] = 0;
+      /* Switch to that directory, and report any error.  */
+      if (chdir (temp) < 0)
+	report_file_error ("In chdir",
+			   Fcons (current_buffer->directory, Qnil));
+    }
 
+#ifndef MAINTAIN_ENVIRONMENT
   /* Set `env' to a vector of the strings in Vprocess_environment.  */
   {
     register Lisp_Object tem;
@@ -422,7 +418,7 @@
     /* new_length + 1 to include terminating 0 */
     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
 
-    /* Copy the Vprocess_alist strings into new_env.  */
+    /* Copy the env strings into new_env.  */
     for (tem = Vprocess_environment;
 	 (XTYPE (tem) == Lisp_Cons
 	  && XTYPE (XCONS (tem)->car) == Lisp_String);
@@ -430,6 +426,7 @@
       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
     *new_env = 0;
   }
+#endif /* Not MAINTAIN_ENVIRONMENT */
 
   close (0);
   close (1);
@@ -442,11 +439,6 @@
   close (out);
   close (err);
 
-#ifdef USG
-  setpgrp ();			/* No arguments but equivalent in this case */
-#else
-  setpgrp (pid, pid);
-#endif /* USG */
   setpgrp_of_tty (pid);
 
 #ifdef vipc
@@ -464,111 +456,38 @@
   _exit (1);
 }
 
-static int
-getenv_internal (var, varlen, value, valuelen)
-     char *var;
-     int varlen;
-     char **value;
-     int *valuelen;
-{
-  Lisp_Object scan;
-
-  for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
-    {
-      Lisp_Object entry = XCONS (scan)->car;
-      
-      if (XTYPE (entry) == Lisp_String
-	  && XSTRING (entry)->size > varlen
-	  && XSTRING (entry)->data[varlen] == '='
-	  && ! bcmp (XSTRING (entry)->data, var, varlen))
-	{
-	  *value    = (char *) XSTRING (entry)->data + (varlen + 1);
-	  *valuelen = XSTRING (entry)->size - (varlen + 1);
-	  return 1;
-	}
-    }
-
-  return 0;
-}
-
-DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
-  "Return the value of environment variable VAR, as a string.\n\
-VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
-This function consults the variable ``process-environment'' for its value.")
-  (var)
-     Lisp_Object var;
-{
-  char *value;
-  int valuelen;
-
-  CHECK_STRING (var, 0);
-  if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
-		       &value, &valuelen))
-    return make_string (value, valuelen);
-  else
-    return Qnil;
-}
-
-/* A version of getenv that consults process_environment, easily
-   callable from C.  */
-char *
-egetenv (var)
-     char *var;
-{
-  char *value;
-  int valuelen;
-
-  if (getenv_internal (var, strlen (var), &value, &valuelen))
-    return value;
-  else
-    return 0;
-}
-
 #endif /* not VMS */
 
 init_callproc ()
 {
   register char * sh;
   register char **envp;
-  Lisp_Object tempdir;
+  Lisp_Object execdir;
 
-  {
-    char *data_dir = egetenv ("EMACSDATA");
-    
-    Vdata_directory =
-      Ffile_name_as_directory
-	(build_string (data_dir ? data_dir : PATH_DATA));
-  }
-
-  /* Check the EMACSPATH environment variable, defaulting to the
-     PATH_EXEC path from paths.h.  */
-  Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+  /* Turn PATH_EXEC into a path.  `==' is just a string which we know
+     will not be the name of an environment variable.  */
+  Vexec_path = decode_env_path ("==", PATH_EXEC);
   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 
-  tempdir = Fdirectory_file_name (Vexec_directory);
-  if (access (XSTRING (tempdir)->data, 0) < 0)
+  execdir = Fdirectory_file_name (Vexec_directory);
+  if (access (XSTRING (execdir)->data, 0) < 0)
     {
-      printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
+      printf ("Warning: executable/documentation dir (%s) does not exist.\n",
 	      XSTRING (Vexec_directory)->data);
       sleep (2);
     }
 
-  tempdir = Fdirectory_file_name (Vdata_directory);
-  if (access (XSTRING (tempdir)->data, 0) < 0)
-    {
-      printf ("Warning: arch-independent data dir (%s) does not exist.\n",
-	      XSTRING (Vdata_directory)->data);
-      sleep (2);
-    }
-
 #ifdef VMS
   Vshell_file_name = build_string ("*dcl*");
 #else
-  sh = (char *) getenv ("SHELL");
+  sh = (char *) egetenv ("SHELL");
   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 #endif
 
+#ifndef MAINTAIN_ENVIRONMENT
+  /* The equivalent of this operation was done
+     in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
   Vprocess_environment = Qnil;
 #ifndef CANNOT_DUMP
   if (initialized)
@@ -576,6 +495,7 @@
     for (envp = environ; *envp; envp++)
       Vprocess_environment = Fcons (build_string (*envp),
 				    Vprocess_environment);
+#endif /* MAINTAIN_ENVIRONMENT */
 }
 
 syms_of_callproc ()
@@ -589,22 +509,17 @@
 Each element is a string (directory name) or nil (try default directory).");
 
   DEFVAR_LISP ("exec-directory", &Vexec_directory,
-    "Directory of architecture-dependent files that come with GNU Emacs,\n\
-especially executable programs intended for Emacs to invoke.");
+    "Directory that holds programs that come with GNU Emacs,\n\
+intended for Emacs to invoke.");
 
-  DEFVAR_LISP ("data-directory", &Vdata_directory,
-    "Directory of architecture-independent files that come with GNU Emacs,\n\
-intended for Emacs to use.");
-
+#ifndef MAINTAIN_ENVIRONMENT
   DEFVAR_LISP ("process-environment", &Vprocess_environment,
-    "List of environment variables for subprocesses to inherit.\n\
-Each element should be a string of the form ENVVARNAME=VALUE.\n\
-The environment which Emacs inherits is placed in this variable\n\
-when Emacs starts.");
+    "List of strings to append to environment of subprocesses that are started.\n\
+Each string should have the format ENVVARNAME=VALUE.");
+#endif
 
 #ifndef VMS
   defsubr (&Scall_process);
 #endif
-  defsubr (&Sgetenv);
   defsubr (&Scall_process_region);
 }