bug#66020: [PATCH] Reduce GC churn in read_process_output

[Dmitry Gutov <dmitry@gutov.dev>]

[-- Attachment #1: Type: text/plain, Size: 204 bytes --]

Here are the previously discussed patches, collected in one place for 
easier review.

As explained, the last one is more experimental, a possible alternative 
to bumping read-process-output-max to 65536.

[-- Attachment #2: 0001-Go-around-calling-the-default-process-filter-reducin.patch --]
[-- Type: text/x-patch, Size: 9976 bytes --]

From 0082fce45b677f7f92d1a4cbac5b12b763941ad2 Mon Sep 17 00:00:00 2001
From: Dmitry Gutov <dmitry@gutov.dev>
Date: Sun, 24 Sep 2023 01:19:14 +0300
Subject: [PATCH 1/3] Go around calling the default process filter (reducing GC
 churn)

Instead of allocating strings and passing them to the filter, passing
the char buffer to a C function implementing the same logic.

* src/process.c (read_process_output_before_insert)
(read_process_output_after_insert): New functions, extracted from
internal-default-process-filter.
(Finternal_default_process_filter): Use them.
(read_and_insert_process_output): New function.  Use them.
(read_process_output_fast): New variable.
(read_process_output): Use it to choose how to insert (bug#66020).
---
 src/process.c | 198 ++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 143 insertions(+), 55 deletions(-)

diff --git a/src/process.c b/src/process.c
index 2376d0f288d..e932ecf7e43 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6113,6 +6113,11 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
 				    ssize_t nbytes,
 				    struct coding_system *coding);
 
+static void
+read_and_insert_process_output (struct Lisp_Process *p, char *buf,
+				    ssize_t nread,
+				struct coding_system *process_coding);
+
 /* Read pending output from the process channel,
    starting with our buffered-ahead character if we have one.
    Yield number of decoded characters read,
@@ -6228,7 +6233,10 @@ read_process_output (Lisp_Object proc, int channel)
      friends don't expect current-buffer to be changed from under them.  */
   record_unwind_current_buffer ();
 
-  read_and_dispose_of_process_output (p, chars, nbytes, coding);
+  if (p->filter == Qinternal_default_process_filter)
+    read_and_insert_process_output (p, chars, nbytes, coding);
+  else
+    read_and_dispose_of_process_output (p, chars, nbytes, coding);
 
   /* Handling the process output should not deactivate the mark.  */
   Vdeactivate_mark = odeactivate;
@@ -6237,6 +6245,128 @@ read_process_output (Lisp_Object proc, int channel)
   return nbytes;
 }
 
+static void
+read_process_output_before_insert (struct Lisp_Process *p, Lisp_Object *old_read_only,
+				   ptrdiff_t *old_begv, ptrdiff_t *old_zv,
+				   ptrdiff_t *before, ptrdiff_t *before_byte,
+				   ptrdiff_t *opoint, ptrdiff_t *opoint_byte)
+{
+  Fset_buffer (p->buffer);
+  *opoint = PT;
+  *opoint_byte = PT_BYTE;
+  *old_read_only = BVAR (current_buffer, read_only);
+  *old_begv = BEGV;
+  *old_zv = ZV;
+
+  bset_read_only (current_buffer, 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_point_from_marker (p->mark);
+  else
+    SET_PT_BOTH (ZV, ZV_BYTE);
+  *before = PT;
+  *before_byte = PT_BYTE;
+
+  /* If the output marker is outside of the visible region, save
+     the restriction and widen.  */
+  if (! (BEGV <= PT && PT <= ZV))
+    Fwiden ();
+}
+
+static void
+read_process_output_after_insert (struct Lisp_Process *p, Lisp_Object *old_read_only,
+				  ptrdiff_t old_begv, ptrdiff_t old_zv,
+				  ptrdiff_t before, ptrdiff_t before_byte,
+				  ptrdiff_t opoint, ptrdiff_t opoint_byte)
+{
+  struct buffer *b;
+
+  /* Make sure the process marker's position is valid when the
+     process buffer is changed in the signal_after_change above.
+     W3 is known to do that.  */
+  if (BUFFERP (p->buffer)
+      && (b = XBUFFER (p->buffer), b != current_buffer))
+    set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
+  else
+    set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
+
+  update_mode_lines = 23;
+
+  /* Make sure opoint and the old restrictions
+     float ahead of any new text just as point would.  */
+  if (opoint >= before)
+    {
+      opoint += PT - before;
+      opoint_byte += PT_BYTE - before_byte;
+    }
+  if (old_begv > before)
+    old_begv += PT - before;
+  if (old_zv >= before)
+    old_zv += PT - before;
+
+  /* If the restriction isn't what it should be, set it.  */
+  if (old_begv != BEGV || old_zv != ZV)
+    Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv));
+
+  bset_read_only (current_buffer, *old_read_only);
+  SET_PT_BOTH (opoint, opoint_byte);
+}
+
+static void read_and_insert_process_output (struct Lisp_Process *p, char *buf,
+				    ssize_t nread,
+				    struct coding_system *process_coding)
+{
+  if (!nread || NILP (p->buffer) || !BUFFER_LIVE_P (XBUFFER (p->buffer)))
+    return;
+
+  Lisp_Object old_read_only;
+  ptrdiff_t old_begv, old_zv;
+  ptrdiff_t before, before_byte;
+  ptrdiff_t opoint, opoint_byte;
+
+  read_process_output_before_insert (p, &old_read_only, &old_begv, &old_zv,
+				     &before, &before_byte, &opoint, &opoint_byte);
+
+  /* Adapted from call_process.  */
+  if (NILP (BVAR (XBUFFER(p->buffer), enable_multibyte_characters))
+	   && ! CODING_MAY_REQUIRE_DECODING (process_coding))
+    {
+      insert_1_both (buf, nread, nread, 0, 0, 0);
+      signal_after_change (PT - nread, 0, nread);
+    }
+  else
+    {			/* We have to decode the input.  */
+      Lisp_Object curbuf;
+      int carryover = 0;
+      specpdl_ref count1 = SPECPDL_INDEX ();
+
+      XSETBUFFER (curbuf, current_buffer);
+      /* We cannot allow after-change-functions be run
+	 during decoding, because that might modify the
+	 buffer, while we rely on process_coding.produced to
+	 faithfully reflect inserted text until we
+	 TEMP_SET_PT_BOTH below.  */
+      specbind (Qinhibit_modification_hooks, Qt);
+      decode_coding_c_string (process_coding,
+			      (unsigned char *) buf, nread, curbuf);
+      unbind_to (count1, Qnil);
+
+      TEMP_SET_PT_BOTH (PT + process_coding->produced_char,
+			PT_BYTE + process_coding->produced);
+      signal_after_change (PT - process_coding->produced_char,
+			   0, process_coding->produced_char);
+      carryover = process_coding->carryover_bytes;
+      if (carryover > 0)
+	memcpy (buf, process_coding->carryover,
+		process_coding->carryover_bytes);
+    }
+
+  read_process_output_after_insert (p, &old_read_only, old_begv, old_zv,
+				    before, before_byte, opoint, opoint_byte);
+}
+
 static void
 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
 				    ssize_t nbytes,
