diff src/process.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
line wrap: on
line diff
--- a/src/process.c	Mon Aug 13 11:12:06 2007 +0200
+++ b/src/process.c	Mon Aug 13 11:13:30 2007 +0200
@@ -58,7 +58,7 @@
 #include "systty.h"
 #include "syswait.h"
 
-Lisp_Object Qprocessp;
+Lisp_Object Qprocessp, Qprocess_live_p;
 
 /* Process methods */
 struct process_methods the_process_methods;
@@ -71,7 +71,7 @@
 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
 Lisp_Object Qopen, Qclosed;
 /* Protocol families */
-Lisp_Object Qtcpip;
+Lisp_Object Qtcp, Qudp;
 
 #ifdef HAVE_MULTICAST
 Lisp_Object Qmulticast; /* Will be used for occasional warnings */
@@ -106,25 +106,27 @@
 /* List of process objects. */
 Lisp_Object Vprocess_list;
 
+extern Lisp_Object Vlisp_EXEC_SUFFIXES;
+
 
 
 static Lisp_Object
-mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_process (Lisp_Object obj)
 {
-  struct Lisp_Process *proc = XPROCESS (obj);
-  MAYBE_PROCMETH (mark_process_data, (proc, markobj));
-  markobj (proc->name);
-  markobj (proc->command);
-  markobj (proc->filter);
-  markobj (proc->sentinel);
-  markobj (proc->buffer);
-  markobj (proc->mark);
-  markobj (proc->pid);
-  markobj (proc->pipe_instream);
-  markobj (proc->pipe_outstream);
+  Lisp_Process *proc = XPROCESS (obj);
+  MAYBE_PROCMETH (mark_process_data, (proc));
+  mark_object (proc->name);
+  mark_object (proc->command);
+  mark_object (proc->filter);
+  mark_object (proc->sentinel);
+  mark_object (proc->buffer);
+  mark_object (proc->mark);
+  mark_object (proc->pid);
+  mark_object (proc->pipe_instream);
+  mark_object (proc->pipe_outstream);
 #ifdef FILE_CODING
-  markobj (proc->coding_instream);
-  markobj (proc->coding_outstream);
+  mark_object (proc->coding_instream);
+  mark_object (proc->coding_outstream);
 #endif
   return proc->status_symbol;
 }
@@ -132,7 +134,7 @@
 static void
 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-  struct Lisp_Process *proc = XPROCESS (obj);
+  Lisp_Process *proc = XPROCESS (obj);
 
   if (print_readably)
     error ("printing unreadable object #<process %s>",
@@ -145,10 +147,10 @@
   else
     {
       int netp = network_connection_p (obj);
-      write_c_string (((netp) ? GETTEXT ("#<network connection ") :
+      write_c_string ((netp ? GETTEXT ("#<network connection ") :
 		       GETTEXT ("#<process ")), printcharfun);
       print_internal (proc->name, printcharfun, 1);
-      write_c_string (((netp) ? " " : " pid "), printcharfun);
+      write_c_string ((netp ? " " : " pid "), printcharfun);
       print_internal (proc->pid, printcharfun, 1);
       write_c_string (" state:", printcharfun);
       print_internal (proc->status_symbol, printcharfun, 1);
@@ -158,7 +160,7 @@
 }
 
 #ifdef HAVE_WINDOW_SYSTEM
-extern void debug_process_finalization (struct Lisp_Process *p);
+extern void debug_process_finalization (Lisp_Process *p);
 #endif /* HAVE_WINDOW_SYSTEM */
 
 static void
@@ -166,7 +168,7 @@
 {
   /* #### this probably needs to be tied into the tty event loop */
   /* #### when there is one */
-  struct Lisp_Process *p = (struct Lisp_Process *) header;
+  Lisp_Process *p = (Lisp_Process *) header;
 #ifdef HAVE_WINDOW_SYSTEM
   if (!for_disksave)
     {
@@ -184,7 +186,7 @@
 
 DEFINE_LRECORD_IMPLEMENTATION ("process", process,
                                mark_process, print_process, finalize_process,
-                               0, 0, struct Lisp_Process);
+                               0, 0, 0, Lisp_Process);
 
 /************************************************************************/
 /*                       basic process accessors                        */
@@ -194,8 +196,7 @@
    directly to the child process, rather than en/decoding FILE_CODING
    streams */
 void
-get_process_streams (struct Lisp_Process *p,
-		     Lisp_Object *instr, Lisp_Object *outstr)
+get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr)
 {
   assert (p);
   assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream));
@@ -204,14 +205,14 @@
   *outstr = p->pipe_outstream;
 }
 
-struct Lisp_Process *
+Lisp_Process *
 get_process_from_usid (USID usid)
 {
-  CONST void *vval;
+  const void *vval;
 
   assert (usid != USID_ERROR && usid != USID_DONTHASH);
 
-  if (gethash ((CONST void*)usid, usid_to_process, &vval))
+  if (gethash ((const void*)usid, usid_to_process, &vval))
     {
       Lisp_Object proc;
       CVOID_TO_LISP (proc, vval);
@@ -222,19 +223,19 @@
 }
 
 int
-get_process_selected_p (struct Lisp_Process *p)
+get_process_selected_p (Lisp_Process *p)
 {
   return p->selected;
 }
 
 void
-set_process_selected_p (struct Lisp_Process *p, int selected_p)
+set_process_selected_p (Lisp_Process *p, int selected_p)
 {
   p->selected = !!selected_p;
 }
 
 int
-connected_via_filedesc_p (struct Lisp_Process *p)
+connected_via_filedesc_p (Lisp_Process *p)
 {
   return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p));
 }
