modules: [0/n] introduce a new structure ecl_module in the system

This will allow us to decouple forward system initialization from the early
process code.

src/c/Makefile.in

@@ -50,7 +50,7 @@ HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h $(HDIR)/object.h
 	$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h                   \
 	$(HDIR)/impl/math_fenv_msvc.h $(HDIR)/nucleus.h
 
-BOOT_OBJS = boot.o escape.o
+BOOT_OBJS = boot.o escape.o module.o
 
 CLOS_OBJS = clos/cache.o clos/accessor.o clos/instance.o clos/gfun.o
 

src/c/alloc_2.d

@@ -553,6 +553,7 @@ void init_type_info (void)
   init_tm(t_foreign, "FOREIGN", sizeof(struct ecl_foreign), 2);
   init_tm(t_frame, "STACK-FRAME", sizeof(struct ecl_stack_frame), 0);
   init_tm(t_exception, "EXCEPTION", sizeof(struct ecl_exception), 3);
+  init_tm(t_module, "MODULE", sizeof(struct ecl_module), 2);
   init_tm(t_weak_pointer, "WEAK-POINTER", sizeof(struct ecl_weak_pointer), 0);
 #ifdef ECL_SSE2
   init_tm(t_sse_pack, "SSE-PACK", sizeof(struct ecl_sse_pack), 0);
@@ -714,6 +715,7 @@ void init_type_info (void)
     to_bitmap(&o, &(o.exception.arg1)) |
     to_bitmap(&o, &(o.exception.arg2)) |
     to_bitmap(&o, &(o.exception.arg3));
+  type_info[t_module].descriptor = 0;
   type_info[t_weak_pointer].descriptor = 0;
 #ifdef ECL_SSE2
   type_info[t_sse_pack].descriptor = 0;

src/c/boot.d

@@ -156,6 +156,8 @@ struct ecl_core_struct ecl_core = {
   /* pathnames */
   .path_max = 0,
   .pathname_translations = ECL_NIL,
+  /* MODULES is a stack of plugins that may be loaded at boot time. */
+  .modules = ECL_NIL,
   /* LIBRARIES is a list of objects. It behaves as a sequence of weak pointers
      thanks to the magic in the garbage collector. */
   .libraries = ECL_NIL,
@@ -176,8 +178,8 @@ ecl_boot(void)
     }
     return 1;
   }
-
   init_process();
+  init_modules();
   /* init_unixint(); */
   /* init_garbage(); */
 

src/c/clos/instance.d

@@ -380,6 +380,7 @@ enum ecl_built_in_classes {
   ECL_BUILTIN_FOREIGN_DATA,
   ECL_BUILTIN_FRAME,
   ECL_BUILTIN_EXCEPTION,
+  ECL_BUILTIN_MODULE,
   ECL_BUILTIN_WEAK_POINTER
   ,
   ECL_BUILTIN_PROCESS,
@@ -500,6 +501,8 @@ cl_class_of(cl_object x)
     index = ECL_BUILTIN_FRAME; break;
   case t_exception:
     index = ECL_BUILTIN_EXCEPTION; break;
+  case t_module:
+    index = ECL_BUILTIN_MODULE; break;
   case t_weak_pointer:
     index = ECL_BUILTIN_WEAK_POINTER; break;
 #ifdef ECL_SSE2

src/c/main.d

@@ -93,7 +93,7 @@ init_env_aux(cl_env_ptr env)
 }
 
 void
