modules: [7/n] introduce ecl_module_stacks

src/c/main.d

@@ -51,22 +51,18 @@ ecl_init_first_env(cl_env_ptr the_env)
 #else
   ecl_cs_init(env);
 #endif
-  ecl_cs_init(the_env);
-  init_stacks(the_env);
 }
 
 void
 ecl_init_env(cl_env_ptr env)
 {
   ecl_modules_init_env(env);
-  init_stacks(env);
 }
 
 void
 _ecl_dealloc_env(cl_env_ptr env)
 {
   ecl_modules_free_env(env);
-  free_stacks(env);
 #if defined(ECL_USE_MPROTECT)
   if (munmap(env, sizeof(*env)))
     ecl_internal_error("Unable to deallocate environment structure.");
@@ -111,11 +107,7 @@ _ecl_alloc_env(cl_env_ptr parent)
 # endif
 #endif
   /* Initialize the structure with NULL data. */
-#if defined(ECL_THREADS)
-  output->bds_stack.tl_bindings_size = 0;
-  output->bds_stack.tl_bindings = NULL;
-#endif
-  output->c_stack.org = NULL;
+  memset(output, 0, sizeof(*output));
   return output;
 }
 
@@ -248,6 +240,7 @@ cl_boot(int argc, char **argv)
   ecl_self = argv[0];
 
   ecl_add_module(ecl_module_process);
+  ecl_add_module(ecl_module_stacks);
   ecl_add_module(ecl_module_gc);
   ecl_add_module(ecl_module_unixint);
   ecl_add_module(ecl_module_bignum);

src/c/process.d

@@ -212,10 +212,8 @@ thread_entry_point(void *ptr)
   cl_object process = the_env->own_process;
   /* Setup the environment for the execution of the thread. */
   ecl_modules_init_cpu(the_env);
-  ecl_cs_init(the_env);
-
+  /* Start the user routine */
   process->process.entry(0);
-
   /* This routine performs some cleanup before a thread is completely
    * killed. For instance, it has to remove the associated process object from
    * the list, an it has to dealloc some memory.
@@ -224,7 +222,6 @@ thread_entry_point(void *ptr)
    * that all UNWIND-PROTECT forms are properly executed, never use the function
    * pthread_cancel() to kill a process, but rather use the lisp functions
    * mp_interrupt_process() and mp_process_kill(). */
-
   ecl_disable_interrupts_env(the_env);
   ecl_modules_free_cpu(the_env);
   del_env(the_env);

src/c/stacks.d

@@ -370,7 +370,7 @@ bds_init(cl_env_ptr env)
   margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
   limit_size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE];
   size = limit_size + 2 * margin;
-  env->bds_stack.org = (ecl_bds_ptr)ecl_malloc(size * sizeof(*env->bds_stack.org));
+  env->bds_stack.org = (ecl_bds_ptr)ecl_malloc(size * sizeof(cl_object*));
   env->bds_stack.top = env->bds_stack.org-1;
   env->bds_stack.limit = &env->bds_stack.org[limit_size];
   env->bds_stack.size = size;
@@ -709,46 +709,92 @@ frs_sch (cl_object frame_id)
   return(NULL);
 }
 
