unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: sbaugh@catern.com
To: emacs-devel@gnu.org
Subject: Re: call-process should not block process filters from running
Date: Mon, 03 Jul 2023 21:04:57 -0400	[thread overview]
Message-ID: <87sfa4pjuu.fsf@catern.com> (raw)
In-Reply-To: 834jmkn7zt.fsf@gnu.org


The following diff makes call_process reentrant.  It can actually be
achieved quite elegantly by just moving synch_process_pid into variables
on the stack.

So with this change, this code (which executes call-process inside
call-process) works fine:

(length (let* (marks
              (timer (run-at-time "0 sec" .1
                                  (lambda ()
                                    (shell-command "true")
                                    (push (float-time) marks)))))
          (project-find-regexp "foobar")
          (cancel-timer timer)
          marks))

diff --git a/src/callproc.c b/src/callproc.c
index 6f3d4fad9be..6391ad6c6d8 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -95,26 +95,6 @@ #define _P_NOWAIT 1	/* from process.h */
 /* Pattern used by call-process-region to make temp files.  */
 static Lisp_Object Vtemp_file_name_pattern;
 
-/* The next two variables are used while record-unwind-protect is in place
-   during call-process for a subprocess for which record_deleted_pid has
-   not yet been called.  At other times, synch_process_pid is zero and
-   synch_process_tempfile's contents are irrelevant.  Doing this via static
-   C variables is more convenient than putting them into the arguments
-   of record-unwind-protect, as they need to be updated at randomish
-   times in the code, and Lisp cannot always store these values as
-   Emacs integers.  It's safe to use static variables here, as the
-   code is never invoked reentrantly.  */
-
-/* If nonzero, a process-ID that has not been reaped.  */
-static pid_t synch_process_pid;
-
-/* If a string, the name of a temp file that has not been removed.  */
-#ifdef MSDOS
-static Lisp_Object synch_process_tempfile;
-#else
-# define synch_process_tempfile make_fixnum (0)
-#endif
-
 /* Indexes of file descriptors that need closing on call_process_kill.  */
 enum
   {
@@ -189,6 +169,14 @@ record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
 }
 
 /* Clean up files, file descriptors and processes created by Fcall_process.  */
+struct synch_process {
+  /* If nonzero, a process-ID that has not been reaped.  */
+  pid_t pid;
+  /* If a string, the name of a temp file that has not been removed.  */
+  Lisp_Object tempfile;
+  int* callproc_fd;
+  Lisp_Object buffer;
+};
 
 static void
 delete_temp_file (Lisp_Object name)
@@ -199,41 +187,43 @@ delete_temp_file (Lisp_Object name)
 static void
 call_process_kill (void *ptr)
 {
-  int *callproc_fd = ptr;
+  struct synch_process *synch_process = ptr;
+  int *callproc_fd = synch_process->callproc_fd;
   int i;
   for (i = 0; i < CALLPROC_FDS; i++)
     if (0 <= callproc_fd[i])
       emacs_close (callproc_fd[i]);
 
-  if (synch_process_pid)
+  if (synch_process->pid)
     {
       struct Lisp_Process proc;
       proc.alive = 1;
-      proc.pid = synch_process_pid;
-      record_kill_process (&proc, synch_process_tempfile);
-      synch_process_pid = 0;
+      proc.pid = synch_process->pid;
+      record_kill_process (&proc, synch_process->tempfile);
+      synch_process->pid = 0;
     }
-  else if (STRINGP (synch_process_tempfile))
-    delete_temp_file (synch_process_tempfile);
+  else if (STRINGP (synch_process->tempfile))
+    delete_temp_file (synch_process->tempfile);
 }
 
 /* Clean up when exiting Fcall_process: restore the buffer, and
    kill the subsidiary process group if the process still exists.  */
 
 static void
