From e1d3382279e536d0a5e45195dfebfa21bb830d81 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Wed, 12 Oct 2005 09:22:09 +0000
Subject: [PATCH] Importing of C threads into the lisp world

---
 msvc/ecl-threads.def  |  3 ++-
 src/CHANGELOG         |  7 +++++++
 src/c/threads.d       | 20 ++++++++++++++++++++
 src/c/threads_win32.d | 21 ++++++++++++++++++++-
 src/h/external.h      |  3 +++
 5 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/msvc/ecl-threads.def b/msvc/ecl-threads.def
index ce137ccf3..abf99e0a7 100755
--- a/msvc/ecl-threads.def
+++ b/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
 
diff --git a/src/CHANGELOG b/src/CHANGELOG
index ab8440de9..340cd3464 100644
--- a/src/CHANGELOG
+++ b/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
diff --git a/src/c/threads.d b/src/c/threads.d
index 14827287f..cdfd194cf 100644
--- a/src/c/threads.d
+++ b/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;
diff --git a/src/c/threads_win32.d b/src/c/threads_win32.d
index 303a24285..d148a4840 100644
--- a/src/c/threads_win32.d
+++ b/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;
diff --git a/src/h/external.h b/src/h/external.h
index e54c43cd1..940a64995 100644
--- a/src/h/external.h
+++ b/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