[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master 1392ec7 2/3: A quicker check for quit |
Date: |
Thu, 26 Jan 2017 05:25:42 +0000 (UTC) |
branch: master
commit 1392ec7420ee23238a1588b759c631d87a677483
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
A quicker check for quit
On some microbenchmarks this lets Emacs run 60% faster on my
platform (AMD Phenom II X4 910e, Fedora 25 x86-64).
* src/atimer.c: Include keyboard.h, for pending_signals.
* src/editfns.c (Fcompare_buffer_substrings):
* src/fns.c (Fnthcdr, Fmemq, Fmemql, Fassq, Frassq, Fplist_put)
(Fnconc, Fplist_member):
Set and clear immediate_quit before and after loop instead of
executing QUIT each time through the loop. This is OK for loops
that affect only locals.
* src/eval.c (process_quit_flag): Now static.
(maybe_quit): New function, containing QUIT’s old body.
* src/fns.c (rarely_quit): New function.
(Fmember, Fassoc, Frassoc, Fdelete, Fnreverse, Freverse)
(Flax_plist_get, Flax_plist_put, internal_equal, Fnconc):
Use it instead of QUIT, for
speed in tight loops that might modify non-locals.
* src/keyboard.h (pending_signals, process_pending_signals):
These belong to keyboard.c, so move them here ...
* src/lisp.h: ... from here.
(QUIT): Redefine in terms of the new maybe_quit function, which
contains this macro’s old definiens. This works well with branch
prediction on processors with return stack buffers, e.g., x86
other than the original Pentium.
---
src/atimer.c | 1 +
src/editfns.c | 14 +++---
src/eval.c | 11 ++++-
src/fns.c | 132 +++++++++++++++++++++++++++++++++++---------------------
src/keyboard.h | 2 +
src/lisp.h | 16 ++-----
6 files changed, 108 insertions(+), 68 deletions(-)
diff --git a/src/atimer.c b/src/atimer.c
index 7f09980..5feb1f6 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include "lisp.h"
+#include "keyboard.h"
#include "syssignal.h"
#include "systime.h"
#include "atimer.h"
diff --git a/src/editfns.c b/src/editfns.c
index bee3bbc..634aa1f 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3053,6 +3053,7 @@ determines whether case is significant or ignored. */)
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
+ immediate_quit = true;
while (i1 < endp1 && i2 < endp2)
{
@@ -3060,8 +3061,6 @@ determines whether case is significant or ignored. */)
characters, not just the bytes. */
int c1, c2;
- QUIT;
-
if (! NILP (BVAR (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
@@ -3093,14 +3092,17 @@ determines whether case is significant or ignored. */)
c1 = char_table_translate (trt, c1);
c2 = char_table_translate (trt, c2);
}
- if (c1 < c2)
- return make_number (- 1 - chars);
- if (c1 > c2)
- return make_number (chars + 1);
+ if (c1 != c2)
+ {
+ immediate_quit = false;
+ return make_number (c1 < c2 ? -1 - chars : chars + 1);
+ }
chars++;
}
+ immediate_quit = false;
+
/* The strings match as far as they go.
If one is shorter, that one is less. */
if (chars < endp1 - begp1)
diff --git a/src/eval.c b/src/eval.c
index 01e3db4..734f01d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1450,7 +1450,7 @@ static Lisp_Object find_handler_clause (Lisp_Object,
Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
-void
+static void
process_quit_flag (void)
{
Lisp_Object flag = Vquit_flag;
@@ -1462,6 +1462,15 @@ process_quit_flag (void)
quit ();
}
+void
+maybe_quit (void)
+{
+ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+ process_quit_flag ();
+ else if (pending_signals)
+ process_pending_signals ();
+}
+
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
This function does not return.
diff --git a/src/fns.c b/src/fns.c
index c65a731..c175dd9 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -84,9 +84,21 @@ See Info node `(elisp)Random Numbers' for more details. */)
}
/* Heuristic on how many iterations of a tight loop can be safely done
- before it's time to do a QUIT. This must be a power of 2. */
+ before it's time to do a quit. This must be a power of 2. It
+ is nice but not necessary for it to equal USHRT_MAX + 1. */
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
+/* Process a quit, but do it only rarely, for efficiency. "Rarely"
+ means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
+ whichever is smaller. Use *QUIT_COUNT to count this. */
+
+static void
+rarely_quit (unsigned short int *quit_count)
+{
+ if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
+ QUIT;
+}
+
/* Random data-structure functions. */
DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -1348,16 +1360,18 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
CHECK_NUMBER (n);
EMACS_INT num = XINT (n);
Lisp_Object tail = list;
+ immediate_quit = true;
for (EMACS_INT i = 0; i < num; i++)
{
if (! CONSP (tail))
{
+ immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
tail = XCDR (tail);
- QUIT;
}
+ immediate_quit = false;
return tail;
}
@@ -1387,12 +1401,13 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (! NILP (Fequal (elt, XCAR (tail))))
return tail;
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1403,13 +1418,17 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
+ immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (EQ (XCAR (tail), elt))
- return tail;
- QUIT;
+ {
+ immediate_quit = false;
+ return tail;
+ }
}
+ immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1422,14 +1441,18 @@ The value is actually the tail of LIST whose car is
ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
+ immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object tem = XCAR (tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
- return tail;
- QUIT;
+ {
+ immediate_quit = false;
+ return tail;
+ }
}
+ immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1440,13 +1463,15 @@ The value is actually the first element of LIST whose
car is KEY.
Elements of LIST that are not conses are ignored. */)
(Lisp_Object key, Lisp_Object list)
{
+ immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
+ {
+ immediate_quit = false;
return XCAR (tail);
- QUIT;
- }
+ }
+ immediate_quit = true;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1468,6 +1493,7 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
The value is actually the first element of LIST whose car equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
@@ -1475,7 +1501,7 @@ The value is actually the first element of LIST whose car
equals KEY. */)
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1502,13 +1528,15 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
The value is actually the first element of LIST whose cdr is KEY. */)
(Lisp_Object key, Lisp_Object list)
{
+ immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- {
- if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
+ {
+ immediate_quit = false;
return XCAR (tail);
- QUIT;
- }
+ }
+ immediate_quit = true;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1518,6 +1546,7 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
The value is actually the first element of LIST whose cdr equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
@@ -1525,7 +1554,7 @@ The value is actually the first element of LIST whose cdr
equals KEY. */)
if (CONSP (car)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1666,6 +1695,7 @@ changing the value of a sequence `foo'. */)
}
else
{
+ unsigned short int quit_count = 0;
Lisp_Object tail, prev;
for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
@@ -1679,7 +1709,7 @@ changing the value of a sequence `foo'. */)
}
else
prev = tail;
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, seq);
}
@@ -1699,11 +1729,12 @@ This function may destructively modify SEQ to produce
the value. */)
return Freverse (seq);
else if (CONSP (seq))
{
+ unsigned short int quit_count = 0;
Lisp_Object prev, tail, next;
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
- QUIT;
+ rarely_quit (&quit_count);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
@@ -1749,9 +1780,10 @@ See also the function `nreverse', which is used more
often. */)
return Qnil;
else if (CONSP (seq))
{
+ unsigned short int quit_count = 0;
for (new = Qnil; CONSP (seq); seq = XCDR (seq))
{
- QUIT;
+ rarely_quit (&quit_count);
new = Fcons (XCAR (seq), new);
}
CHECK_LIST_END (seq, seq);
@@ -2041,28 +2073,28 @@ If PROP is already a property on the list, its value is
set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
- (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- register Lisp_Object tail, prev;
- Lisp_Object newcell;
- prev = Qnil;
- for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
+ immediate_quit = true;
+ Lisp_Object prev = Qnil;
+ for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (prop, XCAR (tail)))
{
+ immediate_quit = false;
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
- QUIT;
}
- newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR
(prev))));
+ immediate_quit = true;
+ Lisp_Object newcell
+ = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
return newcell;
- else
- Fsetcdr (XCDR (prev), newcell);
+ Fsetcdr (XCDR (prev), newcell);
return plist;
}
@@ -2085,6 +2117,7 @@ corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
{
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = plist;
@@ -2093,8 +2126,7 @@ one of the properties on the list. */)
{
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
-
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, prop);
@@ -2110,12 +2142,11 @@ If PROP is already a property on the list, its value is
set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
- (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- register Lisp_Object tail, prev;
- Lisp_Object newcell;
- prev = Qnil;
- for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
+ unsigned short int quit_count = 0;
+ Lisp_Object prev = Qnil;
+ for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (! NILP (Fequal (prop, XCAR (tail))))
@@ -2125,13 +2156,12 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- QUIT;
+ rarely_quit (&quit_count);
}
- newcell = list2 (prop, val);
+ Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
- else
- Fsetcdr (XCDR (prev), newcell);
+ Fsetcdr (XCDR (prev), newcell);
return plist;
}
@@ -2204,8 +2234,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
}
}
+ unsigned short int quit_count = 0;
tail_recurse:
- QUIT;
+ rarely_quit (&quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@@ -2394,14 +2425,12 @@ Only the last argument is not altered, and need not be
a list.
usage: (nconc &rest LISTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t argnum;
- register Lisp_Object tail, tem, val;
+ unsigned short int quit_count = 0;
+ Lisp_Object val = Qnil;
- val = tail = Qnil;
-
- for (argnum = 0; argnum < nargs; argnum++)
+ for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
{
- tem = args[argnum];
+ Lisp_Object tem = args[argnum];
if (NILP (tem)) continue;
if (NILP (val))
@@ -2411,14 +2440,18 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
+ immediate_quit = true;
+ Lisp_Object tail;
do
{
tail = tem;
tem = XCDR (tail);
- QUIT;
}
while (CONSP (tem));
+ immediate_quit = false;
+ rarely_quit (&quit_count);
+
tem = args[argnum + 1];
Fsetcdr (tail, tem);
if (NILP (tem))
@@ -2839,12 +2872,13 @@ property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
{
+ immediate_quit = true;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
plist = XCDR (plist);
plist = CDR (plist);
- QUIT;
}
+ immediate_quit = false;
return plist;
}
diff --git a/src/keyboard.h b/src/keyboard.h
index 7cd41ae..2219c01 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -486,6 +486,8 @@ extern bool kbd_buffer_events_waiting (void);
extern void add_user_signal (int, const char *);
extern int tty_read_avail_input (struct terminal *, struct input_event *);
+extern bool volatile pending_signals;
+extern void process_pending_signals (void);
extern struct timespec timer_check (void);
extern void mark_kboards (void);
diff --git a/src/lisp.h b/src/lisp.h
index 7e91824..01a08a0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3133,20 +3133,12 @@ extern Lisp_Object memory_signal_data;
and (in particular) cannot call arbitrary Lisp code.
If quit-flag is set to `kill-emacs' the SIGINT handler has received
- a request to exit Emacs when it is safe to do. */
+ a request to exit Emacs when it is safe to do.
-extern void process_pending_signals (void);
-extern bool volatile pending_signals;
-
-extern void process_quit_flag (void);
-#define QUIT \
- do { \
- if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
- process_quit_flag (); \
- else if (pending_signals) \
- process_pending_signals (); \
- } while (false)
+ When not quitting, process any pending signals. */
+extern void maybe_quit (void);
+#define QUIT maybe_quit ()
/* True if ought to quit now. */