bug#64391: buffer narrowing slowdown regression in emacs 29

["Mattias Engdegård" <mattias.engdegard@gmail.com>]

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

1 juli 2023 kl. 06.59 skrev Andrew Cohen <acohen@ust.hk>:

> Just for fun I simply commented it out (since the test code doesn't use
> labeled restrictions) and ran the test code, and the problem disappears:

The attached patch combines narrow-to-region and internal--label-restriction into a single function, internal--narrow-to-region. (We could also add the label as an optional argument to narrow-to-region.)

As a result, the up-front consing and marker allocation disappear entirely for normal (unlabelled) narrowing, as does the expensive buffer-local `outermost-restriction` variable.

Labelled narrowing is almost as expensive as before but is, we hope, less common. Maybe we can work separately on reducing its cost.

(And to those reading the patch: yes, some work on doc strings is needed. Suggestions welcome.)


[-- Attachment #2: narrow-to-region-with-label.diff --]
[-- Type: application/octet-stream, Size: 5509 bytes --]

diff --git a/lisp/subr.el b/lisp/subr.el
index 4c462830120..37c9a422e7f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4077,8 +4077,7 @@ with-restriction
 (defun internal--with-restriction (start end body &optional label)
   "Helper function for `with-restriction', which see."
   (save-restriction
-    (narrow-to-region start end)
-    (if label (internal--label-restriction label))
+    (internal--narrow-to-region start end label)
     (funcall body)))
 
 (defmacro without-restriction (&rest rest)
diff --git a/src/editfns.c b/src/editfns.c
index b920857b664..c434fbd4d39 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2682,7 +2682,7 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
    records the restriction bounds that were current when the first
    labeled restriction was entered (which may be a narrowing that was
    set by the user and is visible on display).  This alist is used
-   internally by narrow-to-region, widen, internal--label-restriction,
+   internally by internal--narrow-to-region, widen,
    internal--unlabel-restriction and save-restriction.  For efficiency
    reasons, an alist is used instead of a buffer-local variable:
    otherwise reset_outermost_restrictions, which is called during each
@@ -2868,8 +2868,7 @@ unwind_labeled_narrow_to_region (Lisp_Object label)
 labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv,
 			  Lisp_Object label)
 {
-  Fnarrow_to_region (begv, zv);
-  Finternal__label_restriction (label);
+  Finternal__narrow_to_region (begv, zv, label);
   record_unwind_protect (restore_point_unwind, Fpoint_marker ());
   record_unwind_protect (unwind_labeled_narrow_to_region, label);
 }
@@ -2885,7 +2884,6 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
 `without-restriction' with the same label.  */)
   (void)
 {
-  Fset (Qoutermost_restriction, Qnil);
   Lisp_Object buf = Fcurrent_buffer ();
   Lisp_Object label = labeled_restrictions_peek_label (buf);
 
@@ -2940,6 +2938,15 @@ positions (integers or markers) bounding the text that should
 argument.  To gain access to other portions of the buffer, use
 `without-restriction' with the same label.  */)
   (Lisp_Object start, Lisp_Object end)
+{
+  return Finternal__narrow_to_region (start, end, Qnil);
+}
+
+DEFUN ("internal--narrow-to-region", Finternal__narrow_to_region,
+       Sinternal__narrow_to_region, 3, 3, 0,
+       doc: /* Labelled restriction of editing to a region.
+Internal use only.  */)
+  (Lisp_Object start, Lisp_Object end, Lisp_Object label)
 {
   EMACS_INT s = fix_position (start), e = fix_position (end);
 
@@ -2968,11 +2975,11 @@ positions (integers or markers) bounding the text that should
     }
 
   /* Record the accessible range of the buffer when narrow-to-region
-     is called, that is, before applying the narrowing.  That
-     information is used only by internal--label-restriction.  */
-  Fset (Qoutermost_restriction, list3 (Qoutermost_restriction,
-				       Fpoint_min_marker (),
-				       Fpoint_max_marker ()));
+     is called, that is, before applying the narrowing.  */
+  EMACS_INT begv = BEGV;
+  EMACS_INT begv_byte = BEGV_BYTE;
+  EMACS_INT zv = ZV;
+  EMACS_INT zv_byte = ZV_BYTE;
 
   if (BEGV != s || ZV != e)
     current_buffer->clip_changed = 1;
@@ -2986,28 +2993,21 @@ positions (integers or markers) bounding the text that should
     SET_PT (e);
   /* Changing the buffer bounds invalidates any recorded current column.  */
   invalidate_current_column ();
-  return Qnil;
-}
 
-DEFUN ("internal--label-restriction", Finternal__label_restriction,
-       Sinternal__label_restriction, 1, 1, 0,
-       doc: /* Label the current restriction with LABEL.
+  if (!NILP (label))
+    {
+      if (NILP (labeled_restrictions_peek_label (buf)))
+	labeled_restrictions_push (buf,
+				   list3 (Qoutermost_restriction,
+					  build_marker (current_buffer,
+							begv, begv_byte),
+					  build_marker (current_buffer,
+							zv, zv_byte)));
+      labeled_restrictions_push (buf, list3 (label,
+					     Fpoint_min_marker (),
+					     Fpoint_max_marker ()));
+    }
 
-This is an internal function used by `with-restriction'.  */)
-  (Lisp_Object label)
-{
-  Lisp_Object buf = Fcurrent_buffer ();
-  Lisp_Object outermost_restriction
-    = buffer_local_value (Qoutermost_restriction, buf);
-  /* If internal--label-restriction is ever called without being
-     preceded by narrow-to-region, do nothing.  */
-  if (NILP (outermost_restriction))
-    return Qnil;
-  if (NILP (labeled_restrictions_peek_label (buf)))
-    labeled_restrictions_push (buf, outermost_restriction);
-  labeled_restrictions_push (buf, list3 (label,
-					 Fpoint_min_marker (),
-					 Fpoint_max_marker ()));
   return Qnil;
 }
 
@@ -4865,10 +4865,6 @@ syms_of_editfns (void)
 it to be non-nil.  */);
   binary_as_unsigned = false;
 
-  DEFVAR_LISP ("outermost-restriction", Voutermost_restriction,
-	       doc: /* Outermost narrowing bounds, if any.  Internal use only.  */);
-  Voutermost_restriction = Qnil;
-  Fmake_variable_buffer_local (Qoutermost_restriction);
   DEFSYM (Qoutermost_restriction, "outermost-restriction");
   Funintern (Qoutermost_restriction, Qnil);
 
@@ -4963,7 +4959,7 @@ syms_of_editfns (void)
   defsubr (&Sdelete_and_extract_region);
   defsubr (&Swiden);
   defsubr (&Snarrow_to_region);
-  defsubr (&Sinternal__label_restriction);
+  defsubr (&Sinternal__narrow_to_region);
   defsubr (&Sinternal__unlabel_restriction);
   defsubr (&Ssave_restriction);
   defsubr (&Stranspose_regions);