sexp sexp_mutex_state (sexp ctx sexp_api_params(self, n), sexp mutex) {
sexp_assert_type(ctx, sexp_mutexp, sexp_mutex_id, mutex);
if (sexp_truep(sexp_mutex_lockp(mutex))) {
if (sexp_contextp(sexp_mutex_thread(mutex)))
return sexp_mutex_thread(mutex);
else
return sexp_intern(ctx, "not-owned", -1);
} else {
return sexp_intern(ctx, (sexp_mutex_thread(mutex) ? "not-abandoned" : "abandoned"), -1);
}
}
sexp sexp_mutex_state (sexp ctx, sexp self, sexp_sint_t n, sexp mutex) {
if (!sexp_mutexp(ctx, mutex))
return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_THREADS_POLLFDS_ID)), mutex);
if (sexp_truep(sexp_mutex_lockp(mutex))) {
if (sexp_contextp(sexp_mutex_thread(mutex)))
return sexp_mutex_thread(mutex);
else
return sexp_intern(ctx, "not-owned", -1);
} else {
return sexp_intern(ctx, (sexp_mutex_thread(mutex) ? "not-abandoned" : "abandoned"), -1);
}
}
sexp sexp_mutex_unlock (sexp ctx, sexp self, sexp_sint_t n, sexp mutex, sexp condvar, sexp timeout) {
sexp ls1, ls2;
/* first unlock and unblock threads */
if (sexp_truep(sexp_mutex_lockp(mutex))) {
sexp_mutex_lockp(mutex) = SEXP_FALSE;
sexp_mutex_thread(mutex) = ctx;
/* search for threads blocked on this mutex */
for (ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
if (sexp_context_event(sexp_car(ls2)) == mutex) {
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2;
if (! sexp_pairp(sexp_cdr(ls2)))
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
sexp_context_waitp(sexp_car(ls2))
= sexp_context_timeoutp(sexp_car(ls2)) = 0;
break;
}
}
if (sexp_truep(condvar)) {
/* wait on condition var if specified */
sexp_context_waitp(ctx) = 1;
sexp_context_event(ctx) = condvar;
sexp_insert_timed(ctx, ctx, timeout);
return SEXP_FALSE;
}
return SEXP_TRUE;
}
sexp sexp_mutex_unlock (sexp ctx sexp_api_params(self, n), sexp mutex, sexp condvar, sexp timeout) {
sexp ls1, ls2;
if (sexp_not(condvar)) {
/* normal unlock - always succeeds, just need to unblock threads */
if (sexp_truep(sexp_mutex_lockp(mutex))) {
sexp_mutex_lockp(mutex) = SEXP_FALSE;
sexp_mutex_thread(mutex) = ctx;
/* search for threads blocked on this mutex */
for (ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
if (sexp_context_event(sexp_car(ls2)) == mutex) {
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2;
if (! sexp_pairp(sexp_cdr(ls2)))
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
sexp_context_waitp(sexp_car(ls2))
= sexp_context_timeoutp(sexp_car(ls2)) = 0;
break;
}
}
return SEXP_TRUE;
} else {
/* wait on condition var */
sexp_context_waitp(ctx) = 1;
sexp_context_event(ctx) = condvar;
sexp_insert_timed(ctx, ctx, timeout);
return SEXP_FALSE;
}
}
sexp sexp_mutex_lock (sexp ctx, sexp self, sexp_sint_t n, sexp mutex, sexp timeout, sexp thread) {
if (thread == SEXP_TRUE)
thread = ctx;
if (sexp_not(sexp_mutex_lockp(mutex))) {
sexp_mutex_lockp(mutex) = SEXP_TRUE;
sexp_mutex_thread(mutex) = thread;
return SEXP_TRUE;
} else {
sexp_context_waitp(ctx) = 1;
sexp_context_event(ctx) = mutex;
sexp_insert_timed(ctx, ctx, timeout);
return SEXP_FALSE;
}
}
