*** empty log message ***
[bpt/emacs.git] / src / process.c
index c2ec602..4f6d283 100644 (file)
@@ -1,7 +1,7 @@
 /* Asynchronous subprocess control for GNU Emacs.
    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
                  1996, 1998, 1999, 2001, 2002, 2003, 2004,
-                 2005, 2006 Free Software Foundation, Inc.
+                 2005, 2006, 2007 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -815,9 +815,12 @@ nil, indicating the current buffer's process.  */)
     {
 #ifdef SIGCHLD
       Lisp_Object symbol;
+      /* Assignment to EMACS_INT stops GCC whining about limited range
+        of data type.  */
+      EMACS_INT pid = p->pid;
 
       /* No problem storing the pid here, as it is still in Vprocess_alist.  */
-      deleted_pid_list = Fcons (make_fixnum_or_float (p->pid),
+      deleted_pid_list = Fcons (make_fixnum_or_float (pid),
                                /* GC treated elements set to nil.  */
                                Fdelq (Qnil, deleted_pid_list));
       /* If the process has already signaled, remove it from the list.  */
@@ -827,7 +830,8 @@ nil, indicating the current buffer's process.  */)
       if (CONSP (p->status))
        symbol = XCAR (p->status);
       if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
-       Fdelete (make_fixnum_or_float (p->pid), deleted_pid_list);
+       deleted_pid_list
+         = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
       else
 #endif
        {
@@ -912,10 +916,13 @@ For a network connection, this value is nil.  */)
      (process)
      register Lisp_Object process;
 {
+  /* Assignment to EMACS_INT stops GCC whining about limited range of
+     data type.  */
+  EMACS_INT pid;
+
   CHECK_PROCESS (process);
-  return (XPROCESS (process)->pid
-         ? make_fixnum_or_float (XPROCESS (process)->pid)
-         : Qnil);
+  pid = XPROCESS (process)->pid;
+  return (pid ? make_fixnum_or_float (pid) : Qnil);
 }
 
 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
@@ -1261,7 +1268,7 @@ Returns nil if format of ADDRESS is invalid.  */)
   if (VECTORP (address))  /* AF_INET or AF_INET6 */
     {
       register struct Lisp_Vector *p = XVECTOR (address);
-      Lisp_Object args[6];
+      Lisp_Object args[10];
       int nargs, i;
 
       if (p->size == 4 || (p->size == 5 && !NILP (omit_port)))
@@ -1298,7 +1305,6 @@ Returns nil if format of ADDRESS is invalid.  */)
       args[0] = build_string ("<Family %d>");
       args[1] = Fcar (address);
       return Fformat (2, args);
-
     }
 
   return Qnil;
@@ -1812,7 +1818,8 @@ create_process (process, new_argv, current_dir)
      char **new_argv;
      Lisp_Object current_dir;
 {
-  int pid, inchannel, outchannel;
+  int inchannel, outchannel;
+  pid_t pid;
   int sv[2];
 #ifdef POSIX_SIGNALS
   sigset_t procmask;
@@ -3328,13 +3335,17 @@ usage: (make-network-process &rest ARGS)  */)
 #endif
     }
 
+  immediate_quit = 0;
+
 #ifdef HAVE_GETADDRINFO
   if (res != &ai)
-    freeaddrinfo (res);
+    {
+      BLOCK_INPUT;
+      freeaddrinfo (res);
+      UNBLOCK_INPUT;
+    }
 #endif
 
-  immediate_quit = 0;
-
   /* Discard the unwind protect for closing S, if any.  */
   specpdl_ptr = specpdl + count1;
 
@@ -5654,6 +5665,91 @@ send_process (proc, buf, len, object)
   UNGCPRO;
 }
 
