regression: add back removed interfaces

Adds back ecl_import_current_thread and ecl_release_current_thread.
Closes #8.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
This commit is contained in:
Daniel Kochmański 2015-09-04 21:29:08 +02:00
parent 0df10e8b8d
commit 0d25eccfb8
2 changed files with 91 additions and 0 deletions

View file

@ -332,6 +332,95 @@ 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

@ -1728,6 +1728,8 @@ 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 */