Implement a more 'standard' interface for creating processes.

src/c/all_symbols.d

@@ -9,6 +9,8 @@
 #define SI_SPECIAL 5
 #define KEYWORD 10
 #define FORM_ORDINARY 16
+#define MP_ORDINARY 12
+#define MP_SPECIAL 13
 
 #include "symbols_list.h"
 
@@ -151,6 +153,9 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
 	case 0: package = cl_core.lisp_package; break;
 	case 4: package = cl_core.system_package; break;
 	case 8: package = cl_core.keyword_package; break;
+#ifdef ECL_THREADS
+	case 12: package = cl_core.mp_package; break;
+#endif
 	}
 	s->symbol.t = t_symbol;
 	s->symbol.dynamic = 0;

src/c/main.d

@@ -170,6 +170,11 @@ cl_boot(int argc, char **argv)
 	cl_core.tk_package = make_package(make_simple_string("TK"),
 					  Cnil, CONS(cl_core.lisp_package, Cnil));
 #endif
+#ifdef ECL_THREADS
+	cl_core.mp_package = make_package(make_simple_string("MP"),
+					  CONS(make_simple_string("MULTIPROCESSING"), Cnil),
+					  CONS(cl_core.lisp_package, Cnil));
+#endif
 
 	Cnil->symbol.hpack = cl_core.lisp_package;
 	cl_import2(Cnil, cl_core.lisp_package);
@@ -234,7 +239,7 @@ cl_boot(int argc, char **argv)
 	process->process.thread = NULL;
 	process->process.function = Cnil;
 	process->process.args = Cnil;
-	ECL_SET(@'si::*current-process*', process);
+	ECL_SET(@'mp::*current-process*', process);
 	cl_core.processes = CONS(process, Cnil);
 	}
 #endif

src/c/symbols_list.h

@@ -1,5 +1,6 @@
 #ifdef DPP
 #define SYS_ "SI::"
