* bug#51293: 29.0.50; [PATCH] Avoid excessive specbinding in all-completions
@ 2021-10-19 21:58 miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-20 8:21 ` Lars Ingebrigtsen
0 siblings, 1 reply; 2+ messages in thread
From: miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-19 21:58 UTC (permalink / raw)
To: 51293
[-- 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 --]
^ permalink raw reply related [flat|nested] 2+ messages in thread
end of thread, other threads:[~2021-10-20 8:21 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-10-19 21:58 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
2021-10-20 8:21 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).