Simplify and speed up numeric comparisons

This makes comparison functions (=, /=, <, <=, >, >=, min, max) quite
a bit faster (10-20 %).  Bytecode ops on fixnums are not affected,
nor is `value<`.

* src/data.c (arithcompare): Simplify the code to reduce the number of
branches.  Remove the comparison code argument; instead, return the
relation encoded as bits, which can be tested cheaply.  All callers
adapted.
* src/lisp.h (enum Arith_Comparison): Remove.
(Cmp_Bit_*, cmp_bits_t): New.

4 files changed, 96 insertions, 99 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index 75f9f1d0ac7..ce075c86afd 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1242,7 +1242,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
             if (FIXNUMP (v1) && FIXNUMP (v2))
               TOP = BASE_EQ (v1, v2) ? Qt : Qnil;
             else
-              TOP = arithcompare (v1, v2, ARITH_EQUAL);
+              TOP = arithcompare (v1, v2) & Cmp_EQ ? Qt : Qnil;
             NEXT;
           }
 
@@ -1253,7 +1253,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
             if (FIXNUMP (v1) && FIXNUMP (v2))
               TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil;
             else
-              TOP = arithcompare (v1, v2, ARITH_GRTR);
+              TOP = arithcompare (v1, v2) & Cmp_GT ? Qt : Qnil;
             NEXT;
           }
 
@@ -1264,7 +1264,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
             if (FIXNUMP (v1) && FIXNUMP (v2))
               TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil;
             else
-              TOP = arithcompare (v1, v2, ARITH_LESS);
+              TOP = arithcompare (v1, v2) & Cmp_LT ? Qt : Qnil;
             NEXT;
           }
 
@@ -1275,7 +1275,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
             if (FIXNUMP (v1) && FIXNUMP (v2))
               TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil;
             else
-              TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL);
+              TOP = arithcompare (v1, v2) & (Cmp_LT | Cmp_EQ) ? Qt : Qnil;
             NEXT;
           }
 
@@ -1286,7 +1286,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
             if (FIXNUMP (v1) && FIXNUMP (v2))
               TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil;
             else
-              TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL);
+              TOP = arithcompare (v1, v2) & (Cmp_GT | Cmp_EQ) ? Qt : Qnil;
             NEXT;
           }
 
diff --git a/src/data.c b/src/data.c
index 752856abf09..b4d08a3ff06 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2682,26 +2682,13 @@ check_number_coerce_marker (Lisp_Object x)
   return x;
 }
 
-Lisp_Object
-arithcompare (Lisp_Object num1, Lisp_Object num2,
-              enum Arith_Comparison comparison)
+cmp_bits_t
+arithcompare (Lisp_Object num1, Lisp_Object num2)
 {
-  EMACS_INT i1 = 0, i2 = 0;
-  bool lt, eq = true, gt;
-  bool test;
-
   num1 = check_number_coerce_marker (num1);
   num2 = check_number_coerce_marker (num2);
 
-  /* If the comparison is mostly done by comparing two doubles,
-     set LT, EQ, and GT to the <, ==, > results of that comparison,
-     respectively, taking care to avoid problems if either is a NaN,
-     and trying to avoid problems on platforms where variables (in
-     violation of the C standard) can contain excess precision.
-     Regardless, set I1 and I2 to integers that break ties if the
-     two-double comparison is either not done or reports
-     equality.  */
-
+  bool lt, eq, gt;
   if (FLOATP (num1))
     {
       double f1 = XFLOAT_DATA (num1);
@@ -2723,16 +2710,30 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
              (exactly) so I1 - I2 = NUM1 - NUM2 (exactly), so comparing I1
              to I2 will break the tie correctly.  */
           double f2 = XFIXNUM (num2);
-          lt = f1 < f2;
-          eq = f1 == f2;
-          gt = f1 > f2;
-          i1 = f2;
-          i2 = XFIXNUM (num2);
+          if (f1 == f2)
+            {
+              EMACS_INT i1 = f2;
+              EMACS_INT i2 = XFIXNUM (num2);
+              eq = i1 == i2;
+              lt = i1 < i2;
+              gt = i1 > i2;
+            }
+          else
+            {
+              eq = false;
+              lt = f1 < f2;
+              gt = f1 > f2;
+            }
         }
       else if (isnan (f1))
         lt = eq = gt = false;
       else
-        i2 = mpz_cmp_d (*xbignum_val (num2), f1);
+        {
+          int cmp = mpz_cmp_d (*xbignum_val (num2), f1);
+          eq = cmp == 0;
+          lt = cmp > 0;
+          gt = cmp < 0;
+        }
     }
   else if (FIXNUMP (num1))
     {
@@ -2741,19 +2742,36 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
           /* Compare an integer NUM1 to a float NUM2.  This is the
              converse of comparing float to integer (see above).  */
           double f1 = XFIXNUM (num1), f2 = XFLOAT_DATA (num2);
-          lt = f1 < f2;
-          eq = f1 == f2;
-          gt = f1 > f2;
-          i1 = XFIXNUM (num1);
-          i2 = f1;
+          if (f1 == f2)
+            {
+              EMACS_INT i1 = XFIXNUM (num1);
+              EMACS_INT i2 = f1;
+              eq = i1 == i2;
+              lt = i1 < i2;
+              gt = i1 > i2;
+            }
+          else
+            {
+              eq = false;
+              lt = f1 < f2;
+              gt = f1 > f2;
+            }
         }
       else if (FIXNUMP (num2))
         {
-          i1 = XFIXNUM (num1);
-          i2 = XFIXNUM (num2);
+          EMACS_INT i1 = XFIXNUM (num1);
+          EMACS_INT i2 = XFIXNUM (num2);
+          eq = i1 == i2;
+          lt = i1 < i2;
+          gt = i1 > i2;
         }
       else
