From 4a760a06ddc7c598bef0e16efcedf11d5db247c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 14 May 2025 11:03:49 +0200 Subject: [PATCH] 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. --- src/c/alloc_2.d | 99 ++++++++++++------------ src/c/ffi/libraries.d | 14 ++-- src/c/main.d | 116 +++++++++++++++------------- src/c/package.d | 6 +- src/c/pathname.d | 10 +-- src/c/process.d | 10 +-- src/c/stacks.d | 10 +-- src/c/threads/thread.d | 28 +++---- src/c/unixfsys.d | 10 +-- src/c/unixint.d | 20 ++--- src/h/external.h | 69 ++++++++--------- src/h/internal.h | 24 +++--- src/tests/normal-tests/compiler.lsp | 2 +- 13 files changed, 211 insertions(+), 207 deletions(-) diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 62e8d59a8..fa8d4ebbf 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -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); } } } diff --git a/src/c/ffi/libraries.d b/src/c/ffi/libraries.d index 098cd483d..21441dfc0 100644 --- a/src/c/ffi/libraries.d +++ b/src/c/ffi/libraries.d @@ -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)); } } diff --git a/src/c/main.d b/src/c/main.d index 5a270eeb6..e8b77fd2d 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -35,6 +35,7 @@ # define MAP_FAILED -1 # endif #endif +#include #include #include #include @@ -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; diff --git a/src/c/package.d b/src/c/package.d index 9494fcb93..2fc45f63e 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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; diff --git a/src/c/pathname.d b/src/c/pathname.d index 03c3d18bf..ca674a28f 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -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); diff --git a/src/c/process.d b/src/c/process.d index 9f9fffda4..e74b2c6ce 100644 --- a/src/c/process.d +++ b/src/c/process.d @@ -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; diff --git a/src/c/stacks.d b/src/c/stacks.d index a9b8f1781..0c22031e4 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -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)); diff --git a/src/c/threads/thread.d b/src/c/threads/thread.d index 4dc6280c7..fc5817b85 100644 --- a/src/c/threads/thread.d +++ b/src/c/threads/thread.d @@ -31,7 +31,7 @@ # include #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; } } diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 56a6e48ea..a25b04868 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -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)) diff --git a/src/c/unixint.d b/src/c/unixint.d index 8c1209c2b..f4c6e90d8 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -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); diff --git a/src/h/external.h b/src/h/external.h index 2f3d4db6f..d6d794d36 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -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; diff --git a/src/h/internal.h b/src/h/internal.h index dc7113bc5..4deb8a0bf 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -753,8 +753,8 @@ extern void ecl_interrupt_process(cl_object process, cl_object function); #include #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) diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index 32d7d3b5c..6c23eb505 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -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!