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

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]

[-- 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 --]

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

[Lars Ingebrigtsen]

miha@kamnitnik.top writes:

>   (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.

Impressive!

I've tested your patch, and everything seems to work for me (and all
tests pass).  It also simplifies the code, so I've pushed this to Emacs
29 now.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no