+#define MP_ "MP::"
 #define KEY_ ":"
 struct {
 	const char *name, *translation;
@@ -9,6 +10,7 @@ struct {
 extern cl_object si_formatter_aux _ARGS((int narg, cl_object strm, cl_object string, ...));
 #endif
 #define SYS_
+#define MP_
 #define KEY_
 cl_symbol_initializer
 #endif
@@ -1347,19 +1349,23 @@ cl_symbols[] = {
 #endif
 
 #ifdef ECL_THREADS
-{SYS_ "PROCESS", CL_ORDINARY, NULL, -1, OBJNULL},
-{SYS_ "MAKE-PROCESS", SI_ORDINARY, si_make_process, -1, OBJNULL},
-{SYS_ "DESTROY-PROCESS", SI_ORDINARY, si_kill_process, 1, OBJNULL},
-{SYS_ "EXIT-PROCESS", SI_ORDINARY, si_exit_process, 0, OBJNULL},
-{SYS_ "ALL-PROCESSES", SI_ORDINARY, si_all_processes, 0, OBJNULL},
-{SYS_ "PROCESS-NAME", SI_ORDINARY, si_process_name, 1, OBJNULL},
-{SYS_ "PROCESS-ACTIVE-P", SI_ORDINARY, si_process_active_p, 1, OBJNULL},
-{SYS_ "PROCESS-WHOSTATE", SI_ORDINARY, si_process_whostate, 1, OBJNULL},
-{SYS_ "LOCK", CL_ORDINARY, NULL, -1, OBJNULL},
-{SYS_ "MAKE-LOCK", CL_ORDINARY, si_make_lock, -1, OBJNULL},
-{SYS_ "GET-LOCK", CL_ORDINARY, si_get_lock, -1, OBJNULL},
-{SYS_ "GIVEUP-LOCK", CL_ORDINARY, si_giveup_lock, 1, OBJNULL},
-{SYS_ "*CURRENT-PROCESS*", CL_SPECIAL, NULL, -1, OBJNULL},
+{MP_ "PROCESS", CL_ORDINARY, NULL, -1, OBJNULL},
+{MP_ "LOCK", CL_ORDINARY, NULL, -1, OBJNULL},
+{MP_ "*CURRENT-PROCESS*", CL_SPECIAL, NULL, -1, OBJNULL},
+{MP_ "ALL-PROCESSES", MP_ORDINARY, mp_all_processes, 0, OBJNULL},
+{MP_ "EXIT-PROCESS", MP_ORDINARY, mp_exit_process, 0, OBJNULL},
+{MP_ "MAKE-PROCESS", MP_ORDINARY, mp_make_process, -1, OBJNULL},
+{MP_ "PROCESS-ACTIVE-P", MP_ORDINARY, mp_process_active_p, 1, OBJNULL},
+{MP_ "PROCESS-ENABLE", MP_ORDINARY, mp_process_enable, 1, OBJNULL},
+{MP_ "PROCESS-KILL", MP_ORDINARY, mp_process_kill, 1, OBJNULL},
+{MP_ "PROCESS-NAME", MP_ORDINARY, mp_process_name, 1, OBJNULL},
+{MP_ "PROCESS-PRESET", MP_ORDINARY, mp_process_preset, -1, OBJNULL},
+{MP_ "PROCESS-RUN-FUNCTION", MP_ORDINARY, mp_process_run_function, -1, OBJNULL},
+{MP_ "PROCESS-WHOSTATE", MP_ORDINARY, mp_process_whostate, 1, OBJNULL},
+{MP_ "MAKE-LOCK", CL_ORDINARY, mp_make_lock, -1, OBJNULL},
+{MP_ "GET-LOCK", CL_ORDINARY, mp_get_lock, -1, OBJNULL},
+{MP_ "GIVEUP-LOCK", CL_ORDINARY, mp_giveup_lock, 1, OBJNULL},
+{KEY_ "INITIAL-BINDINGS", KEYWORD, NULL, -1, OBJNULL},
 #endif
 
 /* Tag for end of list */

src/c/threads.d

@@ -20,7 +20,7 @@ pthread_mutex_t ecl_threads_mutex = PTHREAD_MUTEX_INITIALIZER;
 static struct cl_env_struct cl_envs_array[128];
 static pthread_key_t cl_env_key;
 
-extern void ecl_intt_env(struct cl_env_struct *env);
+extern void ecl_init_env(struct cl_env_struct *env);
 
 struct cl_env_struct *
 ecl_thread_env(void)
@@ -32,6 +32,13 @@ ecl_thread_env(void)
  * THREAD OBJECT
  */
 
+static void
+assert_type_process(cl_object o)
+{
+	if (type_of(o) != t_process)
+		FEwrong_type_argument(@'mp::process', o);
+}
+
 static void
 thread_cleanup(void *env)
 {
@@ -62,7 +69,7 @@ thread_entry_point(cl_object process)
 	ecl_init_env(process->process.env);
 
 	/* 2) Execute the code */
-	bds_bind(@'si::*current-process*', process);
+	bds_bind(@'mp::*current-process*', process);
 	cl_apply(2, process->process.function, process->process.args);
 	bds_unwind1();
 
@@ -71,30 +78,39 @@ thread_entry_point(cl_object process)
 	return NULL;
 }
 
-cl_object
-si_make_process(int narg, cl_object name, cl_object function, ...)
-{
+@(defun mp::make-process (&key name ((:initial-bindings initial_bindings)))
+@
 	cl_object process;
-	cl_va_list args;
-	cl_va_start(args, function, narg, 2);
 
 	process = cl_alloc_object(t_process);
 	process->process.name = name;
-	process->process.function = function;
-	process->process.args = cl_grab_rest_args(args);
+	process->process.function = Cnil;
+	process->process.args = Cnil;
 	process->process.thread = NULL;
 	process->process.env = cl_alloc(sizeof(*process->process.env));
 	process->process.env->bindings_hash =
 		si_copy_hash_table(cl_env.bindings_hash);
-	return si_restart_process(process);
+	@(return process)
+@)
+
+cl_object
+mp_process_preset(int narg, cl_object process, cl_object function, ...)
+{
+	cl_va_list args;
+	cl_va_start(args, function, narg, 2);
+	if (narg < 2)
+		FEwrong_num_arguments(@'mp::process-preset');
+	assert_type_process(process);
+	process->process.function = function;
+	process->process.args = cl_grab_rest_args(args);
+	@(return process)
 }
 
 cl_object
-si_kill_process(cl_object process)
+mp_process_kill(cl_object process)
 {
 	cl_object output = Cnil;
-	if (type_of(process) != t_process)
-		FEwrong_type_argument(@'si::process', process);
+	assert_type_process(process);
 	if (process->process.thread) {
 		if (pthread_cancel(*((pthread_t*)process->process.thread)) == 0)
 			output = Ct;
@@ -103,19 +119,14 @@ si_kill_process(cl_object process)
 }
 
 cl_object
-si_exit_process(void)
-{
-	pthread_exit(NULL);
-}
-
-cl_object
-si_restart_process(cl_object process)
+mp_process_enable(cl_object process)
 {
 	pthread_t *posix_thread;
 	int code;
 
-	if (type_of(process) != t_process)
-		FEwrong_type_argument(@'si::process', process);
+	assert_type_process(process);
+	if (process->process.thread != NULL)
+		FEerror("Cannot enable the running process ~A.", 1, process);
 	posix_thread = cl_alloc_atomic(sizeof(*posix_thread));
 	process->process.thread = posix_thread;
 	pthread_mutex_lock(&ecl_threads_mutex);
@@ -129,43 +140,62 @@ si_restart_process(cl_object process)
 }
 
 cl_object
-si_all_processes(void)
+mp_exit_process(void)
+{
+	pthread_exit(NULL);
+}
+
+cl_object
+mp_all_processes(void)
 {
 	@(return cl_copy_list(cl_core.processes))
 }
 
 cl_object
-si_process_name(cl_object process)
+mp_process_name(cl_object process)
 {
-	if (type_of(process) != t_process)
-		FEwrong_type_argument(@'si::process', process);
+	assert_type_process(process);
 	@(return process->process.name)
 }
 
 cl_object
-si_process_active_p(cl_object process)
+mp_process_active_p(cl_object process)
 {
-	/* FIXME! */
-	if (type_of(process) != t_process)
-		FEwrong_type_argument(@'si::process', process);
-	@(return (process->process.thread != NULL? Ct : Cnil))
+	assert_type_process(process);
+	@(return ((process->process.thread == NULL)? Cnil : Ct))
 }
 
 cl_object
-si_process_whostate(cl_object process)
+mp_process_whostate(cl_object process)
 {
-	/* FIXME! */
-	if (type_of(process) != t_process)
-		FEwrong_type_argument(@'si::process', process);
+	assert_type_process(process);
 	@(return (cl_core.null_string))
 }
 
+cl_object
+mp_process_run_function(int narg, cl_object name, cl_object function, ...)
+{
+	cl_object process;
+	cl_va_list args;
+	cl_va_start(args, function, narg, 2);
+	if (narg < 2)
+		FEwrong_num_arguments(@'mp::process-run-function');
+	if (CONSP(name)) {
+		process = cl_apply(2, @'mp::make-process', name);
+	} else {
+		process = mp_make_process(2, @':name', name);
+	}
+	cl_apply(4, @'mp::process-preset', process, function,
+		 cl_grab_rest_args(args));
+	return mp_process_enable(process);
+}
+
 
 /*----------------------------------------------------------------------
  * LOCKS or MUTEX
  */
 
-@(defun si::make-lock (&key name)
+@(defun mp::make-lock (&key name)
 @
 	cl_object output = cl_alloc_object(t_lock);
 	output->lock.name = name;
@@ -175,19 +205,19 @@ si_process_whostate(cl_object process)
 @)
 
 cl_object
-si_giveup_lock(cl_object lock)
+mp_giveup_lock(cl_object lock)
 {
 	if (type_of(lock) != t_lock)
-		FEwrong_type_argument(@'si::lock', lock);
+		FEwrong_type_argument(@'mp::lock', lock);
 	pthread_mutex_unlock(lock->lock.mutex);
 	@(return Ct)
 }
 
-@(defun si::get-lock (lock &optional (wait Ct))
+@(defun mp::get-lock (lock &optional (wait Ct))
 	cl_object output;
 @
 	if (type_of(lock) != t_lock)
-		FEwrong_type_argument(@'si::lock', lock);
+		FEwrong_type_argument(@'mp::lock', lock);
 	if (wait == Ct) {
 		pthread_mutex_lock(lock->lock.mutex);
 		output = Ct;

src/c/typespec.d

@@ -351,9 +351,9 @@ cl_type_of(cl_object x)
 #endif
 #ifdef ECL_THREADS
 	case t_process:
-		t = @'si::process'; break;
+		t = @'mp::process'; break;
 	case t_lock:
-		t = @'si::lock'; break;
+		t = @'mp::lock'; break;
 #endif
 	default:
 		error("not a lisp data object");

src/clos/builtin.lsp

@@ -130,5 +130,5 @@
 	    (hash-table)
 	    (random-state)
 	    (readtable)
-	    #+threads (si::process)
-	    #+threads (si::lock)))
+	    #+threads (mp::process)
+	    #+threads (mp::lock)))

src/clos/kernel.lsp

@@ -142,7 +142,7 @@
 	(SIMPLE-VECTOR (find-class 'vector))
 	(SIMPLE-BIT-VECTOR (find-class 'bit-vector))
 	(SIMPLE-STRING (find-class 'string))
-	((SI::PROCESS SI::LOCK) (find-class type))
+	((MP::PROCESS MP::LOCK) (find-class type))
 	(otherwise (find-class 't)))))
 
 (defun classp (obj)

src/h/external.h

@@ -129,6 +129,9 @@ struct cl_core_struct {
 	cl_object system_package;
 #ifdef CLOS
 	cl_object clos_package;
+#endif
+#ifdef ECL_THREADS
+	cl_object mp_package;
 #endif
 	cl_object packages_to_be_created;
 
@@ -1315,17 +1318,19 @@ extern cl_object make_stream(cl_object host, int fd, enum ecl_smmode smm);
 /* threads.c */
 
 #ifdef ECL_THREADS
-extern cl_object si_make_process _ARGS((int narg, cl_object name, cl_object function, ...));
-extern cl_object si_kill_process(cl_object thread);
-extern cl_object si_exit_process(void) __attribute__((noreturn));
-extern cl_object si_restart_process(cl_object process);
-extern cl_object si_all_processes(void);
-extern cl_object si_process_name(cl_object process);
-extern cl_object si_process_active_p(cl_object process);
-extern cl_object si_process_whostate(cl_object process);
-extern cl_object si_make_lock _ARGS((int narg, ...));
-extern cl_object si_get_lock _ARGS((int narg, cl_object lock, ...));
-extern cl_object si_giveup_lock(cl_object lock);
+extern cl_object mp_all_processes(void);
+extern cl_object mp_exit_process(void) __attribute__((noreturn));
+extern cl_object mp_make_process _ARGS((int narg, ...));
+extern cl_object mp_process_active_p(cl_object process);
+extern cl_object mp_process_enable(cl_object process);
+extern cl_object mp_process_kill(cl_object process);
+extern cl_object mp_process_name(cl_object process);
+extern cl_object mp_process_preset _ARGS((int narg, cl_object process, cl_object function, ...));
+extern cl_object mp_process_run_function _ARGS((int narg, cl_object name, cl_object function, ...));
+extern cl_object mp_process_whostate(cl_object process);
+extern cl_object mp_make_lock _ARGS((int narg, ...));
+extern cl_object mp_get_lock _ARGS((int narg, cl_object lock, ...));
+extern cl_object mp_giveup_lock(cl_object lock);
 #endif
 
 

src/lsp/autoload.lsp

@@ -113,7 +113,7 @@ number is zero.  The optional X is simply ignored."
 			stream random-state readtable pathname
 			bytecodes cfun cclosure
 			#-clos structure #+clos instance #+clos generic-function
-			#+threads si::process #+threads si::lock
+			#+threads mp::process #+threads mp::lock
 			#+ffi si::foreign))
 	   (tl type-list (cdr tl))
 	   (i 0 (+ i (if (nth 2 l) (nth 2 l) 0))))

src/lsp/predlib.lsp

@@ -1068,8 +1068,8 @@ if not possible."
 			   FILE-STREAM STRING-STREAM SYNONYM-STREAM TWO-WAY-STREAM))
 
 	       (READTABLE)
-	       #+threads (SI::PROCESS)
-	       #+threads (SI::LOCK)
+	       #+threads (MP::PROCESS)
+	       #+threads (MP::LOCK)
 	       ))
     (let* ((type (first i))
 	   (alias (second i))