mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-06 02:40:26 -08:00
modules: [A/n] move the environment allocators to nucleus
Also clean up initialization code across different paths to have the same order.
This commit is contained in:
Daniel Kochmański
parent
5e20d8bd9a
commit
f567c1829e
3 changed files with 105 additions and 111 deletions
97
src/c/boot.d
97
src/c/boot.d
|
|
@ -5,7 +5,21 @@
|
|||
|
||||
/* -- imports --------------------------------------------------------------- */
|
||||
|
||||
#include <ecl/ecl.h>
|
||||
#include <ecl/ecl-inl.h>
|
||||
#include <ecl/internal.h>
|
||||
#include <ecl/external.h>
|
||||
|
||||
#ifdef ECL_USE_MPROTECT
|
||||
# include <sys/mman.h>
|
||||
# ifndef MAP_FAILED
|
||||
# define MAP_FAILED -1
|
||||
# endif
|
||||
#endif
|
||||
#include <limits.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
# include <windows.h>
|
||||
# include <shellapi.h>
|
||||
|
|
@ -20,11 +34,6 @@
|
|||
# endif
|
||||
#endif
|
||||
|
||||
#include <ecl/ecl.h>
|
||||
#include <ecl/ecl-inl.h>
|
||||
#include <ecl/internal.h>
|
||||
#include <ecl/external.h>
|
||||
|
||||
/* -- 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. */
|
||||
|
|
|
|||
77
src/c/main.d
77
src/c/main.d
|
|
@ -12,15 +12,9 @@
|
|||
*
|
||||
*/
|
||||
|
||||
/******************************** IMPORTS *****************************/
|
||||
/* -- Imports ------------------------------------------------------- */
|
||||
|
||||
#include <ecl/ecl.h>
|
||||
#ifdef ECL_USE_MPROTECT
|
||||
# include <sys/mman.h>
|
||||
# ifndef MAP_FAILED
|
||||
# define MAP_FAILED -1
|
||||
# endif
|
||||
#endif
|
||||
#include <limits.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
|
@ -29,77 +23,15 @@
|
|||
#include <ecl/internal.h>
|
||||
#include <ecl/ecl-inl.h>
|
||||
|
||||
|
||||
#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)
|
||||
{
|
||||
|
|
@ -513,7 +445,8 @@ cl_boot(int argc, char **argv)
|
|||
return 1;
|
||||
}
|
||||
|
||||
/* -- Module definition (auxiliary structures) ------------------------------- */
|
||||
/* -- Module definition (auxiliary structures) ---------------------- */
|
||||
|
||||
static cl_object
|
||||
create_aux()
|
||||
{
|
||||
|
|
@ -557,7 +490,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))
|
||||
@ {
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue