XEmacs 21.2.20 "Yoko".

[chise/xemacs-chise.git.1] / src / process-unix.c

diff --git a/src/process-unix.c b/src/process-unix.c
index 8220dcc..b4a612e 100644 (file)
--- a/src/process-unix.c
+++ b/src/process-unix.c
@@ -1,4 +1,4 @@
-/* Asynchronous subprocess implemenation for UNIX
+/* Asynchronous subprocess implementation for UNIX

    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.

@@ -37,11 +37,9 @@ Boston, MA 02111-1307, USA.  */
 #include "lisp.h"
 
 #include "buffer.h"
 #include "lisp.h"
 
 #include "buffer.h"

-#include "commands.h"

 #include "events.h"
 #include "frame.h"
 #include "hash.h"
 #include "events.h"
 #include "frame.h"
 #include "hash.h"

-#include "insdel.h"

 #include "lstream.h"
 #include "opaque.h"
 #include "process.h"
 #include "lstream.h"
 #include "opaque.h"
 #include "process.h"

@@ -62,7 +60,7 @@ Boston, MA 02111-1307, USA.  */
 
 
 /*
 
 
 /*

- * Implemenation-specific data. Pointed to by Lisp_Process->process_data
+ * Implementation-specific data. Pointed to by Lisp_Process->process_data

  */
 
 struct unix_process_data
  */
 
 struct unix_process_data

@@ -214,9 +212,11 @@ allocate_pty (void)
      end of the ptys.  */
   int failed_count = 0;
 #endif
      end of the ptys.  */
   int failed_count = 0;
 #endif

-  int i;

   int fd;
   int fd;

+#ifndef HAVE_GETPT
+  int i;

   int c;
   int c;

+#endif

 
 #ifdef PTY_ITERATION
   PTY_ITERATION
 
 #ifdef PTY_ITERATION
   PTY_ITERATION

@@ -236,7 +236,7 @@ allocate_pty (void)
 #else /* no PTY_OPEN */
 #ifdef IRIS
        /* Unusual IRIS code */
 #else /* no PTY_OPEN */
 #ifdef IRIS
        /* Unusual IRIS code */

-       *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY | OPEN_BINARY, 0);
+       *ptyv = open ("/dev/ptc", O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);

        if (fd < 0)
          return -1;
        if (fstat (fd, &stb) < 0)
        if (fd < 0)
          return -1;
        if (fstat (fd, &stb) < 0)

@@ -250,11 +250,7 @@ allocate_pty (void)
          }
        else
          failed_count = 0;
          }
        else
          failed_count = 0;

-#ifdef O_NONBLOCK

        fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
        fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);

-#else
-       fd = open (pty_name, O_RDWR | O_NDELAY | OPEN_BINARY, 0);
-#endif

 #endif /* not IRIS */
 #endif /* no PTY_OPEN */
 
 #endif /* not IRIS */
 #endif /* no PTY_OPEN */
 

@@ -267,7 +263,7 @@ allocate_pty (void)
 #else
             sprintf (pty_name, "/dev/tty%c%x", c, i);
 #endif /* no PTY_TTY_NAME_SPRINTF */
 #else
             sprintf (pty_name, "/dev/tty%c%x", c, i);
 #endif /* no PTY_TTY_NAME_SPRINTF */

-#ifndef UNIPLUS
+#if !defined(UNIPLUS) && !defined(HAVE_GETPT)

            if (access (pty_name, 6) != 0)
              {
                close (fd);
            if (access (pty_name, 6) != 0)
              {
                close (fd);

@@ -390,7 +386,7 @@ set_socket_nonblocking_maybe (int fd, int port, CONST char* proto)
          else
            continue;
        }
          else
            continue;
        }

-      else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port))
+      else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port))

        break;
     }
 
        break;
     }
 

@@ -669,14 +665,13 @@ unix_alloc_process_data (struct Lisp_Process *p)
  */
 
 static void
  */
 
 static void