-call_process_cleanup (Lisp_Object buffer)
+call_process_cleanup (void *ptr)
 {
-  Fset_buffer (buffer);
+  struct synch_process *synch_process = ptr;
+  Fset_buffer (synch_process->buffer);
 
 #ifndef MSDOS
-  if (synch_process_pid)
+  if (synch_process->pid)
     {
-      kill (-synch_process_pid, SIGINT);
+      kill (-synch_process->pid, SIGINT);
       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
 
       /* This will quit on C-g.  */
-      bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
-      synch_process_pid = 0;
+      bool wait_ok = wait_for_termination (synch_process->pid, NULL, true);
+      synch_process->pid = 0;
       message1 (wait_ok
 		? "Waiting for process to die...done"
 		: "Waiting for process to die...internal error");
@@ -361,9 +351,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
   Lisp_Object coding_systems;
   bool discard_output;
 
-  if (synch_process_pid)
-    error ("call-process invoked recursively");
-
   /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
   coding_systems = Qt;
 
@@ -489,10 +476,13 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 
   for (i = 0; i < CALLPROC_FDS; i++)
     callproc_fd[i] = -1;
-#ifdef MSDOS
-  synch_process_tempfile = make_fixnum (0);
-#endif
-  record_unwind_protect_ptr (call_process_kill, callproc_fd);
+  struct synch_process synch_process = {
+    .pid = 0,
+    .tempfile = make_fixnum (0),
+    .callproc_fd = callproc_fd,
+    .buffer = Fcurrent_buffer (),
+  };
+  record_unwind_protect_ptr (call_process_kill, &synch_process);
 
   /* Search for program; barf if not found.  */
   {
@@ -547,7 +537,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
       if (!*tempfile)
 	report_file_error ("Opening process output file", Qnil);
       output_file = build_string (tempfile);
-      synch_process_tempfile = output_file;
+      data.tempfile = output_file;
     }
 #endif
 
@@ -644,7 +634,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
   /* Do the unwind-protect now, even though the pid is not known, so
      that no storage allocation is done in the critical section.
      The actual PID will be filled in during the critical section.  */
-  record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
+  record_unwind_protect_ptr (call_process_cleanup, &synch_process);
 
 #ifndef MSDOS
 
@@ -659,7 +649,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 
   if (pid > 0)
     {
-      synch_process_pid = pid;
+      synch_process.pid = pid;
 
       if (FIXNUMP (buffer))
 	{
@@ -671,7 +661,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 	      record_deleted_pid (pid, args[1]);
 	      clear_unwind_protect (tempfile_index);
 	    }
-	  synch_process_pid = 0;
+	  synch_process.pid = 0;
 	}
     }
 
@@ -778,6 +768,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 	      nread += this_read;
 	      total_read += this_read;
 
+	      wait_reading_process_output(-1, -1, 0, display_on_the_fly,
+					  NULL, NULL, 0);
+	      swallow_events(display_on_the_fly);
 	      if (display_on_the_fly)
 		break;
 	    }
@@ -904,7 +897,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 
   /* Don't kill any children that the subprocess may have left behind
      when exiting.  */
-  synch_process_pid = 0;
+  synch_process.pid = 0;
 
   SAFE_FREE_UNBIND_TO (count, Qnil);
 
@@ -2035,11 +2028,6 @@ syms_of_callproc (void)
 #endif
   staticpro (&Vtemp_file_name_pattern);
 
-#ifdef MSDOS
-  synch_process_tempfile = make_fixnum (0);
-  staticpro (&synch_process_tempfile);
-#endif
-
   DEFVAR_LISP ("shell-file-name", Vshell_file_name,
 	       doc: /* File name to load inferior shells from.
 Initialized from the SHELL environment variable, or to a system-dependent




  parent reply	other threads:[~2023-07-04  1:04 UTC|newest]

Thread overview: 43+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-06-27 21:55 call-process should not block process filters from running Spencer Baugh
2023-06-28 11:39 ` Mattias Engdegård
2023-06-28 11:56 ` Po Lu
2023-06-28 12:08   ` Spencer Baugh
2023-06-28 13:17     ` Po Lu
2023-06-28 12:52 ` Eli Zaretskii
2023-06-28 13:27   ` Spencer Baugh
2023-06-28 13:34     ` Eli Zaretskii
2023-07-01 18:24     ` Spencer Baugh
2023-07-01 18:59       ` Eli Zaretskii
2023-07-01 19:17         ` Spencer Baugh
2023-07-02  5:45           ` Eli Zaretskii
2023-07-03  0:02             ` sbaugh
2023-07-03 10:00               ` Po Lu
2023-07-03 17:53                 ` sbaugh
2023-07-03 18:51                   ` Eli Zaretskii
2023-07-03 20:28                     ` sbaugh
2023-07-04  4:12                       ` Po Lu
2023-07-04 11:25                         ` Eli Zaretskii
2023-07-04 12:42                         ` sbaugh
2023-07-04 13:42                           ` Michael Albinus
2023-07-04 14:16                             ` sbaugh
2023-07-05  6:36                               ` Michael Albinus
2023-07-04 11:10                       ` Eli Zaretskii
2023-07-04 12:20                         ` sbaugh
2023-07-04 13:09                           ` Eli Zaretskii
2023-07-04 13:37                             ` sbaugh
2023-07-04 13:25                           ` Po Lu
2023-07-04  1:04                     ` sbaugh [this message]
2023-07-04  4:09                       ` Po Lu
2023-07-04 12:27                         ` sbaugh
2023-07-04 13:22                           ` Po Lu
2023-07-04 13:51                             ` sbaugh
2023-07-04 16:38                               ` Eli Zaretskii
2023-07-04 16:53                                 ` sbaugh
2023-07-04 17:14                                   ` Eli Zaretskii
2023-07-04 16:49               ` Dmitry Gutov
2023-07-04 18:12                 ` sbaugh
2023-07-05 18:53                   ` Dmitry Gutov
2023-07-06  2:24                     ` sbaugh
2023-07-06  8:06                       ` Michael Albinus
2023-07-08 15:54                         ` sbaugh
2023-07-09  9:04                           ` Michael Albinus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87sfa4pjuu.fsf@catern.com \
    --to=sbaugh@catern.com \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).