core: split cl_core_struct in two structure cl_core and ecl_core

ecl_core contains early global environment that is meant to be shared by all
runtimes, while cl_core contains an environment relevant to common lisp.
This commit is contained in:
Daniel Kochmański 2025-05-14 11:03:49 +02:00
parent b0d52e622d
commit 4a760a06dd
13 changed files with 211 additions and 207 deletions

View file

@ -54,13 +54,13 @@ _ecl_set_max_heap_size(size_t new_size)
{
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
GC_set_max_heap_size(cl_core.max_heap_size = new_size);
GC_set_max_heap_size(ecl_core.max_heap_size = new_size);
if (new_size == 0) {
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
cl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (cl_core.safety_region) {
GC_FREE(cl_core.safety_region);
cl_core.safety_region = 0;
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (ecl_core.safety_region) {
GC_FREE(ecl_core.safety_region);
ecl_core.safety_region = 0;
}
ecl_enable_interrupts_env(the_env);
}
@ -96,7 +96,7 @@ out_of_memory(size_t requested_bytes)
/* The out of memory condition may happen in more than one thread */
/* But then we have to ensure the error has not been solved */
#ifdef ECL_THREADS
ecl_mutex_lock(&cl_core.error_lock);
ecl_mutex_lock(&ecl_core.error_lock);
ECL_UNWIND_PROTECT_BEGIN(the_env)
#endif
{
@ -111,23 +111,23 @@ out_of_memory(size_t requested_bytes)
goto OUTPUT;
}
}
if (cl_core.max_heap_size == 0) {
if (ecl_core.max_heap_size == 0) {
/* We did not set any limit in the amount of memory,
* yet we failed, or we had some limits but we have
* not reached them. */
if (cl_core.safety_region) {
if (ecl_core.safety_region) {
/* We can free some memory and try handling the error */
GC_FREE(cl_core.safety_region);
GC_FREE(ecl_core.safety_region);
the_env->string_pool = ECL_NIL;
cl_core.safety_region = 0;
ecl_core.safety_region = 0;
method = 0;
} else {
/* No possibility of continuing */
method = 2;
}
} else {
cl_core.max_heap_size += ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
GC_set_max_heap_size(cl_core.max_heap_size);
ecl_core.max_heap_size += ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
GC_set_max_heap_size(ecl_core.max_heap_size);
method = 1;
}
OUTPUT:
@ -135,7 +135,7 @@ out_of_memory(size_t requested_bytes)
}
#ifdef ECL_THREADS
ECL_UNWIND_PROTECT_EXIT {
ecl_mutex_unlock(&cl_core.error_lock);
ecl_mutex_unlock(&ecl_core.error_lock);
} ECL_UNWIND_PROTECT_END;
#endif
ecl_bds_unwind1(the_env);
@ -154,8 +154,8 @@ out_of_memory(size_t requested_bytes)
}
if (!interrupts)
ecl_disable_interrupts_env(the_env);
GC_set_max_heap_size(cl_core.max_heap_size +=
cl_core.max_heap_size / 2);
ecl_core.max_heap_size += (ecl_core.max_heap_size / 2);
GC_set_max_heap_size(ecl_core.max_heap_size);
/* Default allocation. Note that we do not allocate atomic. */
return GC_MALLOC(requested_bytes);
}
@ -792,14 +792,14 @@ init_alloc(int pass)
FALSE, TRUE);
# endif
#endif /* !GBC_BOEHM_PRECISE */
GC_set_max_heap_size(cl_core.max_heap_size = ecl_option_values[ECL_OPT_HEAP_SIZE]);
ecl_core.max_heap_size = ecl_option_values[ECL_OPT_HEAP_SIZE];
GC_set_max_heap_size(ecl_core.max_heap_size);
/* Save some memory for the case we get tight. */
if (cl_core.max_heap_size == 0) {
if (ecl_core.max_heap_size == 0) {
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
cl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (cl_core.safety_region) {
cl_core.safety_region = 0;
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
} else if (ecl_core.safety_region) {
ecl_core.safety_region = 0;
}
init_type_info();
@ -889,7 +889,7 @@ standard_finalizer(cl_object o)
}
case t_symbol: {
if (o->symbol.binding != ECL_MISSING_SPECIAL_BINDING) {
ecl_atomic_push(&cl_core.reused_indices, ecl_make_fixnum(o->symbol.binding));
ecl_atomic_push(&ecl_core.reused_indices, ecl_make_fixnum(o->symbol.binding));
o->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
}
}
@ -1066,33 +1066,33 @@ si_gc_stats(cl_object enable)
cl_object old_status;
cl_object size1;
cl_object size2;
if (cl_core.gc_stats == 0) {
if (ecl_core.gc_stats == 0) {
old_status = ECL_NIL;
} else if (GC_print_stats) {
old_status = @':full';
} else {
old_status = ECL_T;
}
if (cl_core.bytes_consed == ECL_NIL) {
cl_core.bytes_consed = ecl_alloc_object(t_bignum);
mpz_init2(ecl_bignum(cl_core.bytes_consed), 128);
cl_core.gc_counter = ecl_alloc_object(t_bignum);
mpz_init2(ecl_bignum(cl_core.gc_counter), 128);
if (ecl_core.bytes_consed == ECL_NIL) {
ecl_core.bytes_consed = ecl_alloc_object(t_bignum);
mpz_init2(ecl_bignum(ecl_core.bytes_consed), 128);
ecl_core.gc_counter = ecl_alloc_object(t_bignum);
mpz_init2(ecl_bignum(ecl_core.gc_counter), 128);
}
update_bytes_consed();
/* We need fresh copies of the bignums */
size1 = _ecl_big_register_copy(cl_core.bytes_consed);
size2 = _ecl_big_register_copy(cl_core.gc_counter);
size1 = _ecl_big_register_copy(ecl_core.bytes_consed);
size2 = _ecl_big_register_copy(ecl_core.gc_counter);
if (enable == ECL_NIL) {
GC_print_stats = 0;
cl_core.gc_stats = 0;
ecl_core.gc_stats = 0;
} else if (enable == ecl_make_fixnum(0)) {
mpz_set_ui(ecl_bignum(cl_core.bytes_consed), 0);
mpz_set_ui(ecl_bignum(cl_core.gc_counter), 0);
mpz_set_ui(ecl_bignum(ecl_core.bytes_consed), 0);
mpz_set_ui(ecl_bignum(ecl_core.gc_counter), 0);
} else {
cl_core.gc_stats = 1;
ecl_core.gc_stats = 1;
GC_print_stats = (enable == @':full');
}
@(return size1 size2 old_status);
@ -1105,10 +1105,10 @@ static void
gather_statistics()
{
/* GC stats rely on bignums */
if (cl_core.gc_stats) {
if (ecl_core.gc_stats) {
update_bytes_consed();
mpz_add_ui(ecl_bignum(cl_core.gc_counter),
ecl_bignum(cl_core.gc_counter),
mpz_add_ui(ecl_bignum(ecl_core.gc_counter),
ecl_bignum(ecl_core.gc_counter),
1);
}
if (GC_old_start_callback)
@ -1118,8 +1118,8 @@ gather_statistics()
static void
update_bytes_consed () {
#if GBC_BOEHM == 0
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
ecl_bignum(cl_core.bytes_consed),
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
ecl_bignum(ecl_core.bytes_consed),
GC_get_bytes_since_gc());
#else
/* This is not accurate and may wrap around. We try to detect this
@ -1130,15 +1130,15 @@ update_bytes_consed () {
if (bytes > new_bytes) {
cl_index wrapped;
wrapped = ~((cl_index)0) - bytes;
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
ecl_bignum(cl_core.bytes_consed),
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
ecl_bignum(ecl_core.bytes_consed),
wrapped);
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
ecl_bignum(cl_core.bytes_consed),
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
ecl_bignum(ecl_core.bytes_consed),
new_bytes);
} else {
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
ecl_bignum(cl_core.bytes_consed),
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
ecl_bignum(ecl_core.bytes_consed),
new_bytes - bytes);
}
bytes = new_bytes;
@ -1170,7 +1170,7 @@ ecl_mark_env(struct cl_env_struct *env)
static void
stacks_scanner()
{
cl_object l = cl_core.libraries;
cl_object l = ecl_core.libraries;
loop_for_on_unsafe(l) {
cl_object dll = ECL_CONS_CAR(l);
if (dll->cblock.locked) {
@ -1178,18 +1178,19 @@ stacks_scanner()
GC_set_mark_bit((void *)dll);
}
} end_loop_for_on_unsafe(l);
GC_push_all((void *)(&ecl_core), (void *)(&ecl_core + 1));
GC_push_all((void *)(&cl_core), (void *)(&cl_core + 1));
GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core));
ecl_mark_env(cl_core.first_env);
ecl_mark_env(ecl_core.first_env);
#ifdef ECL_THREADS
l = cl_core.processes;
l = ecl_core.processes;
if (l != OBJNULL) {
cl_index i, size;
for (i = 0, size = l->vector.dim; i < size; i++) {
cl_object process = l->vector.self.t[i];
if (!Null(process)) {
cl_env_ptr env = process->process.env;
if (env && (env != cl_core.first_env)) ecl_mark_env(env);
if (env && (env != ecl_core.first_env)) ecl_mark_env(env);
}
}
}

View file

@ -221,7 +221,7 @@ static cl_object
ecl_library_find_by_name(cl_object filename)
{
cl_object l;
for (l = cl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
for (l = ecl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
cl_object name = other->cblock.name;
if (!Null(name) && ecl_string_eq(name, filename)) {
@ -235,7 +235,7 @@ static cl_object
ecl_library_find_by_handle(void *handle)
{
cl_object l;
for (l = cl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
for (l = ecl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
if (handle == other->cblock.handle) {
return other;
@ -268,7 +268,7 @@ ecl_library_open_inner(cl_object filename, bool self_destruct)
block->cblock.refs = ecl_one_plus(block->cblock.refs);
} else {
si_set_finalizer(block, ECL_T);
cl_core.libraries = CONS(block, cl_core.libraries);
ecl_core.libraries = CONS(block, ecl_core.libraries);
}
}
ecl_enable_interrupts();
@ -341,7 +341,7 @@ ecl_library_symbol(cl_object block, const char *symbol, bool lock) {
void *p;
if (block == @':default') {
cl_object l;
for (l = cl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
for (l = ecl_core.libraries; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
cl_object block = ECL_CONS_CAR(l);
p = ecl_library_symbol(block, symbol, lock);
if (p) return p;
@ -426,7 +426,7 @@ ecl_library_close(cl_object block) {
block = ECL_NIL;
} else if (block->cblock.handle != NULL) {
success = GC_call_with_alloc_lock(dlclose_wrapper, block);
cl_core.libraries = ecl_remove_eq(block, cl_core.libraries);
ecl_core.libraries = ecl_remove_eq(block, ecl_core.libraries);
} else { /* block not loaded */
success = FALSE;
}
@ -443,8 +443,8 @@ ecl_library_close(cl_object block) {
void
ecl_library_close_all(void)
{
while (cl_core.libraries != ECL_NIL) {
ecl_library_close(ECL_CONS_CAR(cl_core.libraries));
while (ecl_core.libraries != ECL_NIL) {
ecl_library_close(ECL_CONS_CAR(ecl_core.libraries));
}
}

View file

@ -35,6 +35,7 @@
# define MAP_FAILED -1
# endif
#endif
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@ -49,8 +50,62 @@
/******************************* EXPORTS ******************************/
const char *ecl_self;
/* -- core runtime ---------------------------------------------------------- */
/* The root environment is a default execution context. */
static struct cl_env_struct first_env;
struct ecl_core_struct ecl_core = {
.first_env = &first_env,
/* processes */
#ifdef ECL_THREADS
.processes = ECL_NIL,
.last_var_index = 0,
.reused_indices = ECL_NIL,
#endif
/* signals */
.default_sigmask_bytes = 0,
.known_signals = ECL_NIL,
/* allocation */
.max_heap_size = 0,
.bytes_consed = ECL_NIL,
.gc_counter = ECL_NIL,
.gc_stats = 0,
.safety_region = NULL,
/* pathnames */
.path_max = 0,
.pathname_translations = 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,
.library_pathname = ECL_NIL
};
/* note that this function does not create any environment */
int
ecl_boot(void)
{
int i;
i = ecl_option_values[ECL_OPT_BOOTED];
if (i) {
if (i < 0) {
/* We have called cl_shutdown and want to use ECL again. */
ecl_set_option(ECL_OPT_BOOTED, 1);
}
return 1;
}
init_process();
/* init_unixint(); */
/* init_garbage(); */
ecl_core.path_max = MAXPATHLEN;
return 0;
}
/* -- constants ----------------------------------------------------- */
const cl_object ecl_ct_Jan1st1970UT = ecl_make_fixnum(39052800);
@ -271,7 +326,7 @@ _ecl_alloc_env(cl_env_ptr parent)
* 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 cl_core.processes could lead to
* 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.
*/
@ -293,14 +348,14 @@ _ecl_alloc_env(cl_env_ptr parent)
# endif
#endif
{
size_t bytes = cl_core.default_sigmask_bytes;
size_t bytes = ecl_core.default_sigmask_bytes;
if (bytes == 0) {
output->default_sigmask = 0;
} else if (parent) {
output->default_sigmask = ecl_alloc_atomic(bytes);
memcpy(output->default_sigmask, parent->default_sigmask, bytes);
} else {
output->default_sigmask = cl_core.default_sigmask;
output->default_sigmask = ecl_core.first_env->default_sigmask;
}
}
for (cl_index i = 0; i < ECL_BIGNUM_REGISTER_NUMBER; i++) {
@ -390,9 +445,6 @@ struct cl_core_struct cl_core = {
.c_package = ECL_NIL,
.ffi_package = ECL_NIL,
.pathname_translations = ECL_NIL,
.library_pathname = ECL_NIL,
.terminal_io = ECL_NIL,
.null_stream = ECL_NIL,
.standard_input = ECL_NIL,
@ -408,34 +460,7 @@ struct cl_core_struct cl_core = {
.gentemp_counter = ecl_make_fixnum(0),
.system_properties = ECL_NIL,
.first_env = &first_env,
#ifdef ECL_THREADS
.processes = ECL_NIL,
#endif
/* LIBRARIES is an adjustable vector of objects. It behaves as a vector of
weak pointers thanks to the magic in the garbage collector. */
.libraries = ECL_NIL,
.max_heap_size = 0,
.bytes_consed = ECL_NIL,
.gc_counter = ECL_NIL,
.gc_stats = 0,
.path_max = 0,
#ifdef GBC_BOEHM
.safety_region = NULL,
#endif
.default_sigmask = NULL,
.default_sigmask_bytes = 0,
#ifdef ECL_THREADS
.last_var_index = 0,
.reused_indices = ECL_NIL,
#endif
.compiler_dispatch = ECL_NIL,
.known_signals = ECL_NIL
};
#if !defined(ECL_MS_WINDOWS_HOST)
@ -468,22 +493,8 @@ cl_boot(int argc, char **argv)
int i;
cl_env_ptr env;
i = ecl_option_values[ECL_OPT_BOOTED];
if (i) {
if (i < 0) {
/* We have called cl_shutdown and want to use ECL again. */
ecl_set_option(ECL_OPT_BOOTED, 1);
}
return 1;
}
/*ecl_set_option(ECL_OPT_SIGNAL_HANDLING_THREAD, 0);*/
#if !defined(GBC_BOEHM)
setbuf(stdin, stdin_buf);
setbuf(stdout, stdout_buf);
#endif
init_process();
i = ecl_boot();
if (i==1) return 1;
ARGC = argc;
ARGV = argv;
@ -499,7 +510,7 @@ cl_boot(int argc, char **argv)
* ext::*interrupts-enabled* while creating packages.
*/
env = cl_core.first_env;
env = ecl_core.first_env;
ecl_init_first_env(env);
/*
@ -538,11 +549,6 @@ cl_boot(int argc, char **argv)
#endif
cl_num_symbols_in_core=2;
#ifdef NO_PATH_MAX
cl_core.path_max = sysconf(_PC_PATH_MAX);
#else
cl_core.path_max = MAXPATHLEN;
#endif
cl_core.gensym_prefix = (cl_object)&str_G_data;
cl_core.gentemp_prefix = (cl_object)&str_T_data;

View file

@ -23,8 +23,8 @@
* NOTE 1: we only need to use the package locks when reading/writing the hash
* tables, or changing the fields of a package. We do not need the locks to
* read lists from the packages (i.e. list of shadowing symbols, used
* packages, etc), or from the global environment (cl_core.packages_list) if
* we do not destructively modify them (For instance, use ecl_remove_eq
* packages, etc), or from the global environment (cl_core.packages_list)
* if we do not destructively modify them (For instance, use ecl_remove_eq
* instead of ecl_delete_eq).
*/
/*
@ -270,7 +270,7 @@ ecl_make_package(cl_object name, cl_object nicknames,
nicknamed->pack.nicknamedby = CONS(x, nicknamed->pack.nicknamedby);
} end_loop_for_in;
/* Finally, add it to the list of packages */
cl_core.packages = CONS(x, cl_core.packages);
cl_core.packages = ecl_cons(x, cl_core.packages);
OUTPUT:
(void)0;
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;

View file

@ -525,7 +525,7 @@ ecl_logical_hostname_p(cl_object host)
{
if (!ecl_stringp(host))
return FALSE;
return !Null(ecl_assqlp(host, cl_core.pathname_translations));
return !Null(ecl_assqlp(host, ecl_core.pathname_translations));
}
/*
@ -900,8 +900,8 @@ si_coerce_to_filename(cl_object pathname_orig)
pathname_orig->pathname.type,
pathname_orig->pathname.version);
}
if (cl_core.path_max != -1 &&
ecl_length(namestring) >= cl_core.path_max - 16)
if (ecl_core.path_max != -1 &&
ecl_length(namestring) >= ecl_core.path_max - 16)
FEerror("Too long filename: ~S.", 1, namestring);
return namestring;
}
@ -1542,7 +1542,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
FEerror("Wrong host syntax ~S", 1, host);
}
/* Find its translation list */
pair = ecl_assqlp(host, cl_core.pathname_translations);
pair = ecl_assqlp(host, ecl_core.pathname_translations);
if (set == OBJNULL) {
@(return ((pair == ECL_NIL)? ECL_NIL : CADR(pair)));
}
@ -1552,7 +1552,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
}
if (pair == ECL_NIL) {
pair = CONS(host, CONS(ECL_NIL, ECL_NIL));
cl_core.pathname_translations = CONS(pair, cl_core.pathname_translations);
ecl_core.pathname_translations = CONS(pair, ecl_core.pathname_translations);
}
for (l = set, set = ECL_NIL; !ecl_endp(l); l = CDR(l)) {
cl_object item = CAR(l);

View file

@ -84,13 +84,13 @@ cl_env_ptr cl_env_p = NULL;
void
init_process(void)
{
cl_env_ptr env = cl_core.first_env;
cl_env_ptr env = ecl_core.first_env;
#ifdef ECL_THREADS
ecl_process_key_create(cl_env_key);
ecl_mutex_init(&cl_core.processes_lock, 1);
ecl_mutex_init(&cl_core.global_lock, 1);
ecl_mutex_init(&cl_core.error_lock, 1);
ecl_rwlock_init(&cl_core.global_env_lock);
ecl_mutex_init(&ecl_core.processes_lock, 1);
ecl_mutex_init(&ecl_core.global_lock, 1);
ecl_mutex_init(&ecl_core.error_lock, 1);
ecl_rwlock_init(&ecl_core.global_env_lock);
#endif
ecl_set_process_env(env);
env->default_sigmask = NULL;

View file

@ -382,11 +382,11 @@ ecl_new_binding_index(cl_env_ptr env, cl_object symbol)
cl_object pool;
cl_index new_index = symbol->symbol.binding;
if (new_index == ECL_MISSING_SPECIAL_BINDING) {
pool = ecl_atomic_pop(&cl_core.reused_indices);
pool = ecl_atomic_pop(&ecl_core.reused_indices);
if (!Null(pool)) {
new_index = ecl_fixnum(ECL_CONS_CAR(pool));
} else {
new_index = ecl_atomic_index_incf(&cl_core.last_var_index);
new_index = ecl_atomic_index_incf(&ecl_core.last_var_index);
}
symbol->symbol.binding = new_index;
}
@ -402,7 +402,7 @@ invalid_or_too_large_binding_index(cl_env_ptr env, cl_object s)
}
if (index >= env->bds_stack.tl_bindings_size) {
cl_index osize = env->bds_stack.tl_bindings_size;
cl_index nsize = cl_core.last_var_index * 1.25;
cl_index nsize = ecl_core.last_var_index * 1.25;
cl_object *old_vector = env->bds_stack.tl_bindings;
cl_object *new_vector = ecl_realloc(old_vector,
osize*sizeof(cl_object*),
@ -660,7 +660,7 @@ cl_object
init_stacks(cl_env_ptr the_env)
{
#ifdef ECL_THREADS
if (the_env == cl_core.first_env) {
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++) {
@ -1029,7 +1029,7 @@ si_get_limit(cl_object type)
output = env->c_stack.limit_size;
else if (type == @'ext::heap-size') {
/* size_t can be larger than cl_index */
ecl_return1(env, ecl_make_unsigned_integer(cl_core.max_heap_size));
ecl_return1(env, ecl_make_unsigned_integer(ecl_core.max_heap_size));
}
ecl_return1(env, ecl_make_unsigned_integer(output));

View file

@ -31,7 +31,7 @@
# include <sched.h>
#endif
/* -- Macros -------------------------------------------------------- */
/* -- Macros ---------------------------------------------------------------- */
#ifdef ECL_WINDOWS_THREADS
# define ecl_process_eq(t1, t2) (GetThreadId(t1) == GetThreadId(t2))
@ -56,18 +56,18 @@
static void
extend_process_vector()
{
cl_object v = cl_core.processes;
cl_object v = ecl_core.processes;
cl_index new_size = v->vector.dim + v->vector.dim/2;
cl_env_ptr the_env = ecl_process_env();
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &cl_core.processes_lock) {
cl_object other = cl_core.processes;
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &ecl_core.processes_lock) {
cl_object other = ecl_core.processes;
if (new_size > other->vector.dim) {
cl_object new = si_make_vector(ECL_T,
ecl_make_fixnum(new_size),
ecl_make_fixnum(other->vector.fillp),
ECL_NIL, ECL_NIL, ECL_NIL);
ecl_copy_subarray(new, 0, other, 0, other->vector.dim);
cl_core.processes = new;
ecl_core.processes = new;
}
} ECL_WITH_NATIVE_LOCK_END;
}
@ -78,8 +78,8 @@ ecl_list_process(cl_object process)
cl_env_ptr the_env = ecl_process_env();
bool ok = 0;
do {
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &cl_core.processes_lock) {
cl_object vector = cl_core.processes;
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &ecl_core.processes_lock) {
cl_object vector = ecl_core.processes;
cl_index size = vector->vector.dim;
cl_index ndx = vector->vector.fillp;
if (ndx < size) {
@ -98,8 +98,8 @@ ecl_list_process(cl_object process)
static void
ecl_unlist_process(cl_object process)
{
ecl_mutex_lock(&cl_core.processes_lock);
cl_object vector = cl_core.processes;
ecl_mutex_lock(&ecl_core.processes_lock);
cl_object vector = ecl_core.processes;
cl_index i;
for (i = 0; i < vector->vector.fillp; i++) {
if (vector->vector.self.t[i] == process) {
@ -111,7 +111,7 @@ ecl_unlist_process(cl_object process)
break;
}
}
ecl_mutex_unlock(&cl_core.processes_lock);
ecl_mutex_unlock(&ecl_core.processes_lock);
}
static cl_object
@ -119,8 +119,8 @@ ecl_process_list()
{
cl_env_ptr the_env = ecl_process_env();
cl_object output = ECL_NIL;
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &cl_core.processes_lock) {
cl_object vector = cl_core.processes;
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &ecl_core.processes_lock) {
cl_object vector = ecl_core.processes;
cl_object *data = vector->vector.self.t;
cl_index i;
for (i = 0; i < vector->vector.fillp; i++) {
@ -344,7 +344,7 @@ ecl_import_current_thread(cl_object name, cl_object bindings)
}
#endif
{
cl_object processes = cl_core.processes;
cl_object processes = ecl_core.processes;
cl_index i, size;
for (i = 0, size = processes->vector.fillp; i < size; i++) {
cl_object p = processes->vector.self.t[i];
@ -783,6 +783,6 @@ init_threads()
ECL_NIL, ECL_NIL, ECL_NIL);
v->vector.self.t[0] = process;
v->vector.fillp = 1;
cl_core.processes = v;
ecl_core.processes = v;
}
}

View file

@ -1085,7 +1085,7 @@ dir_recursive(cl_object base_dir, cl_object directory, cl_object filemask, int f
cl_object
si_get_library_pathname(void)
{
cl_object s = cl_core.library_pathname;
cl_object s = ecl_core.library_pathname;
if (!Null(s)) {
goto OUTPUT_UNCHANGED;
} else {
@ -1100,11 +1100,11 @@ si_get_library_pathname(void)
ecl_filename_char *buffer;
HMODULE hnd;
cl_index len, ep;
s = ecl_alloc_adjustable_filename(cl_core.path_max);
s = ecl_alloc_adjustable_filename(ecl_core.path_max);
buffer = ecl_filename_self(s);
ecl_disable_interrupts();
hnd = GetModuleHandle("ecl.dll");
len = ecl_GetModuleFileName(hnd, buffer, cl_core.path_max-1);
len = ecl_GetModuleFileName(hnd, buffer, ecl_core.path_max-1);
ecl_enable_interrupts();
if (len == 0) {
FEerror("GetModuleFileName failed (last error = ~S)",
@ -1125,9 +1125,9 @@ si_get_library_pathname(void)
s = current_dir();
}
}
cl_core.library_pathname = ecl_decode_filename(s, ECL_NIL);
ecl_core.library_pathname = ecl_decode_filename(s, ECL_NIL);
OUTPUT_UNCHANGED:
@(return cl_core.library_pathname);
@(return ecl_core.library_pathname);
}
@(defun ext::chdir (directory &optional (change_d_p_d ECL_T))

View file

@ -534,7 +534,7 @@ handler_fn_prototype(non_evil_signal_handler, int sig, siginfo_t *siginfo, void
unlikely_if (zombie_process(the_env))
return;
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
cl_core.known_signals,
ecl_core.known_signals,
ECL_NIL);
handle_or_queue(the_env, signal_object, sig);
errno = old_errno;
@ -552,7 +552,7 @@ handler_fn_prototype(evil_signal_handler, int sig, siginfo_t *siginfo, void *dat
unlikely_if (zombie_process(the_env))
return;
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
cl_core.known_signals,
ecl_core.known_signals,
ECL_NIL);
handle_signal_now(signal_object);
errno = old_errno;
@ -647,7 +647,7 @@ asynchronous_signal_servicing_thread()
break;
}
signal_code = ecl_gethash_safe(ecl_make_fixnum(signal_thread_msg.signo),
cl_core.known_signals,
ecl_core.known_signals,
ECL_NIL);
if (!Null(signal_code)) {
mp_process_run_function(3, @'si::handle-signal',
@ -959,7 +959,7 @@ cl_object
si_get_signal_handler(cl_object code)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object handler = ecl_gethash_safe(code, cl_core.known_signals, OBJNULL);
cl_object handler = ecl_gethash_safe(code, ecl_core.known_signals, OBJNULL);
unlikely_if (handler == OBJNULL) {
illegal_signal_code(code);
}
@ -970,11 +970,11 @@ cl_object
si_set_signal_handler(cl_object code, cl_object handler)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object action = ecl_gethash_safe(code, cl_core.known_signals, OBJNULL);
cl_object action = ecl_gethash_safe(code, ecl_core.known_signals, OBJNULL);
unlikely_if (action == OBJNULL) {
illegal_signal_code(code);
}
ecl_sethash(code, cl_core.known_signals, handler);
ecl_sethash(code, ecl_core.known_signals, handler);
si_catch_signal(2, code, ECL_T);
ecl_return0(the_env);
}
@ -984,7 +984,7 @@ si_set_signal_handler(cl_object code, cl_object handler)
{
const cl_env_ptr the_env = ecl_process_env();
int code_int;
unlikely_if (ecl_gethash_safe(code, cl_core.known_signals, OBJNULL) == OBJNULL) {
unlikely_if (ecl_gethash_safe(code, ecl_core.known_signals, OBJNULL) == OBJNULL) {
illegal_signal_code(code);
}
code_int = ecl_fixnum(code);
@ -1312,8 +1312,8 @@ install_asynchronous_signal_handlers()
# endif
#endif
#ifdef HAVE_SIGPROCMASK
sigset_t *sigmask = cl_core.default_sigmask = &main_thread_sigmask;
cl_core.default_sigmask_bytes = sizeof(sigset_t);
sigset_t *sigmask = ecl_core.first_env->default_sigmask = &main_thread_sigmask;
ecl_core.default_sigmask_bytes = sizeof(sigset_t);
# ifdef ECL_THREADS
pthread_sigmask(SIG_SETMASK, NULL, sigmask);
# else
@ -1472,7 +1472,7 @@ static void
create_signal_code_constants()
{
cl_object hash =
cl_core.known_signals =
ecl_core.known_signals =
cl__make_hash_table(@'eql', ecl_make_fixnum(128),
ecl_ct_default_rehash_size,
ecl_ct_default_rehash_threshold);

View file

@ -169,9 +169,36 @@ struct ecl_interrupt_struct {
extern ECL_API cl_env_ptr cl_env_p;
#endif
/*
* Per-process data. Modify main.d accordingly.
*/
/* Core environment. */
struct ecl_core_struct {
cl_env_ptr first_env;
#ifdef ECL_THREADS
cl_object processes;
ecl_mutex_t processes_lock;
ecl_mutex_t global_lock;
ecl_mutex_t error_lock;
ecl_rwlock_t global_env_lock;
cl_index last_var_index;
cl_object reused_indices;
#endif
size_t max_heap_size;
cl_object bytes_consed;
cl_object gc_counter;
bool gc_stats;
char *safety_region;
cl_index default_sigmask_bytes;
cl_object known_signals;
int path_max;
cl_object pathname_translations;
cl_object libraries;
cl_object library_pathname;
};
/* Per-process data. Modify main.d accordingly. */
struct cl_core_struct {
cl_object packages;
@ -188,9 +215,6 @@ struct cl_core_struct {
cl_object c_package;
cl_object ffi_package;
cl_object pathname_translations;
cl_object library_pathname;
cl_object terminal_io;
cl_object null_stream;
cl_object standard_input;
@ -206,39 +230,10 @@ struct cl_core_struct {
cl_object gentemp_counter;
cl_object system_properties;
cl_env_ptr first_env;
#ifdef ECL_THREADS
cl_object processes;
ecl_mutex_t processes_lock;
ecl_mutex_t global_lock;
ecl_mutex_t error_lock;
ecl_rwlock_t global_env_lock;
#endif
cl_object libraries;
size_t max_heap_size;
cl_object bytes_consed;
cl_object gc_counter;
bool gc_stats;
int path_max;
#ifdef GBC_BOEHM
char *safety_region;
#endif
void *default_sigmask;
cl_index default_sigmask_bytes;
#ifdef ECL_THREADS
cl_index last_var_index;
cl_object reused_indices;
#endif
cl_object slash;
cl_object compiler_dispatch;
cl_object known_signals;
};
extern ECL_API struct ecl_core_struct ecl_core;
extern ECL_API struct cl_core_struct cl_core;
/* memory.c */
@ -249,6 +244,8 @@ extern ECL_API void ecl_copy(void *dst, void *src, cl_index ndx);
#define ecl_free_unsafe(x) ecl_free(x);
/* cold_boot.c */
extern ECL_API int ecl_boot(void);
extern ECL_API const cl_object ecl_ct_Jan1st1970UT;
extern ECL_API const cl_object ecl_ct_null_string;

View file

@ -753,8 +753,8 @@ extern void ecl_interrupt_process(cl_object process, cl_object function);
#include <ecl/threads.h>
#ifdef ECL_THREADS
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &cl_core.global_lock)
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &ecl_core.global_lock)
# define ECL_WITH_GLOBAL_LOCK_END \
ECL_WITH_NATIVE_LOCK_END
# define ECL_WITH_LOCK_BEGIN(the_env,lock) { \
@ -779,21 +779,21 @@ extern void ecl_interrupt_process(cl_object process, cl_object function);
ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT { \
ecl_mutex_unlock(__ecl_the_lock); \
} ECL_UNWIND_PROTECT_THREAD_SAFE_END; }
# define ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
# define ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
ecl_rwlock_lock_read(&cl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END \
ecl_rwlock_unlock_read(&cl_core.global_env_lock); \
ecl_bds_unwind1(__ecl_pack_env); \
ecl_rwlock_lock_read(&ecl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END \
ecl_rwlock_unlock_read(&ecl_core.global_env_lock); \
ecl_bds_unwind1(__ecl_pack_env); \
ecl_check_pending_interrupts(__ecl_pack_env); }
# define ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env) { \
const cl_env_ptr __ecl_pack_env = the_env; \
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
ecl_rwlock_lock_write(&cl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END \
ecl_rwlock_unlock_write(&cl_core.global_env_lock); \
ecl_bds_unwind1(__ecl_pack_env); \
ecl_rwlock_lock_write(&ecl_core.global_env_lock);
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END \
ecl_rwlock_unlock_write(&ecl_core.global_env_lock); \
ecl_bds_unwind1(__ecl_pack_env); \
ecl_check_pending_interrupts(__ecl_pack_env); }
#else
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)

View file

@ -192,7 +192,7 @@
;;; Fixed: 10/10/2006
;;; Description:
;;;
;;; Nested calls to queue_finalizer trashed the value of cl_core.to_be_finalized
;;; Nested calls to queue_finalizer trashed the value of ecl_core.to_be_finalized
;;; The following code tests that at least three objects are finalized.
;;;
;;; Note: this test fails in multithreaded mode. GC takes too long!