@@ -6340,7 +6470,6 @@ DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
   (Lisp_Object proc, Lisp_Object text)
 {
   struct Lisp_Process *p;
-  ptrdiff_t opoint;
 
   CHECK_PROCESS (proc);
   p = XPROCESS (proc);
@@ -6351,31 +6480,10 @@ DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
       Lisp_Object old_read_only;
       ptrdiff_t old_begv, old_zv;
       ptrdiff_t before, before_byte;
-      ptrdiff_t opoint_byte;
-      struct buffer *b;
-
-      Fset_buffer (p->buffer);
-      opoint = PT;
-      opoint_byte = PT_BYTE;
-      old_read_only = BVAR (current_buffer, read_only);
-      old_begv = BEGV;
-      old_zv = ZV;
-
-      bset_read_only (current_buffer, 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_point_from_marker (p->mark);
-      else
-	SET_PT_BOTH (ZV, ZV_BYTE);
-      before = PT;
-      before_byte = PT_BYTE;
+      ptrdiff_t opoint, opoint_byte;
 
-      /* If the output marker is outside of the visible region, save
-	 the restriction and widen.  */
-      if (! (BEGV <= PT && PT <= ZV))
-	Fwiden ();
+      read_process_output_before_insert (p, &old_read_only, &old_begv, &old_zv,
+					 &before, &before_byte, &opoint, &opoint_byte);
 
       /* Adjust the multibyteness of TEXT to that of the buffer.  */
       if (NILP (BVAR (current_buffer, enable_multibyte_characters))
@@ -6388,35 +6496,8 @@ DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
       insert_from_string_before_markers (text, 0, 0,
 					 SCHARS (text), SBYTES (text), 0);
 
-      /* Make sure the process marker's position is valid when the
-	 process buffer is changed in the signal_after_change above.
-	 W3 is known to do that.  */
-      if (BUFFERP (p->buffer)
-	  && (b = XBUFFER (p->buffer), b != current_buffer))
-	set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
-      else
-	set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
-
-      update_mode_lines = 23;
-
-      /* Make sure opoint and the old restrictions
-	 float ahead of any new text just as point would.  */
-      if (opoint >= before)
-	{
-	  opoint += PT - before;
-	  opoint_byte += PT_BYTE - before_byte;
-	}
-      if (old_begv > before)
-	old_begv += PT - before;
-      if (old_zv >= before)
-	old_zv += PT - before;
-
-      /* If the restriction isn't what it should be, set it.  */
-      if (old_begv != BEGV || old_zv != ZV)
-	Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv));
-
-      bset_read_only (current_buffer, old_read_only);
-      SET_PT_BOTH (opoint, opoint_byte);
+      read_process_output_after_insert (p, &old_read_only, old_begv, old_zv,
+					before, before_byte, opoint, opoint_byte);
     }
   return Qnil;
 }
