summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2018-09-03 18:37:40 -0700
committerPaul Eggert <eggert@cs.ucla.edu>2018-09-03 18:50:34 -0700
commitfe042e9d15da7863b5beb4c2cc326a62d2c7fccb (patch)
tree84fac8f99c678667e01d69d5e2ef17f4c8e8e275 /src
parent40f8ade7c81ab6f99537691ae00d2d42069bdb20 (diff)
downloademacs-fe042e9d15da7863b5beb4c2cc326a62d2c7fccb.tar.gz
Speed up (+ 2 2) by a factor of 10
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.
Diffstat (limited to 'src')
-rw-r--r--src/bignum.c71
-rw-r--r--src/bignum.h19
-rw-r--r--src/data.c669
-rw-r--r--src/emacs.c1
-rw-r--r--src/floatfns.c44
-rw-r--r--src/fns.c12
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 <https://www.gnu.org/licenses/>. */
#include <stdlib.h>
+/* 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;