diff --git a/src/aclocal.m4 b/src/aclocal.m4 index 71953d534..a106f61a5 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -841,3 +841,28 @@ case "${host_cpu}" in esac AC_SUBST(ECL_FPE_CODE) ]) + +dnl ---------------------------------------------------------------------- +dnl Check whether we have unnamed POSIX semaphores available +AC_DEFUN([ECL_POSIX_SEMAPHORES], +[AC_MSG_CHECKING(working sem_init()) +AC_RUN_IFELSE([AC_LANG_SOURCE([[ +#ifdef HAVE_SEMAPHORE_H +#include +int main() { + sem_t aux; + if (sem_init(&aux, 0, 0)) + exit(1); + exit(0); +#else +int main() { + exit(1); +} +#endif +}]])],[working_sem_init=yes],[working_sem_init=no],[]) +AC_MSG_RESULT([$working_sem_init]) +if test $working_sem_init = yes ; then + AC_DEFINE(ECL_SEMAPHORES) + AC_DEFINE(HAVE_SEM_INIT) +fi +]) diff --git a/src/c/alloc.d b/src/c/alloc.d index 8f9709a5f..9b017d3e4 100644 --- a/src/c/alloc.d +++ b/src/c/alloc.d @@ -405,6 +405,11 @@ ONCE_MORE: obj->condition_variable.cv = OBJNULL; break; #endif +#ifdef ECL_SEMAPHORES + case t_semaphore: + obj->semaphore.handle = NULL; + break; +#endif #ifdef CLOS case t_instance: obj->instance.length = 0; @@ -758,6 +763,10 @@ init_alloc(void) init_tm(t_condition_variable, "tCONDITION-VARIABLE", sizeof(struct ecl_condition_variable), 2); #endif /* THREADS */ +#ifdef ECL_SEMAPHORES + init_tm(t_semaphore, "tSEMAPHORE", + sizeof(struct ecl_semaphore), 2); +#endif #ifdef ECL_LONG_FLOAT init_tm(t_longfloat, "tLONGFLOAT", sizeof(struct ecl_long_float), 2); #endif diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 51096bba1..96367ab9f 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -188,6 +188,9 @@ ecl_alloc_object(cl_type t) case t_process: case t_lock: case t_condition_variable: +#endif +#ifdef ECL_SEMAPHORES: + case t_semaphores: #endif case t_foreign: case t_codeblock: { @@ -422,6 +425,9 @@ init_alloc(void) init_tm(t_condition_variable, "CONDITION-VARIABLE", sizeof(struct ecl_condition_variable)); #endif +#ifdef ECL_SEMAPHORES + init_tm(t_semaphores, "SEMAPHORES", sizeof(struct ecl_semaphores)); +#endif #ifdef ECL_LONG_FLOAT init_tm(t_longfloat, "LONG-FLOAT", sizeof(struct ecl_long_float)); #endif @@ -477,6 +483,12 @@ standard_finalizer(cl_object o) ecl_enable_interrupts_env(the_env); break; } +#endif +#ifdef ECL_SEMAPHORES + case t_semaphore: { + mp_semaphore_close(o); + break; + } #endif default:; } diff --git a/src/c/gbc.d b/src/c/gbc.d index d8c64efda..e3acef483 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -391,6 +391,10 @@ BEGIN: case t_condition_variable: break; #endif /* THREADS */ +#ifdef ECL_SEMAPHORES + case t_semaphore: + break; +#endif #ifdef CLOS case t_instance: mark_object(x->instance.clas); @@ -670,6 +674,11 @@ sweep_phase(void) pthread_cond_destroy(&x->condition_variable.cv); #endif break; +#endif +#ifdef ECL_SEMAPHORES + case t_semaphore: +#error "Unfinished" + break; #endif default:; } diff --git a/src/c/instance.d b/src/c/instance.d index 6a07d1e71..d54183ca2 100644 --- a/src/c/instance.d +++ b/src/c/instance.d @@ -262,6 +262,9 @@ enum ecl_built_in_classes { ECL_BUILTIN_LOCK, ECL_BUILTIN_CONDITION_VARIABLE #endif +#ifdef ECL_SEMAPHORES + , ECL_BUILTIN_SEMAPHORE +#endif }; cl_object @@ -350,6 +353,10 @@ cl_class_of(cl_object x) index = ECL_BUILTIN_LOCK; break; case t_condition_variable: index = ECL_BUILTIN_CONDITION_VARIABLE; break; +#endif +#ifdef ECL_SEMAPHORES + case t_semaphores: + index = ECL_BUILTIN_SEMAPHORE; break; #endif case t_codeblock: index = ECL_BUILTIN_CODE_BLOCK; break; diff --git a/src/c/main.d b/src/c/main.d index 58208742b..5d01bf986 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -107,6 +107,9 @@ static const char *feature_names[] = { #ifdef ECL_THREADS "THREADS", #endif +#ifdef ECL_SEMAPHORES + "SEMAPHORES", +#endif #ifdef CLOS "CLOS", #endif diff --git a/src/c/print.d b/src/c/print.d index 9dc6e15e4..716d5b0b5 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -1612,6 +1612,14 @@ si_write_ugly_object(cl_object x, cl_object stream) write_ch('>', stream); break; #endif /* ECL_THREADS */ +#ifdef ECL_SEMAPHORES + case t_semaphore: + if (ecl_print_readably()) FEprint_not_readable(x); + write_str("#', stream); + break; +#endif default: if (ecl_print_readably()) FEprint_not_readable(x); write_str("# #endif +#ifdef HAVE_SEMAPHORE_H +# include +#endif #if defined(_MSC_VER) || defined(mingw32) # define ECL_WINDOWS_THREADS @@ -832,6 +835,188 @@ mp_condition_variable_broadcast(cl_object cv) @(return Ct) } +/*---------------------------------------------------------------------- + * SEMAPHORES + */ + +#ifdef ECL_SEMAPHORES + +# ifdef ECL_MACH_SEMAPHORES +struct ecl_semaphore_inner { + task_t owner; + semaphore_t counter[1]; +}; +# endif + +@(defun mp::make-semaphore (max &key name ((:count count) MAKE_FIXNUM(0))) + cl_object output; + cl_index initial_count, max_count; +@ +{ + output = ecl_alloc_object(t_semaphore); + ecl_disable_interrupts_env(the_env); + output->semaphore.name = name; + output->semaphore.handle = NULL; + ecl_set_finalizer_unprotected(output, Ct); + max_count = ecl_fixnum_in_range(@'mp:make-semaphore', "maximum count", + max, 0, 0xFFFF); + initial_count = ecl_fixnum_in_range(@'mp:make-semaphore', "initial count", + count, 0, max_count); +#ifdef ECL_WINDOWS_THREADS + { + HANDLE h = CreateSemaphore(NULL, + initial_count, + 0xFFFF, + NULL); + output->semaphore.handle = h; + ecl_enable_interrupts_env(the_env); + if (h == NULL) + FEwin32_error("Unable to create semaphore object.", 0); + } +#else +# ifdef HAVE_SEM_INIT + { + sem_t *h = ecl_alloc_atomic(sizeof(sem_t)); + int rc = sem_init(h, 0, initial_count); + if (!rc) + output->semaphore.handle = h; + ecl_enable_interrupts(); + if (rc) + FEerror("Unable to create semaphore object.", 0); + } +# endif /* HAVE_SEM_INIT */ +#endif /* ECL_WINDOWS_THREADS */ + @(return output) +} +@) + +cl_object +mp_semaphore_trywait(cl_object sem) +{ + cl_object output; + if (typeof(sem) != t_semaphore) + FEwrong_type_argument(@'mp::semaphore', cv); + AGAIN: +#ifdef ECL_WINDOWS_THREADS + { + HANDLE h = (HANDLE)(sem->semaphore.handle); + switch (WaitForSingleObject(h, 0)) { + case WAIT_OBJECT_0: + output = Ct; + break; + case WAIT_TIMEOUT: + output = Cnil; + break; + default: + FEwin32_error("Unable to wait on semaphore", 0); + output = Cnil; + } + } +#else +# ifdef HAVE_SEM_INIT + { + sem_t *h = (sem_t *)(sem->semaphore.handle); + int rc = sem_trywait(h); + if (sem_trywait(h)) { + if (errno != EAGAIN) { + FElibc_error("Unable to wait on semaphore", 0); + } + output = Cnil; + } else { + output = Ct; + } + } +# endif /* HAVE_SEM_INIT */ +#endif /* ECL_WINDOWS_THREADS */ + @(return output) +} + + +cl_object +mp_semaphore_wait(cl_object sem) +{ + cl_object output; + if (typeof(sem) != t_semaphore) + FEwrong_type_argument(@'mp::semaphore', cv); + AGAIN: +#ifdef ECL_WINDOWS_THREADS + { + HANDLE h = (HANDLE)(sem->semaphore.handle); + if (WaitForSingleObject(h, INFINITE) != WAIT_OBJECT_0) { + FEwin32_error("Unable to wait on semaphore", 0); + } + } +#else +# ifdef HAVE_SEM_INIT + { + sem_t *h = (sem_t *)(sem->semaphore.handle); + int rc = sem_wait(h); + if (sem_wait(h)) { + if (errno == EINTR) { + ecl_check_pending_interrupts(); + goto AGAIN; + } + FElibc_error("Unable to wait on semaphore", 0); + } + } +# endif /* HAVE_SEM_INIT */ +#endif /* ECL_WINDOWS_THREADS */ + @(return Ct) +} + +cl_object +mp_semaphore_signal(cl_object sem) +{ + if (typeof(sem) != t_semaphore) + FEwrong_type_argument(@'mp::semaphore', cv); + AGAIN: +#ifdef ECL_WINDOWS_THREADS + { + HANDLE h = (HANDLE)(sem->semaphore.handle); + if (!ReleaseSemaphore(h, 1, NULL)) { + FEwin32_error("Unable to post on semaphore ~A" 1, sem); + } + } +#else +# ifdef HAVE_SEM_INIT + { + sem_t *h = (sem_t *)(sem->semaphore.handle); + int rc = sem_wait(h); + if (sem_wait(h)) { + if (errno == EINTR) { + ecl_check_pending_interrupts(); + goto AGAIN; + } + FElibc_error("Unable to post on semaphore ~A", 1, sem); + } + } +# endif /* HAVE_SEM_INIT */ +#endif /* ECL_WINDOWS_THREADS */ + @(return Ct) +} + +cl_object +mp_semaphore_close(cl_object sem) +{ + if (typeof(sem) != t_semaphore) + FEwrong_type_argument(@'mp::semaphore', cv); +#ifdef ECL_WINDOWS_THREADS + { + HANDLE h = (HANDLE)(sem->semaphore.handle); + if (h) CloseHandle(h); + } +#else +# ifdef HAVE_SEM_INIT + /* + * No need for closing. + */ +# endif /* HAVE_SEM_INIT */ +#endif /* ECL_WINDOWS_THREADS */ + @(return Ct) +} + +#endif /* ECL_SEMAPHORES */ + /*---------------------------------------------------------------------- * INITIALIZATION */ diff --git a/src/c/typespec.d b/src/c/typespec.d index b94e35709..4a878f3b2 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -205,6 +205,10 @@ ecl_type_to_symbol(cl_type t) return @'mp::lock'; case t_condition_variable: return @'mp::condition-variable'; +#endif +#ifdef ECL_SEMAPHORES + case t_semaphore: + return @'mp::semaphore'; #endif case t_codeblock: return @'si::code-block'; diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp index d5cddcb44..752899d56 100644 --- a/src/clos/builtin.lsp +++ b/src/clos/builtin.lsp @@ -85,7 +85,8 @@ (si::weak-pointer) #+threads (mp::process) #+threads (mp::lock) - #+threads (mp::condition-variable)))) + #+threads (mp::condition-variable) + #+semaphores (mp::semaphore)))) (loop for (name . rest) in '#.+builtin-classes+ with index = 1 diff --git a/src/configure b/src/configure index bf941fed1..c1a164c0a 100755 --- a/src/configure +++ b/src/configure @@ -5972,6 +5972,87 @@ $as_echo "yes" >&6; } { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi + { $as_echo "$as_me:$LINENO: checking working sem_init()" >&5 +$as_echo_n "checking working sem_init()... " >&6; } +if test "$cross_compiling" = yes; then + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run test program while cross compiling +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: cannot run test program while cross compiling +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#ifdef HAVE_SEMAPHORE_H +#include +int main() { + sem_t aux; + if (sem_init(&aux, 0, 0)) + exit(1); + exit(0); +#else +int main() { + exit(1); +} +#endif +} +_ACEOF +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + working_sem_init=yes +else + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +working_sem_init=no +fi +rm -rf conftest.dSYM +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi + + +{ $as_echo "$as_me:$LINENO: result: $working_sem_init" >&5 +$as_echo "$working_sem_init" >&6; } +if test $working_sem_init = yes ; then + cat >>confdefs.h <<\_ACEOF +#define ECL_SEMAPHORES 1 +_ACEOF + + cat >>confdefs.h <<\_ACEOF +#define HAVE_SEM_INIT 1 +_ACEOF + +fi + fi else boehm_configure_flags="${boehm_configure_flags} --disable-threads" @@ -7366,9 +7447,10 @@ done + for ac_header in sys/resource.h sys/utsname.h float.h pwd.h dlfcn.h link.h \ mach-o/dyld.h ulimit.h dirent.h sys/ioctl.h sys/select.h \ - sys/wait.h + sys/wait.h semaphore.h do as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then diff --git a/src/configure.in b/src/configure.in index 6a0b0a405..8fd20dd65 100644 --- a/src/configure.in +++ b/src/configure.in @@ -454,6 +454,7 @@ if test "${enable_threads}" = "yes" ; then else AC_MSG_RESULT([no]) fi + ECL_POSIX_SEMAPHORES fi else boehm_configure_flags="${boehm_configure_flags} --disable-threads" @@ -564,7 +565,7 @@ dnl !!! end autoscan AC_CHECK_HEADERS( [sys/resource.h sys/utsname.h float.h pwd.h dlfcn.h link.h] \ [mach-o/dyld.h ulimit.h dirent.h sys/ioctl.h sys/select.h] \ - [sys/wait.h] ) + [sys/wait.h semaphore.h] ) dnl ===================================================================== dnl Checks for typedefs, structures, and compiler characteristics. diff --git a/src/h/config.h.in b/src/h/config.h.in index 39ddc0a81..28b2dbf94 100644 --- a/src/h/config.h.in +++ b/src/h/config.h.in @@ -67,6 +67,7 @@ #undef ECL_THREADS #ifdef ECL_THREADS # define GC_THREADS +/* # udef ECL_SEMAPHORES */ #endif /* __thread thread-local variables? */ @@ -337,6 +338,10 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey; #undef HAVE_COPYSIGNL /* whether we have sched_yield() that gives priority to other threads */ #undef HAVE_SCHED_YIELD +/* whether we semaphore.h */ +#undef HAVE_SEMAPHORE_H +/* whether we have a working sem_init() */ +#undef HAVE_SEM_INIT /* uname() for system identification */ #undef HAVE_UNAME #undef HAVE_UNISTD_H diff --git a/src/h/external.h b/src/h/external.h index ea3f14468..ad96dd4ce 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1626,6 +1626,13 @@ 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); +# ifdef ECL_SEMAPHORES +extern ECL_API void mp_make_semaphore _ARGS((cl_narg, cl_object, ...)); +extern ECL_API void mp_semaphore_trywait(cl_object); +extern ECL_API void mp_semaphore_wait(cl_object); +extern ECL_API void mp_semaphore_signal(cl_object); +extern ECL_API void mp_semaphore_close(cl_object); +# endif #endif diff --git a/src/h/object.h b/src/h/object.h index aefc531a7..7d59006e6 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -84,6 +84,9 @@ typedef enum { t_process, t_lock, t_condition_variable, +# ifdef ECL_SEMAPHORES + t_semaphore, +# endif #endif t_codeblock, t_foreign, @@ -851,7 +854,11 @@ struct ecl_condition_variable { pthread_cond_t cv; }; -#endif +struct ecl_semaphore { + HEADER; + void *handle; +}; +#endif /* ECL_THREADS */ #ifdef CLOS #define CLASS_OF(x) (x)->instance.clas @@ -919,6 +926,9 @@ union cl_lispunion { struct ecl_process process; /* process */ struct ecl_lock lock; /* lock */ struct ecl_condition_variable condition_variable; /* condition-variable */ +#endif +#ifdef ECL_SEMAPHORES + struct ecl_semaphore semaphore; /* semaphore */ #endif struct ecl_codeblock cblock; /* codeblock */ struct ecl_foreign foreign; /* user defined data type */