-ecl_init_first_env(cl_env_ptr env)
+ecl_init_first_env(cl_env_ptr the_env)
 {
   env->default_sigmask = cl_core.default_sigmask;
 #ifdef ECL_THREADS
@@ -101,12 +101,17 @@ ecl_init_first_env(cl_env_ptr env)
 #else
   ecl_cs_init(env);
 #endif
-  ecl_init_env(env);
+  ecl_cs_init(the_env);
+  init_env_int(the_env);
+  init_env_aux(the_env);
+  init_env_ffi(the_env);
+  init_stacks(the_env);
 }
 
 void
 ecl_init_env(cl_env_ptr env)
 {
+  ecl_modules_init_env(env);
   init_env_int(env);
   init_env_aux(env);
   init_env_ffi(env);
@@ -116,8 +121,8 @@ ecl_init_env(cl_env_ptr env)
 void
 _ecl_dealloc_env(cl_env_ptr env)
 {
-  /* Environment cleanup. This is required because the environment is allocated
-   * using mmap or some other method. */
+  env->own_process = ECL_NIL;
+  ecl_modules_free_env(env);
   free_stacks(env);
 #ifdef ECL_THREADS
   ecl_mutex_destroy(&env->interrupt_struct->signal_queue_lock);
@@ -326,6 +331,7 @@ cl_boot(int argc, char **argv)
 
   init_unixint(0);
   init_alloc(0);
+
   init_big();
 
   /*

src/c/module.d

@@ -0,0 +1,186 @@
+/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
+/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
+
+/* module.c - managing runtime modules */
+
+/* -- imports ---------------------------------------------------------------- */
+#include <ecl/ecl.h>
+#include <ecl/ecl-inl.h>
+#include <ecl/internal.h>
+#include <ecl/external.h>
+
+/* -- test module ------------------------------------------------------------ */
+
+static cl_object create() {
+  printf("DUMMY: Creating the module!\n");
+  return ECL_NIL;
+}
+
+static cl_object enable() {
+  printf("DUMMY: Enabling the module!\n");
+  return ECL_NIL;
+}
+
+static cl_object init_env(cl_env_ptr the_env) {
+#ifdef ECL_THREADS
+  ecl_thread_t thread_id = the_env->thread;
+  printf("DUMMY: init_env [cpu %p env %p]\n", &thread_id, the_env);
+#else
+  printf("DUMMY: init_env [env %p]\n", the_env);
+#endif
+  return ECL_NIL;
+}
+
+static cl_object init_cpu(cl_env_ptr the_env) {
+#ifdef ECL_THREADS
+  ecl_thread_t thread_id = the_env->thread;
+  printf("DUMMY: init_cpu [cpu %p env %p]\n", &thread_id, the_env);
+#else
+  printf("DUMMY: init_cpu [env %p]\n", the_env);
+#endif
+  return ECL_NIL;
+}
+
+static cl_object free_cpu(cl_env_ptr the_env) {
+#ifdef ECL_THREADS
+  ecl_thread_t thread_id = the_env->thread;
+  printf("DUMMY: free_cpu [cpu %p env %p]\n", &thread_id, the_env);
+#else
+  printf("DUMMY: free_cpu [env %p]\n", the_env);
+#endif
+  return ECL_NIL;
+}
+
+static cl_object free_env(cl_env_ptr the_env) {
+#ifdef ECL_THREADS
+  ecl_thread_t thread_id = the_env->thread;
+  printf("DUMMY: free_env [cpu %p env %p]\n", &thread_id, the_env);
+#else
+  printf("DUMMY: free_env [env %p]\n", the_env);
+#endif
+  return ECL_NIL;
+}
+
+static cl_object disable() {
+  printf("DUMMY: Disabling the module!\n");
+  return ECL_NIL;
+}
+
+static cl_object destroy() {
+  printf("DUMMY: Destroying the module!\n");
+  return ECL_NIL;
+}
+
+ecl_def_ct_base_string(str_dummy, "DUMMY", 5, static, const);
+
+static struct ecl_module module_dummy = {
+  .name = str_dummy,
+  .create = create,
+  .enable = enable,
+  .init_env = init_env,
+  .init_cpu = init_cpu,
+  .free_cpu = free_cpu,
+  .free_env = free_env,
+  .disable = disable,
+  .destroy = destroy
+};
+
+cl_object ecl_module_dummy = (cl_object)&module_dummy;
+
+/* -- implementation --------------------------------------------------------- */
+
+cl_object
+ecl_module_no_op(void)
+{
+  return ECL_NIL;
+}
+
+cl_object
+ecl_module_no_op_env(cl_env_ptr the_env)
+{
+  return ECL_NIL;
+}
+
+cl_object
+ecl_module_no_op_cpu(cl_env_ptr the_env)
+{
+  return ECL_NIL;
+}
+
+cl_object
+ecl_add_module(cl_object self)
+{
+  self->module.create();
+  self->module.init_cpu(ecl_core.first_env);
+  self->module.init_env(ecl_core.first_env);
+  ecl_stack_push(ecl_core.modules, self);
+  return ECL_NIL;
+}
+
+cl_object
+ecl_del_module(cl_object self)
+{
+  ecl_stack_del(ecl_core.modules, self);
+  self->module.disable();
+  self->module.free_env(ecl_core.first_env);
+  self->module.free_cpu(ecl_core.first_env);
+  self->module.destroy();
+  return ECL_NIL;
+}
+
+cl_object
+ecl_modules_init_env(cl_env_ptr the_env) {
+  loop_across_stack_fifo(var, ecl_core.modules) {
+    /* printf("> init_env: %s\n", (var->module.name)->base_string.self); */
+    var->module.init_env(the_env);
+    /* printf("< init_env: %s\n", (var->module.name)->base_string.self); */
+  } end_loop_across_stack();
+  return ECL_NIL;
+}
+
+cl_object
+ecl_modules_init_cpu(cl_env_ptr the_env) {
+  loop_across_stack_fifo(var, ecl_core.modules) {
+    /* printf("> init_cpu: %s\n", (var->module.name)->base_string.self); */
+    var->module.init_cpu(the_env);
+    /* printf("< init_cpu: %s\n", (var->module.name)->base_string.self); */
+  } end_loop_across_stack();
+  return ECL_NIL;
+}
+
+cl_object
+ecl_modules_free_cpu(cl_env_ptr the_env) {
+  loop_across_stack_filo(var, ecl_core.modules) {
+    /* printf("> free_cpu: %s\n", (var->module.name)->base_string.self); */
+    var->module.free_cpu(the_env);
+    /* printf("< free_cpu: %s\n", (var->module.name)->base_string.self); */
+  } end_loop_across_stack();
+  return ECL_NIL;
+}
+
+cl_object
+ecl_modules_free_env(cl_env_ptr the_env) {
+  loop_across_stack_filo(var, ecl_core.modules) {
+    /* printf("> free_env: %s\n", (var->module.name)->base_string.self); */
+    var->module.free_env(the_env);
+    /* printf("< free_env: %s\n", (var->module.name)->base_string.self); */
+  } end_loop_across_stack();
+  return ECL_NIL;
+}
+
+/* INV all modules must be loaded before we make new threads.  */
+/* FIXME enforce this invariant. */
+void
+init_modules(void)
+{
+  cl_object self = ecl_make_stack(16);
+  ecl_core.modules = self;
+}
+
+void
+free_modules(void)
+{
+  loop_across_stack_filo(var, ecl_core.modules) {
+    ecl_del_module(var);
+  } end_loop_across_stack();
+}

src/c/printer/write_ugly.d

@@ -376,6 +376,12 @@ write_exception(cl_object x, cl_object stream)
   _ecl_write_unreadable(x, "exception", ECL_NIL, stream);
 }
 
+static void
+write_module(cl_object x, cl_object stream)
+{
+  _ecl_write_unreadable(x, "module", x->module.name, stream);
+}
+
 static void
 write_weak_pointer(cl_object x, cl_object stream)
 {
@@ -487,6 +493,7 @@ static printer dispatch[FREE+1] = {
   write_foreign,                /* t_foreign */
   write_frame,                  /* t_frame */
   write_exception,              /* t_exception */
+  write_module,                 /* t_module */
   write_weak_pointer,           /* t_weak_pointer */
 #ifdef ECL_SSE2
   _ecl_write_sse,               /* t_sse_pack */

src/c/process.d

@@ -195,9 +195,10 @@ ecl_adopt_cpu()
   /* Allocate, initialize and switch to the real environment. */
   the_env = _ecl_alloc_env(0);
   memcpy(the_env, env_aux, sizeof(*the_env));
-  ecl_set_process_env(the_env);
   add_env(the_env);
   init_tl_bindings(ECL_NIL, the_env);
+  ecl_set_process_env(the_env);
+  ecl_modules_init_cpu(the_env);
 
   return the_env;
 }
@@ -209,6 +210,7 @@ ecl_disown_cpu()
   if (the_env == NULL)
     return;
   ecl_disable_interrupts_env(the_env);
+  ecl_modules_free_cpu(the_env);
 #ifdef ECL_WINDOWS_THREADS
   CloseHandle(the_env->thread);
 #endif
@@ -229,6 +231,7 @@ thread_entry_point(void *ptr)
   cl_object process = the_env->own_process;
   /* Setup the environment for the execution of the thread. */
   ecl_set_process_env(the_env);
+  ecl_modules_init_cpu(the_env);
   ecl_cs_init(the_env);
 
   process->process.entry(0);
@@ -242,8 +245,10 @@ thread_entry_point(void *ptr)
    * 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_set_process_env(NULL);
   the_env->own_process = ECL_NIL;
+  ecl_modules_free_cpu(the_env);
   del_env(the_env);
 #ifdef ECL_WINDOWS_THREADS
   CloseHandle(the_env->thread);

src/c/serialize.d

@@ -77,6 +77,7 @@ static cl_index object_size[] = {
   ROUNDED_SIZE(ecl_foreign), /* t_foreign */
   ROUNDED_SIZE(ecl_stack_frame), /* t_frame */
   ROUNDED_SIZE(ecl_exception), /* t_exception */
+  ROUNDED_SIZE(ecl_module), /* t_module */
   ROUNDED_SIZE(ecl_weak_pointer) /* t_weak_pointer */
 #ifdef ECL_SSE2
   , ROUNDED_SIZE(ecl_sse_pack) /* t_sse_pack */

src/c/symbols_list.h

@@ -1850,6 +1850,7 @@ cl_symbols[] = {
 {SYS_ "CODE-BLOCK" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 
 {SYS_ "EXCEPTION" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
+{SYS_ "MODULE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "FRAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "APPLY-FROM-STACK-FRAME" ECL_FUN("si_apply_from_stack_frame", si_apply_from_stack_frame, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
 

src/c/threads/thread.d

@@ -50,8 +50,6 @@ ecl_process_list()
 
 /* -- Environment --------------------------------------------------- */
 
-extern void ecl_init_env(struct cl_env_struct *env);
-
 cl_object
 mp_current_process(void)
 {

src/c/typespec.d

@@ -183,6 +183,8 @@ ecl_type_to_symbol(cl_type t)
     return @'si::frame';
   case t_exception:
     return @'si::exception';
+  case t_module:
+    return @'si::module';
   case t_weak_pointer:
     return @'ext::weak-pointer';
 #ifdef ECL_SSE2

src/clos/hierarchy.lsp

@@ -229,6 +229,7 @@
             (si::foreign-data)
             (si::frame)
             (si::exception)
+            (si::module)
             (si::weak-pointer)
             (:threads mp::process)
             (:threads mp::lock)

src/h/external.h

@@ -64,7 +64,6 @@ struct ecl_c_stack {
  * Per-thread data.
  */
 
-typedef struct cl_env_struct *cl_env_ptr;
 struct cl_env_struct {
         /* Flag for disabling interrupts while we call C library functions. */
         volatile int disable_interrupts;
@@ -1866,6 +1865,19 @@ extern ECL_API cl_object ecl_make_rwlock(cl_object lock);
 
 #endif /* ECL_THREADS */
 
+/* nucleus/module.c */
+
+extern ECL_API cl_object ecl_add_module(cl_object self);
+extern ECL_API cl_object ecl_del_module(cl_object self);
+extern ECL_API cl_object ecl_modules_init_env(cl_env_ptr the_env);
+extern ECL_API cl_object ecl_modules_free_env(cl_env_ptr the_env);
+extern ECL_API cl_object ecl_modules_init_cpu(cl_env_ptr the_env);
+extern ECL_API cl_object ecl_modules_free_cpu(cl_env_ptr the_env);
+
+extern ECL_API cl_object ecl_module_no_op_env(cl_env_ptr the_env);
+extern ECL_API cl_object ecl_module_no_op_cpu(cl_env_ptr the_env);
+extern ECL_API cl_object ecl_module_no_op();
+
 /* time.c */
 
 extern ECL_API cl_object cl_sleep(cl_object z);

src/h/internal.h

@@ -44,12 +44,15 @@ extern void init_unixint(int pass);
 extern void init_unixtime(void);
 extern void init_compiler(void);
 extern void init_process(void);
+extern void init_modules(void);
 #ifdef ECL_THREADS
 extern void init_threads(void);
 #endif
 extern void ecl_init_env(cl_env_ptr);
 extern void init_lib_LSP(cl_object);
 
+extern void free_modules(void);
+
 extern cl_env_ptr _ecl_alloc_env(cl_env_ptr parent);
 extern void _ecl_dealloc_env(cl_env_ptr);
 

src/h/nucleus.h

@@ -29,6 +29,7 @@ struct ecl_core_struct {
   int path_max;
   cl_object pathname_translations;
 
+  cl_object modules;
   cl_object libraries;
   cl_object library_pathname;
 };

src/h/object.h

@@ -85,6 +85,7 @@ typedef enum {
         t_foreign,
         t_frame,
         t_exception,
+        t_module,
         t_weak_pointer,
 #ifdef ECL_SSE2
         t_sse_pack,
@@ -100,10 +101,12 @@ typedef enum {
         Definition of the type of LISP objects.
 */
 typedef union cl_lispunion *cl_object;
+typedef struct cl_env_struct *cl_env_ptr;
 typedef cl_object cl_return;
 typedef cl_fixnum cl_narg;
 typedef cl_object (*cl_objectfn)(cl_narg narg, ...);
 typedef cl_object (*cl_objectfn_fixed)();
+typedef cl_object (*cl_objectfn_envfn)(cl_env_ptr);
 
 /*
         OBJect NULL value.
@@ -984,6 +987,19 @@ struct ecl_exception {
         void * arg4;         /* arbitrary last ditch argument (usually NULL). */
 };
 
+struct ecl_module {
+        _ECL_HDR;
+        cl_object name;
+        cl_objectfn_fixed create;
+        cl_objectfn_fixed enable;
+        cl_objectfn_envfn init_env;
+        cl_objectfn_envfn init_cpu;
+        cl_objectfn_envfn free_cpu;
+        cl_objectfn_envfn free_env;
+        cl_objectfn_fixed disable;
+        cl_objectfn_fixed destroy;
+};
+
 struct ecl_weak_pointer {       /*  weak pointer to value  */
         _ECL_HDR;
         cl_object value;
@@ -1210,6 +1226,7 @@ union cl_lispunion {
         struct ecl_dummy        d;              /*  dummy  */
         struct ecl_instance     instance;       /*  clos instance */
         struct ecl_exception    exception;      /*  exception */
+        struct ecl_module       module;         /*  core module */
 #ifdef ECL_THREADS
         struct ecl_process      process;        /*  process  */
         struct ecl_lock         lock;           /*  lock  */