bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: miha
Subject: bug#51293: 29.0.50; [PATCH] Avoid excessive specbinding in all-completions
Date: Tue, 19 Oct 2021 23:58:17 +0200

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.

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);
 }

@@ -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: signature.asc
Description: PGP signature


reply via email to

[Prev in Thread] Current Thread [Next in Thread]