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.

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 <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 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.  */