Allocate bignum limbs in the AMC pool

Keep the mpz_t field in the Lisp_Bignum struct and the indirection so
that we don't need to change the bignum_val function.  However, the
value._mp_d fields always points right after the mpz_t.

This patch also changes the peak memory usage for the pidigits benchmark
with MPS:

    |        | max rss   | elapsed time |
    |--------+-----------+--------------|
    | before | 702316 KB | 16.99 s      |
    | after  | 81128 KB  | 17.15 s      |

* src/bignum.h (struct Lisp_Bignum): Add room for the limb array.
* src/bignum.c (make_bignum_from_mpz): New.
(make_bignum_bits, make_bignum_str): Use it.
* src/igc.h (fix_bignum): New, needed to adjust the _mp_d field.
(fix_vector): Call it.
(finalize_bignum): Deleted.
(finalize_vector, maybe_finalize): No more finalization for bignums.
* src/pdumper.c (dump_bignum, dump_do_dump_relocation, dump_cold_bignum):
Adapt to new bignums.

src/alloc.c

@@ -2600,6 +2600,42 @@ make_float (double float_value)
 #endif
 }
 
+
+static void *
+xmalloc_for_gmp (size_t size)
+{
+  tally_consing (size);
+  return xmalloc (size);
+}
+
+static void *
+xrealloc_for_gmp (void *ptr, size_t old_size, size_t new_size)
+{
+  tally_consing (new_size - old_size);
+  return xrealloc (ptr, new_size);
+}
+
+static void
+xfree_for_gmp (void *ptr, size_t size)
+{
+  tally_consing (-size);
+  xfree (ptr);
+}
+
+void
+init_gmp_memory_functions (void)
+{
+  /* FIXME: The Info node `(gmp) Custom Allocation' states: "No error
+     return is allowed from any of these functions, if they return
+     then they must have performed the specified operation. [...]
+       There's currently no defined way for the allocation functions
+     to recover from an error such as out of memory, they must
+     terminate program execution.  A 'longjmp' or throwing a C++
+     exception will have undefined results."  But xmalloc and xrealloc
+     do call 'longjmp'.  */
+  mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp,
+			   xfree_for_gmp);
+}
 
 
 /***********************************************************************

src/bignum.c

@@ -36,33 +36,13 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 mpz_t mpz[5];
 
-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);
-}
-
 void
 init_bignum (void)
 {
   eassert (mp_bits_per_limb == GMP_NUMB_BITS);
   integer_width = 1 << 16;
 
-  /* FIXME: The Info node `(gmp) Custom Allocation' states: "No error
-     return is allowed from any of these functions, if they return
-     then they must have performed the specified operation. [...]
-     There's currently no defined way for the allocation functions to
-     recover from an error such as out of memory, they must terminate
-     program execution.  A 'longjmp' or throwing a C++ exception will
-     have undefined results."  But xmalloc and xrealloc do call
-     'longjmp'.  */
-  mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp);
+  init_gmp_memory_functions ();
 
   for (int i = 0; i < ARRAYELTS (mpz); i++)
     mpz_init (mpz[i]);
@@ -86,6 +66,33 @@ double_to_integer (double d)
   return make_integer_mpz ();
 }
 
+#ifdef HAVE_MPS
+static struct Lisp_Bignum *
+make_bignum_from_mpz (mpz_srcptr z)
+{
+  size_t nlimbs = mpz_size (z);
+  const mp_limb_t *limbs = mpz_limbs_read (z);
+  size_t nbytes = (offsetof (struct Lisp_Bignum, limbs)
+		   + nlimbs * (sizeof *limbs) - header_size);
+  size_t roundup_size = max (GCALIGNMENT, word_size);
+  size_t nwords = ROUNDUP (nbytes, roundup_size) / word_size;
+  size_t rest_max = (1 << PSEUDOVECTOR_REST_BITS) - 1;
+  if (nwords > rest_max)
+    overflow_error ();
+  struct Lisp_Bignum *b
+    = (struct Lisp_Bignum *) allocate_pseudovector (nwords, 0, 0,
+						    PVEC_BIGNUM);
+  eassert (vectorlike_nbytes (&b->header)
+	   == ROUNDUP (nbytes + header_size, roundup_size));
+  eassert (nlimbs > 0);
+  memcpy (b->limbs, limbs, nlimbs * sizeof *limbs);
+  const mpz_t value = MPZ_ROINIT_N (b->limbs, z->_mp_size);
+  mpz_ptr p = b->value;
+  *p = *value;
+  return b;
+}
+#endif
+
 /* 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
@@ -99,10 +106,14 @@ make_bignum_bits (size_t bits)
   if (integer_width < bits && 2 * max (INTMAX_WIDTH, UINTMAX_WIDTH) < bits)
     overflow_error ();
 
+#ifdef HAVE_MPS
+  struct Lisp_Bignum *b = make_bignum_from_mpz (mpz[0]);
+#else
   struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum,
 						       PVEC_BIGNUM);
   mpz_init (b->value);
   mpz_swap (b->value, mpz[0]);
+#endif
   return make_lisp_ptr (b, Lisp_Vectorlike);
 }
 
@@ -462,6 +473,18 @@ bignum_to_string (Lisp_Object num, int base)
    of base-BASE digits, and a terminating null byte, and
    the represented number must not be in fixnum range.  */
 