-unix_mark_process_data (struct Lisp_Process *proc,
-                       void (*markobj) (Lisp_Object))
+unix_mark_process_data (struct Lisp_Process *proc)

 {
 {

-  ((markobj) (UNIX_DATA(proc)->tty_name));
+  mark_object (UNIX_DATA(proc)->tty_name);

 }
 
 /*
 }
 
 /*

- * Initialize XEmacs process implemenation once
+ * Initialize XEmacs process implementation once

  */
 
 #ifdef SIGCHLD
  */
 
 #ifdef SIGCHLD

@@ -704,11 +699,11 @@ unix_init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int f
 }
 
 /*
 }
 
 /*

- * Fork off a subprocess. P is a pointer to newly created subprocess
+ * Fork off a subprocess. P is a pointer to a newly created subprocess

  * object. If this function signals, the caller is responsible for
  * deleting (and finalizing) the process object.
  *
  * object. If this function signals, the caller is responsible for
  * deleting (and finalizing) the process object.
  *

- * The method must return PID of the new proces, a (positive??? ####) number
+ * The method must return PID of the new process, a (positive??? ####) number

  * which fits into Lisp_Int. No return value indicates an error, the method
  * must signal an error instead.
  */
  * which fits into Lisp_Int. No return value indicates an error, the method
  * must signal an error instead.
  */

@@ -720,30 +715,13 @@ unix_create_process (struct Lisp_Process *p,
 {
   /* This function rewritten by ben@xemacs.org. */
 
 {
   /* This function rewritten by ben@xemacs.org. */
 

-  int pid, inchannel, outchannel;
+  int pid;
+  int inchannel  = -1;
+  int outchannel = -1;

   /* Use volatile to protect variables from being clobbered by longjmp.  */
   /* Use volatile to protect variables from being clobbered by longjmp.  */

-  volatile int forkin, forkout;
+  volatile int forkin   = -1;
+  volatile int forkout  = -1;

   volatile int pty_flag = 0;
   volatile int pty_flag = 0;

-  char **env;
-  char **new_argv;
-  char *current_dir;
-  int i;
-
-  env = environ;
-
-  inchannel = outchannel = forkin = forkout = -1;
-
-  /* Nothing below here GCs so our string pointers shouldn't move. */
-  new_argv = alloca_array (char *, nargv + 2);
-  GET_C_STRING_FILENAME_DATA_ALLOCA (program, new_argv[0]);
-  for (i = 0; i < nargv; i++)
-    {
-      Lisp_Object tem = argv[i];
-      CHECK_STRING (tem);
-      new_argv[i + 1] = (char *) XSTRING_DATA (tem);
-    }
-  new_argv[i + 1] = 0;
-  GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir);

 
 #ifdef HAVE_PTYS
   if (!NILP (Vprocess_connection_type))
 
 #ifdef HAVE_PTYS
   if (!NILP (Vprocess_connection_type))

@@ -761,7 +739,7 @@ unix_create_process (struct Lisp_Process *p,
         better error checking. */
 #if !defined(USG)
       /* On USG systems it does not work to open the pty's tty here
         better error checking. */
 #if !defined(USG)
       /* On USG systems it does not work to open the pty's tty here

-              and then close and reopen it in the child.  */
+        and then close and reopen it in the child.  */

 #ifdef O_NOCTTY
       /* Don't let this terminal become our controlling terminal
         (in case we don't have one).  */
 #ifdef O_NOCTTY
       /* Don't let this terminal become our controlling terminal
         (in case we don't have one).  */

@@ -802,14 +780,6 @@ unix_create_process (struct Lisp_Process *p,
     char **save_environ = environ;
 #endif
 
     char **save_environ = environ;
 #endif
 

-#ifdef EMACS_BTL
-    /* when performance monitoring is on, turn it off before the vfork(),
-       as the child has no handler for the signal -- when back in the
-       parent process, turn it back on if it was really on when you "turned
-       it off" */
-    int logging_on = cadillac_stop_logging (); /* #### rename me */
-#endif
-

     pid = fork ();
     if (pid == 0)
       {
     pid = fork ();
     if (pid == 0)
       {

@@ -925,28 +895,42 @@ unix_create_process (struct Lisp_Process *p,
               will die when we want it to.
               JV: This needs to be done ALWAYS as we might have inherited
               a SIG_IGN handling from our parent (nohup) and we are in new
               will die when we want it to.
               JV: This needs to be done ALWAYS as we might have inherited
               a SIG_IGN handling from our parent (nohup) and we are in new

-              process group.          
+              process group.

            */
            signal (SIGHUP, SIG_DFL);
          }
            */
            signal (SIGHUP, SIG_DFL);
          }

+
+       if (pty_flag)
+         /* Set up the terminal characteristics of the pty. */
+         child_setup_tty (xforkout);
+

 #endif /* HAVE_PTYS */
 
 #endif /* HAVE_PTYS */
 

-       signal (SIGINT, SIG_DFL);
+       signal (SIGINT,  SIG_DFL);

        signal (SIGQUIT, SIG_DFL);
 
        signal (SIGQUIT, SIG_DFL);
 

-       if (pty_flag)
-         {
-           /* Set up the terminal characteristics of the pty. */
-           child_setup_tty (xforkout);
-         }
+       {
+         char *current_dir;
+         char **new_argv = alloca_array (char *, nargv + 2);
+         int i;

 
 

-       child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
-      }
-#ifdef EMACS_BTL
-    else if (logging_on)
-      cadillac_start_logging ();       /* #### rename me */
-#endif
+         /* Nothing below here GCs so our string pointers shouldn't move. */
+         new_argv[0] = (char *) XSTRING_DATA (program);
+         for (i = 0; i < nargv; i++)
+           {
+             CHECK_STRING (argv[i]);
+             new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]);
+           }
+         new_argv[i + 1] = 0;
+
+         GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir);
+
+         child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
+       }
+
+      } /**** End of child code ****/

 
 