@@ -243,7 +244,7 @@
 int
 network_connection_p (Lisp_Object process)
 {
-  return GC_CONSP (XPROCESS (process)->pid);
+  return CONSP (XPROCESS (process)->pid);
 }
 #endif
 
@@ -255,6 +256,14 @@
   return PROCESSP (obj) ? Qt : Qnil;
 }
 
+DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /*
+Return t if OBJECT is a process that is alive.
+*/
+       (obj))
+{
+  return PROCESSP (obj) && PROCESS_LIVE_P (XPROCESS (obj)) ? Qt : Qnil;
+}
+
 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /*
 Return a list of all processes.
 */
@@ -270,7 +279,7 @@
 {
   Lisp_Object tail;
 
-  if (GC_PROCESSP (name))
+  if (PROCESSP (name))
     return name;
 
   if (!gc_in_progress)
@@ -278,7 +287,7 @@
        of a signal or crash. */
     CHECK_STRING (name);
 
-  for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail))
+  for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object proc = XCAR (tail);
       QUIT;
@@ -296,18 +305,18 @@
 {
   Lisp_Object buf, tail, proc;
 
-  if (GC_NILP (name)) return Qnil;
+  if (NILP (name)) return Qnil;
   buf = Fget_buffer (name);
-  if (GC_NILP (buf)) return Qnil;
+  if (NILP (buf)) return Qnil;
 
-  for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail))
+  for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
     {
       /* jwz: do not quit here - it isn't necessary, as there is no way for
 	 Vprocess_list to get circular or overwhelmingly long, and this
 	 function is called from layout_mode_element under redisplay. */
       /* QUIT; */
       proc = XCAR (tail);
-      if (GC_PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
+      if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
 	return proc;
     }
   return Qnil;
@@ -329,28 +338,28 @@
 
   /* This may be called during a GC from process_send_signal() from
      kill_buffer_processes() if emacs decides to abort(). */
-  if (GC_PROCESSP (name))
+  if (PROCESSP (name))
     return name;
 
-  if (GC_STRINGP (name))
+  if (STRINGP (name))
     {
       obj = Fget_process (name);
-      if (GC_NILP (obj))
+      if (NILP (obj))
         obj = Fget_buffer (name);
-      if (GC_NILP (obj))
+      if (NILP (obj))
         error ("Process %s does not exist", XSTRING_DATA (name));
     }
-  else if (GC_NILP (name))
+  else if (NILP (name))
     obj = Fcurrent_buffer ();
   else
     obj = name;
 
   /* Now obj should be either a buffer object or a process object.
    */
-  if (GC_BUFFERP (obj))
+  if (BUFFERP (obj))
     {
       proc = Fget_buffer_process (obj);
-      if (GC_NILP (proc))
+      if (NILP (proc))
 	error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name));
     }
   else