+#ifdef HAVE_MPS
+Lisp_Object
+make_bignum_str (char const *num, int base)
+{
+  mpz_t tmp;
+  int check = mpz_init_set_str (tmp, num, base);
+  eassert (check == 0);
+  struct Lisp_Bignum *b = make_bignum_from_mpz (tmp);
+  mpz_clear (tmp);
+  return make_lisp_ptr (b, Lisp_Vectorlike);
+}
+#else
 Lisp_Object
 make_bignum_str (char const *num, int base)
 {
@@ -472,6 +495,7 @@ make_bignum_str (char const *num, int base)
   eassert (check == 0);
   return make_lisp_ptr (b, Lisp_Vectorlike);
 }
+#endif
 
 /* Check that X is a Lisp integer in the range LO..HI.
    Return X's value as an intmax_t.  */

src/bignum.h

@@ -40,6 +40,9 @@ struct Lisp_Bignum
 {
   struct vectorlike_header header;
   mpz_t value;
+#ifdef HAVE_MPS
+  mp_limb_t limbs[FLEXIBLE_ARRAY_MEMBER];
+#endif
 } GCALIGNED_STRUCT;
 
 extern mpz_t mpz[5];
@@ -59,6 +62,9 @@ extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long)
 extern double mpz_get_d_rounded (mpz_t const);
 extern Lisp_Object get_random_bignum (struct Lisp_Bignum const *);
 
+/* defined in alloc.c  */
+extern void init_gmp_memory_functions (void);
+
 INLINE_HEADER_BEGIN
 
 INLINE struct Lisp_Bignum *

src/igc.c

@@ -103,7 +103,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>. */
 # ifndef HASH_Lisp_Finalizer_7DACDD23C5
 #  error "struct Lisp_Finalizer changed"
 # endif
-# ifndef HASH_Lisp_Bignum_8732048B98
+# ifndef HASH_Lisp_Bignum_EC99943321
 #  error "struct Lisp_Bignum changed"
 # endif
 # ifndef HASH_Lisp_Float_4F10F019A4
@@ -2732,6 +2732,18 @@ fix_marker (mps_ss_t ss, struct Lisp_Marker *m)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_bignum (mps_ss_t ss, struct Lisp_Bignum *b)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    mpz_ptr p = b->value;
+    p->_mp_d = b->limbs;
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t
 fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f)
 {
@@ -2937,6 +2949,7 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
 	break;
 
       case PVEC_BIGNUM:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Bignum, v, fix_bignum);
 	break;
 
       case PVEC_NATIVE_COMP_UNIT:
@@ -3732,12 +3745,6 @@ igc_alloc_hash_table_user_test (void)
   return ut;
 }
 
