windows: when using msvc, don't handle interrupts

Installed spawning process was broken and unimportant. ECL ignores C-c
interrupt and passes forward all the others when build with
msvc. Fixes #8.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
This commit is contained in:
Daniel Kochmański 2015-08-21 19:43:27 +02:00
parent f14083e14e
commit 2f869e6eb6
3 changed files with 4 additions and 110 deletions

View file

@ -330,95 +330,6 @@ alloc_process(cl_object name, cl_object initial_bindings)
return process;
}
bool
ecl_import_current_thread(cl_object name, cl_object bindings)
{
struct cl_env_struct env_aux[1];
cl_object process;
pthread_t current;
cl_env_ptr env;
int registered;
struct GC_stack_base stack;
#ifdef ECL_WINDOWS_THREADS
{
HANDLE aux = GetCurrentThread();
DuplicateHandle(GetCurrentProcess(),
aux,
GetCurrentProcess(),
&current,
0,
FALSE,
DUPLICATE_SAME_ACCESS);
CloseHandle(current);
}
#else
current = pthread_self();
#endif
#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:
return 0;
}
#endif
{
cl_object processes = cl_core.processes;
cl_index i, size;
for (i = 0, size = processes->vector.dim; i < size; i++) {
cl_object p = processes->vector.self.t[i];
if (!Null(p) && p->process.thread == current)
return 0;
}
}
/* We need a fake env to allow for interrupts blocking. */
env_aux->disable_interrupts = 1;
ecl_set_process_env(env_aux);
env = _ecl_alloc_env(0);
ecl_set_process_env(env);
env->cleanup = registered;
/* Link environment and process together */
env->own_process = process = alloc_process(name, bindings);
process->process.env = env;
process->process.phase = ECL_PROCESS_BOOTING;
process->process.thread = current;
ecl_list_process(process);
ecl_init_env(env);
env->bindings_array = process->process.initial_bindings;
env->thread_local_bindings_size = env->bindings_array->vector.dim;
env->thread_local_bindings = env->bindings_array->vector.self.t;
ecl_enable_interrupts_env(env);
/* Activate the barrier so that processes can immediately start waiting. */
mp_barrier_unblock(1, process->process.exit_barrier);
process->process.phase = ECL_PROCESS_ACTIVE;
ecl_bds_bind(env, @'mp::*current-process*', process);
return 1;
}
void
ecl_release_current_thread(void)
{
cl_env_ptr env = ecl_process_env();
int cleanup = env->cleanup;
thread_cleanup(env->own_process);
#ifdef GBC_BOEHM
if (cleanup) {
GC_unregister_my_thread();
}
#endif
}
@(defun mp::make-process (&key name ((:initial-bindings initial_bindings) ECL_T))
cl_object process;
@

View file

@ -1116,29 +1116,14 @@ _ecl_w32_exception_filter(struct _EXCEPTION_POINTERS* ep)
return excpt_result;
}
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(4, @'si::handle-signal',
@'si::handle-signal',
signal_code, ECL_NIL);
if (outside_ecl) ecl_release_current_thread();
}
BOOL WINAPI W32_console_ctrl_handler(DWORD type)
{
switch (type)
{
/* Catch CTRL-C */
case CTRL_C_EVENT: {
cl_object function = ECL_SYM_FUN(@'si::terminal-interrupt');
if (function)
W32_handle_in_new_thread(function);
switch (type) {
case CTRL_C_EVENT: /* Catch CTRL-C (ignore interrupt) */
return TRUE;
default:
return FALSE;
}
}
return FALSE;
}
#endif /* ECL_WINDOWS_THREADS */

View file

@ -1726,8 +1726,6 @@ extern ECL_API cl_object mp_current_process(void);
extern ECL_API cl_object mp_block_signals(void);
extern ECL_API cl_object mp_restore_signals(cl_object sigmask);
extern ECL_API bool ecl_import_current_thread(cl_object process_name, cl_object process_binding);
extern ECL_API void ecl_release_current_thread(void);
/* threads/semaphore.d */