/* 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,
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.
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 this to enable generation of a histogram of byte-op usage.
*/
-/* #define BYTE_CODE_SAFE */
-/* #define BYTE_CODE_METER */
+#define BYTE_CODE_METER
\f
#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_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_1(code) METER_2 (0,(code))
-#else /* no BYTE_CODE_METER */
+# 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)
+#else /* ! BYTE_CODE_METER */
-#endif /* no BYTE_CODE_METER */
+# define meter_code(last_code, this_code)
+
+#endif
\f
Lisp_Object Qbytecode;
#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 */
#define Bdelete_region 0174
#define Bnarrow_to_region 0175
#define Bwiden 0176
-#define Bend_of_line 0177
#define Bconstant2 0201
#define Bgoto 0202
#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
#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
\f
{
#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
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;
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;
case Bgotoifnil:
op = FETCH2;
- if (NILP (POP))
+ if (NULL (POP))
{
QUIT;
pc = XSTRING (string_saved)->data + op;
case Bgotoifnonnil:
op = FETCH2;
- if (!NILP (POP))
+ if (!NULL (POP))
{
QUIT;
pc = XSTRING (string_saved)->data + op;
case Bgotoifnilelsepop:
op = FETCH2;
- if (NILP (TOP))
+ if (NULL (TOP))
{
QUIT;
pc = XSTRING (string_saved)->data + op;
}
- else DISCARD (1);
+ 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;
- break;
-
- case BRgotoifnil:
- if (NILP (POP))
- {
- QUIT;
- pc += *pc - 128;
- }
- pc++;
- break;
-
- case BRgotoifnonnil:
- if (!NILP (POP))
- {
- QUIT;
- pc += *pc - 128;
- }
- pc++;
- break;
-
- case BRgotoifnilelsepop:
- op = *pc++;
- if (NILP (TOP))
- {
- QUIT;
- pc += op - 128;
- }
- else DISCARD (1);
- break;
-
- case BRgotoifnonnilelsepop:
- op = *pc++;
- if (!NILP (TOP))
- {
- QUIT;
- pc += op - 128;
- }
- else DISCARD (1);
+ else DISCARD(1);
break;
case Breturn:
goto exit;
case Bdiscard:
- DISCARD (1);
+ DISCARD(1);
break;
case Bdup:
{
if (CONSP (v1))
v1 = XCONS (v1)->cdr;
- else if (!NILP (v1))
+ else if (!NULL (v1))
{
immediate_quit = 0;
v1 = wrong_type_argument (Qlistp, v1);
break;
case Blistp:
- TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
+ TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil;
break;
case Beq:
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;
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;
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)
break;
case Bdiff:
- DISCARD (1);
+ DISCARD(1);
TOP = Fminus (2, &TOP);
break;
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;
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);
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;
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;
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;
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;
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;
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:
error ("scan-buffer is an obsolete bytecode");
break;
case Bmark:
- error ("mark is an obsolete bytecode");
+ error("mark is an obsolete bytecode");
break;
#endif
#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
}
/* 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.
#include <signal.h>
-#include <errno.h>
#include "config.h"
#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. */
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;
#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);
- if (nargs >= 3)
- {
- register Lisp_Object tem;
-
- 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;
+ CHECK_STRING (args[1], 1);
+
+ {
+ 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);
+ }
+ }
- display = nargs >= 4 ? args[3] : Qnil;
+ display = nargs >= 3 ? args[3] : Qnil;
{
register int i;
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));
#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));
#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
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)));
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;
unbind_to (count, Qnil);
+ UNGCPRO;
+
if (synch_process_death)
return build_string (synch_process_death);
return make_number (synch_process_retcode);
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;
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.");
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);
}
\f
ENV is the environment for the subprocess.
SET_PGRP is nonzero if we should put the subprocess into a separate
- 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. */
+ process group. */
-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);
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;
-
- /* 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);
- }
+ if (XTYPE (current_buffer->directory) == Lisp_String)
+ {
+ register unsigned char *temp;
+ register int i;
+
+ 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;
/* 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);
*new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
*new_env = 0;
}
+#endif /* Not MAINTAIN_ENVIRONMENT */
close (0);
close (1);
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
_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 */
\f
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)
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
+#endif /* MAINTAIN_ENVIRONMENT */
}
syms_of_callproc ()
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.");
-
- DEFVAR_LISP ("data-directory", &Vdata_directory,
- "Directory of architecture-independent files that come with GNU Emacs,\n\
-intended for Emacs to use.");
+ "Directory that holds programs that come with GNU Emacs,\n\
+intended for Emacs to invoke.");
+#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);
}
HCoop / bpt / emacs.git / commitdiff