bignums: don't use ecl_alloc_atomic for gmp

The gmp manual (https://gmplib.org/manual/Custom-Allocation.html) states

> GMP may use allocated blocks to hold pointers to other allocated
  blocks. This will limit the assumptions a conservative garbage
  collection scheme can make.

Thus we can't use ecl_alloc_atomic. We could just use ecl_alloc
instead, however our implementation is already structured in such a
way that it is sufficient to use ecl_alloc_uncollectable. The reason
for that is that currently all bignums except those in the bignum
registers in the thread local environment are allocated as compact
objects so that we only need to call mpz_clear for the few non-compact
objects in the bignum registers.

See also commits 7b536161 and bd48b859.
Fixes #485.

msvc/ecl/config.h.msvc6

@@ -148,6 +148,8 @@ typedef unsigned int cl_index;
 typedef unsigned int cl_hashkey;
 #endif
 
+#define ECL_BIGNUM_REGISTER_NUMBER 3
+
 /*
  * The character type
  */

src/c/big.d

@@ -2,7 +2,8 @@
 /* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
 
 /*
- * big.c - bignum routines based on the GMP
+ * big.c - bignum routines based on the GMP multiple precision
+ * integers.
  *
  * Copyright (c) 1990 Giuseppe Attardi
  * Copyright (c) 2001 Juan Jose Garcia Ripoll
@@ -17,8 +18,29 @@
 #include <ecl/ecl.h>
 #include <ecl/internal.h>
 
-/* 
- * Using GMP multiple precision integers.
+/*************************************************************
+ * MEMORY MANAGEMENT WITH GMP
+ *
+ * A careful reader of the below code will note that there is no
+ * invocation of mpz_init anywhere. The reason for this is that we
+ * keep a number of initialized bignums in the thread local
+ * environment in what are called bignum registers. From these bignum
+ * registers, we obtain bignum objects that are passed around in user
+ * code by copying the contents of the mpz_t object into a compact
+ * object. This means that the bignum type and the contents of the
+ * corresponding mpz_t are allocated as a single block.
+ *
+ * A consequence of the above is that we also need not call mpz_clear,
+ * since a garbage collection of a compactly allocated bignum
+ * automatically leads to a deallocation of the contents of the
+ * corresponding mpz_t object. The exception to this rule are the
+ * bignum registers which are deallocated upon thread exit.
+ *
+ * The GMP library may also allocate temporary memory for its
+ * computations. It is configurable at runtime whether we use malloc
+ * and free or the corresponding equivalents from the garbage
+ * collector (ecl_alloc_uncollectable and ecl_free_uncollectable) for
+ * that.
  */
 
 void
@@ -273,13 +295,13 @@ _ecl_fix_divided_by_big(cl_fixnum x, cl_object y)
 static void *
 mp_alloc(size_t size)
 {
-  return ecl_alloc_atomic(size);
+  return ecl_alloc_uncollectable(size);
 }
 
 static void
 mp_free(void *ptr, size_t size)
 {
-  ecl_dealloc(ptr);
+  ecl_free_uncollectable(ptr);
 }
 
 static void *

src/c/main.d

@@ -130,6 +130,26 @@ ecl_set_option(int option, cl_fixnum value)
   }
 }
 
+void
+ecl_init_bignum_registers(cl_env_ptr env)
+{
+  int i;
+  for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
+    cl_object x = ecl_alloc_object(t_bignum);
+    _ecl_big_init2(x, ECL_BIG_REGISTER_SIZE);
+    env->big_register[i] = x;
+  }
+}
+
+void
+ecl_clear_bignum_registers(cl_env_ptr env)
+{
+  int i;
+  for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
+    _ecl_big_clear(env->big_register[i]);
+  }
+}
+
 void
 ecl_init_env(cl_env_ptr env)
 {
@@ -167,14 +187,7 @@ ecl_init_env(cl_env_ptr env)
 
   init_stacks(env);
 
-  {
-    int i;
-    for (i = 0; i < 3; i++) {
-      cl_object x = ecl_alloc_object(t_bignum);
-      _ecl_big_init2(x, ECL_BIG_REGISTER_SIZE);
-      env->big_register[i] = x;
-    }
-  }
+  ecl_init_bignum_registers(env);
 
   env->trap_fpe_bits = 0;
 

src/c/threads/process.d

@@ -194,7 +194,10 @@ thread_cleanup(void *aux)
   cl_env_ptr env = process->process.env;
   /* The following flags will disable all interrupts. */
   AO_store_full((AO_t*)&process->process.phase, ECL_PROCESS_EXITING);
-  if (env) ecl_disable_interrupts_env(env);
+  if (env) {
+    ecl_clear_bignum_registers(env);
+    ecl_disable_interrupts_env(env);
+  }
 #ifdef HAVE_SIGPROCMASK
   /* ...but we might get stray signals. */
   {

src/c/unixint.d

@@ -385,10 +385,15 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
         cl_object values[ECL_MULTIPLE_VALUES_LIMIT];
         memcpy(values, env->values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object));
         cl_object stack_frame = env->stack_frame;
-        cl_object big_register[3];
-        memcpy(big_register, env->big_register, 3*sizeof(cl_object));
         cl_object packages_to_be_created = env->packages_to_be_created;
         cl_object packages_to_be_created_p = env->packages_to_be_created_p;
+        /* bignum registers need some special handling, because their
+         * contents are allocated as uncollectable memory. If we did
+         * not init and clear them before calling the interrupting
+         * code we would risk memory leaks. */
+        cl_object big_register[ECL_BIGNUM_REGISTER_NUMBER];
+        memcpy(big_register, env->big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object));
+        ecl_init_bignum_registers(env);
         /* We might have been interrupted while we push/pop in the
          * stack. Increasing env->stack_top ensures that we don't
          * overwrite the topmost stack value. */
