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.

(cherry picked from commit 2fd38e5c496a2351a25e95df37a7900f6f80f22f)

diff --git a/src/bytecode.c b/src/bytecode.c
index 75f9f1d0ac7877fbcfe83f6d87672db48d47b381..ce075c86afd6584fa10a1e33120a6f31309ff60d 100644 (file)
--- 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 752856abf09879d040973decf7605cb71ac24b35..b4d08a3ff06c0344f991ba743dd06d04ece80199 100644 (file)
--- 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;
 }
 \f
 /* 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 fa280f2db0027a374978f93f2654a7f27e988071..22a566a1881efe3a1770c10be1ed64cc45f3bc93 100644 (file)
--- 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 976b7a15251f6a84a137ada0b82b552a9bd06849..8ac65ca429c7784231d1f25074750d29c045b24c 100644 (file)
--- 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