From: Daniel Kochmański <daniel@turtleware.eu>
Date: Fri, 4 Sep 2015 19:29:08 +0000 (+0200)
Subject: regression: add back removed interfaces
X-Git-Url: http://git.pulsar-zone.net/?a=commitdiff_plain;h=0d25eccfb881eff7dfd3bbdae496b23ae9b71452;p=ecl.git

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>
---

diff --git a/src/c/threads/process.d b/src/c/threads/process.d
index 6bd9398..57b00f5 100755
--- a/src/c/threads/process.d
+++ b/src/c/threads/process.d
@@ -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;
 @
diff --git a/src/h/external.h b/src/h/external.h
index d74469c..6a53588 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -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 */