modules: [4/n] introduce ecl_module_bignum

src/c/big.d

@@ -14,10 +14,13 @@
  */
 
 #define ECL_INCLUDE_MATH_H
+#include <ecl/ecl.h>
+#include <ecl/ecl-inl.h>
+#include <ecl/internal.h>
+#include <ecl/external.h>
+
 #include <limits.h>
 #include <string.h>
-#include <ecl/ecl.h>
-#include <ecl/internal.h>
 
 /*************************************************************
  * MEMORY MANAGEMENT WITH GMP
@@ -326,22 +329,20 @@ _ecl_fix_divided_by_big(cl_fixnum x, cl_object y)
 static void *
 mp_alloc(size_t size)
 {
-  return ecl_alloc_uncollectable(size);
+  return ecl_malloc(size);
 }
 
 static void
 mp_free(void *ptr, size_t size)
 {
-  ecl_free_uncollectable(ptr);
+  ecl_free(ptr);
 }
 
 static void *
 mp_realloc(void *ptr, size_t osize, size_t nsize)
 {
-  mp_limb_t *p = mp_alloc(nsize);
-  memcpy(p, ptr, (osize < nsize)? osize : nsize);
-  mp_free(ptr, osize);
-  return p;
+  ptr = ecl_realloc(ptr, osize, nsize);
+  return ptr;
 }
 
 #ifdef ECL_GMP_FIXNUM_TO_LIMBS
@@ -607,29 +608,52 @@ _ecl_big_boole_operator(int op)
   return bignum_operations[op];
 }
 
-void
+/* -- module definition ------------------------------------------------------ */
+
+static cl_object
+create_bignum ()
+{
+  if (ecl_option_values[ECL_OPT_SET_GMP_MEMORY_FUNCTIONS])
+    mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);
+  return ECL_NIL;
+}
+
+cl_object
 ecl_init_bignum_registers(cl_env_ptr env)
 {
   int i;
   for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
+    /* INV this implies the standard allocator already initialized. */
     cl_object x = ecl_alloc_object(t_bignum);
     _ecl_big_init2(x, ECL_BIG_REGISTER_SIZE);
     env->big_register[i] = x;
   }
+  return ECL_NIL;
 }
 
-void
-ecl_clear_bignum_registers(cl_env_ptr env)
+cl_object
+ecl_free_bignum_registers(cl_env_ptr env)
 {
   int i;
   for (i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
     _ecl_big_clear(env->big_register[i]);
+    env->big_register[i] = ECL_NIL;
   }
+  return ECL_NIL;
 }
 
-void
-init_big()
-{
-  if (ecl_option_values[ECL_OPT_SET_GMP_MEMORY_FUNCTIONS])
-    mp_set_memory_functions(mp_alloc, mp_realloc, mp_free);
-}
+ecl_def_ct_base_string(str_bignum, "BIGNUM", 6, static, const);
+
+static struct ecl_module module_bignum = {
+  .name = str_bignum,
+  .create = create_bignum,
+  .enable = ecl_module_no_op,
+  .init_env = ecl_init_bignum_registers,
+  .init_cpu = ecl_module_no_op_cpu,
+  .free_cpu = ecl_module_no_op_cpu,
+  .free_env = ecl_free_bignum_registers,
+  .disable = ecl_module_no_op,
+  .destroy = ecl_module_no_op
+};
+
+cl_object ecl_module_bignum = (cl_object)&module_bignum;

src/c/main.d

@@ -65,8 +65,6 @@ init_env_aux(cl_env_ptr env)
 #if !defined(ECL_CMU_FORMAT)
   env->fmt_aux_stream = ecl_make_string_output_stream(64, 1);
 #endif
-  /* Bignum arithmetic */
-  ecl_init_bignum_registers(env);
   /* Bytecodes compiler environment */
   env->c_env = NULL;
   /* CLOS caches */
@@ -110,7 +108,6 @@ _ecl_dealloc_env(cl_env_ptr env)
   if (!VirtualFree(env, 0, MEM_RELEASE))
     ecl_internal_error("Unable to deallocate environment structure.");
 #else
