comparison src/process.c @ 1594:b476a97ad17e

* systty.h, process.c, buffer.h, callproc.c, sysdep.c, dired.c: Added VMS changes from Roland Roberts. * process.c (read_process_output): Save, widen, insert the process output, and then restore the restriction if inserting text outside the visible region. * process.c (Fstart_process): Establish an unwind-protect to remove PROC from the process list if an error occurs while starting it. (start_process_unwind): New function to help with that. (create_process): There's no need to explicitly call remove_process if the fork fails; the record_unwind_protect in Fstart_process will take care of it. * process.c (wait_reading_process_input): Test the C preprocessor symbol "ultrix", not "__ultrix__" to see if we should ignore ENOMEM errors from select. * process.c (process_send_signal): On systems which have both the TIOCGETC and TCGETA ioctls, just use the former. * s/bsd4-2.h, s/bsd4-3.h: #define SIGNALS_VIA_CHARACTERS. * process.c (process_send_signal): Put all the code for sending signals via characters in a #ifdef SIGNALS_VIA_CHARACTERS. Decide whether to use the Berkeley-style or SYSV-style ioctls by seeing which ioctl commands are #defined. * process.c (process_send_signal): Doc fix.

1593:a3862c6dfcd0

#endif /* no WAITTYPE */
#else /* VMS */

/* For the CMU PTY driver + */
#define DCL_PROMPT "$ "

#include <ssdef.h>
#include <iodef.h>
#include <clidef.h>
#include "vmsproc.h"
#endif /* VMS */

  decode_status (status, &symbol, &code, &coredump);

  if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
    {
      string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
      string2 = build_string (coredump ? " (core dumped)\n" : "\n");
      XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
      return concat2 (string, string2);
    }
  else if (EQ (symbol, Qexit))

	{
	  Lisp_Object tem;
	  tem = Fcar (Fcdr (p->status));
#ifdef VMS
	  if (XINT (tem) < NSIG)
	    write_string (sys_siglist [XINT (tem)], -1);
	  else
#endif
	    Fprinc (symbol, Qnil);
	}
      else if (NETCONN_P (proc))

  ()
{
  return Fmapcar (Qcdr, Vprocess_alist);
}

DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
  "Start a program in a subprocess.  Return the process object for it.\n\
Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
NAME is name for process.  It is modified if necessary to make it unique.\n\
BUFFER is the buffer or (buffer-name) to associate with the process.\n\

  int len;
#else
  register unsigned char **new_argv;
#endif
  register int i;

  buffer = args[1];
  if (!NILP (buffer))
    buffer = Fget_buffer_create (buffer);

      tem = args[i];
      CHECK_STRING (tem, i);
      strcat (new_argv, " ");
      strcat (new_argv, XSTRING (tem)->data);
    }
#else /* not VMS */
  new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));

  for (i = 3; i < nargs; i++)
    {

      new_argv[0] = XSTRING (tem)->data;
    }
#endif /* not VMS */

  proc = make_process (name);

  XPROCESS (proc)->childp = Qt;
  XPROCESS (proc)->command_channel_p = Qnil;
  XPROCESS (proc)->buffer = buffer;
  XPROCESS (proc)->sentinel = Qnil;
  XPROCESS (proc)->filter = Qnil;
  XPROCESS (proc)->command = Flist (nargs - 2, args + 2);

  create_process (proc, new_argv);

  return proc;
}

SIGTYPE
create_process_1 (signo)
     int signo;
{

      }
    environ = save_environ;
  }

  if (pid < 0)
    {
      remove_process (process);
      report_file_error ("Doing vfork", Qnil);
    }

  XFASTINT (XPROCESS (process)->pid) = pid;

  FD_SET (inchannel, &input_wait_mask);

  /* If the subfork execv fails, and it exits,

	break;
      if (nfds < 0)
	{
	  if (xerrno == EINTR)
	    FD_ZERO (&Available);
#ifdef __ultrix__
	  /* Ultrix select seems to return ENOMEM when it is interrupted.
	     Treat it just like EINTR.  Bleah.  -JimB  */
	  else if (xerrno == ENOMEM)
	    FD_ZERO (&Available);
