Merge branch 'gmp-alloc-fix' into 'develop'

Fix gmp allocation functions and #485

Closes #485

See merge request embeddable-common-lisp/ecl!176

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,14 +18,38 @@
 #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
 _ecl_big_register_free(cl_object x)
 {
-  return;
+  /* We only need to free the integer when it gets too large */
+  if (ECL_BIGNUM_DIM(x) > 4 * ECL_BIG_REGISTER_SIZE) {
+    _ecl_big_realloc2(x, ECL_BIG_REGISTER_SIZE);
+  }
 }
 
 static cl_object
@@ -273,13 +298,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/number.h

@@ -45,6 +45,7 @@ extern ECL_API _ecl_big_binary_op _ecl_big_boole_operator(int op);
 #define _ecl_big_set_index(x, f) mpz_set_ui((x)->big.big_num,(f))
 #endif
 #define _ecl_big_init2(x,size)  mpz_init2((x)->big.big_num,(size)*GMP_LIMB_BITS)
+#define _ecl_big_realloc2(x,size)       mpz_realloc2((x)->big.big_num,(size)*GMP_LIMB_BITS)
 #define _ecl_big_clear(x)       mpz_clear((x)->big.big_num)
 #define _ecl_big_set(x,y)       mpz_set((x)->big.big_num,(y)->big.big_num)
 #define _ecl_big_odd_p(x)       ((mpz_get_ui(x->big.big_num) & 1) != 0)

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;