-  ecl_clear_bignum_registers(env);
   ecl_free_unsafe(env);
 #endif
 }
@@ -153,9 +150,6 @@ _ecl_alloc_env(cl_env_ptr parent)
   output->bds_stack.tl_bindings = NULL;
 #endif
   output->c_stack.org = NULL;
-  for (cl_index i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
-    output->big_register[i] = ECL_NIL;
-  }
   output->method_cache = output->slot_cache = NULL;
   return output;
 }
@@ -292,8 +286,7 @@ cl_boot(int argc, char **argv)
   ecl_add_module(ecl_module_process);
   ecl_add_module(ecl_module_gc);
   ecl_add_module(ecl_module_unixint);
-
-  init_big();
+  ecl_add_module(ecl_module_bignum);
 
   /*
    * Initialize the per-thread data.

src/c/threads/thread.d

@@ -115,7 +115,6 @@ run_process(cl_narg narg, ...)
   } ECL_CATCH_ALL_END;
 
   ecl_disable_interrupts_env(the_env);
-  ecl_clear_bignum_registers(the_env);
 
   ecl_mutex_lock(&process->process.start_stop_lock);
   process->process.phase = ECL_PROCESS_EXITING;

src/c/unixint.d

@@ -366,15 +366,14 @@ handle_all_queued(cl_env_ptr env)
 static void
 handle_all_queued_interrupt_safe(cl_env_ptr env)
 {
-  /* We have to save and later restore thread-local variables to
-   * ensure that they don't get overwritten by the interrupting
-   * code */
-  /* INV: - IHS stack manipulations are interrupt safe
-   *      - The rest of the thread local variables are
-   *        guaranteed to be used in an interrupt safe way. This
-   *        is not true for the compiler environment and ffi
-   *        data, but it is unclear whether the DFFI or compiler
-   *        are thread safe anyway. */
+  /* We have to save and later restore thread-local variables to ensure that
+   * they don't get overwritten by the interrupting code. */
+  /* FIXME introduce save/load procedure in modules. */
+  /* INV IHS stack manipulations are interrupt safe; the rest of the thread
+   * local variables are guaranteed to be used in an interrupt safe way[1].
+   *
+   * [1] This is not true for the compiler environment and ffi data, but it is
+   * unclear whether the DFFI or the compiler are thread safe anyway. */
   cl_object fun = env->function;
   cl_index nvalues = env->nvalues;
   cl_object values[ECL_MULTIPLE_VALUES_LIMIT];
@@ -387,7 +386,8 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
    * 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));
+  cl_index big_register_size = ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object);
+  ecl_copy(big_register, env->big_register, big_register_size);
   ecl_init_bignum_registers(env);
   /* We might have been interrupted while we push/pop in the stack. Increasing
    * env->run_stack.top ensures that we don't overwrite the topmost stack
@@ -407,8 +407,8 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
   memcpy(env->bds_stack.top+1, &top_binding, sizeof(struct ecl_bds_frame));
   memcpy(env->frs_stack.top+1, &top_frame, sizeof(struct ecl_frame));
   env->run_stack.top--;
-  ecl_clear_bignum_registers(env);
-  memcpy(env->big_register, big_register, ECL_BIGNUM_REGISTER_NUMBER*sizeof(cl_object));
+  ecl_free_bignum_registers(env);
+  ecl_copy(env->big_register, big_register, big_register_size);
   env->packages_to_be_created_p = packages_to_be_created_p;
   env->packages_to_be_created = packages_to_be_created;
   env->stack_frame = stack_frame;

src/h/internal.h

@@ -27,6 +27,7 @@ extern ECL_API cl_object ecl_module_process;
 extern ECL_API cl_object ecl_module_dummy;
 extern ECL_API cl_object ecl_module_gc;
 extern ECL_API cl_object ecl_module_unixint;
+extern ECL_API cl_object ecl_module_bignum;
 
 extern void init_all_symbols(void);
 extern void init_backq(void);
@@ -627,8 +628,8 @@ 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);
+extern cl_object ecl_init_bignum_registers(cl_env_ptr env);
+extern cl_object ecl_free_bignum_registers(cl_env_ptr env);
 
 /* threads/mutex.d */