Importing of C threads into the lisp world

msvc/ecl-threads.def

@@ -1092,7 +1092,8 @@ EXPORTS
 	bds_bind
 	ecl_symbol_slot
 	ecl_set_symbol
-
+	ecl_import_current_thread
+	ecl_release_current_thread
 
 	; time.c
 

src/CHANGELOG

@@ -37,6 +37,13 @@ ECL 0.9h
 
  - ECL's own conservative garbage collector works again.
 
+ - It is possible now to execute lisp code from threads that have been created
+   by external C applications. The functions
+	ecl_import_current_thread(cl_object name, cl_object bindings)
+   should be called to register the current thread with the lisp world, while
+	ecl_release_current_thread()
+   should be invoked before the current thread exits.
+
 * Visible changes:
 
  - The code for handling command line options has been redesigned. Now multiple

src/c/threads.d

@@ -113,6 +113,26 @@ thread_entry_point(cl_object process)
 	return NULL;
 }
 
+void
+ecl_import_current_thread(cl_object name, cl_object bindings)
+{
+	cl_object process = mp_make_process(4, @':name', name, @':initial-bindings', bindings);
+#ifdef WITH___THREAD
+	cl_env_p = process->process.env;
+#else
+	if (pthread_setspecific(cl_env_key, process->process.env))
+		FElibc_error("pthread_setcspecific() failed.", 0);
+#endif
+	ecl_init_env(&cl_env);
+        init_big_registers();
+}
+
+void
+ecl_release_current_thread(void)
+{
+	thread_cleanup(&cl_env);
+}
+
 @(defun mp::make-process (&key name ((:initial-bindings initial_bindings) Ct))
 	cl_object process;
 	cl_object hash;

src/c/threads_win32.d

@@ -105,10 +105,29 @@ thread_entry_point(cl_object process)
 	/* 3) If everything went right, we should be exiting the thread
 	 *    through this point.
 	 */
-	thread_cleanup(TlsGetValue(cl_env_key));
+	thread_cleanup(&cl_env);
 	return 1;
 }
 
+void
+ecl_import_current_thread(cl_object name, cl_object bindings)
+{
+	cl_object process = mp_make_process(4, @':name', name, @':initial-bindings', bindings);
+#ifdef WITH___THREAD
+	cl_env_p = process->process.env;
+#else
+	TlsSetValue(cl_env_key, (void *)process->process.env);
+#endif
+	ecl_init_env(&cl_env);
+        init_big_registers();
+}
+
+void
+ecl_release_current_thread(void)
+{
+	thread_cleanup(&cl_env);
+}
+
 @(defun mp::make-process (&key name ((:initial-bindings initial_bindings) Ct))
 	cl_object process;
 	cl_object hash;

src/h/external.h

@@ -1381,6 +1381,9 @@ extern cl_object mp_process_whostate(cl_object process);
 extern cl_object mp_make_lock _ARGS((cl_narg narg, ...));
 extern cl_object mp_get_lock _ARGS((cl_narg narg, cl_object lock, ...));
 extern cl_object mp_giveup_lock(cl_object lock);
+
+extern void ecl_import_current_thread(cl_object process_name, cl_object process_binding);
+extern void ecl_release_current_thread(void);
 #endif