From fe042e9d15da7863b5beb4c2cc326a62d2c7fccb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 3 Sep 2018 18:37:40 -0700 Subject: [PATCH] Speed up (+ 2 2) by a factor of 10 MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Improve arithmetic performance by avoiding bignums until needed. Also, simplify bignum memory management, fixing some unlikely leaks. This patch improved the performance of (+ 2 2) by a factor of ten on a simple microbenchmark computing (+ x 2), byte-compiled, with x a local variable initialized to 2 via means the byte compiler could not predict: performance improved from 135 to 13 ns. The platform was Fedora 28 x86-64, AMD Phenom II X4 910e. Performance also improved 0.6% on ‘make compile-always’. * src/bignum.c (init_bignum_once): New function. * src/emacs.c (main): Use it. * src/bignum.c (mpz): New global var. (make_integer_mpz): Rename from make_integer. All uses changed. * src/bignum.c (double_to_bignum, make_bignum_bits) (make_bignum, make_bigint, make_biguint, make_integer_mpz): * src/data.c (bignum_arith_driver, Frem, Flogcount, Fash) (expt_integer, Fadd1, Fsub1, Flognot): * src/floatfns.c (Fabs, rounding_driver, rounddiv_q): * src/fns.c (Fnthcdr): Use mpz rather than mpz_initting and mpz_clearing private temporaries. * src/bignum.h (bignum_integer): New function. * src/data.c (Frem, Fmod, Fash, expt_integer): * src/floatfns.c (rounding_driver): Use it to simplify code. * src/data.c (FIXNUMS_FIT_IN_LONG, free_mpz_value): Remove. All uses removed. (floating_point_op): New function. (floatop_arith_driver): New function, with much of the guts of the old float_arith_driver. (float_arith_driver): Use it. (floatop_arith_driver, arith_driver): Simplify by assuming NARGS is at least 2. All callers changed. (float_arith_driver): New arg, containing the partly converted value of the next arg. Reorder args for consistency. All uses changed. (bignum_arith_driver): New function. (arith_driver): Use it. Do fixnum-only integer calculations in intmax_t instead of mpz_t, when they fit. Break out mpz_t calculations into bignum_arith_driver. (Fquo): Use floatop_arith_driver instead of float_arith_driver, since the op is known to be valid. (Flogcount, Fash): Simplify by coalescing bignum and fixnum code. (Fadd1, Fsub1): Simplify by using make_int. --- src/bignum.c | 71 +++--- src/bignum.h | 19 +- src/data.c | 669 ++++++++++++++++++++----------------------------- src/emacs.c | 1 + src/floatfns.c | 44 +--- src/fns.c | 12 +- 6 files changed, 340 insertions(+), 476 deletions(-) diff --git a/src/bignum.c b/src/bignum.c index b18ceccb59d..2ce7412d06c 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -25,6 +25,22 @@ along with GNU Emacs. If not, see . */ #include +/* mpz global temporaries. Making them global saves the trouble of + properly using mpz_init and mpz_clear on temporaries even when + storage is exhausted. Admittedly this is not ideal. An mpz value + in a temporary is made permanent by mpz_swapping it with a bignum's + value. Although typically at most two temporaries are needed, + rounding_driver and rounddiv_q need four altogther. */ + +mpz_t mpz[4]; + +void +init_bignum_once (void) +{ + for (int i = 0; i < ARRAYELTS (mpz); i++) + mpz_init (mpz[i]); +} + /* Return the value of the Lisp bignum N, as a double. */ double bignum_to_double (Lisp_Object n) @@ -36,17 +52,14 @@ bignum_to_double (Lisp_Object n) Lisp_Object double_to_bignum (double d) { - mpz_t z; - mpz_init_set_d (z, d); - Lisp_Object result = make_integer (z); - mpz_clear (z); - return result; + mpz_set_d (mpz[0], d); + return make_integer_mpz (); } -/* Return a Lisp integer equal to OP, which has BITS bits and which - must not be in fixnum range. */ +/* Return a Lisp integer equal to mpz[0], which has BITS bits and which + must not be in fixnum range. Set mpz[0] to a junk value. */ static Lisp_Object -make_bignum_bits (mpz_t const op, size_t bits) +make_bignum_bits (size_t bits) { /* The documentation says integer-width should be nonnegative, so a single comparison suffices even though 'bits' is unsigned. */ @@ -55,18 +68,17 @@ make_bignum_bits (mpz_t const op, size_t bits) struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, PVEC_BIGNUM); - /* We could mpz_init + mpz_swap here, to avoid a copy, but the - resulting API seemed possibly confusing. */ - mpz_init_set (b->value, op); - + mpz_init (b->value); + mpz_swap (b->value, mpz[0]); return make_lisp_ptr (b, Lisp_Vectorlike); } -/* Return a Lisp integer equal to OP, which must not be in fixnum range. */ +/* Return a Lisp integer equal to mpz[0], which must not be in fixnum range. + Set mpz[0] to a junk value. */ static Lisp_Object -make_bignum (mpz_t const op) +make_bignum (void) { - return make_bignum_bits (op, mpz_sizeinbase (op, 2)); + return make_bignum_bits (mpz_sizeinbase (mpz[0], 2)); } static void mpz_set_uintmax_slow (mpz_t, uintmax_t); @@ -86,30 +98,23 @@ Lisp_Object make_bigint (intmax_t n) { eassert (FIXNUM_OVERFLOW_P (n)); - mpz_t z; - mpz_init (z); - mpz_set_intmax (z, n); - Lisp_Object result = make_bignum (z); - mpz_clear (z); - return result; + mpz_set_intmax (mpz[0], n); + return make_bignum (); } Lisp_Object make_biguint (uintmax_t n) { eassert (FIXNUM_OVERFLOW_P (n)); - mpz_t z; - mpz_init (z); - mpz_set_uintmax (z, n); - Lisp_Object result = make_bignum (z); - mpz_clear (z); - return result; + mpz_set_uintmax (mpz[0], n); + return make_bignum (); } -/* Return a Lisp integer with value taken from OP. */ +/* Return a Lisp integer with value taken from mpz[0]. + Set mpz[0] to a junk value. */ Lisp_Object -make_integer (mpz_t const op) +make_integer_mpz (void) { - size_t bits = mpz_sizeinbase (op, 2); + size_t bits = mpz_sizeinbase (mpz[0], 2); if (bits <= FIXNUM_BITS) { @@ -118,20 +123,20 @@ make_integer (mpz_t const op) do { - EMACS_INT limb = mpz_getlimbn (op, i++); + EMACS_INT limb = mpz_getlimbn (mpz[0], i++); v += limb << shift; shift += GMP_NUMB_BITS; } while (shift < bits); - if (mpz_sgn (op) < 0) + if (mpz_sgn (mpz[0]) < 0) v = -v; if (!FIXNUM_OVERFLOW_P (v)) return make_fixnum (v); } - return make_bignum_bits (op, bits); + return make_bignum_bits (bits); } /* Set RESULT to V. This code is for when intmax_t is wider than long. */ diff --git a/src/bignum.h b/src/bignum.h index a368333d77e..07622a37af4 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -41,7 +41,10 @@ struct Lisp_Bignum mpz_t value; }; -extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1)); +extern mpz_t mpz[4]; + +extern void init_bignum_once (void); +extern Lisp_Object make_integer_mpz (void); extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1)); INLINE_HEADER_BEGIN @@ -65,6 +68,20 @@ mpz_set_intmax (mpz_t result, intmax_t v) mpz_set_intmax_slow (result, v); } +/* Return a pointer to an mpz_t that is equal to the Lisp integer I. + If I is a bignum this returns a pointer to I's representation; + otherwise this sets *TMP to I's value and returns TMP. */ +INLINE mpz_t * +bignum_integer (mpz_t *tmp, Lisp_Object i) +{ + if (FIXNUMP (i)) + { + mpz_set_intmax (*tmp, XFIXNUM (i)); + return tmp; + } + return &XBIGNUM (i)->value; +} + INLINE_HEADER_END #endif /* BIGNUM_H */ diff --git a/src/data.c b/src/data.c index 6afda1e6fb9..7be2052362b 100644 --- a/src/data.c +++ b/src/data.c @@ -2832,232 +2832,186 @@ enum arithop Alogior, Alogxor }; - -enum { FIXNUMS_FIT_IN_LONG = (LONG_MIN <= MOST_NEGATIVE_FIXNUM - && MOST_POSITIVE_FIXNUM <= LONG_MAX) }; - -static void -free_mpz_value (void *value_ptr) +static bool +floating_point_op (enum arithop code) { - mpz_clear (*(mpz_t *) value_ptr); + return code <= Adiv; } -static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop, - ptrdiff_t, Lisp_Object *); +/* Return the result of applying the floating-point operation CODE to + the NARGS arguments starting at ARGS. If ARGNUM is positive, + ARGNUM of the arguments were already consumed, yielding ACCUM. + 0 <= ARGNUM < NARGS, 2 <= NARGS, and NEXT is the value of + ARGS[ARGSNUM], converted to double. */ static Lisp_Object -arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) +floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, double accum, double next) { - Lisp_Object val = Qnil; - ptrdiff_t argnum; - ptrdiff_t count = SPECPDL_INDEX (); - mpz_t accum; - - mpz_init (accum); - record_unwind_protect_ptr (free_mpz_value, &accum); - - switch (code) + if (argnum == 0) { - case Alogior: - case Alogxor: - case Aadd: - case Asub: - /* ACCUM is already 0. */ - break; - case Amult: - case Adiv: - mpz_set_si (accum, 1); - break; - case Alogand: - mpz_set_si (accum, -1); - break; - default: - break; + accum = next; + goto next_arg; } - for (argnum = 0; argnum < nargs; argnum++) + while (true) { - /* Using args[argnum] as argument to CHECK_NUMBER... */ - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - - if (FLOATP (val)) - return unbind_to (count, - float_arith_driver (mpz_get_d (accum), argnum, code, - nargs, args)); switch (code) { - case Aadd: - if (BIGNUMP (val)) - mpz_add (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_add (accum, accum, tem); - mpz_clear (tem); - } - else if (XFIXNUM (val) < 0) - mpz_sub_ui (accum, accum, - XFIXNUM (val)); - else - mpz_add_ui (accum, accum, XFIXNUM (val)); - break; - case Asub: - if (! argnum) - { - if (BIGNUMP (val)) - mpz_set (accum, XBIGNUM (val)->value); - else - mpz_set_intmax (accum, XFIXNUM (val)); - if (nargs == 1) - mpz_neg (accum, accum); - } - else if (BIGNUMP (val)) - mpz_sub (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_sub (accum, accum, tem); - mpz_clear (tem); - } - else if (XFIXNUM (val) < 0) - mpz_add_ui (accum, accum, - XFIXNUM (val)); - else - mpz_sub_ui (accum, accum, XFIXNUM (val)); - break; - case Amult: - if (BIGNUMP (val)) - emacs_mpz_mul (accum, accum, XBIGNUM (val)->value); - else if (! FIXNUMS_FIT_IN_LONG) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - emacs_mpz_mul (accum, accum, tem); - mpz_clear (tem); - } - else - mpz_mul_si (accum, accum, XFIXNUM (val)); - break; + case Aadd : accum += next; break; + case Asub : accum -= next; break; + case Amult: accum *= next; break; case Adiv: - if (! (argnum || nargs == 1)) - { - if (BIGNUMP (val)) - mpz_set (accum, XBIGNUM (val)->value); - else - mpz_set_intmax (accum, XFIXNUM (val)); - } - else - { - /* Note that a bignum can never be 0, so we don't need - to check that case. */ - if (BIGNUMP (val)) - mpz_tdiv_q (accum, accum, XBIGNUM (val)->value); - else if (XFIXNUM (val) == 0) - xsignal0 (Qarith_error); - else if (ULONG_MAX < -MOST_NEGATIVE_FIXNUM) - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_tdiv_q (accum, accum, tem); - mpz_clear (tem); - } - else - { - EMACS_INT value = XFIXNUM (val); - mpz_tdiv_q_ui (accum, accum, eabs (value)); - if (value < 0) - mpz_neg (accum, accum); - } - } - break; - case Alogand: - if (BIGNUMP (val)) - mpz_and (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_and (accum, accum, tem); - mpz_clear (tem); - } - break; - case Alogior: - if (BIGNUMP (val)) - mpz_ior (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_ior (accum, accum, tem); - mpz_clear (tem); - } - break; - case Alogxor: - if (BIGNUMP (val)) - mpz_xor (accum, accum, XBIGNUM (val)->value); - else - { - mpz_t tem; - mpz_init (tem); - mpz_set_intmax (tem, XFIXNUM (val)); - mpz_xor (accum, accum, tem); - mpz_clear (tem); - } + if (! IEEE_FLOATING_POINT && next == 0) + xsignal0 (Qarith_error); + accum /= next; break; + default: eassume (false); } + + next_arg: + argnum++; + if (argnum == nargs) + return make_float (accum); + Lisp_Object val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + next = XFLOATINT (val); } +} + +/* Like floatop_arith_driver, except CODE might not be a floating-point + operation, and NEXT is a Lisp float rather than a C double. */ - return unbind_to (count, make_integer (accum)); +static Lisp_Object +float_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, double accum, Lisp_Object next) +{ + if (! floating_point_op (code)) + wrong_type_argument (Qinteger_or_marker_p, next); + return floatop_arith_driver (code, nargs, args, argnum, accum, + XFLOAT_DATA (next)); } +/* Return the result of applying the arithmetic operation CODE to the + NARGS arguments starting at ARGS. If ARGNUM is positive, ARGNUM of + the arguments were already consumed, yielding IACCUM. 0 <= ARGNUM + < NARGS, 2 <= NARGS, and VAL is the value of ARGS[ARGSNUM], + converted to integer. */ + static Lisp_Object -float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, - ptrdiff_t nargs, Lisp_Object *args) +bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + ptrdiff_t argnum, intmax_t iaccum, Lisp_Object val) { - for (; argnum < nargs; argnum++) + mpz_t *accum; + if (argnum == 0) { - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - double next = (FIXNUMP (val) ? XFIXNUM (val) - : FLOATP (val) ? XFLOAT_DATA (val) - : mpz_get_d (XBIGNUM (val)->value)); + accum = bignum_integer (&mpz[0], val); + goto next_arg; + } + mpz_set_intmax (mpz[0], iaccum); + accum = &mpz[0]; + + while (true) + { + mpz_t *next = bignum_integer (&mpz[1], val); switch (code) { - case Aadd: - accum += next; - break; - case Asub: - accum = argnum ? accum - next : nargs == 1 ? - next : next; - break; - case Amult: - accum *= next; - break; + case Aadd : mpz_add (mpz[0], *accum, *next); break; + case Asub : mpz_sub (mpz[0], *accum, *next); break; + case Amult : emacs_mpz_mul (mpz[0], *accum, *next); break; + case Alogand: mpz_and (mpz[0], *accum, *next); break; + case Alogior: mpz_ior (mpz[0], *accum, *next); break; + case Alogxor: mpz_xor (mpz[0], *accum, *next); break; case Adiv: - if (! (argnum || nargs == 1)) - accum = next; - else - { - if (! IEEE_FLOATING_POINT && next == 0) - xsignal0 (Qarith_error); - accum /= next; - } + if (mpz_sgn (*next) == 0) + xsignal0 (Qarith_error); + mpz_tdiv_q (mpz[0], *accum, *next); break; - case Alogand: - case Alogior: - case Alogxor: - wrong_type_argument (Qinteger_or_marker_p, val); + default: + eassume (false); } + accum = &mpz[0]; + + next_arg: + argnum++; + if (argnum == nargs) + return make_integer_mpz (); + val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + if (FLOATP (val)) + float_arith_driver (code, nargs, args, argnum, + mpz_get_d (*accum), val); } +} + +/* Return the result of applying the arithmetic operation CODE to the + NARGS arguments starting at ARGS, with the first argument being the + number VAL. 2 <= NARGS. Check that the remaining arguments are + numbers or markers. */ + +static Lisp_Object +arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, + Lisp_Object val) +{ + eassume (2 <= nargs); + + ptrdiff_t argnum = 0; + /* Set ACCUM to VAL's value if it is a fixnum, otherwise to some + ignored value to avoid using an uninitialized variable later. */ + intmax_t accum = XFIXNUM (val); + + if (FIXNUMP (val)) + while (true) + { + argnum++; + if (argnum == nargs) + return make_int (accum); + val = args[argnum]; + CHECK_NUMBER_COERCE_MARKER (val); + + /* Set NEXT to the next value if it fits, else exit the loop. */ + intmax_t next; + if (FIXNUMP (val)) + next = XFIXNUM (val); + else if (FLOATP (val)) + break; + else + { + next = bignum_to_intmax (val); + if (next == 0) + break; + } + + /* Set ACCUM to the next operation's result if it fits, + else exit the loop. */ + bool overflow = false; + intmax_t a; + switch (code) + { + case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break; + case Amult: overflow = INT_MULTIPLY_WRAPV (accum, next, &a); break; + case Asub : overflow = INT_SUBTRACT_WRAPV (accum, next, &a); break; + case Adiv: + if (next == 0) + xsignal0 (Qarith_error); + overflow = INT_DIVIDE_OVERFLOW (accum, next); + if (!overflow) + a = accum / next; + break; + case Alogand: accum &= next; continue; + case Alogior: accum |= next; continue; + case Alogxor: accum ^= next; continue; + default: eassume (false); + } + if (overflow) + break; + accum = a; + } - return make_float (accum); + return (FLOATP (val) + ? float_arith_driver (code, nargs, args, argnum, accum, val) + : bignum_arith_driver (code, nargs, args, argnum, accum, val)); } @@ -3066,7 +3020,11 @@ DEFUN ("+", Fplus, Splus, 0, MANY, 0, usage: (+ &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Aadd, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); } DEFUN ("-", Fminus, Sminus, 0, MANY, 0, @@ -3076,7 +3034,20 @@ subtracts all but the first from the first. usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Asub, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + if (nargs == 1) + { + if (FIXNUMP (a)) + return make_int (-XFIXNUM (a)); + if (FLOATP (a)) + return make_float (-XFLOAT_DATA (a)); + mpz_neg (mpz[0], XBIGNUM (a)->value); + return make_integer_mpz (); + } + return arith_driver (Asub, nargs, args, a); } DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, @@ -3084,7 +3055,11 @@ DEFUN ("*", Ftimes, Stimes, 0, MANY, 0, usage: (* &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Amult, nargs, args); + if (nargs == 0) + return make_fixnum (1); + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); } DEFUN ("/", Fquo, Squo, 1, MANY, 0, @@ -3095,11 +3070,31 @@ The arguments must be numbers or markers. usage: (/ NUMBER &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t argnum; - for (argnum = 2; argnum < nargs; argnum++) + Lisp_Object a = args[0]; + CHECK_NUMBER_COERCE_MARKER (a); + if (nargs == 1) + { + if (FIXNUMP (a)) + { + if (XFIXNUM (a) == 0) + xsignal0 (Qarith_error); + return make_fixnum (1 / XFIXNUM (a)); + } + if (FLOATP (a)) + { + if (! IEEE_FLOATING_POINT && XFLOAT_DATA (a) == 0) + xsignal0 (Qarith_error); + return make_float (1 / XFLOAT_DATA (a)); + } + /* Dividing 1 by any bignum yields 0. */ + return make_fixnum (0); + } + + /* Do all computation in floating-point if any arg is a float. */ + for (ptrdiff_t argnum = 2; argnum < nargs; argnum++) if (FLOATP (args[argnum])) - return float_arith_driver (0, 0, Adiv, nargs, args); - return arith_driver (Adiv, nargs, args); + return floatop_arith_driver (Adiv, nargs, args, 0, 0, XFLOATINT (a)); + return arith_driver (Adiv, nargs, args, a); } DEFUN ("%", Frem, Srem, 2, 2, 0, @@ -3107,52 +3102,22 @@ DEFUN ("%", Frem, Srem, 2, 2, 0, Both must be integers or markers. */) (register Lisp_Object x, Lisp_Object y) { - Lisp_Object val; - CHECK_INTEGER_COERCE_MARKER (x); CHECK_INTEGER_COERCE_MARKER (y); - /* Note that a bignum can never be 0, so we don't need to check that - case. */ + /* A bignum can never be 0, so don't check that case. */ if (FIXNUMP (y) && XFIXNUM (y) == 0) xsignal0 (Qarith_error); if (FIXNUMP (x) && FIXNUMP (y)) - XSETINT (val, XFIXNUM (x) % XFIXNUM (y)); + return make_fixnum (XFIXNUM (x) % XFIXNUM (y)); else { - mpz_t xm, ym, *xmp, *ymp; - mpz_t result; - - if (BIGNUMP (x)) - xmp = &XBIGNUM (x)->value; - else - { - mpz_init (xm); - mpz_set_intmax (xm, XFIXNUM (x)); - xmp = &xm; - } - - if (BIGNUMP (y)) - ymp = &XBIGNUM (y)->value; - else - { - mpz_init (ym); - mpz_set_intmax (ym, XFIXNUM (y)); - ymp = &ym; - } - - mpz_init (result); - mpz_tdiv_r (result, *xmp, *ymp); - val = make_integer (result); - mpz_clear (result); - - if (xmp == &xm) - mpz_clear (xm); - if (ymp == &ym) - mpz_clear (ym); + mpz_tdiv_r (mpz[0], + *bignum_integer (&mpz[0], x), + *bignum_integer (&mpz[1], y)); + return make_integer_mpz (); } - return val; } DEFUN ("mod", Fmod, Smod, 2, 2, 0, @@ -3161,9 +3126,6 @@ The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers. */) (register Lisp_Object x, Lisp_Object y) { - Lisp_Object val; - EMACS_INT i1, i2; - CHECK_NUMBER_COERCE_MARKER (x); CHECK_NUMBER_COERCE_MARKER (y); @@ -3177,8 +3139,7 @@ Both X and Y must be numbers or markers. */) if (FIXNUMP (x) && FIXNUMP (y)) { - i1 = XFIXNUM (x); - i2 = XFIXNUM (y); + EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y); if (i2 == 0) xsignal0 (Qarith_error); @@ -3189,51 +3150,21 @@ Both X and Y must be numbers or markers. */) if (i2 < 0 ? i1 > 0 : i1 < 0) i1 += i2; - XSETINT (val, i1); + return make_fixnum (i1); } else { - mpz_t xm, ym, *xmp, *ymp; - mpz_t result; - int cmpr, cmpy; - - if (BIGNUMP (x)) - xmp = &XBIGNUM (x)->value; - else - { - mpz_init (xm); - mpz_set_intmax (xm, XFIXNUM (x)); - xmp = &xm; - } - - if (BIGNUMP (y)) - ymp = &XBIGNUM (y)->value; - else - { - mpz_init (ym); - mpz_set_intmax (ym, XFIXNUM (y)); - ymp = &ym; - } - - mpz_init (result); - mpz_mod (result, *xmp, *ymp); + mpz_t *ym = bignum_integer (&mpz[1], y); + bool neg_y = mpz_sgn (*ym) < 0; + mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym); /* Fix the sign if needed. */ - cmpr = mpz_sgn (result); - cmpy = mpz_sgn (*ymp); - if (cmpy < 0 ? cmpr > 0 : cmpr < 0) - mpz_add (result, result, *ymp); - - val = make_integer (result); - mpz_clear (result); - - if (xmp == &xm) - mpz_clear (xm); - if (ymp == &ym) - mpz_clear (ym); - } + int sgn_r = mpz_sgn (mpz[0]); + if (neg_y ? sgn_r > 0 : sgn_r < 0) + mpz_add (mpz[0], mpz[0], *ym); - return val; + return make_integer_mpz (); + } } static Lisp_Object @@ -3278,7 +3209,11 @@ Arguments may be integers, or markers converted to integers. usage: (logand &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogand, nargs, args); + if (nargs == 0) + return make_fixnum (-1); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); } DEFUN ("logior", Flogior, Slogior, 0, MANY, 0, @@ -3287,7 +3222,11 @@ Arguments may be integers, or markers converted to integers. usage: (logior &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogior, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); } DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0, @@ -3296,7 +3235,11 @@ Arguments may be integers, or markers converted to integers. usage: (logxor &rest INTS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arith_driver (Alogxor, nargs, args); + if (nargs == 0) + return make_fixnum (0); + Lisp_Object a = args[0]; + CHECK_INTEGER_COERCE_MARKER (a); + return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); } DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0, @@ -3310,14 +3253,13 @@ representation. */) if (BIGNUMP (value)) { - if (mpz_sgn (XBIGNUM (value)->value) >= 0) - return make_fixnum (mpz_popcount (XBIGNUM (value)->value)); - mpz_t tem; - mpz_init (tem); - mpz_com (tem, XBIGNUM (value)->value); - Lisp_Object result = make_fixnum (mpz_popcount (tem)); - mpz_clear (tem); - return result; + mpz_t *nonneg = &XBIGNUM (value)->value; + if (mpz_sgn (*nonneg) < 0) + { + mpz_com (mpz[0], *nonneg); + nonneg = &mpz[0]; + } + return make_fixnum (mpz_popcount (*nonneg)); } eassume (FIXNUMP (value)); @@ -3335,8 +3277,6 @@ If COUNT is negative, shifting is actually to the right. In this case, the sign bit is duplicated. */) (Lisp_Object value, Lisp_Object count) { - Lisp_Object val; - /* The negative of the minimum value of COUNT that fits into a fixnum, such that mpz_fdiv_q_exp supports -COUNT. */ EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM, @@ -3344,48 +3284,27 @@ In this case, the sign bit is duplicated. */) CHECK_INTEGER (value); CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t)); - if (BIGNUMP (value)) + if (XFIXNUM (count) <= 0) { if (XFIXNUM (count) == 0) return value; - mpz_t result; - mpz_init (result); - if (XFIXNUM (count) > 0) - emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); - else - mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); - val = make_integer (result); - mpz_clear (result); - } - else if (XFIXNUM (count) <= 0) - { - /* This code assumes that signed right shifts are arithmetic. */ - verify ((EMACS_INT) -1 >> 1 == -1); - - EMACS_INT shift = -XFIXNUM (count); - EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift - : XFIXNUM (value) < 0 ? -1 : 0); - val = make_fixnum (result); - } - else - { - /* Just do the work as bignums to make the code simpler. */ - mpz_t result; - eassume (FIXNUMP (value)); - mpz_init (result); - - mpz_set_intmax (result, XFIXNUM (value)); - - if (XFIXNUM (count) >= 0) - emacs_mpz_mul_2exp (result, result, XFIXNUM (count)); - else - mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); - val = make_integer (result); - mpz_clear (result); + if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value)) + { + EMACS_INT shift = -XFIXNUM (count); + EMACS_INT result + = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift + : XFIXNUM (value) < 0 ? -1 : 0); + return make_fixnum (result); + } } - return val; + mpz_t *zval = bignum_integer (&mpz[0], value); + if (XFIXNUM (count) < 0) + mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count)); + else + emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count)); + return make_integer_mpz (); } /* Return X ** Y as an integer. X and Y must be integers, and Y must @@ -3403,16 +3322,8 @@ expt_integer (Lisp_Object x, Lisp_Object y) else range_error (); - mpz_t val; - mpz_init (val); - emacs_mpz_pow_ui (val, - (FIXNUMP (x) - ? (mpz_set_intmax (val, XFIXNUM (x)), val) - : XBIGNUM (x)->value), - exp); - Lisp_Object res = make_integer (val); - mpz_clear (val); - return res; + emacs_mpz_pow_ui (mpz[0], *bignum_integer (&mpz[0], x), exp); + return make_integer_mpz (); } DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, @@ -3422,32 +3333,12 @@ Markers are converted to integers. */) { CHECK_NUMBER_COERCE_MARKER (number); + if (FIXNUMP (number)) + return make_int (XFIXNUM (number) + 1); if (FLOATP (number)) return (make_float (1.0 + XFLOAT_DATA (number))); - - if (BIGNUMP (number)) - { - mpz_t num; - mpz_init (num); - mpz_add_ui (num, XBIGNUM (number)->value, 1); - number = make_integer (num); - mpz_clear (num); - } - else - { - eassume (FIXNUMP (number)); - if (XFIXNUM (number) < MOST_POSITIVE_FIXNUM) - XSETINT (number, XFIXNUM (number) + 1); - else - { - mpz_t num; - mpz_init (num); - mpz_set_intmax (num, XFIXNUM (number) + 1); - number = make_integer (num); - mpz_clear (num); - } - } - return number; + mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1); + return make_integer_mpz (); } DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, @@ -3457,32 +3348,12 @@ Markers are converted to integers. */) { CHECK_NUMBER_COERCE_MARKER (number); + if (FIXNUMP (number)) + return make_int (XFIXNUM (number) - 1); if (FLOATP (number)) return (make_float (-1.0 + XFLOAT_DATA (number))); - - if (BIGNUMP (number)) - { - mpz_t num; - mpz_init (num); - mpz_sub_ui (num, XBIGNUM (number)->value, 1); - number = make_integer (num); - mpz_clear (num); - } - else - { - eassume (FIXNUMP (number)); - if (XFIXNUM (number) > MOST_NEGATIVE_FIXNUM) - XSETINT (number, XFIXNUM (number) - 1); - else - { - mpz_t num; - mpz_init (num); - mpz_set_intmax (num, XFIXNUM (number) - 1); - number = make_integer (num); - mpz_clear (num); - } - } - return number; + mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1); + return make_integer_mpz (); } DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, @@ -3490,20 +3361,10 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, (register Lisp_Object number) { CHECK_INTEGER (number); - if (BIGNUMP (number)) - { - mpz_t value; - mpz_init (value); - mpz_com (value, XBIGNUM (number)->value); - number = make_integer (value); - mpz_clear (value); - } - else - { - eassume (FIXNUMP (number)); - XSETINT (number, ~XFIXNUM (number)); - } - return number; + if (FIXNUMP (number)) + return make_fixnum (~XFIXNUM (number)); + mpz_com (mpz[0], XBIGNUM (number)->value); + return make_integer_mpz (); } DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, diff --git a/src/emacs.c b/src/emacs.c index 07a1aff9b06..5b399eca64f 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1209,6 +1209,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); + init_bignum_once (); init_threads_once (); init_obarray (); init_eval_once (); diff --git a/src/floatfns.c b/src/floatfns.c index 77e20d5640b..2f33b8652b2 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -270,11 +270,8 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0, { if (mpz_sgn (XBIGNUM (arg)->value) < 0) { - mpz_t val; - mpz_init (val); - mpz_neg (val, XBIGNUM (arg)->value); - arg = make_integer (val); - mpz_clear (val); + mpz_neg (mpz[0], XBIGNUM (arg)->value); + arg = make_integer_mpz (); } } @@ -360,20 +357,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, { if (EQ (divisor, make_fixnum (0))) xsignal0 (Qarith_error); - mpz_t d, q; - mpz_init (d); - mpz_init (q); - int_divide (q, - (FIXNUMP (arg) - ? (mpz_set_intmax (q, XFIXNUM (arg)), q) - : XBIGNUM (arg)->value), - (FIXNUMP (divisor) - ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) - : XBIGNUM (divisor)->value)); - Lisp_Object result = make_integer (q); - mpz_clear (d); - mpz_clear (q); - return result; + int_divide (mpz[0], + *bignum_integer (&mpz[0], arg), + *bignum_integer (&mpz[1], divisor)); + return make_integer_mpz (); } double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg); @@ -417,20 +404,15 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d) if (abs_r1 < abs_r + (q & 1)) q += neg_d == neg_r ? 1 : -1; */ - mpz_t r, abs_r1; - mpz_init (r); - mpz_init (abs_r1); - mpz_tdiv_qr (q, r, n, d); + mpz_t *r = &mpz[2], *abs_r = r, *abs_r1 = &mpz[3]; + mpz_tdiv_qr (q, *r, n, d); bool neg_d = mpz_sgn (d) < 0; - bool neg_r = mpz_sgn (r) < 0; - mpz_t *abs_r = &r; - mpz_abs (*abs_r, r); - mpz_abs (abs_r1, d); - mpz_sub (abs_r1, abs_r1, *abs_r); - if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) + bool neg_r = mpz_sgn (*r) < 0; + mpz_abs (*abs_r, *r); + mpz_abs (*abs_r1, d); + mpz_sub (*abs_r1, *abs_r1, *abs_r); + if (mpz_cmp (*abs_r1, *abs_r) < (mpz_odd_p (q) != 0)) (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); - mpz_clear (r); - mpz_clear (abs_r1); } /* The code uses emacs_rint, so that it works to undefine HAVE_RINT diff --git a/src/fns.c b/src/fns.c index 17a869e1abc..8b25492eaeb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1468,19 +1468,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, /* Undo any error introduced when LARGE_NUM was substituted for N, by adding N - LARGE_NUM to NUM, using arithmetic modulo CYCLE_LENGTH. */ - mpz_t z; /* N mod CYCLE_LENGTH. */ - mpz_init (z); + /* Add N mod CYCLE_LENGTH to NUM. */ if (cycle_length <= ULONG_MAX) - num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length); + num += mpz_mod_ui (mpz[0], XBIGNUM (n)->value, cycle_length); else { - mpz_set_intmax (z, cycle_length); - mpz_mod (z, XBIGNUM (n)->value, z); + mpz_set_intmax (mpz[0], cycle_length); + mpz_mod (mpz[0], XBIGNUM (n)->value, mpz[0]); intptr_t iz; - mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z); + mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); num += iz; } - mpz_clear (z); num += cycle_length - large_num % cycle_length; } num %= cycle_length; -- 2.39.2