-        i2 = mpz_sgn (*xbignum_val (num2));
+        {
+          int sgn = mpz_sgn (*xbignum_val (num2));
+          eq = sgn == 0;
+          lt = sgn > 0;
+          gt = sgn < 0;
+        }
     }
   else if (FLOATP (num2))
     {
@@ -2761,61 +2779,36 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
       if (isnan (f2))
         lt = eq = gt = false;
       else
-        i1 = mpz_cmp_d (*xbignum_val (num1), f2);
+        {
+          int cmp = mpz_cmp_d (*xbignum_val (num1), f2);
+          eq = cmp == 0;
+          lt = cmp < 0;
+          gt = cmp > 0;
+        }
     }
   else if (FIXNUMP (num2))
-    i1 = mpz_sgn (*xbignum_val (num1));
-  else
-    i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
-
-  if (eq)
     {
-      /* The two-double comparison either reported equality, or was not done.
-         Break the tie by comparing the integers.  */
-      lt = i1 < i2;
-      eq = i1 == i2;
-      gt = i1 > i2;
+      int sgn = mpz_sgn (*xbignum_val (num1));
+      eq = sgn == 0;
+      lt = sgn < 0;
+      gt = sgn > 0;
     }
-
-  switch (comparison)
+  else
     {
-    case ARITH_EQUAL:
-      test = eq;
-      break;
-
-    case ARITH_NOTEQUAL:
-      test = !eq;
-      break;
-
-    case ARITH_LESS:
-      test = lt;
-      break;
-
-    case ARITH_LESS_OR_EQUAL:
-      test = lt | eq;
-      break;
-
-    case ARITH_GRTR:
-      test = gt;
-      break;
-
-    case ARITH_GRTR_OR_EQUAL:
-      test = gt | eq;
-      break;
-
-    default:
-      eassume (false);
+      int cmp = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
+      eq = cmp == 0;
+      lt = cmp < 0;
+      gt = cmp > 0;
     }
 
-  return test ? Qt : Qnil;
+  return lt << Cmp_Bit_LT | gt << Cmp_Bit_GT | eq << Cmp_Bit_EQ;
 }
 
 static Lisp_Object
-arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
-                     enum Arith_Comparison comparison)
+arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args, cmp_bits_t cmpmask)
 {
   for (ptrdiff_t i = 1; i < nargs; i++)
-    if (NILP (arithcompare (args[i - 1], args[i], comparison)))
+    if (!(arithcompare (args[i - 1], args[i]) & cmpmask))
       return Qnil;
   return Qt;
 }
@@ -2825,7 +2818,7 @@ DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
 usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare_driver (nargs, args, ARITH_EQUAL);
+  return arithcompare_driver (nargs, args, Cmp_EQ);
 }
 
 DEFUN ("<", Flss, Slss, 1, MANY, 0,
@@ -2836,7 +2829,7 @@ usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1]))
     return XFIXNUM (args[0]) < XFIXNUM (args[1]) ? Qt : Qnil;
 
-  return arithcompare_driver (nargs, args, ARITH_LESS);
+  return arithcompare_driver (nargs, args, Cmp_LT);
 }
 
 DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
