procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Avoid libgmp aborts by imposing limits

Browse source 
libgmp calls ‘abort’ when given numbers too big for its
internal data structures.  The numeric limit is large and
platform-dependent; with 64-bit GMP 6.1.2 it is around
2**2**37.  Work around the problem by refusing to call libgmp
functions with arguments that would cause an abort.  With luck
libgmp will have a better way to do this in the future.
Also, introduce a variable integer-width that lets the user
control how large bignums can be.  This currently defaults
to 2**16, i.e., it allows bignums up to 2**2**16.  This
should be enough for ordinary computation, and should
help Emacs to avoid thrashing or hanging.
Problem noted by Pip Cet (Bug#32463#71).
* doc/lispref/numbers.texi, etc/NEWS:
Document recent bignum changes, including this one.
Improve documentation for bitwise operations, in the light
of bignums.
* src/alloc.c (make_number): Enforce integer-width.
(integer_overflow): New function.
(xrealloc_for_gmp, xfree_for_gmp):
Move here from emacs.c, as it's memory allocation.
(init_alloc): Initialize GMP here, rather than in emacs.c.
(integer_width): New var.
* src/data.c (GMP_NLIMBS_MAX, NLIMBS_LIMIT): New constants.
(emacs_mpz_size, emacs_mpz_mul)
(emacs_mpz_mul_2exp, emacs_mpz_pow_ui): New functions.
(arith_driver, Fash, expt_integer): Use them.
(expt_integer): New function, containing integer code
that was out of place in floatfns.c.
(check_bignum_size, xmalloc_for_gmp): Remove.
* src/emacs.c (main): Do not initialize GMP here.
* src/floatfns.c (Fexpt): Use expt_integer, which
now contains integer code moved from here.
* src/lisp.h (GMP_NUMB_BITS): Define if gmp.h doesn’t.
This commit is contained in:
Paul Eggert 2018-08-21 02:16:50 -07:00
parent 77fc272598
commit d6a497dd88
7 changed files with 339 additions and 268 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

348
doc/lispref/numbers.texi
View file

@ -34,13 +34,21 @@ numbers have a fixed amount of precision.
@node Integer Basics
@section Integer Basics
Integers in Emacs Lisp can have arbitrary precision.
Integers in Emacs Lisp are not limited to the machine word size.
Under the hood, though, there are two kinds of integers: smaller
ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}.
Some functions in Emacs only accept fixnums. Also, while fixnums can
always be compared for equality with @code{eq}, bignums require the
use of @code{eql}.
Some functions in Emacs accept only fixnums. Also, while fixnums can
always be compared for numeric equality with @code{eq}, bignums
require more-heavyweight equality predicates like @code{eql}.
The range of values for bignums is limited by the amount of main
memory, by machine characteristics such as the size of the word used
to represent a bignum's exponent, and by the @code{integer-width}
variable. These limits are typically much more generous than the
limits for fixnums. A bignum is never numerically equal to a fixnum;
if Emacs computes an integer in fixnum range, it represents the
integer as a fixnum, not a bignum.
The range of values for a fixnum depends on the machine. The
minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e.,
@ -97,33 +105,30 @@ For example:
#24r1k @result{} 44
@end example
An integer is read as a fixnum if it is in the correct range.
Otherwise, it will be read as a bignum.
To understand how various functions work on integers, especially the
bitwise operators (@pxref{Bitwise Operations}), it is often helpful to
view the numbers in their binary form.
In 30-bit binary, the decimal integer 5 looks like this:
In binary, the decimal integer 5 looks like this:
@example
0000...000101 (30 bits total)
...000101
@end example
@noindent
(The @samp{...} stands for enough bits to fill out a 30-bit word; in
this case, @samp{...} stands for twenty 0 bits. Later examples also
use the @samp{...} notation to make binary integers easier to read.)
(The @samp{...} stands for a conceptually infinite number of bits that
match the leading bit; here, an infinite number of 0 bits. Later
examples also use this @samp{...} notation.)
The integer @minus{}1 looks like this:
@example
1111...111111 (30 bits total)
...111111
@end example
@noindent
@cindex two's complement
@minus{}1 is represented as 30 ones. (This is called @dfn{two's
@minus{}1 is represented as all ones. (This is called @dfn{two's
complement} notation.)
Subtracting 4 from @minus{}1 returns the negative integer @minus{}5.
@ -131,14 +136,7 @@ In binary, the decimal integer 4 is 100. Consequently,
@minus{}5 looks like this:
@example
1111...111011 (30 bits total)
@end example
In this implementation, the largest 30-bit binary integer is
536,870,911 in decimal. In binary, it looks like this:
@example
0111...111111 (30 bits total)
...111011
@end example
Many of the functions described in this chapter accept markers for
@ -147,10 +145,10 @@ arguments to such functions may be either numbers or markers, we often
give these arguments the name @var{number-or-marker}. When the argument
value is a marker, its position value is used and its buffer is ignored.
@cindex largest Lisp integer
@cindex maximum Lisp integer
@cindex largest fixnum
@cindex maximum fixnum
@defvar most-positive-fixnum
The value of this variable is the largest ``small'' integer that Emacs
The value of this variable is the greatest ``small'' integer that Emacs
Lisp can handle. Typical values are
@ifnottex
2**29 @minus{} 1
@ -168,11 +166,11 @@ on 32-bit and
on 64-bit platforms.
@end defvar
@cindex smallest Lisp integer
@cindex minimum Lisp integer
@cindex smallest fixnum
@cindex minimum fixnum
@defvar most-negative-fixnum
The value of this variable is the smallest small integer that Emacs
Lisp can handle. It is negative. Typical values are
The value of this variable is the numerically least ``small'' integer
that Emacs Lisp can handle. It is negative. Typical values are
@ifnottex
@minus{}2**29
@end ifnottex
@ -187,6 +185,19 @@ on 32-bit and
@math{-2^{61}}
@end tex
on 64-bit platforms.
@end defvar
@cindex bignum range
@cindex integer range
@defvar integer-width
The value of this variable is a nonnegative integer that is an upper
bound on the number of bits in a bignum. Integers outside the fixnum
range are limited to absolute values less than 2@sup{@var{n}}, where
@var{n} is this variable's value. Attempts to create bignums outside
this range result in integer overflow. Setting this variable to zero
disables creation of bignums; setting it to a large number can cause
Emacs to consume large quantities of memory if a computation creates
huge integers.
@end defvar
In Emacs Lisp, text characters are represented by integers. Any
@ -378,17 +389,17 @@ comparison, and sometimes returns @code{t} when a non-numeric
comparison would return @code{nil} and vice versa. @xref{Float
Basics}.
In Emacs Lisp, each small integer is a unique Lisp object.
Therefore, @code{eq} is equivalent to @code{=} where small integers are
concerned. It is sometimes convenient to use @code{eq} for comparing
an unknown value with an integer, because @code{eq} does not report an
In Emacs Lisp, if two fixnums are numerically equal, they are the
same Lisp object. That is, @code{eq} is equivalent to @code{=} on
fixnums. It is sometimes convenient to use @code{eq} for comparing
an unknown value with a fixnum, because @code{eq} does not report an
error if the unknown value is not a number---it accepts arguments of
any type. By contrast, @code{=} signals an error if the arguments are
not numbers or markers. However, it is better programming practice to
use @code{=} if you can, even for comparing integers.
Sometimes it is useful to compare numbers with @code{equal}, which
treats two numbers as equal if they have the same data type (both
Sometimes it is useful to compare numbers with @code{eql} or @code{equal},
which treat two numbers as equal if they have the same data type (both
integers, or both floating point) and the same value. By contrast,
@code{=} can treat an integer and a floating-point number as equal.
@xref{Equality Predicates}.
@ -830,142 +841,113 @@ Rounding a value equidistant between two integers returns the even integer.
@cindex logical arithmetic
In a computer, an integer is represented as a binary number, a
sequence of @dfn{bits} (digits which are either zero or one). A bitwise
sequence of @dfn{bits} (digits which are either zero or one).
Conceptually the bit sequence is infinite on the left, with the
most-significant bits being all zeros or all ones. A bitwise
operation acts on the individual bits of such a sequence. For example,
@dfn{shifting} moves the whole sequence left or right one or more places,
reproducing the same pattern moved over.
The bitwise operations in Emacs Lisp apply only to integers.
@defun ash integer1 count
@cindex arithmetic shift
@code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1}
to the left @var{count} places, or to the right if @var{count} is
negative. Left shifts introduce zero bits on the right; right shifts
discard the rightmost bits. Considered as an integer operation,
@code{ash} multiplies @var{integer1} by 2@sup{@var{count}} and then
converts the result to an integer by rounding downward, toward
minus infinity.
Here are examples of @code{ash}, shifting a pattern of bits one place
to the left and to the right. These examples show only the low-order
bits of the binary pattern; leading bits all agree with the
highest-order bit shown. As you can see, shifting left by one is
equivalent to multiplying by two, whereas shifting right by one is
equivalent to dividing by two and then rounding toward minus infinity.
@example
@group
(ash 7 1) @result{} 14
;; @r{Decimal 7 becomes decimal 14.}
...000111
@result{}
...001110
@end group
@group
(ash 7 -1) @result{} 3
...000111
@result{}
...000011
@end group
@group
(ash -7 1) @result{} -14
...111001
@result{}
...110010
@end group
@group
(ash -7 -1) @result{} -4
...111001
@result{}
...111100
@end group
@end example
Here are examples of shifting left or right by two bits:
@smallexample
@group
; @r{ binary values}
(ash 5 2) ; 5 = @r{...000101}
@result{} 20 ; = @r{...010100}
(ash -5 2) ; -5 = @r{...111011}
@result{} -20 ; = @r{...101100}
@end group
@group
(ash 5 -2)
@result{} 1 ; = @r{...000001}
@end group
@group
(ash -5 -2)
@result{} -2 ; = @r{...111110}
@end group
@end smallexample
@end defun
@defun lsh integer1 count
@cindex logical shift
@code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the
bits in @var{integer1} to the left @var{count} places, or to the right
if @var{count} is negative, bringing zeros into the vacated bits. If
@var{count} is negative, @code{lsh} shifts zeros into the leftmost
(most-significant) bit, producing a nonnegative result even if
@var{integer1} is negative fixnum. (If @var{integer1} is a negative
bignum, @var{count} must be nonnegative.) Contrast this with
@code{ash}, below.
@var{count} is negative, then @var{integer1} must be either a fixnum
or a positive bignum, and @code{lsh} treats a negative fixnum as if it
were unsigned by subtracting twice @code{most-negative-fixnum} before
shifting, producing a nonnegative result. This quirky behavior dates
back to when Emacs supported only fixnums; nowadays @code{ash} is a
better choice.
Here are two examples of @code{lsh}, shifting a pattern of bits one
place to the left. We show only the low-order eight bits of the binary
pattern; the rest are all zero.
As @code{lsh} behaves like @code{ash} except when @var{integer1} and
@var{count1} are both negative, the following examples focus on these
exceptional cases. These examples assume 30-bit fixnums.
@example
@group
(lsh 5 1)
@result{} 10
;; @r{Decimal 5 becomes decimal 10.}
00000101 @result{} 00001010
(lsh 7 1)
@result{} 14
;; @r{Decimal 7 becomes decimal 14.}
00000111 @result{} 00001110
@end group
@end example
@noindent
As the examples illustrate, shifting the pattern of bits one place to
the left produces a number that is twice the value of the previous
number.
Shifting a pattern of bits two places to the left produces results
like this (with 8-bit binary numbers):
@example
@group
(lsh 3 2)
@result{} 12
;; @r{Decimal 3 becomes decimal 12.}
00000011 @result{} 00001100
@end group
@end example
On the other hand, shifting one place to the right looks like this:
@example
@group
(lsh 6 -1)
@result{} 3
;; @r{Decimal 6 becomes decimal 3.}
00000110 @result{} 00000011
@end group
@group
(lsh 5 -1)
@result{} 2
;; @r{Decimal 5 becomes decimal 2.}
00000101 @result{} 00000010
@end group
@end example
@noindent
As the example illustrates, shifting one place to the right divides the
value of a positive integer by two, rounding downward.
@end defun
@defun ash integer1 count
@cindex arithmetic shift
@code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1}
to the left @var{count} places, or to the right if @var{count}
is negative.
@code{ash} gives the same results as @code{lsh} except when
@var{integer1} and @var{count} are both negative. In that case,
@code{ash} puts ones in the empty bit positions on the left, while
@code{lsh} puts zeros in those bit positions and requires
@var{integer1} to be a fixnum.
Thus, with @code{ash}, shifting the pattern of bits one place to the right
looks like this:
@example
@group
(ash -6 -1) @result{} -3
;; @r{Decimal @minus{}6 becomes decimal @minus{}3.}
1111...111010 (30 bits total)
@result{}
1111...111101 (30 bits total)
@end group
@end example
Here are other examples:
@c !!! Check if lined up in smallbook format! XDVI shows problem
@c with smallbook but not with regular book! --rjc 16mar92
@smallexample
@group
; @r{ 30-bit binary values}
(lsh 5 2) ; 5 = @r{0000...000101}
@result{} 20 ; = @r{0000...010100}
; @r{ binary values}
(ash -7 -1) ; -7 = @r{...111111111111111111111111111001}
@result{} -4 ; = @r{...111111111111111111111111111100}
(lsh -7 -1)
@result{} 536870908 ; = @r{...011111111111111111111111111100}
@end group
@group
(ash 5 2)
@result{} 20
(lsh -5 2) ; -5 = @r{1111...111011}
@result{} -20 ; = @r{1111...101100}
(ash -5 2)
@result{} -20
@end group
@group
(lsh 5 -2) ; 5 = @r{0000...000101}
@result{} 1 ; = @r{0000...000001}
@end group
@group
(ash 5 -2)
@result{} 1
@end group
@group
(lsh -5 -2) ; -5 = @r{1111...111011}
@result{} 268435454
; = @r{0011...111110}
@end group
@group
(ash -5 -2) ; -5 = @r{1111...111011}
@result{} -2 ; = @r{1111...111110}
(ash -5 -2) ; -5 = @r{...111111111111111111111111111011}
@result{} -2 ; = @r{...111111111111111111111111111110}
(lsh -5 -2)
@result{} 268435454 ; = @r{...001111111111111111111111111110}
@end group
@end smallexample
@end defun
@ -999,23 +981,23 @@ because its binary representation consists entirely of ones. If
@smallexample
@group
; @r{ 30-bit binary values}
; @r{ binary values}
(logand 14 13) ; 14 = @r{0000...001110}
; 13 = @r{0000...001101}
@result{} 12 ; 12 = @r{0000...001100}
(logand 14 13) ; 14 = @r{...001110}
; 13 = @r{...001101}
@result{} 12 ; 12 = @r{...001100}
@end group
@group
(logand 14 13 4) ; 14 = @r{0000...001110}
; 13 = @r{0000...001101}
; 4 = @r{0000...000100}
@result{} 4 ; 4 = @r{0000...000100}
(logand 14 13 4) ; 14 = @r{...001110}
; 13 = @r{...001101}
; 4 = @r{...000100}
@result{} 4 ; 4 = @r{...000100}
@end group
@group
(logand)
@result{} -1 ; -1 = @r{1111...111111}
@result{} -1 ; -1 = @r{...111111}
@end group
@end smallexample
@end defun
@ -1029,18 +1011,18 @@ passed just one argument, it returns that argument.
@smallexample
@group
; @r{ 30-bit binary values}
; @r{ binary values}
(logior 12 5) ; 12 = @r{0000...001100}
; 5 = @r{0000...000101}
@result{} 13 ; 13 = @r{0000...001101}
(logior 12 5) ; 12 = @r{...001100}
; 5 = @r{...000101}
@result{} 13 ; 13 = @r{...001101}
@end group
@group
(logior 12 5 7) ; 12 = @r{0000...001100}
; 5 = @r{0000...000101}
; 7 = @r{0000...000111}
@result{} 15 ; 15 = @r{0000...001111}
(logior 12 5 7) ; 12 = @r{...001100}
; 5 = @r{...000101}
; 7 = @r{...000111}
@result{} 15 ; 15 = @r{...001111}
@end group
@end smallexample
@end defun
@ -1054,18 +1036,18 @@ result is 0, which is an identity element for this operation. If
@smallexample
@group
; @r{ 30-bit binary values}
; @r{ binary values}
(logxor 12 5) ; 12 = @r{0000...001100}
; 5 = @r{0000...000101}
@result{} 9 ; 9 = @r{0000...001001}
(logxor 12 5) ; 12 = @r{...001100}
; 5 = @r{...000101}
@result{} 9 ; 9 = @r{...001001}
@end group
@group
(logxor 12 5 7) ; 12 = @r{0000...001100}
; 5 = @r{0000...000101}
; 7 = @r{0000...000111}
@result{} 14 ; 14 = @r{0000...001110}
(logxor 12 5 7) ; 12 = @r{...001100}
; 5 = @r{...000101}
; 7 = @r{...000111}
@result{} 14 ; 14 = @r{...001110}
@end group
@end smallexample
@end defun
@ -1078,9 +1060,9 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in
@example
(lognot 5)
@result{} -6
;; 5 = @r{0000...000101} (30 bits total)
;; 5 = @r{...000101}
;; @r{becomes}
;; -6 = @r{1111...111010} (30 bits total)
;; -6 = @r{...111010}
@end example
@end defun
@ -1095,9 +1077,9 @@ its two's complement binary representation. The result is always
nonnegative.
@example
(logcount 43) ; 43 = #b101011
(logcount 43) ; 43 = @r{...000101011}
@result{} 4
(logcount -43) ; -43 = #b111...1010101
(logcount -43) ; -43 = @r{...111010101}
@result{} 3
@end example
@end defun

6
etc/NEWS
View file

@ -871,6 +871,12 @@ bignums. However, note that unlike fixnums, bignums will not compare
equal with 'eq', you must use 'eql' instead. (Numerical comparison
with '=' works on both, of course.)
+++
** New variable 'integer-width'.
It is a nonnegative integer specifying the maximum number of bits
allowed in a bignum. Integer overflow occurs if this limit is
exceeded.
** define-minor-mode automatically documents the meaning of ARG
+++

75
src/alloc.c
View file

@ -3746,33 +3746,33 @@ make_bignum_str (const char *num, int base)
Lisp_Object
make_number (mpz_t value)
{
if (mpz_fits_slong_p (value))
{
long l = mpz_get_si (value);
if (!FIXNUM_OVERFLOW_P (l))
return make_fixnum (l);
}
else if (LONG_WIDTH < FIXNUM_BITS)
{
size_t bits = mpz_sizeinbase (value, 2);
size_t bits = mpz_sizeinbase (value, 2);
if (bits <= FIXNUM_BITS)
{
EMACS_INT v = 0;
int i = 0;
for (int shift = 0; shift < bits; shift += mp_bits_per_limb)
{
EMACS_INT limb = mpz_getlimbn (value, i++);
v += limb << shift;
}
if (mpz_sgn (value) < 0)
v = -v;
if (bits <= FIXNUM_BITS)
{
EMACS_INT v = 0;
int i = 0, shift = 0;
if (!FIXNUM_OVERFLOW_P (v))
return make_fixnum (v);
}
do
{
EMACS_INT limb = mpz_getlimbn (value, i++);
v += limb << shift;
shift += GMP_NUMB_BITS;
}
while (shift < bits);
if (mpz_sgn (value) < 0)
v = -v;
if (!FIXNUM_OVERFLOW_P (v))
return make_fixnum (v);
}
/* The documentation says integer-width should be nonnegative, so
a single comparison suffices even though 'bits' is unsigned. */
if (integer_width < bits)
integer_overflow ();
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
@ -7200,6 +7200,26 @@ verify_alloca (void)
#endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
/* Memory allocation for GMP. */
void
integer_overflow (void)
{
error ("Integer too large to be represented");
}
static void *
xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
{
return xrealloc (ptr, size);
}
static void
xfree_for_gmp (void *ptr, size_t ignore)
{
xfree (ptr);
}
/* Initialization. */
void
@ -7233,6 +7253,10 @@ init_alloc_once (void)
void
init_alloc (void)
{
eassert (mp_bits_per_limb == GMP_NUMB_BITS);
integer_width = 1 << 16;
mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp);
Vgc_elapsed = make_float (0.0);
gcs_done = 0;
@ -7335,6 +7359,11 @@ The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
DEFVAR_INT ("integer-width", integer_width,
doc: /* Maximum number of bits in bignums.
Integers outside the fixnum range are limited to absolute values less
than 2**N, where N is this variable's value. N should be nonnegative. */);
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);

109
src/data.c
View file

@ -2383,6 +2383,80 @@ bool-vector. IDX starts at 0. */)
return newelt;
}
/* GMP tests for this value and aborts (!) if it is exceeded.
This is as of GMP 6.1.2 (2016); perhaps future versions will differ. */
enum { GMP_NLIMBS_MAX = min (INT_MAX, ULONG_MAX / GMP_NUMB_BITS) };
/* An upper bound on limb counts, needed to prevent libgmp and/or
Emacs from aborting or otherwise misbehaving. This bound applies
to estimates of mpz_t sizes before the mpz_t objects are created,
as opposed to integer-width which operates on mpz_t values after
creation and before conversion to Lisp bignums. */
enum
{
NLIMBS_LIMIT = min (min (/* libgmp needs to store limb counts. */
GMP_NLIMBS_MAX,
/* Size calculations need to work. */
min (PTRDIFF_MAX, SIZE_MAX) / sizeof (mp_limb_t)),
/* Emacs puts bit counts into fixnums. */
MOST_POSITIVE_FIXNUM / GMP_NUMB_BITS)
};
/* Like mpz_size, but tell the compiler the result is a nonnegative int. */
static int
emacs_mpz_size (mpz_t const op)
{
mp_size_t size = mpz_size (op);
eassume (0 <= size && size <= INT_MAX);
return size;
}
/* Wrappers to work around GMP limitations. As of GMP 6.1.2 (2016),
the library code aborts when a number is too large. These wrappers
avoid the problem for functions that can return numbers much larger
than their arguments. For slowly-growing numbers, the integer
width check in make_number should suffice. */
static void
emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2)
{
if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2))
integer_overflow ();
mpz_mul (rop, op1, op2);
}
static void
emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2)
{
/* Fudge factor derived from GMP 6.1.2, to avoid an abort in
mpz_mul_2exp (look for the '+ 1' in its source code). */
enum { mul_2exp_extra_limbs = 1 };
enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - mul_2exp_extra_limbs) };
mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS;
if (lim - emacs_mpz_size (op1) < op2limbs)
integer_overflow ();
mpz_mul_2exp (rop, op1, op2);
}
static void
emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp)
{
/* This fudge factor is derived from GMP 6.1.2, to avoid an abort in
mpz_n_pow_ui (look for the '5' in its source code). */
enum { pow_ui_extra_limbs = 5 };
enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) };
int nbase = emacs_mpz_size (base), n;
if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n)
integer_overflow ();
mpz_pow_ui (rop, base, exp);
}
/* Arithmetic functions */
@ -2872,13 +2946,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
break;
case Amult:
if (BIGNUMP (val))
mpz_mul (accum, accum, XBIGNUM (val)->value);
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));
mpz_mul (accum, accum, tem);
emacs_mpz_mul (accum, accum, tem);
mpz_clear (tem);
}
else
@ -3293,7 +3367,7 @@ In this case, the sign bit is duplicated. */)
mpz_t result;
mpz_init (result);
if (XFIXNUM (count) > 0)
mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
else
mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
val = make_number (result);
@ -3319,7 +3393,7 @@ In this case, the sign bit is duplicated. */)
mpz_set_intmax (result, XFIXNUM (value));
if (XFIXNUM (count) >= 0)
mpz_mul_2exp (result, result, XFIXNUM (count));
emacs_mpz_mul_2exp (result, result, XFIXNUM (count));
else
mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
@ -3330,6 +3404,33 @@ In this case, the sign bit is duplicated. */)
return val;
}
/* Return X ** Y as an integer. X and Y must be integers, and Y must
be nonnegative. */
Lisp_Object
expt_integer (Lisp_Object x, Lisp_Object y)
{
unsigned long exp;
if (TYPE_RANGED_FIXNUMP (unsigned long, y))
exp = XFIXNUM (y);
else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
&& mpz_fits_ulong_p (XBIGNUM (y)->value))
exp = mpz_get_ui (XBIGNUM (y)->value);
else
integer_overflow ();
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_number (val);
mpz_clear (val);
return res;
}
DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)

