bug#51293: 29.0.50; [PATCH] Avoid excessive specbinding in all-completions

[miha--- via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1.1: Type: text/plain, Size: 818 bytes --]

If 'all-completions' is called under certain conditions,
case-fold-search is specbound and unbound for each matching candidate.
Because this variable is DEFVAR_PER_BUFFER, specbinding it is slow
(scales with number of buffers).  This patch eliminates specbinding from
the three core completion functions.

Benchmark:

  (dotimes (i 300)
    (get-buffer-create (format " *test-buffer-%s*" i)))

  (let ((completion-regexp-list '("\\`.*?")))
    (benchmark-run-compiled 50
      (all-completions "" obarray #'boundp)))

9.9 seconds without patch,
0.83 seconds with patch applied.

Note that for the performance issue to be observed, we must have a lot
of live buffers, completion-regexp-list must be non-nil and a predicate
must be passed to all-completions.  The last two conditions are
satisfied if we press M-x TAB.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Avoid-excessive-specbinding-in-all-completions.patch --]
[-- Type: text/x-patch, Size: 7034 bytes --]

From e74c44270965c725d4e6e27b2b1bebed1f5308a2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Tue, 19 Oct 2021 18:41:13 +0200
Subject: [PATCH] Avoid excessive specbinding in all-completions

* src/minibuf.c (match_regexps):
(Ftry_completion):
(Fall_completions):
(Ftest_completion): Use fast_string_match_internal to match against
regexps in completion-regexp-list without having to bind
case-fold-search.
---
 src/minibuf.c | 105 +++++++++++++++-----------------------------------
 1 file changed, 32 insertions(+), 73 deletions(-)

diff --git a/src/minibuf.c b/src/minibuf.c
index 0dc340e967..6c0cd358c5 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1545,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, Lisp_Object basis)
     return Fstring_make_multibyte (string);
 }
 
+static bool
+match_regexps (Lisp_Object string, Lisp_Object regexps,
+	       bool ignore_case)
+{
+  ptrdiff_t val;
+  for (; CONSP (regexps); regexps = XCDR (regexps))
+    {
+      CHECK_STRING (XCAR (regexps));
+
+      val = fast_string_match_internal
+	(XCAR (regexps), string,
+	 (ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil));
+
+      if (val == -2)
+	error ("Stack overflow in regexp matcher");
+      if (val < 0)
+	return false;
+    }
+  return true;
+}
+
 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
        doc: /* Return common substring of all completions of STRING in COLLECTION.
 Test each possible completion specified by COLLECTION
@@ -1578,6 +1599,7 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 is used to further constrain the set of candidates.  */)
   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
 {
+
   Lisp_Object bestmatch, tail, elt, eltstring;
   /* Size in bytes of BESTMATCH.  */
   ptrdiff_t bestmatchsize = 0;
@@ -1591,7 +1613,6 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 	       ? list_table : function_table));
   ptrdiff_t idx = 0, obsize = 0;
   int matchcount = 0;
-  ptrdiff_t bindcount = -1;
   Lisp_Object bucket, zero, end, tem;
 
   CHECK_STRING (string);
@@ -1670,27 +1691,10 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 				      completion_ignore_case ? Qt : Qnil),
 	      EQ (Qt, tem)))
 	{
-	  /* Yes.  */
-	  Lisp_Object regexps;
-
 	  /* Ignore this element if it fails to match all the regexps.  */
-	  {
-	    for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-		 regexps = XCDR (regexps))
-	      {
-		if (bindcount < 0)
-		  {
-		    bindcount = SPECPDL_INDEX ();
-		    specbind (Qcase_fold_search,
-			      completion_ignore_case ? Qt : Qnil);
-		  }
-		tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
-		if (NILP (tem))
-		  break;
-	      }
-	    if (CONSP (regexps))
-	      continue;
-	  }
+	  if (!match_regexps (eltstring, Vcompletion_regexp_list,
+			      completion_ignore_case))
+	    continue;
 
 	  /* Ignore this element if there is a predicate
 	     and the predicate doesn't like it.  */