+    /**** Back in parent process ****/

 #if !defined(__CYGWIN32__)
     environ = save_environ;
 #endif
 #if !defined(__CYGWIN32__)
     environ = save_environ;
 #endif

@@ -986,19 +970,16 @@ unix_create_process (struct Lisp_Process *p,
 
 io_failure:
   {
 
 io_failure:
   {

-    int temp = errno;
+    int save_errno = errno;

     close_descriptor_pair (forkin, forkout);
     close_descriptor_pair (inchannel, outchannel);
     close_descriptor_pair (forkin, forkout);
     close_descriptor_pair (inchannel, outchannel);

-    errno = temp;
+    errno = save_errno;

     report_file_error ("Opening pty or pipe", Qnil);
     report_file_error ("Opening pty or pipe", Qnil);

+    return 0; /* not reached */

   }
   }

-
-  RETURN_NOT_REACHED (0);

 }
 
 }
 

-/*
- * Return nonzero if this process is a ToolTalk connection.
- */
+/* Return nonzero if this process is a ToolTalk connection. */

 
 static int
 unix_tooltalk_connection_p (struct Lisp_Process *p)
 
 static int
 unix_tooltalk_connection_p (struct Lisp_Process *p)

@@ -1006,9 +987,7 @@ unix_tooltalk_connection_p (struct Lisp_Process *p)
   return UNIX_DATA(p)->connected_via_filedesc_p;
 }
 
   return UNIX_DATA(p)->connected_via_filedesc_p;
 }
 

-/*
- * This is called to set process' virtual terminal size
- */
+/* This is called to set process' virtual terminal size */

 
 static int
 unix_set_window_size (struct Lisp_Process* p, int cols, int rows)
 
 static int
 unix_set_window_size (struct Lisp_Process* p, int cols, int rows)

@@ -1132,7 +1111,7 @@ unix_reap_exited_processes (void)
 #endif /* SIGCHLD */
 
 /*
 #endif /* SIGCHLD */
 
 /*

- * Stuff the entire contents of LSTREAM to the process ouptut pipe
+ * Stuff the entire contents of LSTREAM to the process output pipe

  */
 
 static JMP_BUF send_process_frame;
  */
 
 static JMP_BUF send_process_frame;

@@ -1180,8 +1159,7 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
          if (writeret < 0)
            /* This is a real error.  Blocking errors are handled
               specially inside of the filedesc stream. */
          if (writeret < 0)
            /* This is a real error.  Blocking errors are handled
               specially inside of the filedesc stream. */

