mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-10 07:00:20 -07:00
Code Issues Projects Releases Packages Wiki Activity

nucleus: [1/n] move processing unit managament to nucleus

Browse source
This commit is contained in:
Daniel Kochmański 2025-05-14 20:53:56 +02:00
parent 4f62968697
commit 91f4fa8ec1
9 changed files with 224 additions and 252 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/c/alloc_2.d
View file

@ -1191,17 +1191,11 @@ stacks_scanner()
GC_push_all((void *)cl_symbols, (void *)(cl_symbols + cl_num_symbols_in_core));
ecl_mark_env(ecl_core.first_env);
#ifdef ECL_THREADS
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 != ecl_core.first_env)) ecl_mark_env(env);
}
}
}
loop_across_stack_fifo(_env, ecl_core.threads) {
cl_env_ptr env = ecl_cast_ptr(cl_env_ptr, _env);
if(env != ecl_core.first_env)
ecl_mark_env(env);
} end_loop_across_stack();
#endif
if (old_GC_push_other_roots)
(*old_GC_push_other_roots)();

2
src/c/boot.d
View file

@ -140,7 +140,7 @@ struct ecl_core_struct ecl_core = {
.first_env = &first_env,
/* processes */
#ifdef ECL_THREADS
.processes = ECL_NIL,
.threads = ECL_NIL,
.last_var_index = 0,
.reused_indices = ECL_NIL,
#endif

21
src/c/main.d
View file

@ -42,16 +42,6 @@ const char *ecl_self;
static int ARGC;
static char **ARGV;
static void
init_env_mp(cl_env_ptr env)
{
#if defined(ECL_THREADS)
env->cleanup = 0;
#else
env->own_process = ECL_NIL;
#endif
}
static void
init_env_int(cl_env_ptr env)
{
@ -59,6 +49,9 @@ init_env_int(cl_env_ptr env)
env->interrupt_struct->pending_interrupt = ECL_NIL;
#ifdef ECL_THREADS
ecl_mutex_init(&env->interrupt_struct->signal_queue_lock, FALSE);
#endif
#ifdef ECL_WINDOWS_THREADS
env->interrupt_struct->inside_interrupt = false;
#endif
{
int size = ecl_option_values[ECL_OPT_SIGNAL_QUEUE_SIZE];
@ -111,7 +104,6 @@ ecl_init_first_env(cl_env_ptr env)
void
ecl_init_env(cl_env_ptr env)
{
init_env_mp(env);
init_env_int(env);
init_env_aux(env);
init_env_ffi(env);
@ -170,6 +162,13 @@ _ecl_alloc_env(cl_env_ptr parent)
ecl_internal_error("Unable to allocate environment structure.");
# endif
#endif
/* Initialize the structure with NULL data. */
#if defined(ECL_THREADS)
output->bds_stack.tl_bindings_size = 0;
output->bds_stack.tl_bindings = NULL;
output->cleanup = 0;
#endif
output->own_process = ECL_NIL;
{
size_t bytes = ecl_core.default_sigmask_bytes;
if (bytes == 0) {

114
src/c/process.d
View file

@ -36,11 +36,25 @@
#ifdef ECL_THREADS
# ifdef ECL_WINDOWS_THREADS
# define ecl_process_eq(t1, t2) (GetThreadId(t1) == GetThreadId(t2))
# define ecl_set_process_self(var) \
{ \
HANDLE aux = GetCurrentThread(); \
DuplicateHandle(GetCurrentProcess(), \
aux, \
GetCurrentProcess(), \
&var, \
0, \
FALSE, \
DUPLICATE_SAME_ACCESS); \
}
# define ecl_process_key_t DWORD
# define ecl_process_key_create(key) key = TlsAlloc()
# define ecl_process_get_tls(key) TlsGetValue(key)
# define ecl_process_set_tls(key,val) (TlsSetValue(key,val)!=0)
# else
# define ecl_process_eq(t1, t2) (t1 == t2)
# define ecl_set_process_self(var) (var = pthread_self())
# define ecl_process_key_t static pthread_key_t
# define ecl_process_key_create(key) pthread_key_create(&key, NULL)
# define ecl_process_get_tls(key) pthread_getspecific(key)
@ -79,6 +93,105 @@ ecl_set_process_env(cl_env_ptr env)
cl_env_ptr cl_env_p = NULL;
#endif /* ECL_THREADS */
/* -- Managing the collection of processes ---------------------------------- */
#ifdef ECL_THREADS
static void
add_env(cl_env_ptr the_env)
{
cl_object _env;
ecl_mutex_lock(&ecl_core.processes_lock);
_env = ecl_cast_ptr(cl_object,the_env);
ecl_stack_push(ecl_core.threads, _env);
ecl_mutex_unlock(&ecl_core.processes_lock);
}
static void
del_env(cl_env_ptr the_env)
{
cl_object _env;
ecl_mutex_lock(&ecl_core.processes_lock);
_env = ecl_cast_ptr(cl_object,the_env);
ecl_stack_del(ecl_core.threads, _env);
ecl_mutex_unlock(&ecl_core.processes_lock);
}
/* Run a process in the current system thread. */
cl_env_ptr
ecl_adopt_cpu()
{
struct cl_env_struct env_aux[1];
cl_env_ptr the_env = ecl_process_env_unsafe();
ecl_thread_t current;
int registered;
if (the_env != NULL)
return the_env;
/* 1. Ensure that the thread is known to the GC. */
/* FIXME this should be executed with hooks. */
#ifdef GBC_BOEHM
{
struct GC_stack_base stack;
GC_get_stack_base(&stack);
switch (GC_register_my_thread(&stack)) {
case GC_SUCCESS:
registered = 1;
break;
case GC_DUPLICATE:
/* Thread was probably created using the GC hooks for thread creation. */
registered = 0;
break;
default:
ecl_internal_error("gc returned an impossible answer.");
}
}
#endif
ecl_set_process_self(current);
/* We need a fake env to allow for interrupts blocking and to set up frame
* stacks or other stuff that is needed by ecl_init_env. Since the fake env is
* allocated on the stack, we can safely store pointers to memory allocated by
* the gc there. */
memset(env_aux, 0, sizeof(*env_aux));
env_aux->disable_interrupts = 1;
env_aux->interrupt_struct = ecl_alloc_unprotected(sizeof(*env_aux->interrupt_struct));
env_aux->interrupt_struct->pending_interrupt = ECL_NIL;
ecl_mutex_init(&env_aux->interrupt_struct->signal_queue_lock, FALSE);
env_aux->interrupt_struct->signal_queue = ECL_NIL;
ecl_set_process_env(env_aux);
env_aux->thread = current;
env_aux->cleanup = registered;
ecl_init_env(env_aux);
/* Allocate, initialize and switch to the real environment. */
the_env = _ecl_alloc_env(0);
memcpy(the_env, env_aux, sizeof(*the_env));
ecl_set_process_env(the_env);
add_env(the_env);
return the_env;
}
/* Run a process in a new system thread. */
cl_env_ptr
ecl_spawn_cpu()
{
return NULL;
}
void
ecl_add_process(cl_object process)
{
add_env(process->process.env);
}
void
ecl_del_process(cl_object process)
{
del_env(process->process.env);
}
#endif
/* -- Initialiation --------------------------------------------------------- */
void
@ -91,6 +204,7 @@ init_process(void)
ecl_mutex_init(&ecl_core.global_lock, 1);
ecl_mutex_init(&ecl_core.error_lock, 1);
ecl_rwlock_init(&ecl_core.global_env_lock);
ecl_core.threads = ecl_make_stack(16);
#endif
ecl_set_process_env(env);
env->default_sigmask = NULL;

218
src/c/threads/thread.d
View file

@ -53,81 +53,17 @@
/* -- Core ---------------------------------------------------------- */
static void
extend_process_vector()
{
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, &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);
ecl_core.processes = new;
}
} ECL_WITH_NATIVE_LOCK_END;
}
static void
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, &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) {
vector->vector.self.t[ndx++] = process;
vector->vector.fillp = ndx;
ok = 1;
}
} ECL_WITH_NATIVE_LOCK_END;
if (ok) break;
extend_process_vector();
} while (1);
}
/* Must be called with disabled interrupts to prevent race conditions
* in thread_cleanup */
static void
ecl_unlist_process(cl_object process)
{
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) {
vector->vector.fillp--;
do {
vector->vector.self.t[i] =
vector->vector.self.t[i+1];
} while (++i < vector->vector.fillp);
break;
}
}
ecl_mutex_unlock(&ecl_core.processes_lock);
}
static cl_object
ecl_process_list()
{
cl_env_ptr the_env = ecl_process_env();
cl_object output = ECL_NIL;
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++) {
cl_object p = data[i];
if (p != ECL_NIL)
output = ecl_cons(p, output);
}
loop_across_stack_fifo(_env, ecl_core.threads) {
cl_env_ptr env = ecl_cast_ptr(cl_env_ptr, _env);
cl_object p = env->own_process;
output = ecl_cons(p, output);
} end_loop_across_stack();
} ECL_WITH_NATIVE_LOCK_END;
return output;
}
@ -183,10 +119,10 @@ thread_cleanup(void *aux)
pthread_sigmask(SIG_BLOCK, new, NULL);
}
#endif
ecl_del_process(process);
process->process.env = NULL;
ecl_unlist_process(process);
#ifdef ECL_WINDOWS_THREADS
CloseHandle(process->process.thread);
CloseHandle(env->thread);
#endif
ecl_set_process_env(NULL);
if (env) _ecl_dealloc_env(env);
@ -238,21 +174,12 @@ thread_entry_point(void *arg)
#endif
process->process.phase = ECL_PROCESS_ACTIVE;
ecl_mutex_unlock(&process->process.start_stop_lock);
ecl_enable_interrupts_env(env);
si_trap_fpe(@'last', ECL_T);
ecl_enable_interrupts_env(env);
ecl_bds_bind(env, @'mp::*current-process*', process);
ECL_RESTART_CASE_BEGIN(env, @'abort') {
env->values[0] = cl_apply(2, process->process.function,
process->process.args);
{
cl_object output = ECL_NIL;
int i = env->nvalues;
while (i--) {
output = CONS(env->values[i], output);
}
process->process.exit_values = output;
}
process->process.entry(0);
} ECL_RESTART_CASE(1,args) {
/* ABORT restart. */
process->process.exit_values = args;
@ -295,22 +222,36 @@ init_tl_bindings(cl_object process, cl_env_ptr env)
env->bds_stack.tl_bindings = bindings;
}
static cl_object
run_process(cl_narg narg, ...)
{
cl_env_ptr the_env = ecl_process_env();
cl_object process = the_env->own_process;
cl_object fun = process->process.function;
cl_object args = process->process.args;
cl_object output = ECL_NIL;
the_env->values[0] = cl_apply(2, fun, args);
int i = the_env->nvalues;
while (i--) {
output = CONS(the_env->values[i], output);
}
process->process.exit_values = output;
return the_env->values[0];
}
static cl_object
alloc_process(cl_object name, cl_object initial_bindings_p)
{
cl_env_ptr env = ecl_process_env();
cl_object process = ecl_alloc_object(t_process), array;
cl_index bindings_size;
cl_object* bindings;
cl_object process = ecl_alloc_object(t_process);
process->process.phase = ECL_PROCESS_INACTIVE;
process->process.exit_values = ECL_NIL;
process->process.entry = run_process;
process->process.name = name;
process->process.function = ECL_NIL;
process->process.args = ECL_NIL;
process->process.interrupt = ECL_NIL;
process->process.inherit_bindings_p = Null(initial_bindings_p)? ECL_T : ECL_NIL;
process->process.exit_values = ECL_NIL;
process->process.env = NULL;
process->process.woken_up = ECL_NIL;
process->process.inherit_bindings_p = Null(initial_bindings_p)? ECL_T : ECL_NIL;
ecl_disable_interrupts_env(env);
ecl_mutex_init(&process->process.start_stop_lock, TRUE);
ecl_cond_var_init(&process->process.exit_barrier);
@ -322,71 +263,23 @@ alloc_process(cl_object name, cl_object initial_bindings_p)
bool
ecl_import_current_thread(cl_object name, cl_object bindings)
{
struct cl_env_struct env_aux[1];
cl_object process;
ecl_thread_t current;
cl_env_ptr env;
int registered;
struct GC_stack_base stack;
ecl_set_process_self(current);
#ifdef GBC_BOEHM
GC_get_stack_base(&stack);
switch (GC_register_my_thread(&stack)) {
case GC_SUCCESS:
registered = 1;
break;
case GC_DUPLICATE:
/* Thread was probably created using the GC hooks for thread creation. */
registered = 0;
break;
default:
cl_env_ptr the_env;
if (ecl_process_env_unsafe() != NULL)
return 0;
}
#endif
{
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];
if (!Null(p) && ecl_process_eq(p->process.thread, current)) {
return 0;
}
}
}
/* We need a fake env to allow for interrupts blocking and to set up
* frame stacks or other stuff which may be needed by alloc_process
* and ecl_list_process. Since the fake env is allocated on the stack,
* we can safely store pointers to memory allocated by the gc there. */
memset(env_aux, 0, sizeof(*env_aux));
env_aux->disable_interrupts = 1;
env_aux->interrupt_struct = ecl_alloc_unprotected(sizeof(*env_aux->interrupt_struct));
env_aux->interrupt_struct->pending_interrupt = ECL_NIL;
ecl_mutex_init(&env_aux->interrupt_struct->signal_queue_lock, FALSE);
env_aux->interrupt_struct->signal_queue = ECL_NIL;
ecl_set_process_env(env_aux);
ecl_init_env(env_aux);
the_env = ecl_adopt_cpu();
ecl_enable_interrupts_env(the_env);
/* Allocate real environment, link it together with process */
env = _ecl_alloc_env(0);
process = alloc_process(name, ECL_NIL);
process->process.env = env;
process->process.env = the_env;
process->process.phase = ECL_PROCESS_BOOTING;
process->process.thread = current;
/* Copy initial bindings from process to the fake environment */
env_aux->cleanup = registered;
init_tl_bindings(process, env_aux);
/* Switch over to the real environment */
memcpy(env, env_aux, sizeof(*env));
env->own_process = process;
ecl_set_process_env(env);
ecl_list_process(process);
ecl_enable_interrupts_env(env);
init_tl_bindings(process, the_env);
the_env->own_process = process;
process->process.phase = ECL_PROCESS_ACTIVE;
ecl_bds_bind(env, @'mp::*current-process*', process);
ecl_bds_bind(the_env, @'mp::*current-process*', process);
return 1;
}
@ -512,10 +405,6 @@ mp_process_enable(cl_object process)
ok = 0;
process->process.phase = ECL_PROCESS_BOOTING;
process->process.parent = mp_current_process();
process->process.trap_fpe_bits =
process->process.parent->process.env->trap_fpe_bits;
/* Link environment and process together */
process_env = _ecl_alloc_env(the_env);
process_env->own_process = process;
@ -523,13 +412,13 @@ mp_process_enable(cl_object process)
/* Immediately list the process such that its environment is
* marked by the gc when its contents are allocated */
ecl_list_process(process);
ecl_add_process(process);
/* Now we can safely allocate memory for the environment contents
* and store pointers to it in the environment */
ecl_init_env(process_env);
process_env->trap_fpe_bits = process->process.trap_fpe_bits;
process_env->trap_fpe_bits = the_env->trap_fpe_bits;
init_tl_bindings(process, process_env);
ecl_disable_interrupts_env(the_env);
@ -539,7 +428,7 @@ mp_process_enable(cl_object process)
DWORD threadId;
code = (HANDLE)CreateThread(NULL, 0, thread_entry_point, process, 0, &threadId);
ok = (process->process.thread = code) != NULL;
ok = (process_env->thread = code) != NULL;
}
#else
{
@ -560,12 +449,12 @@ mp_process_enable(cl_object process)
sigdelset(&new, SIGSEGV);
sigdelset(&new, SIGBUS);
pthread_sigmask(SIG_BLOCK, &new, &previous);
code = pthread_create(&process->process.thread, &pthreadattr,
code = pthread_create(&process_env->thread, &pthreadattr,
thread_entry_point, process);
pthread_sigmask(SIG_SETMASK, &previous, NULL);
}
#else
code = pthread_create(&process->process.thread, &pthreadattr,
code = pthread_create(&process_env->thread, &pthreadattr,
thread_entry_point, process);
#endif
ok = (code == 0);
@ -576,7 +465,7 @@ mp_process_enable(cl_object process)
if (!ok) {
/* INV: interrupts are already disabled through thread safe
* unwind-protect */
ecl_unlist_process(process);
ecl_del_process(process);
process->process.phase = ECL_PROCESS_INACTIVE;
/* Alert possible waiting processes. */
ecl_cond_var_broadcast(&process->process.exit_barrier);
@ -668,8 +557,7 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...)
ecl_va_start(args, function, narg, 2);
rest = cl_grab_rest_args(args);
ecl_va_end(args);
cl_apply(4, @'mp::process-preset', process, function,
rest);
cl_apply(4, @'mp::process-preset', process, function, rest);
return mp_process_enable(process);
}
@ -758,7 +646,7 @@ void
init_threads()
{
cl_env_ptr the_env = ecl_process_env();
cl_object process;
cl_object process, _env = ecl_cast_ptr(cl_object,the_env);
ecl_thread_t main_thread;
/* We have to set the environment before any allocation takes place,
* so that the interrupt handling code works. */
@ -769,20 +657,10 @@ init_threads()
process->process.name = @'si::top-level';
process->process.function = ECL_NIL;
process->process.args = ECL_NIL;
process->process.thread = main_thread;
process->process.env = the_env;
process->process.woken_up = ECL_NIL;
ecl_mutex_init(&process->process.start_stop_lock, TRUE);
ecl_cond_var_init(&process->process.exit_barrier);
the_env->thread = main_thread;
the_env->own_process = process;
{
cl_object v = si_make_vector(ECL_T, /* Element type */
ecl_make_fixnum(256), /* Size */
ecl_make_fixnum(0), /* fill pointer */
ECL_NIL, ECL_NIL, ECL_NIL);
v->vector.self.t[0] = process;
v->vector.fillp = 1;
ecl_core.processes = v;
}
ecl_stack_push(ecl_core.threads, _env);
}

81
src/c/unixint.d
View file

@ -265,8 +265,8 @@ static void early_signal_error() ecl_attr_noreturn;
static void
early_signal_error()
{
ecl_internal_error("Got signal before environment was installed"
" on our thread");
ecl_internal_error
("Got signal before environment was installed on our thread");
}
static void illegal_signal_code(cl_object code) ecl_attr_noreturn;
@ -869,7 +869,7 @@ cl_object
si_check_pending_interrupts(void)
{
const cl_env_ptr the_env = ecl_process_env();
handle_all_queued(ecl_process_env());
handle_all_queued(the_env);
ecl_return0(the_env);
}
@ -950,8 +950,7 @@ do_catch_signal(int code, cl_object action, cl_object process)
}
return ECL_T;
} else {
FEerror("Unknown 2nd argument to EXT:CATCH-SIGNAL: ~A", 1,
action);
FEerror("Unknown 2nd argument to EXT:CATCH-SIGNAL: ~A", 1, action);
}
}
@ -992,19 +991,16 @@ si_set_signal_handler(cl_object code, cl_object handler)
# ifdef SIGSEGV
unlikely_if ((code == ecl_make_fixnum(SIGSEGV)) &&
ecl_option_values[ECL_OPT_INCREMENTAL_GC])
FEerror("It is not allowed to change the behavior of SIGSEGV.",
0);
FEerror("It is not allowed to change the behavior of SIGSEGV.", 0);
# endif
# ifdef SIGBUS
unlikely_if (code_int == SIGBUS)
FEerror("It is not allowed to change the behavior of SIGBUS.",
0);
FEerror("It is not allowed to change the behavior of SIGBUS.", 0);
# endif
#endif
#if defined(ECL_THREADS) && !defined(ECL_MS_WINDOWS_HOST)
unlikely_if (code_int == ecl_option_values[ECL_OPT_THREAD_INTERRUPT_SIGNAL]) {
FEerror("It is not allowed to change the behavior of signal ~D", 1,
code);
FEerror("It is not allowed to change the behavior of signal ~D", 1, code);
}
#endif
#ifdef SIGFPE
@ -1036,40 +1032,34 @@ wakeup_noop(ULONG_PTR foo)
static bool
do_interrupt_thread(cl_object process)
{
cl_env_ptr process_env = process->process.env;
# ifdef ECL_WINDOWS_THREADS
# ifndef ECL_USE_GUARD_PAGE
# error "Cannot implement ecl_interrupt_process without guard pages"
# endif
HANDLE thread = process->process.thread;
HANDLE thread = process_env->thread;
CONTEXT context;
void *trap_address = process->process.env;
void *trap_address = ecl_cast_ptr(void*, process_env);;
DWORD guard = PAGE_GUARD | PAGE_READWRITE;
int ok = 1;
if (SuspendThread(thread) == (DWORD)-1) {
FEwin32_error("Unable to suspend thread ~A", 1,
process);
FEwin32_error("Unable to suspend thread ~A", 1, process);
ok = 0;
goto EXIT;
}
process->process.interrupt = ECL_T;
if (!VirtualProtect(process->process.env,
sizeof(struct cl_env_struct),
guard,
&guard))
process_env->interrupt_struct->inside_interrupt = true;
if (!VirtualProtect(process_env, sizeof(struct cl_env_struct), guard, &guard))
{
FEwin32_error("Unable to protect memory from thread ~A",
1, process);
FEwin32_error("Unable to protect memory from thread ~A", 1, process);
ok = 0;
}
RESUME:
if (!QueueUserAPC(wakeup_function, thread, 0)) {
FEwin32_error("Unable to queue APC call to thread ~A",
1, process);
FEwin32_error("Unable to queue APC call to thread ~A", 1, process);
ok = 0;
}
if (ResumeThread(thread) == (DWORD)-1) {
FEwin32_error("Unable to resume thread ~A", 1,
process);
FEwin32_error("Unable to resume thread ~A", 1, process);
ok = 0;
goto EXIT;
}
@ -1077,9 +1067,8 @@ do_interrupt_thread(cl_object process)
return ok;
# else
int signal = ecl_option_values[ECL_OPT_THREAD_INTERRUPT_SIGNAL];
if (pthread_kill(process->process.thread, signal)) {
FElibc_error("Unable to interrupt process ~A", 1,
process);
if (pthread_kill(process_env->thread, signal)) {
FElibc_error("Unable to interrupt process ~A", 1, process);
}
return 1;
# endif
@ -1120,10 +1109,10 @@ void
ecl_wakeup_process(cl_object process)
{
# ifdef ECL_WINDOWS_THREADS
HANDLE thread = process->process.thread;
cl_env_ptr process_env = process->process.env;
HANDLE thread = process_env->thread;
if (!QueueUserAPC(wakeup_noop, thread, 0)) {
FEwin32_error("Unable to queue APC call to thread ~A",
1, process);
FEwin32_error("Unable to queue APC call to thread ~A", 1, process);
}
# else
do_interrupt_thread(process);
@ -1145,9 +1134,8 @@ _ecl_w32_exception_filter(struct _EXCEPTION_POINTERS* ep)
{
/* Access to guard page */
case STATUS_GUARD_PAGE_VIOLATION: {
cl_object process = the_env->own_process;
if (!Null(process->process.interrupt)) {
process->process.interrupt = ECL_NIL;
if(the_env->interrupt_struct->inside_interrupt) {
the_env->interrupt_struct->inside_interrupt = false;
handle_all_queued_interrupt_safe(the_env);
}
return EXCEPTION_CONTINUE_EXECUTION;
@ -1207,8 +1195,7 @@ static cl_object
W32_handle_in_new_thread(cl_object signal_code)
{
int outside_ecl = ecl_import_current_thread(@'si::handle-signal', ECL_NIL);
mp_process_run_function(3, @'si::handle-signal',
@'si::handle-signal',
mp_process_run_function(3, @'si::handle-signal', @'si::handle-signal',
signal_code);
if (outside_ecl) ecl_release_current_thread();
}
@ -1356,19 +1343,13 @@ install_signal_handling_thread()
ecl_process_env()->default_sigmask = &main_thread_sigmask;
if (ecl_option_values[ECL_OPT_SIGNAL_HANDLING_THREAD]) {
cl_object fun =
ecl_make_cfun((cl_objectfn_fixed)
asynchronous_signal_servicing_thread,
@'si::signal-servicing',
ECL_NIL,
0);
ecl_make_cfun((cl_objectfn_fixed) asynchronous_signal_servicing_thread,
@'si::signal-servicing', ECL_NIL, 0);
cl_object process =
signal_thread_process =
mp_process_run_function_wait(2,
@'si::signal-servicing',
fun);
mp_process_run_function_wait(2, @'si::signal-servicing', fun);
if (Null(process)) {
ecl_internal_error("Unable to create signal "
"servicing thread");
ecl_internal_error("Unable to create signal servicing thread.");
}
}
#endif
@ -1416,8 +1397,7 @@ install_synchronous_signal_handlers()
int signal = ecl_option_values[ECL_OPT_THREAD_INTERRUPT_SIGNAL];
if (signal == 0) {
signal = DEFAULT_THREAD_INTERRUPT_SIGNAL;
ecl_set_option(ECL_OPT_THREAD_INTERRUPT_SIGNAL,
signal);
ecl_set_option(ECL_OPT_THREAD_INTERRUPT_SIGNAL, signal);
}
mysignal(signal, process_interrupt_handler);
#ifdef HAVE_SIGPROCMASK
@ -1479,8 +1459,7 @@ create_signal_code_constants()
int i;
for (i = 0; known_signals[i].code >= 0; i++) {
add_one_signal(hash, known_signals[i].code,
_ecl_intern(known_signals[i].name,
cl_core.ext_package),
_ecl_intern(known_signals[i].name, cl_core.ext_package),
known_signals[i].handler);
}
#ifdef SIGRTMIN

6
src/h/external.h
View file

@ -99,7 +99,8 @@ struct cl_env_struct {
/* -- System Processes (native threads) ------------------------------ */
#ifdef ECL_THREADS
cl_object own_process; /* Backpointer to the host process. */
cl_object own_process; /* Backpointer to the running process. */
ecl_thread_t thread;
int cleanup;
#endif
@ -151,6 +152,9 @@ struct ecl_interrupt_struct {
#ifdef ECL_THREADS
ecl_mutex_t signal_queue_lock;
#endif
#ifdef ECL_WINDOWS_THREADS
bool inside_interrupt;
#endif
};
#ifndef __GNUC__

9
src/h/nucleus.h
View file

@ -9,7 +9,7 @@
struct ecl_core_struct {
cl_env_ptr first_env;
#ifdef ECL_THREADS
cl_object processes;
cl_object threads;
ecl_mutex_t processes_lock;
ecl_mutex_t global_lock;
ecl_mutex_t error_lock;
@ -33,6 +33,13 @@ struct ecl_core_struct {
cl_object library_pathname;
};
/* process.c */
cl_env_ptr ecl_adopt_cpu();
cl_env_ptr ecl_spawn_cpu();
void ecl_add_process(cl_object process);
void ecl_del_process(cl_object process);
/* control.c */
cl_object ecl_escape(cl_object continuation) ecl_attr_noreturn;
cl_object ecl_signal(cl_object condition, cl_object returns, cl_object thread);

9
src/h/object.h
View file

@ -1023,19 +1023,16 @@ enum {
struct ecl_process {
_ECL_HDR;
cl_object name;
cl_object exit_values;
cl_objectfn entry; /* entry address (matches ecl_cfun offset) */
cl_object function;
cl_object args;
struct cl_env_struct *env;
cl_object interrupt;
cl_object inherit_bindings_p;
cl_object parent;
cl_object exit_values;
cl_object woken_up;
ecl_mutex_t start_stop_lock; /* phase is updated only when we hold this lock */
ecl_cond_var_t exit_barrier; /* process-join waits on this barrier */
cl_index phase;
ecl_thread_t thread;
int trap_fpe_bits;
struct cl_env_struct *env;
};
enum {