@@ -1701,11 +1705,6 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 		tem = Fcommandp (elt, Qnil);
 	      else
 		{
-		  if (bindcount >= 0)
-		    {
-		      unbind_to (bindcount, Qnil);
-		      bindcount = -1;
-		    }
 		  tem = (type == hash_table
 			 ? call2 (predicate, elt,
 				  HASH_VALUE (XHASH_TABLE (collection),
@@ -1787,9 +1786,6 @@ DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
 	}
     }
 
-  if (bindcount >= 0)
-    unbind_to (bindcount, Qnil);
-
   if (NILP (bestmatch))
     return Qnil;		/* No completions found.  */
   /* If we are ignoring case, and there is no exact match,
@@ -1849,7 +1845,6 @@ DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
     : VECTORP (collection) ? 2
     : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
   ptrdiff_t idx = 0, obsize = 0;
-  ptrdiff_t bindcount = -1;
   Lisp_Object bucket, tem, zero;
 
   CHECK_STRING (string);
@@ -1934,27 +1929,10 @@ DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
 				      completion_ignore_case ? Qt : Qnil),
 	      EQ (Qt, tem)))
 	{
-	  /* Yes.  */
-	  Lisp_Object regexps;
-
 	  /* Ignore this element if it fails to match all the regexps.  */
-	  {
-	    for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-		 regexps = XCDR (regexps))
-	      {
-		if (bindcount < 0)
-		  {
-		    bindcount = SPECPDL_INDEX ();
-		    specbind (Qcase_fold_search,
-			      completion_ignore_case ? Qt : Qnil);
-		  }
-		tem = Fstring_match (XCAR (regexps), eltstring, zero, Qnil);
-		if (NILP (tem))
-		  break;
-	      }
-	    if (CONSP (regexps))
-	      continue;
-	  }
+	  if (!match_regexps (eltstring, Vcompletion_regexp_list,
+			      completion_ignore_case))
+	    continue;
 
 	  /* Ignore this element if there is a predicate
 	     and the predicate doesn't like it.  */
@@ -1965,11 +1943,6 @@ DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
 		tem = Fcommandp (elt, Qnil);
 	      else
 		{
-		  if (bindcount >= 0)
-		    {
-		      unbind_to (bindcount, Qnil);
-		      bindcount = -1;
-		    }
 		  tem = type == 3
 		    ? call2 (predicate, elt,
 			     HASH_VALUE (XHASH_TABLE (collection), idx - 1))
@@ -1982,9 +1955,6 @@ DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
 	}
     }
 
-  if (bindcount >= 0)
-    unbind_to (bindcount, Qnil);
-
   return Fnreverse (allmatches);
 }
 \f
@@ -2068,7 +2038,7 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
 the values STRING, PREDICATE and `lambda'.  */)
   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
 {
-  Lisp_Object regexps, tail, tem = Qnil;
+  Lisp_Object tail, tem = Qnil;
   ptrdiff_t i = 0;
 
   CHECK_STRING (string);
@@ -2154,20 +2124,9 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
     return call3 (collection, string, predicate, Qlambda);
 
   /* Reject this element if it fails to match all the regexps.  */
-  if (CONSP (Vcompletion_regexp_list))
-    {
-      ptrdiff_t count = SPECPDL_INDEX ();
-      specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
-      for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-	   regexps = XCDR (regexps))
-	{
-          /* We can test against STRING, because if we got here, then
-             the element is equivalent to it.  */
-          if (NILP (Fstring_match (XCAR (regexps), string, Qnil, Qnil)))
-	    return unbind_to (count, Qnil);
-	}
-      unbind_to (count, Qnil);
-    }
+  if (!match_regexps (string, Vcompletion_regexp_list,
+		      completion_ignore_case))
+    return Qnil;
 
   /* Finally, check the predicate.  */
   if (!NILP (predicate))
-- 
2.33.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]