@@ -414,8 +423,7 @@
 {
   Lisp_Object val, name1;
   int i;
-  struct Lisp_Process *p =
-    alloc_lcrecord_type (struct Lisp_Process, lrecord_process);
+  Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process);
 
   /* If name is already in use, modify it until it is unused.  */
   name1 = name;
@@ -462,7 +470,7 @@
 }
 
 void
-init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags)
+init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
 {
   USID usid = event_stream_create_stream_pair (in, out,
 					       &p->pipe_instream, &p->pipe_outstream,
@@ -475,7 +483,7 @@
     {
       Lisp_Object proc = Qnil;
       XSETPROCESS (proc, p);
-      puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process);
+      puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process);
     }
 
   MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags));
@@ -497,7 +505,7 @@
 create_process (Lisp_Object process, Lisp_Object *argv, int nargv,
 		Lisp_Object program, Lisp_Object cur_dir)
 {
-  struct Lisp_Process *p = XPROCESS (process);
+  Lisp_Process *p = XPROCESS (process);
   int pid;
 
   /* *_create_process may change status_symbol, if the process
@@ -508,7 +516,7 @@
   pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir));
 
   p->pid = make_int (pid);
-  if (!NILP(p->pipe_instream))
+  if (PROCESS_LIVE_P (p))
     event_stream_select_process (p);
 }
 
@@ -591,8 +599,7 @@
 
       tem = Qnil;
       NGCPRO1 (tem);
-      locate_file (Vexec_path, program, EXEC_SUFFIXES, &tem,
-		   X_OK);
+      locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK);
       if (NILP (tem))
 	report_file_error ("Searching for program", list1 (program));
       program = Fexpand_file_name (tem, Qnil);
@@ -658,7 +665,7 @@
 
 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
 Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
+Return a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
 
 NAME is name for process.  It is modified if necessary to make it unique.
@@ -670,10 +677,18 @@
 Third arg is name of the host to connect to, or its IP address.
 Fourth arg SERVICE is name of the service desired, or an integer
  specifying a port number to connect to.
-Fifth argument FAMILY is a protocol family. When omitted, 'tcp/ip
-\(Internet protocol family TCP/IP) is assumed.
+Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
+ (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
+ supported.  When omitted, 'tcp is assumed.
+
+Ouput via `process-send-string' and input via buffer or filter (see
+`set-process-filter') are stream-oriented.  That means UDP datagrams are
+not guaranteed to be sent and received in discrete packets. (But small
+datagrams around 500 bytes that are not truncated by `process-send-string'
+are usually fine.)  Note further that UDP protocol does not guard against
+lost packets.
 */
-       (name, buffer, host, service, family))
+       (name, buffer, host, service, protocol))
 {
   /* !!#### This function has not been Mule-ized */
   /* This function can GC */
@@ -681,17 +696,17 @@
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
   void *inch, *outch;
 
-  GCPRO5 (name, buffer, host, service, family);
+  GCPRO5 (name, buffer, host, service, protocol);
   CHECK_STRING (name);
 
-  if (NILP(family))
-    family = Qtcpip;
+  if (NILP(protocol))
+    protocol = Qtcp;
   else
-    CHECK_SYMBOL (family);
+    CHECK_SYMBOL (protocol);
 
   /* Since this code is inside HAVE_SOCKETS, existence of
      open_network_stream is mandatory */
-  PROCMETH (open_network_stream, (name, host, service, family,
+  PROCMETH (open_network_stream, (name, host, service, protocol,
 				  &inch, &outch));
 
   if (!NILP (buffer))
@@ -715,7 +730,7 @@
 
 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
 Open a multicast connection on the specified dest/port/ttl.
-Returns a subprocess-object to represent the connection.
+Return a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
 
 NAME is name for process.  It is modified if necessary to make it unique.
@@ -804,7 +819,7 @@
   Bytecount nbytes, nchars;
   Bufbyte chars[1024];
   Lisp_Object outstream;
-  struct Lisp_Process *p = XPROCESS (proc);
+  Lisp_Process *p = XPROCESS (proc);
 
   /* If there is a lot of output from the subprocess, the loop in
      execute_internal_event() might call read_process_output() more
@@ -814,7 +829,7 @@
      Really, the loop in execute_internal_event() should check itself
      for a process-filter change, like in status_notify(); but the
      struct Lisp_Process is not exported outside of this file. */
-  if (NILP(p->pipe_instream))
+  if (!PROCESS_LIVE_P (p))
     return -1; /* already closed */
 
   if (!NILP (p->filter) && (p->filter_does_read))
@@ -949,7 +964,7 @@
 
 void
 send_process (Lisp_Object proc,
-              Lisp_Object relocatable, CONST Bufbyte *nonrelocatable,
+              Lisp_Object relocatable, const Bufbyte *nonrelocatable,
               int start, int len)
 {
   /* This function can GC */
@@ -964,7 +979,7 @@
   if (nonrelocatable)
     lstream =
       make_fixed_buffer_input_stream (nonrelocatable + start, len);
-  else if (GC_BUFFERP (relocatable))
+  else if (BUFFERP (relocatable))
     lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable),
 					     start, start + len, 0);
   else
@@ -1023,7 +1038,7 @@
 set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read)
 {
   CHECK_PROCESS (proc);
-  if (PROCESS_LIVE_P (proc)) {
+  if (PROCESS_LIVE_P (XPROCESS (proc))) {
     if (EQ (filter, Qt))
       event_stream_unselect_process (XPROCESS (proc));
     else
@@ -1112,6 +1127,7 @@
        (process))
 {
   process = get_process (process);
+  CHECK_LIVE_PROCESS (process);
   return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) );
 }
 
@@ -1121,6 +1137,7 @@
        (process))
 {
   process = get_process (process);
+  CHECK_LIVE_PROCESS (process);
   return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream));
 }
 
