This seems to be a good compromise, using the underlying operating system for waiting and signaling and using a fast atomic path for detecting the lock-free case. First the simple mutex

cl_object
mp_get_lock_wait(cl_object lock)
{
if (ecl_atomic_queue_list(lock) != Cnil ||
   mp_get_lock_nowait(lock) == Cnil) {
ecl_wait_on(get_lock_inner, lock);
}
@(return Ct)
}

Note that the first part of the conditional is what makes this a fair implementation: if there are others waiting, we respect their precedence. The nowait locking is very simple as well

static cl_object
get_lock_inner(cl_env_ptr env, cl_object lock)
{
cl_object output;
cl_object own_process = env->own_process;
ecl_disable_interrupts_env(env);
        if (AO_compare_and_swap_full((AO_t*)&(lock->lock.owner),
    (AO_t)Cnil, (AO_t)own_process)) {
lock->lock.counter = 1;
output = Ct;
print_lock("acquiring\t", lock, lock);
} else  [...]
ecl_enable_interrupts_env(env);
return output;
}

Now comes the hard part, which is waiting for the lock (or condition variable or semaphore) to change. Apart from the polling version which is in CVS, I came up with this other version which relies on POSIX signals and seems to work reasonably fast -- at least as fast as the POSIX mutexes on the same platform.

void
ecl_wait_on(cl_object (*condition)(cl_env_ptr, cl_object), cl_object o)
{
const cl_env_ptr the_env = ecl_process_env();
volatile cl_object own_process = the_env->own_process;
volatile cl_object record;
volatile sigset_t original;

/* 0) We reserve a record for the queue. In order to a void
* using the garbage collector, we reuse records */
record = own_process->process.queue_record;
unlikely_if (record == Cnil) {
record = ecl_list1(own_process);
} else {
own_process->process.queue_record = Cnil;
}

/* 1) First we block all signals. */
{
sigset_t empty;
sigemptyset(&empty);
pthread_sigmask(SIG_SETMASK, &original, &empty);
}

/* 2) Now we add ourselves to the queue. In order to avoid a
* call to the GC, we try to reuse records. */
ecl_atomic_queue_nconc(the_env, o->lock.queue_list, record);
own_process->process.waiting_for = o;

CL_UNWIND_PROTECT_BEGIN(the_env) {
/* 3) At this point we may receive signals, but we
* might have missed a wakeup event if that happened
* between 0) and 2), which is why we start with the
* check*/
cl_object queue = ECL_CONS_CDR(o->lock.queue_list);
if (ECL_CONS_CAR(queue) != own_process ||
   condition(the_env, o) == Cnil)
{
do {
/* This will wait until we get a signal that
* demands some code being executed. Note that
* this includes our communication signals and
* the signals used by the GC. Note also that
* as a consequence we might throw / return
* which is why need to protect it all with
* UNWIND-PROTECT. */
sigsuspend(&original);
} while (condition(the_env, o) == Cnil);
}
} CL_UNWIND_PROTECT_EXIT {
/* 4) At this point we wrap up. We remove ourselves
  from the queue and restore signals, which were */
own_process->process.waiting_for = Cnil;
ecl_atomic_queue_delete(the_env, o->lock.queue_list, own_process);
own_process->process.queue_record = record;
ECL_RPLACD(record, Cnil);
pthread_sigmask(SIG_SETMASK, NULL, &original);
} CL_UNWIND_PROTECT_END;
}

I am now working on small optimizations of this code and further testing. I believe the same code can be used for Windows, because there we use a type of signals that are not delivered until the code enters some specific functions. Thus we could get rid of pthread_sigmask() (which do not exist in Windows) and just replace sigsuspend() with a simple SleepEx().

Juanjo

--
Instituto de Física Fundamental, CSIC
c/ Serrano, 113b, Madrid 28006 (Spain)
http://juanjose.garciaripoll.googlepages.com