@@ -2847,7 +2840,7 @@ usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1]))
     return XFIXNUM (args[0]) > XFIXNUM (args[1]) ? Qt : Qnil;
 
-  return arithcompare_driver (nargs, args, ARITH_GRTR);
+  return arithcompare_driver (nargs, args, Cmp_GT);
 }
 
 DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
@@ -2858,7 +2851,7 @@ usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1]))
     return XFIXNUM (args[0]) <= XFIXNUM (args[1]) ? Qt : Qnil;
 
-  return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL);
+  return arithcompare_driver (nargs, args, Cmp_LT | Cmp_EQ);
 }
 
 DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
@@ -2869,14 +2862,14 @@ usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1]))
     return XFIXNUM (args[0]) >= XFIXNUM (args[1]) ? Qt : Qnil;
 
-  return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
+  return arithcompare_driver (nargs, args, Cmp_GT | Cmp_EQ);
 }
 
 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
        doc: /* Return t if first arg is not equal to second arg.  Both must be numbers or markers.  */)
   (register Lisp_Object num1, Lisp_Object num2)
 {
-  return arithcompare (num1, num2, ARITH_NOTEQUAL);
+  return arithcompare (num1, num2) & Cmp_EQ ? Qnil : Qt;
 }
 
 /* Convert the cons-of-integers, integer, or float value C to an
@@ -3418,14 +3411,13 @@ Both X and Y must be numbers or markers.  */)
 }
 
 static Lisp_Object
-minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
-               enum Arith_Comparison comparison)
+minmax_driver (ptrdiff_t nargs, Lisp_Object *args, cmp_bits_t cmpmask)
 {
   Lisp_Object accum = check_number_coerce_marker (args[0]);
   for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
     {
       Lisp_Object val = check_number_coerce_marker (args[argnum]);
-      if (!NILP (arithcompare (val, accum, comparison)))
+      if (arithcompare (val, accum) & cmpmask)
         accum = val;
       else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
         return val;
@@ -3439,7 +3431,7 @@ The value is always a number; markers are converted to numbers.
 usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return minmax_driver (nargs, args, ARITH_GRTR);
+  return minmax_driver (nargs, args, Cmp_GT);
 }
 
 DEFUN ("min", Fmin, Smin, 1, MANY, 0,
@@ -3448,7 +3440,7 @@ The value is always a number; markers are converted to numbers.
 usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return minmax_driver (nargs, args, ARITH_LESS);
+  return minmax_driver (nargs, args, Cmp_LT);
 }
 
 DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
diff --git a/src/fileio.c b/src/fileio.c
index fa280f2db00..22a566a1881 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5741,7 +5741,7 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
   Lisp_Object ca = Fcar (a), cb = Fcar (b);
   if (FIXNUMP (ca) && FIXNUMP (cb))
     return XFIXNUM (ca) < XFIXNUM (cb) ? Qt : Qnil;
-  return arithcompare (ca, cb, ARITH_LESS);
+  return arithcompare (ca, cb) & Cmp_LT ? Qt : Qnil;
 }
 
 /* Build the complete list of annotations appropriate for writing out
diff --git a/src/lisp.h b/src/lisp.h
index 976b7a15251..8ac65ca429c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4224,16 +4224,21 @@ extern void notify_variable_watchers (Lisp_Object, Lisp_Object,
                                       Lisp_Object, Lisp_Object);
 extern Lisp_Object indirect_function (Lisp_Object);
 extern Lisp_Object find_symbol_value (Lisp_Object);
-enum Arith_Comparison {
-  ARITH_EQUAL,
-  ARITH_NOTEQUAL,
-  ARITH_LESS,
-  ARITH_GRTR,
-  ARITH_LESS_OR_EQUAL,
-  ARITH_GRTR_OR_EQUAL
+
+enum {
+  Cmp_Bit_EQ,
+  Cmp_Bit_LT,
+  Cmp_Bit_GT
 };
-extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
-                                 enum Arith_Comparison comparison);
+
+/* code indicating a comparison outcome */
+typedef enum {
+  Cmp_EQ = 1 << Cmp_Bit_EQ,     /* = */
+  Cmp_LT = 1 << Cmp_Bit_LT,     /* < */
+  Cmp_GT = 1 << Cmp_Bit_GT      /* > */
+} cmp_bits_t;
+
+extern cmp_bits_t arithcompare (Lisp_Object num1, Lisp_Object num2);
 
 /* Convert the Emacs representation CONS back to an integer of type
    TYPE, storing the result the variable VAR.  Signal an error if CONS