@@ -407,9 +412,10 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
         memcpy(env->bds_top+1, &top_binding, sizeof(struct ecl_bds_frame));
         memcpy(env->frs_top+1, &top_frame, sizeof(struct ecl_frame));
         env->stack_top--;
+        ecl_clear_bignum_registers(env);
+        memcpy(env->big_register, big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object));
         env->packages_to_be_created_p = packages_to_be_created_p;
         env->packages_to_be_created = packages_to_be_created;
-        memcpy(env->big_register, big_register, 3*sizeof(cl_object));
         env->stack_frame = stack_frame;
         memcpy(env->values, values, ECL_MULTIPLE_VALUES_LIMIT*sizeof(cl_object));
         env->nvalues = nvalues;

src/h/config.h.in

@@ -151,6 +151,8 @@ typedef @CL_FIXNUM_TYPE@ cl_fixnum;
 typedef unsigned @CL_FIXNUM_TYPE@ cl_index;
 typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
 
+#define ECL_BIGNUM_REGISTER_NUMBER 3
+
 /*
  * The character type
  */

src/h/external.h

@@ -107,11 +107,7 @@ struct cl_env_struct {
 #endif
 
         /* ... arithmetics ... */
-        /* Note: if you change the size of these registers, change also
-           BIGNUM_REGISTER_SIZE in config.h */
-        /* FIXME: actually use BIGNUM_REGISTER_SIZE; Also fix
-           handle_all_queued_interrupt_safe in unixint.d */
-        cl_object big_register[3];
+        cl_object big_register[ECL_BIGNUM_REGISTER_NUMBER];
 
         cl_object own_process;
         /* The objects in this struct need to be writeable from a
@@ -405,6 +401,7 @@ extern ECL_API cl_object mp_atomic_incf_symbol_value(cl_object x, cl_object incr
 
 /* big.c */
 
+/* Note: Needs to be adapted if ECL_BIGNUM_REGISTER_NUMBER changes */
 #define _ecl_big_register0()    ecl_process_env()->big_register[0]
 #define _ecl_big_register1()    ecl_process_env()->big_register[1]
 #define _ecl_big_register2()    ecl_process_env()->big_register[2]
@@ -425,8 +422,6 @@ extern ECL_API cl_object _ecl_big_ceiling(cl_object x, cl_object y, cl_object *r
 extern ECL_API cl_object _ecl_big_floor(cl_object x, cl_object y, cl_object *r);
 extern ECL_API cl_object _ecl_big_negate(cl_object x);
 extern ECL_API void _ecl_big_register_free(cl_object x);
-extern ECL_API cl_object bignum1(cl_fixnum val);
-
 
 /* cfun.c */
 

src/h/internal.h

@@ -307,6 +307,9 @@ extern cl_object _ecl_long_double_to_integer(long double d);
 
 extern cl_fixnum ecl_option_values[ECL_OPT_LIMIT+1];
 
+extern void ecl_init_bignum_registers(cl_env_ptr env);
+extern void ecl_clear_bignum_registers(cl_env_ptr env);
+
 /* print.d */
 
 extern cl_object _ecl_stream_or_default_output(cl_object stream);

src/h/object.h

@@ -221,9 +221,9 @@ struct ecl_bignum {
         mpz_t big_num;
 };
 
-#define ECL_BIGNUM_DIM(x)       ((x)->big.big_num->_mp_alloc)
-#define ECL_BIGNUM_SIZE(x)      ((x)->big.big_num->_mp_size)
-#define ECL_BIGNUM_LIMBS(x)     ((x)->big.big_num->_mp_d)
+#define ECL_BIGNUM_DIM(x)       ((x)->big.big_num->_mp_alloc) /* number of allocated limbs */
+#define ECL_BIGNUM_SIZE(x)      ((x)->big.big_num->_mp_size)  /* number of limbs in use times sign of the bignum */
+#define ECL_BIGNUM_LIMBS(x)     ((x)->big.big_num->_mp_d)     /* pointer to array of allocated limbs */
 
 struct ecl_ratio {
         _ECL_HDR;