mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-15 07:10:36 -08:00
nucleus: move "real" core runtime to runtime.c
Separate ecl_core from cl_core as representing the common language runtime status (as opposed to common lisp status).
This commit is contained in:
parent
6f89059bfd
commit
2367aa2e48
16 changed files with 223 additions and 207 deletions
|
|
@ -48,7 +48,7 @@ HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h $(HDIR)/object.h
|
||||||
$(HDIR)/ecl-inl.h $(HDIR)/internal.h $(HDIR)/stack-resize.h \
|
$(HDIR)/ecl-inl.h $(HDIR)/internal.h $(HDIR)/stack-resize.h \
|
||||||
$(HDIR)/threads.h $(HDIR)/impl/math_dispatch2.h \
|
$(HDIR)/threads.h $(HDIR)/impl/math_dispatch2.h \
|
||||||
$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \
|
$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \
|
||||||
$(HDIR)/impl/math_fenv_msvc.h
|
$(HDIR)/impl/math_fenv_msvc.h $(HDIR)/nucleus.h
|
||||||
|
|
||||||
NUCL_OBJS = nucleus/error.o nucleus/runtime.o
|
NUCL_OBJS = nucleus/error.o nucleus/runtime.o
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -55,13 +55,13 @@ _ecl_set_max_heap_size(size_t new_size)
|
||||||
{
|
{
|
||||||
const cl_env_ptr the_env = ecl_process_env();
|
const cl_env_ptr the_env = ecl_process_env();
|
||||||
ecl_disable_interrupts_env(the_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) {
|
if (new_size == 0) {
|
||||||
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
|
cl_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
|
||||||
cl_core.safety_region = ecl_alloc_atomic_unprotected(size);
|
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
|
||||||
} else if (cl_core.safety_region) {
|
} else if (ecl_core.safety_region) {
|
||||||
GC_FREE(cl_core.safety_region);
|
GC_FREE(ecl_core.safety_region);
|
||||||
cl_core.safety_region = 0;
|
ecl_core.safety_region = 0;
|
||||||
}
|
}
|
||||||
ecl_enable_interrupts_env(the_env);
|
ecl_enable_interrupts_env(the_env);
|
||||||
}
|
}
|
||||||
|
|
@ -97,7 +97,7 @@ out_of_memory(size_t requested_bytes)
|
||||||
/* The out of memory condition may happen in more than one thread */
|
/* The out of memory condition may happen in more than one thread */
|
||||||
/* But then we have to ensure the error has not been solved */
|
/* But then we have to ensure the error has not been solved */
|
||||||
#ifdef ECL_THREADS
|
#ifdef ECL_THREADS
|
||||||
ecl_mutex_lock(&cl_core.error_lock);
|
ecl_mutex_lock(&ecl_core.error_lock);
|
||||||
ECL_UNWIND_PROTECT_BEGIN(the_env)
|
ECL_UNWIND_PROTECT_BEGIN(the_env)
|
||||||
#endif
|
#endif
|
||||||
{
|
{
|
||||||
|
|
@ -112,23 +112,23 @@ out_of_memory(size_t requested_bytes)
|
||||||
goto OUTPUT;
|
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,
|
/* We did not set any limit in the amount of memory,
|
||||||
* yet we failed, or we had some limits but we have
|
* yet we failed, or we had some limits but we have
|
||||||
* not reached them. */
|
* not reached them. */
|
||||||
if (cl_core.safety_region) {
|
if (ecl_core.safety_region) {
|
||||||
/* We can free some memory and try handling the error */
|
/* 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;
|
the_env->string_pool = ECL_NIL;
|
||||||
cl_core.safety_region = 0;
|
ecl_core.safety_region = 0;
|
||||||
method = 0;
|
method = 0;
|
||||||
} else {
|
} else {
|
||||||
/* No possibility of continuing */
|
/* No possibility of continuing */
|
||||||
method = 2;
|
method = 2;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
cl_core.max_heap_size += ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
|
ecl_core.max_heap_size += ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
|
||||||
GC_set_max_heap_size(cl_core.max_heap_size);
|
GC_set_max_heap_size(ecl_core.max_heap_size);
|
||||||
method = 1;
|
method = 1;
|
||||||
}
|
}
|
||||||
OUTPUT:
|
OUTPUT:
|
||||||
|
|
@ -136,7 +136,7 @@ out_of_memory(size_t requested_bytes)
|
||||||
}
|
}
|
||||||
#ifdef ECL_THREADS
|
#ifdef ECL_THREADS
|
||||||
ECL_UNWIND_PROTECT_EXIT {
|
ECL_UNWIND_PROTECT_EXIT {
|
||||||
ecl_mutex_unlock(&cl_core.error_lock);
|
ecl_mutex_unlock(&ecl_core.error_lock);
|
||||||
} ECL_UNWIND_PROTECT_END;
|
} ECL_UNWIND_PROTECT_END;
|
||||||
#endif
|
#endif
|
||||||
ecl_bds_unwind1(the_env);
|
ecl_bds_unwind1(the_env);
|
||||||
|
|
@ -155,8 +155,8 @@ out_of_memory(size_t requested_bytes)
|
||||||
}
|
}
|
||||||
if (!interrupts)
|
if (!interrupts)
|
||||||
ecl_disable_interrupts_env(the_env);
|
ecl_disable_interrupts_env(the_env);
|
||||||
GC_set_max_heap_size(cl_core.max_heap_size +=
|
ecl_core.max_heap_size += (ecl_core.max_heap_size / 2);
|
||||||
cl_core.max_heap_size / 2);
|
GC_set_max_heap_size(ecl_core.max_heap_size);
|
||||||
/* Default allocation. Note that we do not allocate atomic. */
|
/* Default allocation. Note that we do not allocate atomic. */
|
||||||
return GC_MALLOC(requested_bytes);
|
return GC_MALLOC(requested_bytes);
|
||||||
}
|
}
|
||||||
|
|
@ -787,14 +787,14 @@ init_alloc(void)
|
||||||
FALSE, TRUE);
|
FALSE, TRUE);
|
||||||
# endif
|
# endif
|
||||||
#endif /* !GBC_BOEHM_PRECISE */
|
#endif /* !GBC_BOEHM_PRECISE */
|
||||||
|
ecl_core.max_heap_size = ecl_option_values[ECL_OPT_HEAP_SIZE];
|
||||||
GC_set_max_heap_size(cl_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. */
|
/* 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_index size = ecl_option_values[ECL_OPT_HEAP_SAFETY_AREA];
|
||||||
cl_core.safety_region = ecl_alloc_atomic_unprotected(size);
|
ecl_core.safety_region = ecl_alloc_atomic_unprotected(size);
|
||||||
} else if (cl_core.safety_region) {
|
} else if (ecl_core.safety_region) {
|
||||||
cl_core.safety_region = 0;
|
ecl_core.safety_region = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
old_GC_push_other_roots = GC_push_other_roots;
|
old_GC_push_other_roots = GC_push_other_roots;
|
||||||
|
|
@ -882,7 +882,7 @@ standard_finalizer(cl_object o)
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case t_symbol: {
|
case t_symbol: {
|
||||||
ecl_atomic_push(&cl_core.reused_indices,
|
ecl_atomic_push(&ecl_core.reused_indices,
|
||||||
ecl_make_fixnum(o->symbol.binding));
|
ecl_make_fixnum(o->symbol.binding));
|
||||||
o->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
|
o->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
|
||||||
}
|
}
|
||||||
|
|
@ -1059,33 +1059,33 @@ si_gc_stats(cl_object enable)
|
||||||
cl_object old_status;
|
cl_object old_status;
|
||||||
cl_object size1;
|
cl_object size1;
|
||||||
cl_object size2;
|
cl_object size2;
|
||||||
if (cl_core.gc_stats == 0) {
|
if (ecl_core.gc_stats == 0) {
|
||||||
old_status = ECL_NIL;
|
old_status = ECL_NIL;
|
||||||
} else if (GC_print_stats) {
|
} else if (GC_print_stats) {
|
||||||
old_status = @':full';
|
old_status = @':full';
|
||||||
} else {
|
} else {
|
||||||
old_status = ECL_T;
|
old_status = ECL_T;
|
||||||
}
|
}
|
||||||
if (cl_core.bytes_consed == ECL_NIL) {
|
if (ecl_core.bytes_consed == ECL_NIL) {
|
||||||
cl_core.bytes_consed = ecl_alloc_object(t_bignum);
|
ecl_core.bytes_consed = ecl_alloc_object(t_bignum);
|
||||||
mpz_init2(ecl_bignum(cl_core.bytes_consed), 128);
|
mpz_init2(ecl_bignum(ecl_core.bytes_consed), 128);
|
||||||
cl_core.gc_counter = ecl_alloc_object(t_bignum);
|
ecl_core.gc_counter = ecl_alloc_object(t_bignum);
|
||||||
mpz_init2(ecl_bignum(cl_core.gc_counter), 128);
|
mpz_init2(ecl_bignum(ecl_core.gc_counter), 128);
|
||||||
}
|
}
|
||||||
|
|
||||||
update_bytes_consed();
|
update_bytes_consed();
|
||||||
/* We need fresh copies of the bignums */
|
/* We need fresh copies of the bignums */
|
||||||
size1 = _ecl_big_register_copy(cl_core.bytes_consed);
|
size1 = _ecl_big_register_copy(ecl_core.bytes_consed);
|
||||||
size2 = _ecl_big_register_copy(cl_core.gc_counter);
|
size2 = _ecl_big_register_copy(ecl_core.gc_counter);
|
||||||
|
|
||||||
if (enable == ECL_NIL) {
|
if (enable == ECL_NIL) {
|
||||||
GC_print_stats = 0;
|
GC_print_stats = 0;
|
||||||
cl_core.gc_stats = 0;
|
ecl_core.gc_stats = 0;
|
||||||
} else if (enable == ecl_make_fixnum(0)) {
|
} else if (enable == ecl_make_fixnum(0)) {
|
||||||
mpz_set_ui(ecl_bignum(cl_core.bytes_consed), 0);
|
mpz_set_ui(ecl_bignum(ecl_core.bytes_consed), 0);
|
||||||
mpz_set_ui(ecl_bignum(cl_core.gc_counter), 0);
|
mpz_set_ui(ecl_bignum(ecl_core.gc_counter), 0);
|
||||||
} else {
|
} else {
|
||||||
cl_core.gc_stats = 1;
|
ecl_core.gc_stats = 1;
|
||||||
GC_print_stats = (enable == @':full');
|
GC_print_stats = (enable == @':full');
|
||||||
}
|
}
|
||||||
@(return size1 size2 old_status);
|
@(return size1 size2 old_status);
|
||||||
|
|
@ -1098,10 +1098,10 @@ static void
|
||||||
gather_statistics()
|
gather_statistics()
|
||||||
{
|
{
|
||||||
/* GC stats rely on bignums */
|
/* GC stats rely on bignums */
|
||||||
if (cl_core.gc_stats) {
|
if (ecl_core.gc_stats) {
|
||||||
update_bytes_consed();
|
update_bytes_consed();
|
||||||
mpz_add_ui(ecl_bignum(cl_core.gc_counter),
|
mpz_add_ui(ecl_bignum(ecl_core.gc_counter),
|
||||||
ecl_bignum(cl_core.gc_counter),
|
ecl_bignum(ecl_core.gc_counter),
|
||||||
1);
|
1);
|
||||||
}
|
}
|
||||||
if (GC_old_start_callback)
|
if (GC_old_start_callback)
|
||||||
|
|
@ -1111,8 +1111,8 @@ gather_statistics()
|
||||||
static void
|
static void
|
||||||
update_bytes_consed () {
|
update_bytes_consed () {
|
||||||
#if GBC_BOEHM == 0
|
#if GBC_BOEHM == 0
|
||||||
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
|
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
|
||||||
ecl_bignum(cl_core.bytes_consed),
|
ecl_bignum(ecl_core.bytes_consed),
|
||||||
GC_get_bytes_since_gc());
|
GC_get_bytes_since_gc());
|
||||||
#else
|
#else
|
||||||
/* This is not accurate and may wrap around. We try to detect this
|
/* This is not accurate and may wrap around. We try to detect this
|
||||||
|
|
@ -1123,15 +1123,15 @@ update_bytes_consed () {
|
||||||
if (bytes > new_bytes) {
|
if (bytes > new_bytes) {
|
||||||
cl_index wrapped;
|
cl_index wrapped;
|
||||||
wrapped = ~((cl_index)0) - bytes;
|
wrapped = ~((cl_index)0) - bytes;
|
||||||
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
|
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
|
||||||
ecl_bignum(cl_core.bytes_consed),
|
ecl_bignum(ecl_core.bytes_consed),
|
||||||
wrapped);
|
wrapped);
|
||||||
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
|
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
|
||||||
ecl_bignum(cl_core.bytes_consed),
|
ecl_bignum(ecl_core.bytes_consed),
|
||||||
new_bytes);
|
new_bytes);
|
||||||
} else {
|
} else {
|
||||||
mpz_add_ui(ecl_bignum(cl_core.bytes_consed),
|
mpz_add_ui(ecl_bignum(ecl_core.bytes_consed),
|
||||||
ecl_bignum(cl_core.bytes_consed),
|
ecl_bignum(ecl_core.bytes_consed),
|
||||||
new_bytes - bytes);
|
new_bytes - bytes);
|
||||||
}
|
}
|
||||||
bytes = new_bytes;
|
bytes = new_bytes;
|
||||||
|
|
@ -1175,7 +1175,7 @@ stacks_scanner()
|
||||||
{
|
{
|
||||||
cl_env_ptr the_env = ecl_process_env_unsafe();
|
cl_env_ptr the_env = ecl_process_env_unsafe();
|
||||||
cl_object l;
|
cl_object l;
|
||||||
l = cl_core.libraries;
|
l = ecl_core.libraries;
|
||||||
if (l) {
|
if (l) {
|
||||||
for (; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
|
for (; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
|
||||||
cl_object dll = ECL_CONS_CAR(l);
|
cl_object dll = ECL_CONS_CAR(l);
|
||||||
|
|
@ -1185,12 +1185,13 @@ stacks_scanner()
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
GC_push_all((void *)(&cl_core), (void *)(&cl_core + 1));
|
GC_push_all((void *)(&ecl_core), (void *)(&ecl_core + 1));
|
||||||
|
GC_push_all((void *)(&cl_core), (void *)(&ecl_core + 1));
|
||||||
GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core));
|
GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core));
|
||||||
if (the_env != NULL)
|
if (the_env != NULL)
|
||||||
ecl_mark_env(the_env);
|
ecl_mark_env(the_env);
|
||||||
#ifdef ECL_THREADS
|
#ifdef ECL_THREADS
|
||||||
l = cl_core.processes;
|
l = ecl_core.processes;
|
||||||
loop_for_on_unsafe(l) {
|
loop_for_on_unsafe(l) {
|
||||||
cl_object process = ECL_CONS_CAR(l);
|
cl_object process = ECL_CONS_CAR(l);
|
||||||
if (!Null(process)) {
|
if (!Null(process)) {
|
||||||
|
|
|
||||||
|
|
@ -225,7 +225,7 @@ static cl_object
|
||||||
ecl_library_find_by_name(cl_object filename)
|
ecl_library_find_by_name(cl_object filename)
|
||||||
{
|
{
|
||||||
cl_object l;
|
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 other = ECL_CONS_CAR(l);
|
||||||
cl_object name = other->cblock.name;
|
cl_object name = other->cblock.name;
|
||||||
if (!Null(name) && ecl_string_eq(name, filename)) {
|
if (!Null(name) && ecl_string_eq(name, filename)) {
|
||||||
|
|
@ -239,7 +239,7 @@ static cl_object
|
||||||
ecl_library_find_by_handle(void *handle)
|
ecl_library_find_by_handle(void *handle)
|
||||||
{
|
{
|
||||||
cl_object l;
|
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 other = ECL_CONS_CAR(l);
|
||||||
if (handle == other->cblock.handle) {
|
if (handle == other->cblock.handle) {
|
||||||
return other;
|
return other;
|
||||||
|
|
@ -272,7 +272,7 @@ ecl_library_open_inner(cl_object filename, bool self_destruct)
|
||||||
block->cblock.refs = ecl_one_plus(block->cblock.refs);
|
block->cblock.refs = ecl_one_plus(block->cblock.refs);
|
||||||
} else {
|
} else {
|
||||||
si_set_finalizer(block, ECL_T);
|
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();
|
ecl_enable_interrupts();
|
||||||
|
|
@ -345,7 +345,7 @@ ecl_library_symbol(cl_object block, const char *symbol, bool lock) {
|
||||||
void *p;
|
void *p;
|
||||||
if (block == @':default') {
|
if (block == @':default') {
|
||||||
cl_object l;
|
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);
|
cl_object block = ECL_CONS_CAR(l);
|
||||||
p = ecl_library_symbol(block, symbol, lock);
|
p = ecl_library_symbol(block, symbol, lock);
|
||||||
if (p) return p;
|
if (p) return p;
|
||||||
|
|
@ -430,7 +430,7 @@ ecl_library_close(cl_object block) {
|
||||||
block = ECL_NIL;
|
block = ECL_NIL;
|
||||||
} else if (block->cblock.handle != NULL) {
|
} else if (block->cblock.handle != NULL) {
|
||||||
success = GC_call_with_alloc_lock(dlclose_wrapper, block);
|
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 */
|
} else { /* block not loaded */
|
||||||
success = FALSE;
|
success = FALSE;
|
||||||
}
|
}
|
||||||
|
|
@ -447,8 +447,8 @@ ecl_library_close(cl_object block) {
|
||||||
void
|
void
|
||||||
ecl_library_close_all(void)
|
ecl_library_close_all(void)
|
||||||
{
|
{
|
||||||
while (cl_core.libraries != ECL_NIL) {
|
while (ecl_core.libraries != ECL_NIL) {
|
||||||
ecl_library_close(ECL_CONS_CAR(cl_core.libraries));
|
ecl_library_close(ECL_CONS_CAR(ecl_core.libraries));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
71
src/c/main.d
71
src/c/main.d
|
|
@ -15,26 +15,13 @@
|
||||||
/******************************** IMPORTS *****************************/
|
/******************************** IMPORTS *****************************/
|
||||||
|
|
||||||
#include <ecl/ecl.h>
|
#include <ecl/ecl.h>
|
||||||
#include <limits.h>
|
|
||||||
#if defined(ECL_MS_WINDOWS_HOST)
|
|
||||||
# include <windows.h>
|
|
||||||
# include <shellapi.h>
|
|
||||||
# define MAXPATHLEN 512
|
|
||||||
#endif
|
|
||||||
#ifndef MAXPATHLEN
|
|
||||||
# ifdef PATH_MAX
|
|
||||||
# define MAXPATHLEN PATH_MAX
|
|
||||||
# else
|
|
||||||
# define NO_PATH_MAX
|
|
||||||
# include <unistd.h>
|
|
||||||
# endif
|
|
||||||
#endif
|
|
||||||
#ifdef ECL_USE_MPROTECT
|
#ifdef ECL_USE_MPROTECT
|
||||||
# include <sys/mman.h>
|
# include <sys/mman.h>
|
||||||
# ifndef MAP_FAILED
|
# ifndef MAP_FAILED
|
||||||
# define MAP_FAILED -1
|
# define MAP_FAILED -1
|
||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
|
#include <limits.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
@ -160,7 +147,7 @@ _ecl_alloc_env(cl_env_ptr parent)
|
||||||
* Note that at this point we are not allocating any other memory
|
* 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
|
* which is stored via a pointer in the environment. If we would do
|
||||||
* that, an unlucky interrupt by the gc before the allocated
|
* 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
|
* memory being freed because the gc is not aware of the pointer to
|
||||||
* the allocated memory in the environment.
|
* the allocated memory in the environment.
|
||||||
*/
|
*/
|
||||||
|
|
@ -189,7 +176,7 @@ _ecl_alloc_env(cl_env_ptr parent)
|
||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
{
|
{
|
||||||
size_t bytes = cl_core.default_sigmask_bytes;
|
size_t bytes = ecl_core.default_sigmask_bytes;
|
||||||
if (bytes == 0) {
|
if (bytes == 0) {
|
||||||
output->default_sigmask = 0;
|
output->default_sigmask = 0;
|
||||||
} else if (parent) {
|
} else if (parent) {
|
||||||
|
|
@ -198,7 +185,7 @@ _ecl_alloc_env(cl_env_ptr parent)
|
||||||
parent->default_sigmask,
|
parent->default_sigmask,
|
||||||
bytes);
|
bytes);
|
||||||
} else {
|
} else {
|
||||||
output->default_sigmask = cl_core.default_sigmask;
|
output->default_sigmask = ecl_core.default_sigmask;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
output->method_cache = output->slot_cache = NULL;
|
output->method_cache = output->slot_cache = NULL;
|
||||||
|
|
@ -285,9 +272,6 @@ struct cl_core_struct cl_core = {
|
||||||
.c_package = ECL_NIL,
|
.c_package = ECL_NIL,
|
||||||
.ffi_package = ECL_NIL,
|
.ffi_package = ECL_NIL,
|
||||||
|
|
||||||
.pathname_translations = ECL_NIL,
|
|
||||||
.library_pathname = ECL_NIL,
|
|
||||||
|
|
||||||
.terminal_io = ECL_NIL,
|
.terminal_io = ECL_NIL,
|
||||||
.null_stream = ECL_NIL,
|
.null_stream = ECL_NIL,
|
||||||
.standard_input = ECL_NIL,
|
.standard_input = ECL_NIL,
|
||||||
|
|
@ -305,32 +289,7 @@ struct cl_core_struct cl_core = {
|
||||||
.system_properties = ECL_NIL,
|
.system_properties = ECL_NIL,
|
||||||
.setf_definitions = ECL_NIL,
|
.setf_definitions = ECL_NIL,
|
||||||
|
|
||||||
#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,
|
.compiler_dispatch = ECL_NIL,
|
||||||
|
|
||||||
.known_signals = ECL_NIL
|
|
||||||
};
|
};
|
||||||
|
|
||||||
#if !defined(ECL_MS_WINDOWS_HOST)
|
#if !defined(ECL_MS_WINDOWS_HOST)
|
||||||
|
|
@ -363,21 +322,8 @@ cl_boot(int argc, char **argv)
|
||||||
int i;
|
int i;
|
||||||
cl_env_ptr env;
|
cl_env_ptr env;
|
||||||
|
|
||||||
i = ecl_option_values[ECL_OPT_BOOTED];
|
i = ecl_boot();
|
||||||
if (i) {
|
if (i==1) return 1;
|
||||||
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
|
|
||||||
|
|
||||||
ARGC = argc;
|
ARGC = argc;
|
||||||
ARGV = argv;
|
ARGV = argv;
|
||||||
|
|
@ -417,11 +363,6 @@ cl_boot(int argc, char **argv)
|
||||||
#endif
|
#endif
|
||||||
cl_num_symbols_in_core=2;
|
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.gensym_prefix = (cl_object)&str_G_data;
|
||||||
cl_core.gentemp_prefix = (cl_object)&str_T_data;
|
cl_core.gentemp_prefix = (cl_object)&str_T_data;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,21 @@
|
||||||
|
|
||||||
/* -- imports ------------------------------------------------------- */
|
/* -- imports ------------------------------------------------------- */
|
||||||
|
|
||||||
|
#include <limits.h>
|
||||||
|
#if defined(ECL_MS_WINDOWS_HOST)
|
||||||
|
# include <windows.h>
|
||||||
|
# include <shellapi.h>
|
||||||
|
# define MAXPATHLEN 512
|
||||||
|
#endif
|
||||||
|
#ifndef MAXPATHLEN
|
||||||
|
# ifdef PATH_MAX
|
||||||
|
# define MAXPATHLEN PATH_MAX
|
||||||
|
# else
|
||||||
|
# define MAXPATHLEN sysconf(_PC_PATH_MAX)
|
||||||
|
# include <unistd.h>
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <ecl/ecl.h>
|
#include <ecl/ecl.h>
|
||||||
#include <ecl/ecl-inl.h>
|
#include <ecl/ecl-inl.h>
|
||||||
#include <ecl/internal.h>
|
#include <ecl/internal.h>
|
||||||
|
|
@ -105,3 +120,57 @@ ecl_set_option(int option, cl_fixnum value)
|
||||||
}
|
}
|
||||||
return ecl_option_values[option];
|
return ecl_option_values[option];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* -- core runtime -------------------------------------------------- */
|
||||||
|
|
||||||
|
struct ecl_core_struct ecl_core = {
|
||||||
|
/* processes */
|
||||||
|
#ifdef ECL_THREADS
|
||||||
|
.processes = ECL_NIL,
|
||||||
|
.last_var_index = 0,
|
||||||
|
.reused_indices = ECL_NIL,
|
||||||
|
#endif
|
||||||
|
/* signals */
|
||||||
|
.default_sigmask = NULL,
|
||||||
|
.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 an adjustable vector of objects. It behaves as a vector 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
/*ecl_set_option(ECL_OPT_SIGNAL_HANDLING_THREAD, 0);*/
|
||||||
|
|
||||||
|
/* init_process(); */
|
||||||
|
/* init_unixint(); */
|
||||||
|
/* init_garbage(); */
|
||||||
|
|
||||||
|
ecl_core.path_max = MAXPATHLEN;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
|
||||||
|
|
@ -23,8 +23,8 @@
|
||||||
* NOTE 1: we only need to use the package locks when reading/writing the hash
|
* 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
|
* 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
|
* read lists from the packages (i.e. list of shadowing symbols, used
|
||||||
* packages, etc), or from the global environment (cl_core.packages_list) if
|
* packages, etc), or from the global environment (cl_core.packages_list)
|
||||||
* we do not destructively modify them (For instance, use ecl_remove_eq
|
* if we do not destructively modify them (For instance, use ecl_remove_eq
|
||||||
* instead of ecl_delete_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);
|
nicknamed->pack.nicknamedby = CONS(x, nicknamed->pack.nicknamedby);
|
||||||
} end_loop_for_in;
|
} end_loop_for_in;
|
||||||
/* Finally, add it to the list of packages */
|
/* 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:
|
OUTPUT:
|
||||||
(void)0;
|
(void)0;
|
||||||
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
|
} ECL_WITH_GLOBAL_ENV_WRLOCK_END;
|
||||||
|
|
|
||||||
|
|
@ -525,7 +525,7 @@ ecl_logical_hostname_p(cl_object host)
|
||||||
{
|
{
|
||||||
if (!ecl_stringp(host))
|
if (!ecl_stringp(host))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
return !Null(ecl_assqlp(host, cl_core.pathname_translations));
|
return !Null(ecl_assqlp(host, ecl_core.pathname_translations));
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
|
|
@ -917,8 +917,8 @@ si_coerce_to_filename(cl_object pathname_orig)
|
||||||
pathname_orig->pathname.type,
|
pathname_orig->pathname.type,
|
||||||
pathname_orig->pathname.version);
|
pathname_orig->pathname.version);
|
||||||
}
|
}
|
||||||
if (cl_core.path_max != -1 &&
|
if (ecl_core.path_max != -1 &&
|
||||||
ecl_length(namestring) >= cl_core.path_max - 16)
|
ecl_length(namestring) >= ecl_core.path_max - 16)
|
||||||
FEerror("Too long filename: ~S.", 1, namestring);
|
FEerror("Too long filename: ~S.", 1, namestring);
|
||||||
return namestring;
|
return namestring;
|
||||||
}
|
}
|
||||||
|
|
@ -1559,7 +1559,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
|
||||||
FEerror("Wrong host syntax ~S", 1, host);
|
FEerror("Wrong host syntax ~S", 1, host);
|
||||||
}
|
}
|
||||||
/* Find its translation list */
|
/* Find its translation list */
|
||||||
pair = ecl_assqlp(host, cl_core.pathname_translations);
|
pair = ecl_assqlp(host, ecl_core.pathname_translations);
|
||||||
if (set == OBJNULL) {
|
if (set == OBJNULL) {
|
||||||
@(return ((pair == ECL_NIL)? ECL_NIL : CADR(pair)));
|
@(return ((pair == ECL_NIL)? ECL_NIL : CADR(pair)));
|
||||||
}
|
}
|
||||||
|
|
@ -1569,7 +1569,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
|
||||||
}
|
}
|
||||||
if (pair == ECL_NIL) {
|
if (pair == ECL_NIL) {
|
||||||
pair = CONS(host, CONS(ECL_NIL, 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)) {
|
for (l = set, set = ECL_NIL; !ecl_endp(l); l = CDR(l)) {
|
||||||
cl_object item = CAR(l);
|
cl_object item = CAR(l);
|
||||||
|
|
|
||||||
|
|
@ -427,11 +427,11 @@ ecl_new_binding_index(cl_env_ptr env, cl_object symbol)
|
||||||
cl_object pool;
|
cl_object pool;
|
||||||
cl_index new_index = symbol->symbol.binding;
|
cl_index new_index = symbol->symbol.binding;
|
||||||
if (new_index == ECL_MISSING_SPECIAL_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)) {
|
if (!Null(pool)) {
|
||||||
new_index = ecl_fixnum(ECL_CONS_CAR(pool));
|
new_index = ecl_fixnum(ECL_CONS_CAR(pool));
|
||||||
} else {
|
} 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;
|
symbol->symbol.binding = new_index;
|
||||||
}
|
}
|
||||||
|
|
@ -442,7 +442,7 @@ ecl_new_binding_index(cl_env_ptr env, cl_object symbol)
|
||||||
static cl_object
|
static cl_object
|
||||||
ecl_extend_bindings_array(cl_object vector)
|
ecl_extend_bindings_array(cl_object vector)
|
||||||
{
|
{
|
||||||
cl_index new_size = cl_core.last_var_index * 1.25;
|
cl_index new_size = ecl_core.last_var_index * 1.25;
|
||||||
cl_object new_vector = si_make_vector(ECL_T, ecl_make_fixnum(new_size), ECL_NIL,
|
cl_object new_vector = si_make_vector(ECL_T, ecl_make_fixnum(new_size), ECL_NIL,
|
||||||
ECL_NIL, ECL_NIL, ECL_NIL);
|
ECL_NIL, ECL_NIL, ECL_NIL);
|
||||||
si_fill_array_with_elt(new_vector, ECL_NO_TL_BINDING, ecl_make_fixnum(0), ECL_NIL);
|
si_fill_array_with_elt(new_vector, ECL_NO_TL_BINDING, ecl_make_fixnum(0), ECL_NIL);
|
||||||
|
|
@ -834,7 +834,7 @@ si_get_limit(cl_object type)
|
||||||
output = env->stack_limit_size;
|
output = env->stack_limit_size;
|
||||||
else {
|
else {
|
||||||
/* size_t can be larger than cl_index */
|
/* 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));
|
ecl_return1(env, ecl_make_unsigned_integer(output));
|
||||||
|
|
|
||||||
|
|
@ -112,7 +112,7 @@ ecl_set_process_env(cl_env_ptr env)
|
||||||
static void
|
static void
|
||||||
ecl_list_process(cl_object process)
|
ecl_list_process(cl_object process)
|
||||||
{
|
{
|
||||||
ecl_atomic_push(&cl_core.processes, process);
|
ecl_atomic_push(&ecl_core.processes, process);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Must be called with disabled interrupts to prevent race conditions
|
/* Must be called with disabled interrupts to prevent race conditions
|
||||||
|
|
@ -120,18 +120,18 @@ ecl_list_process(cl_object process)
|
||||||
static void
|
static void
|
||||||
ecl_unlist_process(cl_object process)
|
ecl_unlist_process(cl_object process)
|
||||||
{
|
{
|
||||||
ecl_mutex_lock(&cl_core.processes_lock);
|
ecl_mutex_lock(&ecl_core.processes_lock);
|
||||||
cl_core.processes = ecl_delete_eq(process, cl_core.processes);
|
ecl_core.processes = ecl_delete_eq(process, ecl_core.processes);
|
||||||
ecl_mutex_unlock(&cl_core.processes_lock);
|
ecl_mutex_unlock(&ecl_core.processes_lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
static cl_object
|
static cl_object
|
||||||
ecl_process_list()
|
ecl_process_list()
|
||||||
{
|
{
|
||||||
cl_object result;
|
cl_object result;
|
||||||
ecl_mutex_lock(&cl_core.processes_lock);
|
ecl_mutex_lock(&ecl_core.processes_lock);
|
||||||
result = cl_copy_list(cl_core.processes);
|
result = cl_copy_list(ecl_core.processes);
|
||||||
ecl_mutex_unlock(&cl_core.processes_lock);
|
ecl_mutex_unlock(&ecl_core.processes_lock);
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -141,10 +141,10 @@ static void
|
||||||
init_process(void)
|
init_process(void)
|
||||||
{
|
{
|
||||||
ecl_process_key_create(cl_env_key);
|
ecl_process_key_create(cl_env_key);
|
||||||
ecl_mutex_init(&cl_core.processes_lock, 1);
|
ecl_mutex_init(&ecl_core.processes_lock, 1);
|
||||||
ecl_mutex_init(&cl_core.global_lock, 1);
|
ecl_mutex_init(&ecl_core.global_lock, 1);
|
||||||
ecl_mutex_init(&cl_core.error_lock, 1);
|
ecl_mutex_init(&ecl_core.error_lock, 1);
|
||||||
ecl_rwlock_init(&cl_core.global_env_lock);
|
ecl_rwlock_init(&ecl_core.global_env_lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* -- Environment --------------------------------------------------- */
|
/* -- Environment --------------------------------------------------- */
|
||||||
|
|
@ -343,7 +343,7 @@ ecl_import_current_thread(cl_object name, cl_object bindings)
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
{
|
{
|
||||||
cl_object processes = cl_core.processes;
|
cl_object processes = ecl_core.processes;
|
||||||
loop_for_on_unsafe(processes) {
|
loop_for_on_unsafe(processes) {
|
||||||
cl_object p = ECL_CONS_CAR(processes);
|
cl_object p = ECL_CONS_CAR(processes);
|
||||||
if (!Null(p) && ecl_process_eq(p->process.thread, current)) {
|
if (!Null(p) && ecl_process_eq(p->process.thread, current)) {
|
||||||
|
|
|
||||||
|
|
@ -1045,7 +1045,7 @@ dir_recursive(cl_object base_dir, cl_object directory, cl_object filemask, int f
|
||||||
cl_object
|
cl_object
|
||||||
si_get_library_pathname(void)
|
si_get_library_pathname(void)
|
||||||
{
|
{
|
||||||
cl_object s = cl_core.library_pathname;
|
cl_object s = ecl_core.library_pathname;
|
||||||
if (!Null(s)) {
|
if (!Null(s)) {
|
||||||
goto OUTPUT_UNCHANGED;
|
goto OUTPUT_UNCHANGED;
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -1060,11 +1060,11 @@ si_get_library_pathname(void)
|
||||||
ecl_filename_char *buffer;
|
ecl_filename_char *buffer;
|
||||||
HMODULE hnd;
|
HMODULE hnd;
|
||||||
cl_index len, ep;
|
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);
|
buffer = ecl_filename_self(s);
|
||||||
ecl_disable_interrupts();
|
ecl_disable_interrupts();
|
||||||
hnd = GetModuleHandle("ecl.dll");
|
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();
|
ecl_enable_interrupts();
|
||||||
if (len == 0) {
|
if (len == 0) {
|
||||||
FEerror("GetModuleFileName failed (last error = ~S)",
|
FEerror("GetModuleFileName failed (last error = ~S)",
|
||||||
|
|
@ -1085,9 +1085,9 @@ si_get_library_pathname(void)
|
||||||
s = current_dir();
|
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:
|
OUTPUT_UNCHANGED:
|
||||||
@(return cl_core.library_pathname);
|
@(return ecl_core.library_pathname);
|
||||||
}
|
}
|
||||||
|
|
||||||
@(defun ext::chdir (directory &optional (change_d_p_d ECL_T))
|
@(defun ext::chdir (directory &optional (change_d_p_d ECL_T))
|
||||||
|
|
|
||||||
|
|
@ -538,7 +538,7 @@ handler_fn_prototype(non_evil_signal_handler, int sig, siginfo_t *siginfo, void
|
||||||
unlikely_if (zombie_process(the_env))
|
unlikely_if (zombie_process(the_env))
|
||||||
return;
|
return;
|
||||||
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
|
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
|
||||||
cl_core.known_signals,
|
ecl_core.known_signals,
|
||||||
ECL_NIL);
|
ECL_NIL);
|
||||||
handle_or_queue(the_env, signal_object, sig);
|
handle_or_queue(the_env, signal_object, sig);
|
||||||
errno = old_errno;
|
errno = old_errno;
|
||||||
|
|
@ -556,7 +556,7 @@ handler_fn_prototype(evil_signal_handler, int sig, siginfo_t *siginfo, void *dat
|
||||||
unlikely_if (zombie_process(the_env))
|
unlikely_if (zombie_process(the_env))
|
||||||
return;
|
return;
|
||||||
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
|
signal_object = ecl_gethash_safe(ecl_make_fixnum(sig),
|
||||||
cl_core.known_signals,
|
ecl_core.known_signals,
|
||||||
ECL_NIL);
|
ECL_NIL);
|
||||||
handle_signal_now(signal_object);
|
handle_signal_now(signal_object);
|
||||||
errno = old_errno;
|
errno = old_errno;
|
||||||
|
|
@ -651,7 +651,7 @@ asynchronous_signal_servicing_thread()
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
signal_code = ecl_gethash_safe(ecl_make_fixnum(signal_thread_msg.signo),
|
signal_code = ecl_gethash_safe(ecl_make_fixnum(signal_thread_msg.signo),
|
||||||
cl_core.known_signals,
|
ecl_core.known_signals,
|
||||||
ECL_NIL);
|
ECL_NIL);
|
||||||
if (!Null(signal_code)) {
|
if (!Null(signal_code)) {
|
||||||
mp_process_run_function(3, @'si::handle-signal',
|
mp_process_run_function(3, @'si::handle-signal',
|
||||||
|
|
@ -961,7 +961,7 @@ do_catch_signal(int code, cl_object action, cl_object process)
|
||||||
cl_object
|
cl_object
|
||||||
si_get_signal_handler(cl_object code)
|
si_get_signal_handler(cl_object code)
|
||||||
{
|
{
|
||||||
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) {
|
unlikely_if (handler == OBJNULL) {
|
||||||
illegal_signal_code(code);
|
illegal_signal_code(code);
|
||||||
}
|
}
|
||||||
|
|
@ -971,11 +971,11 @@ si_get_signal_handler(cl_object code)
|
||||||
cl_object
|
cl_object
|
||||||
si_set_signal_handler(cl_object code, cl_object handler)
|
si_set_signal_handler(cl_object code, cl_object handler)
|
||||||
{
|
{
|
||||||
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) {
|
unlikely_if (action == OBJNULL) {
|
||||||
illegal_signal_code(code);
|
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);
|
si_catch_signal(2, code, ECL_T);
|
||||||
@(return handler)
|
@(return handler)
|
||||||
}
|
}
|
||||||
|
|
@ -984,7 +984,7 @@ si_set_signal_handler(cl_object code, cl_object handler)
|
||||||
@
|
@
|
||||||
{
|
{
|
||||||
int code_int;
|
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);
|
illegal_signal_code(code);
|
||||||
}
|
}
|
||||||
code_int = ecl_fixnum(code);
|
code_int = ecl_fixnum(code);
|
||||||
|
|
@ -1311,8 +1311,8 @@ install_asynchronous_signal_handlers()
|
||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
#ifdef HAVE_SIGPROCMASK
|
#ifdef HAVE_SIGPROCMASK
|
||||||
sigset_t *sigmask = cl_core.default_sigmask = &main_thread_sigmask;
|
sigset_t *sigmask = ecl_core.default_sigmask = &main_thread_sigmask;
|
||||||
cl_core.default_sigmask_bytes = sizeof(sigset_t);
|
ecl_core.default_sigmask_bytes = sizeof(sigset_t);
|
||||||
# ifdef ECL_THREADS
|
# ifdef ECL_THREADS
|
||||||
pthread_sigmask(SIG_SETMASK, NULL, sigmask);
|
pthread_sigmask(SIG_SETMASK, NULL, sigmask);
|
||||||
# else
|
# else
|
||||||
|
|
@ -1471,7 +1471,7 @@ static void
|
||||||
create_signal_code_constants()
|
create_signal_code_constants()
|
||||||
{
|
{
|
||||||
cl_object hash =
|
cl_object hash =
|
||||||
cl_core.known_signals =
|
ecl_core.known_signals =
|
||||||
cl__make_hash_table(@'eql', ecl_make_fixnum(128),
|
cl__make_hash_table(@'eql', ecl_make_fixnum(128),
|
||||||
ecl_ct_default_rehash_size,
|
ecl_ct_default_rehash_size,
|
||||||
ecl_ct_default_rehash_threshold);
|
ecl_ct_default_rehash_threshold);
|
||||||
|
|
|
||||||
|
|
@ -84,6 +84,7 @@
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <ecl/object.h>
|
#include <ecl/object.h>
|
||||||
|
#include <ecl/nucleus.h>
|
||||||
#include <ecl/external.h>
|
#include <ecl/external.h>
|
||||||
#include <ecl/cons.h>
|
#include <ecl/cons.h>
|
||||||
#include <ecl/stacks.h>
|
#include <ecl/stacks.h>
|
||||||
|
|
|
||||||
|
|
@ -169,9 +169,7 @@ struct ecl_interrupt_struct {
|
||||||
extern ECL_API cl_env_ptr cl_env_p;
|
extern ECL_API cl_env_ptr cl_env_p;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/*
|
/* Per-process data. Modify main.d accordingly. */
|
||||||
* Per-process data. Modify main.d accordingly.
|
|
||||||
*/
|
|
||||||
|
|
||||||
struct cl_core_struct {
|
struct cl_core_struct {
|
||||||
cl_object packages;
|
cl_object packages;
|
||||||
|
|
@ -188,9 +186,6 @@ struct cl_core_struct {
|
||||||
cl_object c_package;
|
cl_object c_package;
|
||||||
cl_object ffi_package;
|
cl_object ffi_package;
|
||||||
|
|
||||||
cl_object pathname_translations;
|
|
||||||
cl_object library_pathname;
|
|
||||||
|
|
||||||
cl_object terminal_io;
|
cl_object terminal_io;
|
||||||
cl_object null_stream;
|
cl_object null_stream;
|
||||||
cl_object standard_input;
|
cl_object standard_input;
|
||||||
|
|
@ -208,40 +203,15 @@ struct cl_core_struct {
|
||||||
cl_object system_properties;
|
cl_object system_properties;
|
||||||
cl_object setf_definitions;
|
cl_object setf_definitions;
|
||||||
|
|
||||||
#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 compiler_dispatch;
|
||||||
|
|
||||||
cl_object known_signals;
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
extern ECL_API struct ecl_core_struct ecl_core;
|
||||||
extern ECL_API struct cl_core_struct cl_core;
|
extern ECL_API struct cl_core_struct cl_core;
|
||||||
|
|
||||||
/* runtime.c */
|
/* runtime.c */
|
||||||
|
extern ECL_API const int ecl_boot(void);
|
||||||
|
|
||||||
extern ECL_API const cl_object ecl_ct_Jan1st1970UT;
|
extern ECL_API const cl_object ecl_ct_Jan1st1970UT;
|
||||||
extern ECL_API const cl_object ecl_ct_null_string;
|
extern ECL_API const cl_object ecl_ct_null_string;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -578,8 +578,8 @@ extern void ecl_interrupt_process(cl_object process, cl_object function);
|
||||||
#include <ecl/threads.h>
|
#include <ecl/threads.h>
|
||||||
|
|
||||||
#ifdef ECL_THREADS
|
#ifdef ECL_THREADS
|
||||||
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
|
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) \
|
||||||
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &cl_core.global_lock)
|
ECL_WITH_NATIVE_LOCK_BEGIN(the_env, &ecl_core.global_lock)
|
||||||
# define ECL_WITH_GLOBAL_LOCK_END \
|
# define ECL_WITH_GLOBAL_LOCK_END \
|
||||||
ECL_WITH_NATIVE_LOCK_END
|
ECL_WITH_NATIVE_LOCK_END
|
||||||
# define ECL_WITH_LOCK_BEGIN(the_env,lock) { \
|
# define ECL_WITH_LOCK_BEGIN(the_env,lock) { \
|
||||||
|
|
@ -604,21 +604,21 @@ extern void ecl_interrupt_process(cl_object process, cl_object function);
|
||||||
ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT { \
|
ECL_UNWIND_PROTECT_THREAD_SAFE_EXIT { \
|
||||||
ecl_mutex_unlock(__ecl_the_lock); \
|
ecl_mutex_unlock(__ecl_the_lock); \
|
||||||
} ECL_UNWIND_PROTECT_THREAD_SAFE_END; }
|
} ECL_UNWIND_PROTECT_THREAD_SAFE_END; }
|
||||||
# define ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) { \
|
# define ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(the_env) { \
|
||||||
const cl_env_ptr __ecl_pack_env = the_env; \
|
const cl_env_ptr __ecl_pack_env = the_env; \
|
||||||
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
|
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
|
||||||
ecl_rwlock_lock_read(&cl_core.global_env_lock);
|
ecl_rwlock_lock_read(&ecl_core.global_env_lock);
|
||||||
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END \
|
# define ECL_WITH_GLOBAL_ENV_RDLOCK_END \
|
||||||
ecl_rwlock_unlock_read(&cl_core.global_env_lock); \
|
ecl_rwlock_unlock_read(&ecl_core.global_env_lock); \
|
||||||
ecl_bds_unwind1(__ecl_pack_env); \
|
ecl_bds_unwind1(__ecl_pack_env); \
|
||||||
ecl_check_pending_interrupts(__ecl_pack_env); }
|
ecl_check_pending_interrupts(__ecl_pack_env); }
|
||||||
# define ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env) { \
|
# define ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env) { \
|
||||||
const cl_env_ptr __ecl_pack_env = the_env; \
|
const cl_env_ptr __ecl_pack_env = the_env; \
|
||||||
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
|
ecl_bds_bind(__ecl_pack_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); \
|
||||||
ecl_rwlock_lock_write(&cl_core.global_env_lock);
|
ecl_rwlock_lock_write(&ecl_core.global_env_lock);
|
||||||
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END \
|
# define ECL_WITH_GLOBAL_ENV_WRLOCK_END \
|
||||||
ecl_rwlock_unlock_write(&cl_core.global_env_lock); \
|
ecl_rwlock_unlock_write(&ecl_core.global_env_lock); \
|
||||||
ecl_bds_unwind1(__ecl_pack_env); \
|
ecl_bds_unwind1(__ecl_pack_env); \
|
||||||
ecl_check_pending_interrupts(__ecl_pack_env); }
|
ecl_check_pending_interrupts(__ecl_pack_env); }
|
||||||
#else
|
#else
|
||||||
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)
|
# define ECL_WITH_GLOBAL_LOCK_BEGIN(the_env)
|
||||||
|
|
|
||||||
34
src/h/nucleus.h
Normal file
34
src/h/nucleus.h
Normal file
|
|
@ -0,0 +1,34 @@
|
||||||
|
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||||
|
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||||
|
|
||||||
|
#ifndef ECL_NUCLEUS_H
|
||||||
|
#define ECL_NUCLEUS_H
|
||||||
|
|
||||||
|
struct ecl_core_struct {
|
||||||
|
#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;
|
||||||
|
|
||||||
|
void *default_sigmask;
|
||||||
|
cl_index default_sigmask_bytes;
|
||||||
|
cl_object known_signals;
|
||||||
|
|
||||||
|
int path_max;
|
||||||
|
cl_object pathname_translations;
|
||||||
|
|
||||||
|
cl_object libraries;
|
||||||
|
cl_object library_pathname;
|
||||||
|
};
|
||||||
|
|
||||||
|
#endif /* ECL_NUCLEUS_H */
|
||||||
|
|
@ -192,7 +192,7 @@
|
||||||
;;; Fixed: 10/10/2006
|
;;; Fixed: 10/10/2006
|
||||||
;;; Description:
|
;;; 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.
|
;;; The following code tests that at least three objects are finalized.
|
||||||
;;;
|
;;;
|
||||||
;;; Note: this test fails in multithreaded mode. GC takes too long!
|
;;; Note: this test fails in multithreaded mode. GC takes too long!
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue