Avoid libgmp aborts by imposing limits

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.

1 files changed, 51 insertions, 22 deletions

diff --git a/src/alloc.c b/src/alloc.c
index ddc0696ba91..24a24aab96b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -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);
+
+  if (bits <= FIXNUM_BITS)
     {
-      size_t bits = mpz_sizeinbase (value, 2);
+      EMACS_INT v = 0;
+      int i = 0, shift = 0;
 
-      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;
+      do
+        {
+          EMACS_INT limb = mpz_getlimbn (value, i++);
+          v += limb << shift;
+          shift += GMP_NUMB_BITS;
+        }
+      while (shift < bits);
 
-          if (!FIXNUM_OVERFLOW_P (v))
-            return make_fixnum (v);
-        }
+      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);