-/* -- Initialization -------------------------------------------------------- */
-cl_object
-init_stacks(cl_env_ptr the_env)
+/* -- Module definition ------------------------------------------------------ */
+
+static cl_object
+create_stacks(void)
 {
+  cl_env_ptr the_env = ecl_core.first_env;
 #ifdef ECL_THREADS
-  if (the_env == ecl_core.first_env) {
-    cl_index idx;
-    cl_object *vector = (cl_object *)ecl_malloc(1024*sizeof(cl_object*));
-    for(idx=0; idx<1024; idx++) {
-      vector[idx] = ECL_NO_TL_BINDING;
-    }
-    the_env->bds_stack.tl_bindings_size = 1024;
-    the_env->bds_stack.tl_bindings = vector;
+  cl_index idx;
+  cl_object *vector = (cl_object *)ecl_malloc(1024*sizeof(cl_object*));
+  for(idx=0; idx<1024; idx++) {
+    vector[idx] = ECL_NO_TL_BINDING;
   }
+  the_env->bds_stack.tl_bindings_size = 1024;
+  the_env->bds_stack.tl_bindings = vector;
 #endif
+  the_env->c_stack.org = NULL;
+  return ECL_NIL;
+}
+
+static cl_object
+enable_stacks(void)
+{
+  return ECL_NIL;
+}
+
+static cl_object
+init_env_stacks(cl_env_ptr the_env)
+{
   frs_init(the_env);
   bds_init(the_env);
   run_init(the_env);
   ihs_init(the_env);
-  /* FIXME ecl_cs_init must be called from the thread entry point at the
-     beginning to correctly determine the stack base. */
-#if 0
-  cs_init(the_env);
-#endif
+  the_env->c_stack.org = NULL;
   return ECL_NIL;
 }
 
-cl_object
-free_stacks(cl_env_ptr the_env)
+static cl_object
+init_cpu_stacks(cl_env_ptr the_env)
+{
+  ecl_cs_init(the_env);
+  return ECL_NIL;
+}
+
+static cl_object
+free_cpu_stacks(cl_env_ptr the_env)
+{
+  return ECL_NIL;
+}
+
+static cl_object
+free_env_stacks(cl_env_ptr the_env)
 {
-#ifdef ECL_THREADS
-  ecl_free(the_env->bds_stack.tl_bindings);
-  the_env->bds_stack.tl_bindings_size = 0;
-#endif
   ecl_free(the_env->run_stack.org);
   ecl_free(the_env->bds_stack.org);
   ecl_free(the_env->frs_stack.org);
   return ECL_NIL;
 }
 
+static cl_object
+destroy_stacks(void)
+{
+  cl_env_ptr the_env = ecl_core.first_env;
+#ifdef ECL_THREADS
+  ecl_free(the_env->bds_stack.tl_bindings);
+  the_env->bds_stack.tl_bindings_size = 0;
+  the_env->bds_stack.tl_bindings = NULL;
+#endif
+  return ECL_NIL;
+}
+
+ecl_def_ct_base_string(str_stacks, "STACKS", 6, static, const);
+
+static struct ecl_module module_stacks = {
+  .name = str_stacks,
+  .create = create_stacks,
+  .enable = enable_stacks,
+  .init_env = init_env_stacks,
+  .init_cpu = init_cpu_stacks,
+  .free_cpu = free_cpu_stacks,
+  .free_env = free_env_stacks,
+  .disable = ecl_module_no_op,
+  .destroy = destroy_stacks
+};
+
+cl_object ecl_module_stacks = (cl_object)&module_stacks;
+
 /* -- High level interface -------------------------------------------------- */
 
 void
@@ -1105,3 +1151,4 @@ si_get_limit(cl_object type)
 
   ecl_return1(env, ecl_make_unsigned_integer(output));
 }
+

src/h/internal.h

@@ -24,6 +24,7 @@ extern "C" {
 
 /* booting */
 extern ECL_API cl_object ecl_module_process;
+extern ECL_API cl_object ecl_module_stacks;
 extern ECL_API cl_object ecl_module_dummy;
 extern ECL_API cl_object ecl_module_gc;
 extern ECL_API cl_object ecl_module_unixint;
@@ -41,10 +42,6 @@ extern void init_file(void);
 extern void init_gc(void);
 extern void init_macros(void);
 extern void init_read(void);
-
-extern cl_object init_stacks(cl_env_ptr);
-extern cl_object free_stacks(cl_env_ptr);
-
 extern void init_unixtime(void);
 extern void init_compiler(void);
 extern void init_process(void);