#endif
#ifdef ALLIANT
	  /* This happens for no known reason on ALLIANT.

    }

  /* If no filter, write into buffer if it isn't dead.  */
  if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
    {
      Lisp_Object tem;

      Fset_buffer (p->buffer);
      opoint = point;

      /* Insert new output into buffer
	 at the current end-of-output marker,
	 thus preserving logical ordering of input and output.  */
      if (XMARKER (p->mark)->buffer)
	SET_PT (marker_position (p->mark));
      else
	SET_PT (ZV);
      if (point <= opoint)
	opoint += nchars;

      tem = current_buffer->read_only;
      current_buffer->read_only = Qnil;
      /* Insert before markers in case we are inserting where
	 the buffer's mark is, and the user's next command is Meta-y.  */
      insert_before_markers (chars, nchars);
      current_buffer->read_only = tem;
      Fset_marker (p->mark, make_number (point), p->buffer);
      update_mode_lines++;

      SET_PT (opoint);
      set_buffer_internal (old);
    }
#ifdef VMS
  start_vms_process_read (vs);

/* send a signal number SIGNO to PROCESS.
   CURRENT_GROUP means send to the process group that currently owns
   the terminal being used to communicate with PROCESS.
   This is used for various commands in shell mode.
   If NOMSG is zero, insert signal-announcements into process's buffers
   right away.  */

static void
process_send_signal (process, signo, current_group, nomsg)
     Lisp_Object process;
     int signo;

    current_group = Qnil;

  /* If we are using pgrps, get a pgrp number and make it negative.  */
  if (!NILP (current_group))
    {
      /* If possible, send signals to the entire pgrp
	 by sending an input character to it.  */
#if defined (TIOCGLTC) && defined (TIOCGETC)
      struct tchars c;
      struct ltchars lc;

      switch (signo)
	{

#ifdef SIGTSTP
	case SIGTSTP:
	  ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
	  send_process (proc, &lc.t_suspc, 1);
	  return;
#endif /* SIGTSTP */
	}
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
      /* It is possible that the following code would work
	 on other kinds of USG systems, not just on the IRIS.
	 This should be tried in Emacs 19.  */
#if defined (USG)
      struct termio t;
      switch (signo)
	{
	case SIGINT:
	  ioctl (XFASTINT (p->infd), TCGETA, &t);

#ifdef SIGTSTP
	case SIGTSTP:
	  ioctl (XFASTINT (p->infd), TCGETA, &t);
	  send_process (proc, &t.c_cc[VSWTCH], 1);
	  return;
#endif
	}
#endif /* ! defined (USG) */

#ifdef TIOCGPGRP 
      /* Get the pgrp using the tty itself, if we have that.
	 Otherwise, use the pty to get the pgrp.
	 On pfa systems, [e-mail] writes:
	 "TICGPGRP symbol defined in sys/ioctl.h at E50.
	  But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
	 His patch indicates that if TIOCGPGRP returns an error, then
	 we should just assume that p->pid is also the process group id.  */
      {
	int err;

      }
      if (gid == -1)
	no_pgrp = 1;
      else
	gid = - gid;
#else /* ! defined (TIOCGPGRP ) */
      /* Can't select pgrps on this system, so we know that
	 the child itself heads the pgrp.  */
      gid = - XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
    }

	  /* Report the status of the synchronous process.  */
	  if (WIFEXITED (w))
	    synch_process_retcode = WRETCODE (w);
	  else if (WIFSIGNALED (w))
	    synch_process_death = sys_siglist[WTERMSIG (w)];
	}

      /* On some systems, we must return right away.
	 If any more processes want to signal us, we will
	 get another signal.

1594:b476a97ad17e

#endif /* no WAITTYPE */
#else /* VMS */

/* For the CMU PTY driver + */
#define DCL_PROMPT "$ "
/* This is a hack.  I have no idea what needs to go here, but this */
/* will get it to compile.  We can fix it later.  rbr */
#define WAITTYPE int
#include <ssdef.h>
#include <iodef.h>
#include <clidef.h>
#include "vmsproc.h"
#endif /* VMS */

  decode_status (status, &symbol, &code, &coredump);

  if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
    {
#ifndef VMS
      string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
#else
      string = build_string (code < NSIG ? sys_errlist[code] : "unknown");
#endif
      string2 = build_string (coredump ? " (core dumped)\n" : "\n");
      XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
      return concat2 (string, string2);
    }
  else if (EQ (symbol, Qexit))

	{
	  Lisp_Object tem;
	  tem = Fcar (Fcdr (p->status));
#ifdef VMS
	  if (XINT (tem) < NSIG)
	    write_string (sys_errlist [XINT (tem)], -1);
	  else
#endif
	    Fprinc (symbol, Qnil);
	}
      else if (NETCONN_P (proc))

  ()
{
  return Fmapcar (Qcdr, Vprocess_alist);
}