-           report_file_error ("writing to process",
-                              list1 (vol_proc));
+           report_file_error ("writing to process", list1 (proc));

          while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
            {
              /* Buffer is full.  Wait, accepting input;
          while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
            {
              /* Buffer is full.  Wait, accepting input;

@@ -1207,7 +1185,7 @@ unix_send_process (Lisp_Object proc, struct lstream* lstream)
       p->core_dumped = 0;
       p->tick++;
       process_tick++;
       p->core_dumped = 0;
       p->tick++;
       process_tick++;

-      deactivate_process (vol_proc);
+      deactivate_process (*((Lisp_Object *) (&vol_proc)));

       error ("SIGPIPE raised on process %s; closed it",
             XSTRING_DATA (p->name));
     }
       error ("SIGPIPE raised on process %s; closed it",
             XSTRING_DATA (p->name));
     }

@@ -1254,7 +1232,7 @@ unix_process_send_eof (Lisp_Object proc)
  * In the lack of this method, only event_stream_delete_stream_pair
  * is called on both I/O streams of the process.
  *
  * In the lack of this method, only event_stream_delete_stream_pair
  * is called on both I/O streams of the process.
  *

- * The UNIX version quards this by ignoring possible SIGPIPE.
+ * The UNIX version guards this by ignoring possible SIGPIPE.

  */
 
 static USID
  */
 
 static USID

@@ -1425,7 +1403,7 @@ unix_get_tty_name (struct Lisp_Process *p)
 /*
  * Canonicalize host name HOST, and return its canonical form
  *
 /*
  * Canonicalize host name HOST, and return its canonical form
  *

- * The default implemenation just takes HOST for a canonical name.
+ * The default implementation just takes HOST for a canonical name.

  */
 
 #ifdef HAVE_SOCKETS
  */
 
 #ifdef HAVE_SOCKETS

@@ -1452,19 +1430,21 @@ unix_canonicalize_host_name (Lisp_Object host)
 
 static void
 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
 
 static void
 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,

-                         Lisp_Object family, void** vinfd, void** voutfd)
+                         Lisp_Object protocol, void** vinfd, void** voutfd)

 {
   struct sockaddr_in address;
 {
   struct sockaddr_in address;

-  int s, inch, outch;
+  int inch;
+  int outch;
+  volatile int s;

   volatile int port;
   volatile int retry = 0;
   int retval;
 
   CHECK_STRING (host);
 
   volatile int port;
   volatile int retry = 0;
   int retval;
 
   CHECK_STRING (host);
 

-  if (!EQ (family, Qtcpip))
-    error ("Unsupported protocol family \"%s\"",
-          string_data (symbol_name (XSYMBOL (family))));
+  if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
+    error ("Unsupported protocol \"%s\"",
+          string_data (symbol_name (XSYMBOL (protocol))));

 
   if (INTP (service))
     port = htons ((unsigned short) XINT (service));
 
   if (INTP (service))
     port = htons ((unsigned short) XINT (service));

@@ -1472,7 +1452,12 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
     {
       struct servent *svc_info;
       CHECK_STRING (service);
     {
       struct servent *svc_info;
       CHECK_STRING (service);

-      svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
+
+      if (EQ (protocol, Qtcp))
+         svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
+      else /* EQ (protocol, Qudp) */
+         svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
+

       if (svc_info == 0)
        error ("Unknown service \"%s\"", XSTRING_DATA (service));
       port = svc_info->s_port;
       if (svc_info == 0)
        error ("Unknown service \"%s\"", XSTRING_DATA (service));
       port = svc_info->s_port;

@@ -1481,7 +1466,11 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
   get_internet_address (host, &address, ERROR_ME);
   address.sin_port = port;
 
   get_internet_address (host, &address, ERROR_ME);
   address.sin_port = port;
 

-  s = socket (address.sin_family, SOCK_STREAM, 0);
+  if (EQ (protocol, Qtcp))
+      s = socket (address.sin_family, SOCK_STREAM, 0);
+  else /* EQ (protocol, Qudp) */
+      s = socket (address.sin_family, SOCK_DGRAM, 0);
+

   if (s < 0)
     report_file_error ("error creating socket", list1 (name));
 
   if (s < 0)
     report_file_error ("error creating socket", list1 (name));
 

@@ -1575,7 +1564,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic
    TCP case, the multicast connection will be seen as a sub-process,
 
    Some notes:
    TCP case, the multicast connection will be seen as a sub-process,
 
    Some notes:

-   - Normaly, we should use sendto and recvfrom with non connected
+   - Normally, we should use sendto and recvfrom with non connected

    sockets. The current code doesn't allow us to do this. In the future, it
    would be a good idea to extend the process data structure in order to deal
    properly with the different types network connections.
    sockets. The current code doesn't allow us to do this. In the future, it
    would be a good idea to extend the process data structure in order to deal
    properly with the different types network connections.

@@ -1656,7 +1645,7 @@ unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, Lisp_Object port,
 
   /* Socket configuration for writing ----------------------- */
 
 
   /* Socket configuration for writing ----------------------- */
 

-  /* Normaly, there's no 'connect' in multicast, since we use preferentialy
+  /* Normally, there's no 'connect' in multicast, since we prefer to use

      'sendto' and 'recvfrom'. However, in order to handle this connection in
      the process-like way it is done for TCP, we must be able to use 'write'
      instead of 'sendto'. Consequently, we 'connect' this socket. */
      'sendto' and 'recvfrom'. However, in order to handle this connection in
      the process-like way it is done for TCP, we must be able to use 'write'
      instead of 'sendto'. Consequently, we 'connect' this socket. */