From: Mattias Engdegård Date: Sat, 20 Jul 2024 11:12:19 +0000 (+0200) Subject: Simplify and speed up numeric comparisons X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=82365f9408461fd471a79902745c204e4af9fced;p=emacs.git 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 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