/* Starting asynchronous inferior processes.  */

static Lisp_Object start_process_unwind ();

DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
  "Start a program in a subprocess.  Return the process object for it.\n\
Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
NAME is name for process.  It is modified if necessary to make it unique.\n\
BUFFER is the buffer or (buffer-name) to associate with the process.\n\

  int len;
#else
  register unsigned char **new_argv;
#endif
  register int i;
  int count = specpdl_ptr - specpdl;

  buffer = args[1];
  if (!NILP (buffer))
    buffer = Fget_buffer_create (buffer);

      tem = args[i];
      CHECK_STRING (tem, i);
      strcat (new_argv, " ");
      strcat (new_argv, XSTRING (tem)->data);
    }
  /* Need to add code here to check for program existence on VMS */
  
#else /* not VMS */
  new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));

  for (i = 3; i < nargs; i++)
    {

      new_argv[0] = XSTRING (tem)->data;
    }
#endif /* not VMS */

  proc = make_process (name);
  /* If an error occurs and we can't start the process, we want to
     remove it from the process list.  This means that each error
     check in create_process doesn't need to call remove_process
     itself; it's all taken care of here.  */
  record_unwind_protect (start_process_unwind, proc);

  XPROCESS (proc)->childp = Qt;
  XPROCESS (proc)->command_channel_p = Qnil;
  XPROCESS (proc)->buffer = buffer;
  XPROCESS (proc)->sentinel = Qnil;
  XPROCESS (proc)->filter = Qnil;
  XPROCESS (proc)->command = Flist (nargs - 2, args + 2);

  create_process (proc, new_argv);

  return unbind_to (count, proc);
}

/* This function is the unwind_protect form for Fstart_process.  If
   PROC doesn't have its pid set, then we know someone has signalled
   an error and the process wasn't started successfully, so we should
   remove it from the process list.  */
static Lisp_Object
start_process_unwind (proc)
     Lisp_Object proc;
{
  if (XTYPE (proc) != Lisp_Process)
    abort ();

  /* Was PROC started successfully?  */
  if (XPROCESS (proc)->pid <= 0)
    remove_process (proc);

  return Qnil;
}


SIGTYPE
create_process_1 (signo)
     int signo;
{

      }
    environ = save_environ;
  }

  if (pid < 0)
    report_file_error ("Doing vfork", Qnil);
  
  XFASTINT (XPROCESS (process)->pid) = pid;

  FD_SET (inchannel, &input_wait_mask);

  /* If the subfork execv fails, and it exits,

	break;
      if (nfds < 0)
	{
	  if (xerrno == EINTR)
	    FD_ZERO (&Available);
#ifdef ultrix
	  /* Ultrix select seems to return ENOMEM when it is
	     interrupted.  Treat it just like EINTR.  Bleah.  Note
	     that we want to test for the "ultrix" CPP symbol, not
	     "__ultrix__"; the latter is only defined under GCC, but
	     not by DEC's bundled CC.  -JimB  */
	  else if (xerrno == ENOMEM)
	    FD_ZERO (&Available);
