diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d index aca9cdaf7..01859ff34 100644 --- a/src/c/all_symbols.d +++ b/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; diff --git a/src/c/main.d b/src/c/main.d index 3e1dfca62..a1e8eddd7 100644 --- a/src/c/main.d +++ b/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 diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index a74ee3280..ff0b5ada9 100644 --- a/src/c/symbols_list.h +++ b/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 */ diff --git a/src/c/threads.d b/src/c/threads.d index 9630c8f2c..1c84cffaf 100644 --- a/src/c/threads.d +++ b/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; diff --git a/src/c/typespec.d b/src/c/typespec.d index f0dff0a24..450ab451f 100644 --- a/src/c/typespec.d +++ b/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"); diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp index 8a2c7cd33..010703ecc 100644 --- a/src/clos/builtin.lsp +++ b/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))) diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp index 2f38135fe..6cb30051e 100644 --- a/src/clos/kernel.lsp +++ b/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) diff --git a/src/h/external.h b/src/h/external.h index e9ecd876f..ee94bbd50 100644 --- a/src/h/external.h +++ b/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 diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp index ab563b2f9..f56eb96c6 100644 --- a/src/lsp/autoload.lsp +++ b/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)))) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 79bf7dea3..369c7ee3d 100644 --- a/src/lsp/predlib.lsp +++ b/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))