34
src/emacs.c
View file

@ -673,38 +673,6 @@ close_output_streams (void)
_exit (EXIT_FAILURE);
}
/* Memory allocation functions for GMP. */
static void
check_bignum_size (size_t size)
{
/* Do not create a bignum whose log base 2 could exceed fixnum range.
This way, functions like mpz_popcount return values in fixnum range.
It may also help to avoid other problems with outlandish bignums. */
if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size)
error ("Integer too large to be represented");
}
static void * ATTRIBUTE_MALLOC
xmalloc_for_gmp (size_t size)
{
check_bignum_size (size);
return xmalloc (size);
}
static void *
xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
{
check_bignum_size (size);
return xrealloc (ptr, size);
}
static void
xfree_for_gmp (void *ptr, size_t ignore)
{
xfree (ptr);
}
/* ARGSUSED */
int
main (int argc, char **argv)
@ -803,8 +771,6 @@ main (int argc, char **argv)
init_standard_fds ();
atexit (close_output_streams);
mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp);
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;

24
src/floatfns.c
View file

@ -210,29 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
/* Common Lisp spec: don't promote if both are integers, and if the
result is not fractional. */
if (INTEGERP (arg1) && NATNUMP (arg2))
{
unsigned long exp;
if (TYPE_RANGED_FIXNUMP (unsigned long, arg2))
exp = XFIXNUM (arg2);
else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2)
&& mpz_fits_ulong_p (XBIGNUM (arg2)->value))
exp = mpz_get_ui (XBIGNUM (arg2)->value);
else
xsignal3 (Qrange_error, build_string ("expt"), arg1, arg2);
mpz_t val;
mpz_init (val);
if (FIXNUMP (arg1))
{
mpz_set_intmax (val, XFIXNUM (arg1));
mpz_pow_ui (val, val, exp);
}
else
mpz_pow_ui (val, XBIGNUM (arg1)->value, exp);
Lisp_Object res = make_number (val);
mpz_clear (val);
return res;
}
return expt_integer (arg1, arg2);
return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2)));
}

11
src/lisp.h
View file

@ -996,6 +996,14 @@ enum More_Lisp_Bits
#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
/* GMP-related limits. */
/* Number of data bits in a limb. */
#ifndef GMP_NUMB_BITS
enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) };
#endif
#if USE_LSB_TAG
INLINE Lisp_Object
@ -3338,7 +3346,7 @@ extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
enum Set_Internal_Bind);
extern void set_default_internal (Lisp_Object, Lisp_Object,
enum Set_Internal_Bind bindflag);
extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
extern void syms_of_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
@ -3700,6 +3708,7 @@ extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern _Noreturn void integer_overflow (void);
extern void init_alloc_once (void);
extern void init_alloc (void);
extern void syms_of_alloc (void);