mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-09 21:20:45 -08:00
Code Issues Projects Releases Wiki Activity

Speed up (+ 2 2) by a factor of 10

Browse source 
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.
This commit is contained in:
Paul Eggert 2018-09-03 18:37:40 -07:00
parent 40f8ade7c8
commit fe042e9d15
6 changed files with 344 additions and 480 deletions
Download patch file Download diff file Expand all files Collapse all files

71
src/bignum.c
View file

@ -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. */

19
src/bignum.h
View file

@ -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 */

677
src/data.c
View file

@ -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);
}
}
return unbind_to (count, make_integer (accum));
}
static Lisp_Object
float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
ptrdiff_t nargs, Lisp_Object *args)
{
for (; argnum < nargs; argnum++)
{
next_arg:
argnum++;
if (argnum == nargs)
return make_float (accum);
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));
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. */
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
bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
ptrdiff_t argnum, intmax_t iaccum, Lisp_Object val)
{
mpz_t *accum;
if (argnum == 0)
{
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];
return make_float (accum);
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 (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);
int sgn_r = mpz_sgn (mpz[0]);
if (neg_y ? sgn_r > 0 : sgn_r < 0)
mpz_add (mpz[0], mpz[0], *ym);
val = make_integer (result);
mpz_clear (result);
if (xmp == &xm)
mpz_clear (xm);
if (ymp == &ym)
mpz_clear (ym);
return make_integer_mpz ();
}
return val;
}
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);
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);
}
}
mpz_t *zval = bignum_integer (&mpz[0], value);
if (XFIXNUM (count) < 0)
mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count));
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);
}
return val;
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,

1
src/emacs.c
View file

@ -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 ();

44
src/floatfns.c
View file

@ -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

12
src/fns.c
View file

@ -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;