diff --git a/src/c/boot.d b/src/c/boot.d index f99014219..e27ffe046 100644 --- a/src/c/boot.d +++ b/src/c/boot.d @@ -5,7 +5,21 @@ /* -- imports --------------------------------------------------------------- */ +#include +#include +#include +#include + +#ifdef ECL_USE_MPROTECT +# include +# ifndef MAP_FAILED +# define MAP_FAILED -1 +# endif +#endif #include +#include +#include +#include #if defined(ECL_MS_WINDOWS_HOST) # include # include @@ -20,11 +34,6 @@ # endif #endif -#include -#include -#include -#include - /* -- constants ----------------------------------------------------- */ const cl_object ecl_ct_Jan1st1970UT = ecl_make_fixnum(39052800); @@ -131,6 +140,84 @@ ecl_set_option(int option, cl_fixnum value) return ecl_option_values[option]; } +/* -- environments ---------------------------------------------------------- */ + +#ifdef ECL_THREADS +static void +add_env(cl_env_ptr the_env) +{ + cl_object _env; + ecl_mutex_lock(&ecl_core.processes_lock); + _env = ecl_cast_ptr(cl_object,the_env); + ecl_stack_push(ecl_core.threads, _env); + ecl_mutex_unlock(&ecl_core.processes_lock); +} + +static void +del_env(cl_env_ptr the_env) +{ + cl_object _env; + ecl_mutex_lock(&ecl_core.processes_lock); + _env = ecl_cast_ptr(cl_object,the_env); + ecl_stack_del(ecl_core.threads, _env); + ecl_mutex_unlock(&ecl_core.processes_lock); +} +#endif + +cl_env_ptr +_ecl_alloc_env(cl_env_ptr parent) +{ + /* Allocates the lisp environment for a thread. Depending on which mechanism + * we use for detecting delayed signals, we may allocate the environment using + * mmap or with malloc. + * + * Note that at this point we are not allocating any other memory which is + * stored via a pointer in the environment. If we would do that, an unlucky + * interrupt by the gc before the allocated environment is registered in + * ecl_core.processes could lead to memory being freed because the gc is not + * aware of the pointer to the allocated memory in the environment. */ + cl_env_ptr output; +#if defined(ECL_USE_MPROTECT) + output = (cl_env_ptr) mmap(0, sizeof(*output), PROT_READ | PROT_WRITE, + MAP_ANON | MAP_PRIVATE, -1, 0); + if (output == MAP_FAILED) + ecl_internal_error("Unable to allocate environment structure."); +#else +# if defined(ECL_USE_GUARD_PAGE) + output = VirtualAlloc(0, sizeof(*output), MEM_COMMIT, PAGE_READWRITE); + if (output == NULL) + ecl_internal_error("Unable to allocate environment structure."); +# else + output = ecl_malloc(sizeof(*output)); + if (output == NULL) + ecl_internal_error("Unable to allocate environment structure."); +# endif +#endif + /* Initialize the structure with NULL data. */ + memset(output, 0, sizeof(*output)); +#ifdef ECL_THREADS + add_env(output); +#endif + return output; +} + +void +_ecl_dealloc_env(cl_env_ptr env) +{ +#ifdef ECL_THREADS + del_env(env); +#endif +#if defined(ECL_USE_MPROTECT) + if (munmap(env, sizeof(*env))) + ecl_internal_error("Unable to deallocate environment structure."); +#elif defined(ECL_USE_GUARD_PAGE) + if (!VirtualFree(env, 0, MEM_RELEASE)) + ecl_internal_error("Unable to deallocate environment structure."); +#else + ecl_free_unsafe(env); +#endif +} + /* -- core runtime ---------------------------------------------------------- */ /* The root environment is a default execution context. */ diff --git a/src/c/main.d b/src/c/main.d index e35ba441a..ba3c43e74 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -12,15 +12,9 @@ * */ -/******************************** IMPORTS *****************************/ +/* -- Imports ------------------------------------------------------- */ #include -#ifdef ECL_USE_MPROTECT -# include -# ifndef MAP_FAILED -# define MAP_FAILED -1 -# endif -#endif #include #include #include @@ -29,77 +23,15 @@ #include #include - #include "ecl_features.h" #include "iso_latin_names.h" -/******************************* EXPORTS ******************************/ +/* -- Global Initialization ----------------------------------------- */ const char *ecl_self; - -/************************ GLOBAL INITIALIZATION ***********************/ - static int ARGC; static char **ARGV; -void -ecl_init_env(cl_env_ptr env) -{ - ecl_modules_init_env(env); -} - -void -_ecl_dealloc_env(cl_env_ptr env) -{ - ecl_modules_free_env(env); -#if defined(ECL_USE_MPROTECT) - if (munmap(env, sizeof(*env))) - ecl_internal_error("Unable to deallocate environment structure."); -#elif defined(ECL_USE_GUARD_PAGE) - if (!VirtualFree(env, 0, MEM_RELEASE)) - ecl_internal_error("Unable to deallocate environment structure."); -#else - ecl_free_unsafe(env); -#endif -} - -cl_env_ptr -_ecl_alloc_env(cl_env_ptr parent) -{ - /* - * Allocates the lisp environment for a thread. Depending on which - * mechanism we use for detecting delayed signals, we may allocate - * the environment using mmap or the garbage collector. - * - * Note that at this point we are not allocating any other memory - * which is stored via a pointer in the environment. If we would do - * that, an unlucky interrupt by the gc before the allocated - * environment is registered in ecl_core.processes could lead to - * memory being freed because the gc is not aware of the pointer to - * the allocated memory in the environment. - */ - cl_env_ptr output; -#if defined(ECL_USE_MPROTECT) - output = (cl_env_ptr) mmap(0, sizeof(*output), PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, -1, 0); - if (output == MAP_FAILED) - ecl_internal_error("Unable to allocate environment structure."); -#else -# if defined(ECL_USE_GUARD_PAGE) - output = VirtualAlloc(0, sizeof(*output), MEM_COMMIT, PAGE_READWRITE); - if (output == NULL) - ecl_internal_error("Unable to allocate environment structure."); -# else - output = ecl_malloc(sizeof(*output)); - if (output == NULL) - ecl_internal_error("Unable to allocate environment structure."); -# endif -#endif - /* Initialize the structure with NULL data. */ - memset(output, 0, sizeof(*output)); - return output; -} - void cl_shutdown(void) { @@ -515,7 +447,8 @@ cl_boot(int argc, char **argv) return 1; } -/* -- Module definition (auxiliary structures) ------------------------------- */ +/* -- Module definition (auxiliary structures) ---------------------- */ + static cl_object create_aux() { @@ -560,7 +493,7 @@ static struct ecl_module module_aux = { }; cl_object ecl_module_aux = (cl_object)&module_aux; -/************************* ENVIRONMENT ROUTINES ***********************/ +/* -- Operating system environment routines ------------------------- */ @(defun ext::quit (&optional (code ecl_make_fixnum(0)) (kill_all_threads ECL_T)) @ { diff --git a/src/c/process.d b/src/c/process.d index 844e80568..beaaaa16e 100644 --- a/src/c/process.d +++ b/src/c/process.d @@ -123,26 +123,6 @@ init_tl_bindings(cl_object process, cl_env_ptr env) #ifdef ECL_THREADS -static void -add_env(cl_env_ptr the_env) -{ - cl_object _env; - ecl_mutex_lock(&ecl_core.processes_lock); - _env = ecl_cast_ptr(cl_object,the_env); - ecl_stack_push(ecl_core.threads, _env); - ecl_mutex_unlock(&ecl_core.processes_lock); -} - -static void -del_env(cl_env_ptr the_env) -{ - cl_object _env; - ecl_mutex_lock(&ecl_core.processes_lock); - _env = ecl_cast_ptr(cl_object,the_env); - ecl_stack_del(ecl_core.threads, _env); - ecl_mutex_unlock(&ecl_core.processes_lock); -} - static void register_gc_thread() { @@ -178,9 +158,8 @@ ecl_adopt_cpu() the_env = _ecl_alloc_env(0); the_env->thread = current; ecl_set_process_env(the_env); - ecl_init_env(the_env); - add_env(the_env); init_tl_bindings(ECL_NIL, the_env); + ecl_modules_init_env(the_env); ecl_modules_init_cpu(the_env); return the_env; @@ -196,7 +175,7 @@ ecl_disown_cpu() #ifdef ECL_WINDOWS_THREADS CloseHandle(the_env->thread); #endif - del_env(the_env); + ecl_modules_free_env(the_env); _ecl_dealloc_env(the_env); unregister_gc_thread(); } @@ -214,9 +193,9 @@ thread_entry_point(void *ptr) ecl_modules_init_cpu(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. + /* 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. * * NOTE: this cleanup does not provide enough "protection". In order to ensure * that all UNWIND-PROTECT forms are properly executed, never use the function @@ -224,10 +203,10 @@ thread_entry_point(void *ptr) * mp_interrupt_process() and mp_process_kill(). */ ecl_disable_interrupts_env(the_env); ecl_modules_free_cpu(the_env); - del_env(the_env); #ifdef ECL_WINDOWS_THREADS CloseHandle(the_env->thread); #endif + ecl_modules_free_env(the_env); _ecl_dealloc_env(the_env); #ifdef ECL_WINDOWS_THREADS return 1; @@ -246,12 +225,7 @@ ecl_spawn_cpu(cl_object process) /* Allocate and initialize the new cpu env. */ { new_env = _ecl_alloc_env(the_env); - /* List the process such that its environment is marked by the GC when its - contents are allocated. */ - add_env(new_env); - /* Now we can safely allocate memory for the environment ocntents and store - pointers to it in the environment. */ - ecl_init_env(new_env); + ecl_modules_init_env(new_env); /* Copy the parent env defaults. */ new_env->trap_fpe_bits = the_env->trap_fpe_bits; new_env->own_process = process; @@ -301,8 +275,8 @@ ecl_spawn_cpu(cl_object process) #endif /* ECL_WINDOWS_THREADS */ /* Deal with the fallout of the thread creation. */ if (!ok) { - del_env(new_env); process->process.env = NULL; + ecl_modules_free_env(new_env); _ecl_dealloc_env(new_env); } ecl_enable_interrupts_env(the_env);