@@ -1130,6 +1147,7 @@
        (process))
 {
   process = get_process (process);
+  CHECK_LIVE_PROCESS (process);
   return Fcons (decoding_stream_coding_system
 		(XLSTREAM (XPROCESS (process)->coding_instream)),
 		encoding_stream_coding_system
@@ -1144,6 +1162,8 @@
 {
   codesys = Fget_coding_system (codesys);
   process = get_process (process);
+  CHECK_LIVE_PROCESS (process);
+
   set_decoding_stream_coding_system
     (XLSTREAM (XPROCESS (process)->coding_instream), codesys);
   return Qnil;
@@ -1157,6 +1177,8 @@
 {
   codesys = Fget_coding_system (codesys);
   process = get_process (process);
+  CHECK_LIVE_PROCESS (process);
+
   set_encoding_stream_coding_system
     (XLSTREAM (XPROCESS (process)->coding_outstream), codesys);
   return Qnil;
@@ -1165,6 +1187,8 @@
 DEFUN ("set-process-coding-system", Fset_process_coding_system,
        1, 3, 0, /*
 Set coding-systems of PROCESS to DECODING and ENCODING.
+DECODING will be used to decode subprocess output and ENCODING to
+encode subprocess input.
 */
        (process, decoding, encoding))
 {
@@ -1186,7 +1210,7 @@
 static Lisp_Object
 exec_sentinel_unwind (Lisp_Object datum)
 {
-  struct Lisp_Cons *d = XCONS (datum);
+  Lisp_Cons *d = XCONS (datum);
   XPROCESS (d->car)->sentinel = d->cdr;
   free_cons (d);
   return Qnil;
@@ -1197,7 +1221,7 @@
 {
   /* This function can GC */
   int speccount = specpdl_depth ();
-  struct Lisp_Process *p = XPROCESS (proc);
+  Lisp_Process *p = XPROCESS (proc);
   Lisp_Object sentinel = p->sentinel;
 
   if (NILP (sentinel))
@@ -1242,13 +1266,13 @@
 }
 
 
-CONST char *
+const char *
 signal_name (int signum)
 {
   if (signum >= 0 && signum < NSIG)
-    return (CONST char *) sys_siglist[signum];
+    return (const char *) sys_siglist[signum];
 
-  return (CONST char *) GETTEXT ("unknown signal");
+  return (const char *) GETTEXT ("unknown signal");
 }
 
 void
@@ -1267,7 +1291,7 @@
 /* Return a string describing a process status list.  */
 
 static Lisp_Object
-status_message (struct Lisp_Process *p)
+status_message (Lisp_Process *p)
 {
   Lisp_Object symbol = p->status_symbol;
   int code = p->exit_code;
@@ -1351,7 +1375,7 @@
   for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object proc = XCAR (tail);
-      struct Lisp_Process *p = XPROCESS (proc);
+      Lisp_Process *p = XPROCESS (proc);
       /* p->tick is also volatile.  Same thing as above applies. */
       int this_process_tick;
 
@@ -1518,9 +1542,7 @@
   if (network_connection_p (proc))
     error ("Network connection %s is not a subprocess",
 	   XSTRING_DATA (XPROCESS(proc)->name));
-  if (!PROCESS_LIVE_P (proc))
-    error ("Process %s is not active",
-	   XSTRING_DATA (XPROCESS(proc)->name));
+  CHECK_LIVE_PROCESS (proc);
 
   MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg));
 }
@@ -1621,7 +1643,7 @@
       name = string_data (XSYMBOL (sigcode)->name);
 
 #define handle_signal(signal)				\
-  else if (!strcmp ((CONST char *) name, #signal))	\
+  else if (!strcmp ((const char *) name, #signal))	\
     XSETINT (sigcode, signal)
 
       if (0)
@@ -1810,7 +1832,7 @@
 void
 deactivate_process (Lisp_Object proc)
 {
-  struct Lisp_Process *p = XPROCESS (proc);
+  Lisp_Process *p = XPROCESS (proc);
   USID usid;
 
   /* It's possible that we got as far in the process-creation
@@ -1837,7 +1859,7 @@
 					    p->pipe_outstream);
 
   if (usid != USID_DONTHASH)
-    remhash ((CONST void*)usid, usid_to_process);
+    remhash ((const void*)usid, usid_to_process);
 
   p->pipe_instream = Qnil;
   p->pipe_outstream = Qnil;
@@ -1863,7 +1885,7 @@
        (proc))
 {
   /* This function can GC */
-  struct Lisp_Process *p;
+  Lisp_Process *p;
   proc = get_process (proc);
   p = XPROCESS (proc);
   if (network_connection_p (proc))
@@ -1874,7 +1896,7 @@
       p->tick++;
       process_tick++;
     }
-  else if (!NILP(p->pipe_instream))
+  else if (PROCESS_LIVE_P (p))
     {
       Fkill_process (proc, Qnil);
       /* Do this now, since remove_process will make sigchld_handler do nothing.  */
@@ -1897,16 +1919,16 @@
 {
   Lisp_Object tail;
 
-  for (tail = Vprocess_list; GC_CONSP (tail);
+  for (tail = Vprocess_list; CONSP (tail);
        tail = XCDR (tail))
     {
       Lisp_Object proc = XCAR (tail);
-      if (GC_PROCESSP (proc)
-	  && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer)))
+      if (PROCESSP (proc)
+	  && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
 	{
 	  if (network_connection_p (proc))
 	    Fdelete_process (proc);
-	  else if (!NILP (XPROCESS (proc)->pipe_instream))
+	  else if (PROCESS_LIVE_P (XPROCESS (proc)))
 	    process_send_signal (proc, SIGHUP, 0, 1);
 	}
     }
@@ -1969,18 +1991,21 @@
 syms_of_process (void)
 {
   defsymbol (&Qprocessp, "processp");
+  defsymbol (&Qprocess_live_p, "process-live-p");
   defsymbol (&Qrun, "run");
   defsymbol (&Qstop, "stop");
   defsymbol (&Qopen, "open");
   defsymbol (&Qclosed, "closed");
 
-  defsymbol (&Qtcpip, "tcp/ip");
+  defsymbol (&Qtcp, "tcp");
+  defsymbol (&Qudp, "udp");
 
 #ifdef HAVE_MULTICAST
   defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
 #endif
 
   DEFSUBR (Fprocessp);
+  DEFSUBR (Fprocess_live_p);
   DEFSUBR (Fget_process);
   DEFSUBR (Fget_buffer_process);
   DEFSUBR (Fdelete_process);