@@ -8764,6 +8845,13 @@ syms_of_process (void)
 /proc/sys/fs/pipe-max-size.  See pipe(7) manpage for details.  */);
   read_process_output_max = 4096;
 
+  DEFVAR_BOOL ("read-process-output-fast", read_process_output_fast,
+	       doc: /* Non-nil to optimize the insertion of process output.
+We skip calling `internal-default-process-filter' and don't allocate
+the Lisp string that would be used as its argument.  Only affects the
+case of asynchronous process with the default filter.  */);
+  read_process_output_fast = Qt;
+
   DEFVAR_INT ("process-error-pause-time", process_error_pause_time,
 	      doc: /* The number of seconds to pause after handling process errors.
 This isn't used for all process-related errors, but is used when a
-- 
2.37.2


[-- Attachment #3: 0002-Remember-the-value-of-read_process_output_max-when-a.patch --]
[-- Type: text/x-patch, Size: 2563 bytes --]

From bc3996f7275780970d2d5dc53da2fd5a8caad1e4 Mon Sep 17 00:00:00 2001
From: Dmitry Gutov <dmitry@gutov.dev>
Date: Sun, 24 Sep 2023 01:24:19 +0300
Subject: [PATCH 2/3] Remember the value of read_process_output_max when a
 process is created

* src/process.c (read_process_output): Use it.
(create_process): Save the value of read_process_output_max to it when
the process is created (bug#66020).
(create_process): Make sure not to reduce the pipe's buffer, only
increase it if our value is higher than the one set by the OS.

* src/process.h (Lisp_Process): Add field readmax.
---
 src/process.c | 7 +++++--
 src/process.h | 2 ++
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/process.c b/src/process.c
index e932ecf7e43..d7aedcdf12d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -2193,6 +2193,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
       outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
     }
 
+  p->readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
+
   /* Set up stdout for the child process.  */
   if (ptychannel >= 0 && p->pty_out)
     {
@@ -2208,7 +2210,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
 
 #if (defined (GNU_LINUX) || defined __ANDROID__)	\
   && defined (F_SETPIPE_SZ)
-      fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
+      if (p->readmax > fcntl (inchannel, F_GETPIPE_SZ, read_process_output_max))
+	fcntl (inchannel, F_SETPIPE_SZ, p->readmax);
 #endif /* (GNU_LINUX || __ANDROID__) && F_SETPIPE_SZ */
     }
 
@@ -6138,7 +6141,7 @@ read_process_output (Lisp_Object proc, int channel)
   eassert (0 <= channel && channel < FD_SETSIZE);
   struct coding_system *coding = proc_decode_coding_system[channel];
   int carryover = p->decoding_carryover;
-  ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
+  ptrdiff_t readmax = p->readmax;
   specpdl_ref count = SPECPDL_INDEX ();
   Lisp_Object odeactivate;
   char *chars;
diff --git a/src/process.h b/src/process.h
index bbe4528dc31..980c7216689 100644
--- a/src/process.h
+++ b/src/process.h
@@ -153,6 +153,8 @@ #define EMACS_PROCESS_H
     unsigned int adaptive_read_buffering : 2;
     /* Skip reading this process on next read.  */
     bool_bf read_output_skip : 1;
+    /* Maximum number of bytes to read in a single chunk. */
+    ptrdiff_t readmax;
     /* True means kill silently if Emacs is exited.
        This is the inverse of the `query-on-exit' flag.  */
     bool_bf kill_without_query : 1;
-- 
2.37.2


[-- Attachment #4: 0003-Dynamically-increase-the-readmax-if-the-pipe-has-mor.patch --]
[-- Type: text/x-patch, Size: 1015 bytes --]

From c1300397f86a397ae38ad08126dc8e021067f128 Mon Sep 17 00:00:00 2001
From: Dmitry Gutov <dmitry@gutov.dev>
Date: Sun, 24 Sep 2023 01:29:18 +0300
Subject: [PATCH 3/3] Dynamically increase the readmax if the pipe has more
 available

* src/process.c (read_process_output): Dynamically increase the
buffer size depending on the pipe's buffered contents (bug#66020).
---
 src/process.c | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/src/process.c b/src/process.c
index d7aedcdf12d..13cf6d6c50d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6146,6 +6146,17 @@ read_process_output (Lisp_Object proc, int channel)
   Lisp_Object odeactivate;
   char *chars;
 
+#ifdef USABLE_FIONREAD
+#ifdef DATAGRAM_SOCKETS
+  if (!DATAGRAM_CHAN_P (channel))
+#endif
+    {
+      int available_read;
+      ioctl (p->infd, FIONREAD, &available_read);
+      readmax = MAX (readmax, available_read);
+    }
+#endif
+
   USE_SAFE_ALLOCA;
   chars = SAFE_ALLOCA (sizeof coding->carryover + readmax);
 
-- 
2.37.2