From e5357950a64c12a29f49e8dac48c86adda2a7d5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 6 Jun 2025 12:49:54 +0200 Subject: [PATCH] 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 | 2 +- src/c/alloc_2.d | 2 + src/c/boot.d | 4 +- src/c/clos/instance.d | 3 + src/c/main.d | 14 ++- src/c/module.d | 186 +++++++++++++++++++++++++++++++++++++ src/c/printer/write_ugly.d | 7 ++ src/c/process.d | 7 +- src/c/serialize.d | 1 + src/c/symbols_list.h | 1 + src/c/threads/thread.d | 2 - src/c/typespec.d | 2 + src/clos/hierarchy.lsp | 1 + src/h/external.h | 14 ++- src/h/internal.h | 3 + src/h/nucleus.h | 1 + src/h/object.h | 17 ++++ 17 files changed, 257 insertions(+), 10 deletions(-) create mode 100644 src/c/module.d diff --git a/src/c/Makefile.in b/src/c/Makefile.in index 3857160b4..49d9a1e07 100644 --- a/src/c/Makefile.in +++ b/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 eql.o +BOOT_OBJS = boot.o escape.o eql.o module.o CLOS_OBJS = clos/cache.o clos/accessor.o clos/instance.o clos/gfun.o diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 2c44cf42e..9fa5e5787 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -557,6 +557,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_token, "TOKEN", sizeof(struct ecl_token), 2); + init_tm(t_module, "MODULE", sizeof(struct ecl_module), 2); init_tm(t_exception, "EXCEPTION", sizeof(struct ecl_exception), 3); init_tm(t_weak_pointer, "WEAK-POINTER", sizeof(struct ecl_weak_pointer), 0); #ifdef ECL_SSE2 @@ -718,6 +719,7 @@ void init_type_info (void) type_info[t_token].descriptor = to_bitmap(&o, &(o.token.string)) | to_bitmap(&o, &(o.token.escape))); + type_info[t_module].descriptor = 0; type_info[t_exception].descriptor = to_bitmap(&o, &(o.exception.arg1)) | to_bitmap(&o, &(o.exception.arg2)) | diff --git a/src/c/boot.d b/src/c/boot.d index b6de35437..0f9cbcd5d 100644 --- a/src/c/boot.d +++ b/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(); */ diff --git a/src/c/clos/instance.d b/src/c/clos/instance.d index c5563046c..5d2199b6a 100644 --- a/src/c/clos/instance.d +++ b/src/c/clos/instance.d @@ -395,6 +395,7 @@ enum ecl_built_in_classes { ECL_BUILTIN_FOREIGN_DATA, ECL_BUILTIN_FRAME, ECL_BUILTIN_TOKEN, + ECL_BUILTIN_MODULE, ECL_BUILTIN_EXCEPTION, ECL_BUILTIN_WEAK_POINTER, ECL_BUILTIN_PROCESS, @@ -515,6 +516,8 @@ cl_class_of(cl_object x) index = ECL_BUILTIN_FRAME; break; case t_token: index = ECL_BUILTIN_TOKEN; break; + case t_module: + index = ECL_BUILTIN_MODULE; break; case t_exception: index = ECL_BUILTIN_EXCEPTION; break; case t_weak_pointer: diff --git a/src/c/main.d b/src/c/main.d index 9d7b426ae..bb9c22fc3 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -94,7 +94,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 = ecl_core.first_env->default_sigmask; #ifdef ECL_THREADS @@ -102,12 +102,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); @@ -117,8 +122,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); @@ -328,6 +333,7 @@ cl_boot(int argc, char **argv) init_unixint(0); init_alloc(0); + init_big(); /* diff --git a/src/c/module.d b/src/c/module.d new file mode 100644 index 000000000..84a588ba1 --- /dev/null +++ b/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 +#include +#include +#include + +/* -- 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(); +} diff --git a/src/c/printer/write_ugly.d b/src/c/printer/write_ugly.d index 86226658d..cf34c4097 100644 --- a/src/c/printer/write_ugly.d +++ b/src/c/printer/write_ugly.d @@ -376,6 +376,12 @@ write_token(cl_object x, cl_object stream) _ecl_write_unreadable(x, "token", x->token.string, stream); } +static void +write_module(cl_object x, cl_object stream) +{ + _ecl_write_unreadable(x, "module", x->module.name, stream); +} + static void write_exception(cl_object x, cl_object stream) { @@ -493,6 +499,7 @@ static printer dispatch[FREE+1] = { write_foreign, /* t_foreign */ write_frame, /* t_frame */ write_token, /* t_token */ + write_module, /* t_module */ write_exception, /* t_exception */ write_weak_pointer, /* t_weak_pointer */ #ifdef ECL_SSE2 diff --git a/src/c/process.d b/src/c/process.d index 5ff7b4afd..094b567fe 100644 --- a/src/c/process.d +++ b/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); diff --git a/src/c/serialize.d b/src/c/serialize.d index 28b387a05..ac6bab82d 100644 --- a/src/c/serialize.d +++ b/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_token), /* t_token */ + ROUNDED_SIZE(ecl_module), /* t_module */ ROUNDED_SIZE(ecl_exception), /* t_exception */ ROUNDED_SIZE(ecl_weak_pointer) /* t_weak_pointer */ #ifdef ECL_SSE2 diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 9c41012f2..7adbf9e44 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1854,6 +1854,7 @@ cl_symbols[] = { {SYS_ "CODE-BLOCK" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "TOKEN" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "MODULE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "EXCEPTION" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "FRAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, diff --git a/src/c/threads/thread.d b/src/c/threads/thread.d index 40942832a..4028059d3 100644 --- a/src/c/threads/thread.d +++ b/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) { diff --git a/src/c/typespec.d b/src/c/typespec.d index 5504da5ba..cf8efb63a 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -183,6 +183,8 @@ ecl_type_to_symbol(cl_type t) return @'si::frame'; case t_token: return @'si::token'; + case t_module: + return @'si::module'; case t_exception: return @'si::exception'; case t_weak_pointer: diff --git a/src/clos/hierarchy.lsp b/src/clos/hierarchy.lsp index 716920362..d21d356fb 100644 --- a/src/clos/hierarchy.lsp +++ b/src/clos/hierarchy.lsp @@ -229,6 +229,7 @@ (si::foreign-data) (si::frame) (si::token) + (si::module) (si::exception) (si::weak-pointer) (:threads mp::process) diff --git a/src/h/external.h b/src/h/external.h index 9cebc9f4b..b995d84a7 100755 --- a/src/h/external.h +++ b/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; @@ -1901,6 +1900,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); diff --git a/src/h/internal.h b/src/h/internal.h index dd5e19275..fbddd8749 100755 --- a/src/h/internal.h +++ b/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); diff --git a/src/h/nucleus.h b/src/h/nucleus.h index db72d2272..2da06975b 100644 --- a/src/h/nucleus.h +++ b/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; }; diff --git a/src/h/object.h b/src/h/object.h index 4191fc998..53509e9a0 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -85,6 +85,7 @@ typedef enum { t_foreign, t_frame, t_token, + t_module, t_exception, t_weak_pointer, #ifdef ECL_SSE2 @@ -101,11 +102,13 @@ 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_parse)(cl_object,cl_object,int); +typedef cl_object (*cl_objectfn_envfn)(cl_env_ptr); /* OBJect NULL value. @@ -960,6 +963,19 @@ struct ecl_token { cl_object escape; /* ranges of escaped characters */ }; +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; +}; + typedef enum { ECL_EX_FERROR, /* general purpose fatal error */ ECL_EX_CERROR, /* general purpose continuable error */ @@ -1235,6 +1251,7 @@ union cl_lispunion { struct ecl_dummy d; /* dummy */ struct ecl_instance instance; /* clos instance */ struct ecl_token token; /* token */ + struct ecl_module module; /* core module */ struct ecl_exception exception; /* exception */ #ifdef ECL_THREADS struct ecl_process process; /* process */