#endif
#ifdef ALLIANT
	  /* This happens for no known reason on ALLIANT.

    }

  /* If no filter, write into buffer if it isn't dead.  */
  if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
    {
      Lisp_Object old_read_only;
      Lisp_Object old_begv, old_zv;

      Fset_buffer (p->buffer);
      opoint = point;
      old_read_only = current_buffer->read_only;
      XFASTINT (old_begv) = BEGV;
      XFASTINT (old_zv) = ZV;

      current_buffer->read_only = Qnil;

      /* Insert new output into buffer
	 at the current end-of-output marker,
	 thus preserving logical ordering of input and output.  */
      if (XMARKER (p->mark)->buffer)
	SET_PT (marker_position (p->mark));
      else
	SET_PT (ZV);

      /* If the output marker is outside of the visible region, save
	 the restriction and widen.  */
      if (! (BEGV <= point && point <= ZV))
	Fwiden ();

      /* Make sure opoint floats ahead of any new text, just as point
	 would.  */
      if (point <= opoint)
	opoint += nchars;

      /* Insert after old_begv, but before old_zv.  */
      if (point < XFASTINT (old_begv))
	XFASTINT (old_begv) += nchars;
      if (point <= XFASTINT (old_zv))
	XFASTINT (old_zv) += nchars;

      /* Insert before markers in case we are inserting where
	 the buffer's mark is, and the user's next command is Meta-y.  */
      insert_before_markers (chars, nchars);
      Fset_marker (p->mark, make_number (point), p->buffer);

      update_mode_lines++;

      /* If the restriction isn't what it should be, set it.  */
      if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV)
	Fnarrow_to_region (old_begv, old_zv);

      current_buffer->read_only = old_read_only;
      SET_PT (opoint);
      set_buffer_internal (old);
    }
#ifdef VMS
  start_vms_process_read (vs);

/* send a signal number SIGNO to PROCESS.
   CURRENT_GROUP means send to the process group that currently owns
   the terminal being used to communicate with PROCESS.
   This is used for various commands in shell mode.
   If NOMSG is zero, insert signal-announcements into process's buffers
   right away.

   If we can, we try to signal PROCESS by sending control characters
   down the pipe.  This allows us to signal inferiors who have changed
   their uid, for which killpg would return an EPERM error.  */

static void
process_send_signal (process, signo, current_group, nomsg)
     Lisp_Object process;
     int signo;

    current_group = Qnil;

  /* If we are using pgrps, get a pgrp number and make it negative.  */
  if (!NILP (current_group))
    {
#ifdef SIGNALS_VIA_CHARACTERS
      /* If possible, send signals to the entire pgrp
	 by sending an input character to it.  */

      /* On Berkeley descendants, the following IOCTL's retrieve the
	 current control characters.  */
#if defined (TIOCGLTC) && defined (TIOCGETC)

      struct tchars c;
      struct ltchars lc;

      switch (signo)
	{

#ifdef SIGTSTP
	case SIGTSTP:
	  ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
	  send_process (proc, &lc.t_suspc, 1);
	  return;
#endif /* ! defined (SIGTSTP) */
	}

#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */

      /* On SYSV descendants, the TCGETA ioctl retrieves the current control
	 characters.  */
#ifdef TCGETA
      struct termio t;
      switch (signo)
	{
	case SIGINT:
	  ioctl (XFASTINT (p->infd), TCGETA, &t);

#ifdef SIGTSTP
	case SIGTSTP:
	  ioctl (XFASTINT (p->infd), TCGETA, &t);
	  send_process (proc, &t.c_cc[VSWTCH], 1);
	  return;
#endif /* ! defined (SIGTSTP) */
	}
#else /* ! defined (TCGETA) */
      Your configuration files are messed up.
      /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
	 you'd better be using one of the alternatives above!  */
#endif /* ! defined (TCGETA) */
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */

#ifdef TIOCGPGRP 
      /* Get the pgrp using the tty itself, if we have that.
	 Otherwise, use the pty to get the pgrp.
	 On pfa systems, [e-mail] writes:
	 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
	 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
	 His patch indicates that if TIOCGPGRP returns an error, then
	 we should just assume that p->pid is also the process group id.  */
      {
	int err;

      }
      if (gid == -1)
	no_pgrp = 1;
      else
	gid = - gid;
#else  /* ! defined (TIOCGPGRP ) */
      /* Can't select pgrps on this system, so we know that
	 the child itself heads the pgrp.  */
      gid = - XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
    }

	  /* Report the status of the synchronous process.  */
	  if (WIFEXITED (w))
	    synch_process_retcode = WRETCODE (w);
	  else if (WIFSIGNALED (w))
#ifndef VMS
	    synch_process_death = sys_siglist[WTERMSIG (w)];
#else
	    synch_process_death = sys_errlist[WTERMSIG (w)];
#endif
	}

      /* On some systems, we must return right away.
	 If any more processes want to signal us, we will
	 get another signal.