-static void
-finalize_bignum (struct Lisp_Bignum *n)
-{
-  mpz_clear (n->value);
-}
-
 static void
 finalize_font (struct font *font)
 {
@@ -3846,10 +3853,6 @@ finalize_vector (mps_addr_t v)
   /* Please use exhaustive switches, just to do me a favor :-).  */
   switch (pseudo_vector_type (v))
     {
-    case PVEC_BIGNUM:
-      finalize_bignum (v);
-      break;
-
     case PVEC_FONT:
       finalize_font (v);
       break;
@@ -3934,6 +3937,7 @@ finalize_vector (mps_addr_t v)
     case PVEC_TERMINAL:
     case PVEC_MARKER:
     case PVEC_MODULE_GLOBAL_REFERENCE:
+    case PVEC_BIGNUM:
       igc_assert (!"finalization not implemented");
       break;
 
@@ -3994,7 +3998,6 @@ maybe_finalize (mps_addr_t ref, enum pvec_type tag)
     }
   switch (tag)
     {
-    case PVEC_BIGNUM:
     case PVEC_FONT:
     case PVEC_THREAD:
     case PVEC_MUTEX:
@@ -4044,6 +4047,7 @@ maybe_finalize (mps_addr_t ref, enum pvec_type tag)
     case PVEC_PACKAGE:
 #endif
     case PVEC_MODULE_GLOBAL_REFERENCE:
+    case PVEC_BIGNUM:
       break;
     }
 }

src/pdumper.c

@@ -2365,16 +2365,24 @@ struct bignum_reload_info
 static dump_off
 dump_bignum (struct dump_context *ctx, Lisp_Object object)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_8732048B98)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_EC99943321)
 # error "Lisp_Bignum changed. See CHECK_STRUCTS comment in config.h."
 #endif
   const struct Lisp_Bignum *bignum = XBIGNUM (object);
   START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
+  dump_off bignum_offset = ctx->offset;
   static_assert (sizeof (out->value) >= sizeof (struct bignum_reload_info));
   dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
-  dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
   if (ctx->flags.dump_object_contents)
     {
+#ifdef HAVE_MPS
+      eassert (out->value->_mp_alloc == 0);
+      DUMP_FIELD_COPY (out, bignum, value->_mp_size);
+      eassert (out->value->_mp_size != 0);
+      eassert (out->value->_mp_d == NULL);
+      size_t nlimbs = mpz_size (bignum->value);
+      memcpy (out->limbs, bignum->limbs, nlimbs * sizeof *out->limbs);
+#else
       /* Export the bignum into a blob in the cold section.  */
       dump_remember_cold_op (ctx, COLD_OP_BIGNUM, object);
 
@@ -2386,7 +2394,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
 		 list3 (make_fixnum (DUMP_FIXUP_BIGNUM_DATA),
 			dump_off_to_lisp (value_offset),
 			object));
-
+#endif
       /* When we load the dump, slurp the data blob and turn it into a
          real bignum.  Attach the relocation to the start of the
          Lisp_Bignum instead of the actual mpz field so that the
@@ -2396,8 +2404,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
                  list2 (make_fixnum (RELOC_BIGNUM),
                         dump_off_to_lisp (bignum_offset)));
     }
-
-  return bignum_offset;
+  return finish_dump_pvec (ctx, &out->header);
 }
 
 static dump_off
@@ -3688,10 +3695,6 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
   eassert (sz_nlimbs < DUMP_OFF_MAX);
   dump_align_output (ctx, alignof (mp_limb_t));
   dump_off nlimbs = (dump_off) sz_nlimbs;
-# ifdef HAVE_MPS
-  char *dummy = (void *)igc_alloc_bytes (nlimbs * sizeof (mp_limb_t));
-  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BIGNUM_DATA, dummy - sizeof (uint64_t));
-# endif
   Lisp_Object descriptor
     = list2 (dump_off_to_lisp (ctx->offset),
 	     dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
@@ -3701,9 +3704,6 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
       mp_limb_t limb = mpz_getlimbn (*n, i);
       dump_write (ctx, &limb, sizeof (limb));
     }
-# ifdef HAVE_MPS
-  dump_igc_finish_obj (ctx);
-# endif
 }
 
 #ifdef HAVE_NATIVE_COMP
@@ -5883,6 +5883,18 @@ dump_do_dump_relocation (const uintptr_t dump_base,
 	break;
       }
 #endif
+#ifdef HAVE_MPS
+    case RELOC_BIGNUM:
+      {
+        struct Lisp_Bignum *b = dump_ptr (dump_base, reloc_offset);
+	mpz_ptr p = b->value;
+	eassert (p->_mp_alloc == 0);
+	eassert (p->_mp_size != 0);
+	eassert (p->_mp_d == NULL);
+	p->_mp_d = b->limbs;
+	break;
+      }
+#else
     case RELOC_BIGNUM:
       {
         struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
@@ -5894,6 +5906,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
         mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
         break;
       }
+#endif
 #ifdef HAVE_MPS
     case RELOC_BUFFER:
       {