Commit 48041ec2 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

Merge branch 'native-mutex' into develop

parents acc9b2a2 4f3dc42e
......@@ -13,7 +13,7 @@ ECL_FPE_CODE=fpe_x86.c
!if "$(ECL_THREADS)" != ""
ECL_THREADS_FLAG=1
THREADS_OBJ= process.obj mutex.obj condition_variable.obj rwlock.obj \
semaphore.obj barrier.obj mailbox.obj atomic.obj queue.obj
semaphore.obj barrier.obj mailbox.obj atomic.obj
!else
ECL_THREADS_FLAG=0
THREADS_OBJ=
......
......@@ -266,7 +266,7 @@ THREAD_CFLAGS=''
THREAD_LIBS=''
THREAD_GC_FLAGS='--enable-threads=posix'
INSTALL_TARGET='install'
THREAD_OBJ="$THREAD_OBJ threads/process threads/queue threads/mutex threads/condition_variable threads/semaphore threads/barrier threads/mailbox"
THREAD_OBJ="$THREAD_OBJ threads/process threads/mutex threads/condition_variable threads/semaphore threads/barrier threads/mailbox threads/rwlock"
clibs='-lm'
SONAME=''
SONAME_LDFLAGS=''
......@@ -928,14 +928,13 @@ fi
dnl ----------------------------------------------------------------------
dnl Check whether we have POSIX read/write locks are available
AC_DEFUN([ECL_POSIX_RWLOCK],[
AC_DEFUN([ECL_PTHREAD_EXTENSIONS],[
AC_CHECK_FUNC( [pthread_rwlock_init], [
AC_CHECK_TYPES([pthread_rwlock_t], [
AC_DEFINE([ECL_RWLOCK], [], [ECL_RWLOCK])
AC_DEFINE([HAVE_POSIX_RWLOCK], [], [HAVE_POSIX_RWLOCK])
], [])
], [])
THREAD_OBJ="$THREAD_OBJ threads/rwlock"
AC_CHECK_FUNCS([pthread_mutex_timedlock])
])
......
......@@ -46,8 +46,9 @@ HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h \
$(HDIR)/number.h $(HDIR)/page.h $(HDIR)/bytecodes.h \
$(HDIR)/cache.h $(HDIR)/config-internal.h $(HDIR)/ecl_atomics.h \
$(HDIR)/ecl-inl.h $(HDIR)/internal.h $(HDIR)/stack-resize.h \
$(HDIR)/impl/math_dispatch2.h $(HDIR)/impl/math_dispatch.h \
$(HDIR)/impl/math_fenv.h $(HDIR)/impl/math_fenv_msvc.h
$(HDIR)/threads.h $(HDIR)/impl/math_dispatch2.h \
$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \
$(HDIR)/impl/math_fenv_msvc.h
CLOS_OBJS = clos/cache.o clos/accessor.o clos/instance.o clos/gfun.o
OBJS = main.o symbol.o package.o cons.o list.o apply.o eval.o \
interpreter.o compiler.o disassembler.o $(CLOS_OBJS) \
......
......@@ -102,7 +102,7 @@ out_of_memory(size_t requested_bytes)
/* The out of memory condition may happen in more than one thread */
/* But then we have to ensure the error has not been solved */
#ifdef ECL_THREADS
mp_get_lock_wait(cl_core.error_lock);
ecl_mutex_lock(&cl_core.error_lock);
ECL_UNWIND_PROTECT_BEGIN(the_env)
#endif
{
......@@ -141,7 +141,7 @@ out_of_memory(size_t requested_bytes)
}
#ifdef ECL_THREADS
ECL_UNWIND_PROTECT_EXIT {
mp_giveup_lock(cl_core.error_lock);
ecl_mutex_unlock(&cl_core.error_lock);
} ECL_UNWIND_PROTECT_END;
#endif
ecl_bds_unwind1(the_env);
......@@ -432,10 +432,8 @@ cl_object_mark_proc(void *addr, struct GC_ms_entry *msp, struct GC_ms_entry *msl
# ifdef ECL_THREADS
case t_process:
MAYBE_MARK(o->process.queue_record);
MAYBE_MARK(o->process.start_stop_spinlock);
MAYBE_MARK(o->process.woken_up);
MAYBE_MARK(o->process.exit_values);
MAYBE_MARK(o->process.exit_barrier);
MAYBE_MARK(o->process.parent);
MAYBE_MARK(o->process.initial_bindings);
MAYBE_MARK(o->process.interrupt);
......@@ -446,37 +444,23 @@ cl_object_mark_proc(void *addr, struct GC_ms_entry *msp, struct GC_ms_entry *msl
ecl_mark_env(o->process.env);
break;
case t_lock:
MAYBE_MARK(o->lock.queue_list);
MAYBE_MARK(o->lock.queue_spinlock);
MAYBE_MARK(o->lock.owner);
MAYBE_MARK(o->lock.name);
break;
case t_condition_variable:
MAYBE_MARK(o->condition_variable.queue_spinlock);
MAYBE_MARK(o->condition_variable.queue_list);
MAYBE_MARK(o->condition_variable.lock);
break;
case t_rwlock:
MAYBE_MARK(o->rwlock.name);
# ifndef ECL_RWLOCK
MAYBE_MARK(o->rwlock.mutex);
break;
# endif
case t_semaphore:
MAYBE_MARK(o->semaphore.queue_list);
MAYBE_MARK(o->semaphore.queue_spinlock);
MAYBE_MARK(o->semaphore.name);
break;
case t_barrier:
MAYBE_MARK(o->barrier.queue_list);
MAYBE_MARK(o->barrier.queue_spinlock);
MAYBE_MARK(o->barrier.name);
break;
case t_mailbox:
MAYBE_MARK(o->mailbox.data);
MAYBE_MARK(o->mailbox.name);
MAYBE_MARK(o->mailbox.reader_semaphore);
MAYBE_MARK(o->mailbox.writer_semaphore);
break;
# endif
case t_codeblock:
......@@ -1013,41 +997,22 @@ init_alloc(void)
to_bitmap(&o, &(o.process.interrupt)) |
to_bitmap(&o, &(o.process.initial_bindings)) |
to_bitmap(&o, &(o.process.parent)) |
to_bitmap(&o, &(o.process.exit_barrier)) |
to_bitmap(&o, &(o.process.exit_values)) |
to_bitmap(&o, &(o.process.woken_up)) |
to_bitmap(&o, &(o.process.start_stop_spinlock)) |
to_bitmap(&o, &(o.process.queue_record));
type_info[t_lock].descriptor =
to_bitmap(&o, &(o.lock.name)) |
to_bitmap(&o, &(o.lock.owner)) |
to_bitmap(&o, &(o.lock.queue_spinlock)) |
to_bitmap(&o, &(o.lock.queue_list));
# ifdef ECL_RWLOCK
to_bitmap(&o, &(o.lock.owner));
type_info[t_rwlock].descriptor =
to_bitmap(&o, &(o.rwlock.name));
# else
type_info[t_rwlock].descriptor =
to_bitmap(&o, &(o.rwlock.name)) |
to_bitmap(&o, &(o.rwlock.mutex));
# endif
type_info[t_condition_variable].descriptor =
to_bitmap(&o, &(o.condition_variable.lock)) |
to_bitmap(&o, &(o.condition_variable.queue_list)) |
to_bitmap(&o, &(o.condition_variable.queue_spinlock));
type_info[t_condition_variable].descriptor = 0;
type_info[t_semaphore].descriptor =
to_bitmap(&o, &(o.semaphore.name)) |
to_bitmap(&o, &(o.semaphore.queue_list)) |
to_bitmap(&o, &(o.semaphore.queue_spinlock));
to_bitmap(&o, &(o.semaphore.name));
type_info[t_barrier].descriptor =
to_bitmap(&o, &(o.barrier.name)) |
to_bitmap(&o, &(o.barrier.queue_list)) |
to_bitmap(&o, &(o.barrier.queue_spinlock));
to_bitmap(&o, &(o.barrier.name));
type_info[t_mailbox].descriptor =
to_bitmap(&o, &(o.mailbox.name)) |
to_bitmap(&o, &(o.mailbox.data)) |
to_bitmap(&o, &(o.mailbox.reader_semaphore)) |
to_bitmap(&o, &(o.mailbox.writer_semaphore));
to_bitmap(&o, &(o.mailbox.data));
# endif
type_info[t_codeblock].descriptor =
to_bitmap(&o, &(o.cblock.data)) |
......@@ -1123,15 +1088,60 @@ standard_finalizer(cl_object o)
GC_unregister_disappearing_link((void**)&(o->weak.value));
break;
#ifdef ECL_THREADS
# ifdef ECL_RWLOCK
case t_lock: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_mutex_destroy(&o->lock.mutex);
ecl_enable_interrupts_env(the_env);
break;
}
case t_condition_variable: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_cond_var_destroy(&o->condition_variable.cv);
ecl_enable_interrupts_env(the_env);
break;
}
case t_barrier: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_mutex_destroy(&o->barrier.mutex);
ecl_cond_var_destroy(&o->barrier.cv);
ecl_enable_interrupts_env(the_env);
break;
}
case t_semaphore: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_mutex_destroy(&o->semaphore.mutex);
ecl_cond_var_destroy(&o->semaphore.cv);
ecl_enable_interrupts_env(the_env);
break;
}
case t_mailbox: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_mutex_destroy(&o->mailbox.mutex);
ecl_cond_var_destroy(&o->mailbox.reader_cv);
ecl_cond_var_destroy(&o->mailbox.writer_cv);
ecl_enable_interrupts_env(the_env);
break;
}
case t_rwlock: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
pthread_rwlock_destroy(&o->rwlock.mutex);
ecl_rwlock_destroy(&o->rwlock.mutex);
ecl_enable_interrupts_env(the_env);
break;
}
case t_process: {
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts_env(the_env);
ecl_mutex_destroy(&o->process.start_stop_lock);
ecl_cond_var_destroy(&o->process.exit_barrier);
ecl_enable_interrupts_env(the_env);
break;
}
# endif
case t_symbol: {
ecl_atomic_push(&cl_core.reused_indices,
ecl_make_fixnum(o->symbol.binding));
......@@ -1169,9 +1179,15 @@ register_finalizer(cl_object o, void *finalized_object,
case t_codeblock:
#endif
case t_stream:
#if defined(ECL_THREADS) && defined(ECL_RWLOCK)
#if defined(ECL_THREADS)
case t_lock:
case t_condition_variable:
case t_barrier:
case t_semaphore:
case t_mailbox:
case t_rwlock:
#endif
case t_process:
#endif /* ECL_THREADS */
/* Don't delete the standard finalizer. */
if (fn == NULL) {
fn = (GC_finalization_proc)wrapped_finalizer;
......
......@@ -102,7 +102,7 @@ ecl_def_string_array(feature_names,static,const) = {
#ifdef ECL_SEMAPHORES
ecl_def_string_array_elt("SEMAPHORES"),
#endif
#ifdef ECL_RWLOCK
#if defined(HAVE_POSIX_RWLOCK) || defined(ECL_WINDOWS_THREADS)
ecl_def_string_array_elt("ECL-READ-WRITE-LOCK"),
#endif
#ifdef WORDS_BIGENDIAN
......
......@@ -463,6 +463,25 @@ FEinvalid_function_name(cl_object fname)
@':datum', fname);
}
#ifdef ECL_THREADS
void
FEerror_not_owned(cl_object lock)
{
FEerror("Attempted to give up lock ~S that is not owned by process ~S",
2, lock, mp_current_process());
}
void
FEunknown_lock_error(cl_object lock)
{
#ifdef ECL_WINDOWS_THREADS
FEwin32_error("When acting on lock ~A, got an unexpected error.", 1, lock);
#else
FEerror("When acting on lock ~A, got an unexpected error.", 1, lock);
#endif
}
#endif
/* bootstrap version */
static int recursive_error = 0;
......
......@@ -181,7 +181,7 @@ ecl_init_env(cl_env_ptr env)
env->slot_cache = ecl_make_cache(3, 4096);
env->interrupt_struct = ecl_alloc(sizeof(*env->interrupt_struct));
env->interrupt_struct->pending_interrupt = ECL_NIL;
env->interrupt_struct->signal_queue_spinlock = ECL_NIL;
ecl_mutex_init(&env->interrupt_struct->signal_queue_lock, FALSE);
{
int size = ecl_option_values[ECL_OPT_SIGNAL_QUEUE_SIZE];
env->interrupt_struct->signal_queue = cl_make_list(1, ecl_make_fixnum(size));
......@@ -208,6 +208,7 @@ _ecl_dealloc_env(cl_env_ptr env)
* a lisp environment set up -- the allocator assumes one -- and we
* may have already cleaned up the value of ecl_process_env()
*/
ecl_mutex_destroy(&env->interrupt_struct->signal_queue_lock);
#if defined(ECL_USE_MPROTECT)
if (munmap(env, sizeof(*env)))
ecl_internal_error("Unable to deallocate environment structure.");
......@@ -360,92 +361,88 @@ ecl_def_ct_complex(flt_imag_unit_neg,&flt_zero_data,&flt_one_neg_data,static,con
ecl_def_ct_complex(flt_imag_two,&flt_zero_data,&flt_two_data,static,const);
struct cl_core_struct cl_core = {
ECL_NIL, /* packages */
ECL_NIL, /* lisp_package */
ECL_NIL, /* user_package */
ECL_NIL, /* keyword_package */
ECL_NIL, /* system_package */
ECL_NIL, /* ext_package */
ECL_NIL, /* clos_package */
.packages = ECL_NIL,
.lisp_package = ECL_NIL,
.user_package = ECL_NIL,
.keyword_package = ECL_NIL,
.system_package = ECL_NIL,
.ext_package = ECL_NIL,
.clos_package = ECL_NIL,
# ifdef ECL_CLOS_STREAMS
ECL_NIL, /* gray_package */
.gray_package = ECL_NIL,
# endif
ECL_NIL, /* mp_package */
ECL_NIL, /* c_package */
ECL_NIL, /* ffi_package */
ECL_NIL, /* pathname_translations */
ECL_NIL, /* library_pathname */
ECL_NIL, /* terminal_io */
ECL_NIL, /* null_stream */
ECL_NIL, /* standard_input */
ECL_NIL, /* standard_output */
ECL_NIL, /* error_output */
ECL_NIL, /* standard_readtable */
ECL_NIL, /* dispatch_reader */
ECL_NIL, /* default_dispatch_macro */
ECL_NIL, /* char_names */
(cl_object)&str_empty_data, /* null_string */
(cl_object)&plus_half_data, /* plus_half */
(cl_object)&minus_half_data, /* minus_half */
(cl_object)&flt_imag_unit_data, /* imag_unit */
(cl_object)&flt_imag_unit_neg_data, /* minus_imag_unit */
(cl_object)&flt_imag_two_data, /* imag_two */
(cl_object)&flt_zero_data, /* singlefloat_zero */
(cl_object)&dbl_zero_data, /* doublefloat_zero */
(cl_object)&flt_zero_neg_data, /* singlefloat_minus_zero */
(cl_object)&dbl_zero_neg_data, /* doublefloat_minus_zero */
(cl_object)&ldbl_zero_data, /* longfloat_zero */
(cl_object)&ldbl_zero_neg_data, /* longfloat_minus_zero */
(cl_object)&str_G_data, /* gensym_prefix */
(cl_object)&str_T_data, /* gentemp_prefix */
ecl_make_fixnum(0), /* gentemp_counter */
ECL_NIL, /* Jan1st1970UT */
ECL_NIL, /* system_properties */
ECL_NIL, /* setf_definition */
.mp_package = ECL_NIL,
.c_package = ECL_NIL,
.ffi_package = ECL_NIL,
.pathname_translations = ECL_NIL,
.library_pathname = ECL_NIL,
.terminal_io = ECL_NIL,
.null_stream = ECL_NIL,
.standard_input = ECL_NIL,
.standard_output = ECL_NIL,
.error_output = ECL_NIL,
.standard_readtable = ECL_NIL,
.dispatch_reader = ECL_NIL,
.default_dispatch_macro = ECL_NIL,
.char_names = ECL_NIL,
.null_string = (cl_object)&str_empty_data,
.plus_half = (cl_object)&plus_half_data,
.minus_half = (cl_object)&minus_half_data,
.imag_unit = (cl_object)&flt_imag_unit_data,
.minus_imag_unit = (cl_object)&flt_imag_unit_neg_data,
.imag_two = (cl_object)&flt_imag_two_data,
.singlefloat_zero = (cl_object)&flt_zero_data,
.doublefloat_zero = (cl_object)&dbl_zero_data,
.singlefloat_minus_zero = (cl_object)&flt_zero_neg_data,
.doublefloat_minus_zero = (cl_object)&dbl_zero_neg_data,
.longfloat_zero = (cl_object)&ldbl_zero_data,
.longfloat_minus_zero = (cl_object)&ldbl_zero_neg_data,
.gensym_prefix = (cl_object)&str_G_data,
.gentemp_prefix = (cl_object)&str_T_data,
.gentemp_counter = ecl_make_fixnum(0),
.Jan1st1970UT = ECL_NIL,
.system_properties = ECL_NIL,
.setf_definitions = ECL_NIL,
#ifdef ECL_THREADS
ECL_NIL, /* processes */
ECL_NIL, /* processes_spinlock */
ECL_NIL, /* global_lock */
ECL_NIL, /* error_lock */
ECL_NIL, /* global_env_lock */
.processes = ECL_NIL,
#endif
/* LIBRARIES is an adjustable vector of objects. It behaves as
a vector of weak pointers thanks to the magic in
gbc.d/alloc_2.d */
ECL_NIL, /* libraries */
.libraries = ECL_NIL,
0, /* max_heap_size */
ECL_NIL, /* bytes_consed */
ECL_NIL, /* gc_counter */
0, /* gc_stats */
0, /* path_max */
.max_heap_size = 0,
.bytes_consed = ECL_NIL,
.gc_counter = ECL_NIL,
.gc_stats = 0,
.path_max = 0,
#ifdef GBC_BOEHM
NULL, /* safety_region */
.safety_region = NULL,
#endif
NULL, /* default_sigmask */
0, /* default_sigmask_bytes */
.default_sigmask = NULL,
.default_sigmask_bytes = 0,
#ifdef ECL_THREADS
0, /* last_var_index */
ECL_NIL, /* reused_indices */
.last_var_index = 0,
.reused_indices = ECL_NIL,
#endif
(cl_object)&str_slash_data, /* slash */
.slash = (cl_object)&str_slash_data,
ECL_NIL, /* compiler_dispatch */
.compiler_dispatch = ECL_NIL,
(cl_object)&default_rehash_size_data, /* rehash_size */
(cl_object)&default_rehash_threshold_data, /* rehash_threshold */
.rehash_size = (cl_object)&default_rehash_size_data,
.rehash_threshold = (cl_object)&default_rehash_threshold_data,
ECL_NIL /* known_signals */
.known_signals = ECL_NIL
};
#if !defined(ECL_MS_WINDOWS_HOST)
......
......@@ -1609,6 +1609,7 @@ cl_symbols[] = {
{MP_ "LOCK-COUNT" ECL_FUN("mp_lock_count", IF_MP(mp_lock_count), 1) ECL_VAR(MP_ORDINARY, OBJNULL)},
{MP_ "GET-LOCK" ECL_FUN("mp_get_lock", IF_MP(mp_get_lock), -2) ECL_VAR(MP_ORDINARY, OBJNULL)},
{MP_ "GIVEUP-LOCK" ECL_FUN("mp_giveup_lock", IF_MP(mp_giveup_lock), 1) ECL_VAR(MP_ORDINARY, OBJNULL)},
{SYS_ "MUTEX-TIMEOUT" ECL_FUN("si_mutex_timeout", IF_MP(si_mutex_timeout), 3) ECL_VAR(SI_SPECIAL, OBJNULL)},
{MP_ "MAKE-CONDITION-VARIABLE" ECL_FUN("mp_make_condition_variable", IF_MP(mp_make_condition_variable), 0) ECL_VAR(MP_ORDINARY, OBJNULL)},
{MP_ "CONDITION-VARIABLE-WAIT" ECL_FUN("mp_condition_variable_wait", IF_MP(mp_condition_variable_wait), 2) ECL_VAR(MP_ORDINARY, OBJNULL)},
{MP_ "CONDITION-VARIABLE-TIMEDWAIT" ECL_FUN("mp_condition_variable_timedwait", IF_MP(mp_condition_variable_timedwait), 3) ECL_VAR(MP_ORDINARY, OBJNULL)},
......
......@@ -5,6 +5,7 @@
* barrier.d - wait barriers
*
* Copyright (c) 2012 Juan Jose Garcia Ripoll
* Copyright (c) 2020 Marius Gerbershagen
*
* See file 'LICENSE' for the copyright details.
*
......@@ -13,21 +14,21 @@
#include <ecl/ecl.h>
#include <ecl/internal.h>
static ECL_INLINE void
FEerror_not_a_barrier(cl_object barrier)
{
FEwrong_type_argument(@'mp::barrier', barrier);
}
cl_object
ecl_make_barrier(cl_object name, cl_index count)
{
cl_env_ptr env = ecl_process_env();
cl_object output = ecl_alloc_object(t_barrier);
output->barrier.disabled = FALSE;
output->barrier.wakeup = 0;
output->barrier.name = name;
output->barrier.arrivers_count = count;
output->barrier.arrivers_count = 0;
output->barrier.count = count;
output->barrier.queue_list = ECL_NIL;
output->barrier.queue_spinlock = ECL_NIL;
ecl_disable_interrupts_env(env);
ecl_cond_var_init(&output->barrier.cv);
ecl_mutex_init(&output->barrier.mutex, FALSE);
ecl_set_finalizer_unprotected(output, ECL_T);
ecl_enable_interrupts_env(env);
return output;
}
......@@ -43,7 +44,7 @@ mp_barrier_name(cl_object barrier)
{
cl_env_ptr env = ecl_process_env();
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
FEwrong_type_only_arg(@[mp::barrier-name], barrier, @[mp::barrier]);
}
ecl_return1(env, barrier->barrier.name);
}
......@@ -53,7 +54,7 @@ mp_barrier_count(cl_object barrier)
{
cl_env_ptr env = ecl_process_env();
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
FEwrong_type_only_arg(@[mp::barrier-count], barrier, @[mp::barrier]);
}
ecl_return1(env, ecl_make_fixnum(barrier->barrier.count));
}
......@@ -61,104 +62,111 @@ mp_barrier_count(cl_object barrier)
cl_object
mp_barrier_arrivers_count(cl_object barrier)
{
cl_fixnum arrivers, count;
cl_env_ptr env = ecl_process_env();
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
FEwrong_type_only_arg(@[mp::barrier-arrivers_count], barrier, @[mp::barrier]);
}
arrivers = barrier->barrier.arrivers_count;
count = barrier->barrier.count;
if (arrivers < 0)
arrivers = 0; /* Disabled barrier */
else
arrivers = count - arrivers;
ecl_return1(env, ecl_make_fixnum(arrivers));
ecl_return1(env, ecl_make_fixnum(barrier->barrier.arrivers_count));
}
/* INV: locking the mutex in mp_barrier_unblock and mp_barrier_wait
* will always succeed since the functions are not reentrant and only
* lock/unlock the mutex while interrupts are disabled, therefore
* deadlocks can't happen. */
@(defun mp::barrier-unblock (barrier &key reset_count disable kill_waiting)
int ping_flags = ECL_WAKEUP_RESET_FLAG | ECL_WAKEUP_ALL;
int kill_flags = ECL_WAKEUP_RESET_FLAG | ECL_WAKEUP_KILL | ECL_WAKEUP_ALL;
@
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
FEwrong_type_nth_arg(@[mp::barrier-unblock], 1, barrier, @[mp::barrier]);
}
ecl_disable_interrupts_env(the_env);
AGAIN:
ecl_mutex_lock(&barrier->barrier.mutex);
if (barrier->barrier.wakeup) {
/* we are currently waking up blocked threads; loop until all
* threads have woken up */
ecl_mutex_unlock(&barrier->barrier.mutex);
goto AGAIN;
}
if (!Null(reset_count))
if (!Null(reset_count)) {
barrier->barrier.count = fixnnint(reset_count);
if (!Null(disable))
barrier->barrier.arrivers_count = -1;
else
barrier->barrier.arrivers_count = barrier->barrier.count;
ecl_wakeup_waiters(the_env, barrier,
Null(kill_waiting)? ping_flags : kill_flags);
}
if (!Null(disable)) {
barrier->barrier.disabled = TRUE;
} else {
barrier->barrier.disabled = FALSE;
}
if (barrier->barrier.arrivers_count > 0) {
if (!Null(kill_waiting)) {
barrier->barrier.wakeup = ECL_BARRIER_WAKEUP_KILL;
} else {
barrier->barrier.wakeup = ECL_BARRIER_WAKEUP_NORMAL;
}
ecl_cond_var_broadcast(&barrier->barrier.cv);
}
ecl_mutex_unlock(&barrier->barrier.mutex);
ecl_enable_interrupts_env(the_env);
@(return);
@)
static cl_object
barrier_wait_condition(cl_env_ptr env, cl_object barrier)
{
/* We were signaled */
if (env->own_process->process.woken_up != ECL_NIL)
return ECL_T;
/* Disabled barrier */
else if (barrier->barrier.arrivers_count < 0)
return ECL_T;
else
return ECL_NIL;
}
static cl_fixnum
decrement_counter(cl_fixnum *counter)
{
/* The logic is as follows:
* - If the counter is negative, we abort. This is a way of
* disabling the counter.
* - Otherwise, we decrease the counter only if it is positive