From 1392ec7420ee23238a1588b759c631d87a677483 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 25 Jan 2017 20:27:45 -0800 Subject: [PATCH] A quicker check for quit MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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 7f099809d3c..5feb1f6777d 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #include #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 bee3bbc2cdd..634aa1f63b2 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 01e3db44082..734f01d81ae 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 c65a731f325..c175dd935d3 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 7cd41ae55b6..2219c011352 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 7e918249935..01a08a05f20 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. */ -- 2.39.5