+static Lisp_Object
+send_process_object_unwind (buf)
+     Lisp_Object buf;
+{
+  Lisp_Object tembuf;
+
+  if (XBUFFER (buf) == current_buffer)
+    return Qnil;
+  tembuf = Fcurrent_buffer ();
+  Fset_buffer (buf);
+  Fkill_buffer (tembuf);
+  return Qnil;
+}
+
+/* Send current contents of region between START and END to PROC.
+   If START is a string, send it instead.
+   This function can evaluate Lisp code and can garbage collect.  */
+
+static void
+send_process_object (proc, start, end)
+     Lisp_Object proc, start, end;
+{
+  int count = SPECPDL_INDEX ();
+  Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer ();
+  struct buffer *given_buffer = current_buffer;
+  unsigned char *buf;
+  int len;
+
+  record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ());
+
+  if (STRINGP (object) ? STRING_MULTIBYTE (object)
+      : ! NILP (XBUFFER (object)->enable_multibyte_characters))
+    {
+      struct Lisp_Process *p = XPROCESS (proc);
+      struct coding_system *coding;
+
+      if (p->raw_status_new)
+       update_status (p);
+      if (! EQ (p->status, Qrun))
+       error ("Process %s not running", SDATA (p->name));
+      if (XINT (p->outfd) < 0)
+       error ("Output file descriptor of %s is closed", SDATA (p->name));
+
+      coding = proc_encode_coding_system[XINT (p->outfd)];
+      if (! EQ (coding->symbol, p->encode_coding_system))
+       /* The coding system for encoding was changed to raw-text
+          because we sent a unibyte text previously.  Now we are
+          sending a multibyte text, thus we must encode it by the
+          original coding system specified for the current process.  */
+       setup_coding_system (p->encode_coding_system, coding);
+      if (! NILP (coding->pre_write_conversion))
+       {
+         struct gcpro gcpro1, gcpro2;
+
+         GCPRO2 (proc, object);
+         call2 (coding->pre_write_conversion, start, end);
+         UNGCPRO;
+         if (given_buffer != current_buffer)
+           {
+             start = make_number (BEGV), end = make_number (ZV);
+             object = Fcurrent_buffer ();
+           }
+       }
+    }
+
+  if (BUFFERP (object))
+    {
+      EMACS_INT start_byte;
+
+      if (XINT (start) < GPT && XINT (end) > GPT)
+       move_gap (XINT (end));
+      start_byte = CHAR_TO_BYTE (XINT (start));
+      buf = BYTE_POS_ADDR (start_byte);
+      len = CHAR_TO_BYTE (XINT (end)) - start_byte;
+    }
+  else
+    {
+      buf = SDATA (object);
+      len = SBYTES (object);
+    }
+  send_process (proc, buf, len, object);
+
+  unbind_to (count, Qnil);
+}
+
 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
        3, 3, 0,
        doc: /* Send current contents of region as input to PROCESS.
@@ -5667,19 +5763,10 @@ Output from processes can arrive in between bunches.  */)
      Lisp_Object process, start, end;
 {
   Lisp_Object proc;
-  int start1, end1;
 
   proc = get_process (process);
   validate_region (&start, &end);
-
-  if (XINT (start) < GPT && XINT (end) > GPT)
-    move_gap (XINT (start));
-
-  start1 = CHAR_TO_BYTE (XINT (start));
-  end1 = CHAR_TO_BYTE (XINT (end));
-  send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
-               Fcurrent_buffer ());
-
+  send_process_object (proc, start, end);
   return Qnil;
 }
 
@@ -5697,8 +5784,7 @@ Output from processes can arrive in between bunches.  */)
   Lisp_Object proc;
   CHECK_STRING (string);
   proc = get_process (process);
-  send_process (proc, SDATA (string),
-               SBYTES (string), string);
+  send_process_object (proc, string, Qnil);
   return Qnil;
 }
 \f
@@ -6405,7 +6491,7 @@ sigchld_handler (signo)
 
   while (1)
     {
-      register int pid;
+      pid_t pid;
       WAITTYPE w;
       Lisp_Object tail;
 
@@ -6415,7 +6501,12 @@ sigchld_handler (signo)
 #endif /* no WUNTRACED */
       /* Keep trying to get a status until we get a definitive result.  */
       do
-       {
+        {
+         /* For some reason, this sleep() prevents Emacs from sending
+             loadavg to 5-8(!) for ~10 seconds.
+             See http://thread.gmane.org/gmane.emacs.devel/67722 or
+             http://www.google.com/search?q=busyloop+in+sigchld_handler */
+          usleep (1000);
          errno = 0;
          pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
        }
@@ -6445,11 +6536,15 @@ sigchld_handler (signo)
       /* Find the process that signaled us, and record its status.  */
 
       /* The process can have been deleted by Fdelete_process.  */
-      tail = Fmember (make_fixnum_or_float (pid), deleted_pid_list);
-      if (!NILP (tail))
+      for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail))
        {
-         Fsetcar (tail, Qnil);
-         goto sigchld_end_of_loop;
+         Lisp_Object xpid = XCAR (tail);
+         if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
+             || (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
+           {
+             XSETCAR (tail, Qnil);
+             goto sigchld_end_of_loop;
+           }
        }
 
       /* Otherwise, if it is asynchronous, it is in Vprocess_alist.  */