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_thread_join (sexp ctx, sexp self, sexp_sint_t n, sexp thread, sexp timeout) {
sexp_assert_type(ctx, sexp_contextp, SEXP_CONTEXT, thread);
if (sexp_context_refuel(thread) <= 0) /* return true if already terminated */ {
return SEXP_TRUE;
}
sexp_context_timeoutp(ctx) = 0;
sexp_context_waitp(ctx) = 1;
sexp_context_event(ctx) = thread;
sexp_insert_timed(ctx, ctx, timeout);
return SEXP_FALSE;
}
sexp sexp_condition_variable_signal (sexp ctx, sexp self, sexp_sint_t n, sexp condvar) {
sexp ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
for ( ; sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
if (sexp_context_event(sexp_car(ls2)) == condvar) {
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;
return SEXP_TRUE;
}
return SEXP_FALSE;
}
sexp sexp_thread_timeoutp (sexp ctx, sexp self, sexp_sint_t n) {
return sexp_make_boolean(sexp_context_timeoutp(ctx));
}
sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
int i, k;
struct timeval tval;
struct pollfd *pfds;
useconds_t usecs = 0;
sexp res, ls1, ls2, evt, runner, paused, front, pollfds;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
/* check signals */
if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) {
runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
if (! sexp_contextp(runner)) { /* ensure the runner exists */
if (sexp_envp(runner)) {
tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) {
runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE);
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner;
sexp_thread_start(ctx, self, 1, runner);
if (!sexp_pairp(front))
front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
}
}
} else if (sexp_context_waitp(runner)) { /* wake it if it's sleeping */
sexp_context_waitp(runner) = 0;
sexp_thread_start(ctx, self, 1, runner);
}
}
/* check blocked fds */
pollfds = sexp_global(ctx, SEXP_G_THREADS_POLL_FDS);
if (sexp_pollfdsp(ctx, pollfds) && sexp_pollfds_num_fds(pollfds) > 0) {
pfds = sexp_pollfds_fds(pollfds);
k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), 0);
for (i=sexp_pollfds_num_fds(pollfds)-1; i>=0 && k>0; --i) {
if (pfds[i].revents > 0) { /* free all threads blocked on this fd */
k--;
/* maybe unblock the current thread */
evt = sexp_context_event(ctx);
if ((sexp_portp(evt) && (sexp_port_fileno(evt) == pfds[i].fd))
|| (sexp_fixnump(evt) && (sexp_unbox_fixnum(evt) == pfds[i].fd))) {
sexp_context_waitp(ctx) = 0;
sexp_context_timeoutp(ctx) = 0;
sexp_context_event(ctx) = SEXP_FALSE;
}
/* maybe unblock paused threads */
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
/* TODO: distinguish input and output on the same fd? */
evt = sexp_context_event(sexp_car(ls2));
if ((sexp_portp(evt) && sexp_port_fileno(evt) == pfds[i].fd)
|| (sexp_fixnump(evt) && sexp_unbox_fixnum(evt) == pfds[i].fd)) {
sexp_context_waitp(sexp_car(ls2)) = 0;
sexp_context_timeoutp(sexp_car(ls2)) = 0;
sexp_context_event(sexp_car(ls2)) = SEXP_FALSE;
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
tmp = sexp_cdr(ls2);
sexp_cdr(ls2) = SEXP_NULL;
if (sexp_car(ls2) != ctx) {
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
}
ls2 = tmp;
} else {
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
}
if (i < (sexp_pollfds_num_fds(pollfds) - 1)) {
pfds[i] = pfds[sexp_pollfds_num_fds(pollfds) - 1];
}
sexp_pollfds_num_fds(pollfds) -= 1;
}
}
}
/* if we've terminated, check threads joining us */
if (sexp_context_refuel(ctx) <= 0) {
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
if (sexp_context_event(sexp_car(ls2)) == ctx) {
sexp_context_waitp(sexp_car(ls2)) = 0;
sexp_context_timeoutp(sexp_car(ls2)) = 0;
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
tmp = sexp_cdr(ls2);
sexp_cdr(ls2) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
ls2 = tmp;
} else {
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
}
}
/* check timeouts */
if (sexp_pairp(paused)) {
if (gettimeofday(&tval, NULL) == 0) {
ls1 = SEXP_NULL;
ls2 = paused;
while (sexp_pairp(ls2) && sexp_context_before(sexp_car(ls2), tval)) {
sexp_context_timeoutp(sexp_car(ls2)) = 1;
sexp_context_waitp(sexp_car(ls2)) = 0;
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
if (sexp_pairp(ls1)) {
sexp_cdr(ls1) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2;
}
}
}
/* dequeue next thread */
if (sexp_pairp(front)) {
res = sexp_car(front);
if ((sexp_context_refuel(ctx) <= 0) || sexp_context_waitp(ctx)) {
/* orig ctx is either terminated or paused */
sexp_global(ctx, SEXP_G_THREADS_FRONT) = sexp_cdr(front);
if (! sexp_pairp(sexp_cdr(front)))
sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
if (sexp_context_refuel(ctx) > 0 && sexp_not(sexp_memq(ctx, ctx, paused)))
sexp_insert_timed(ctx, ctx, SEXP_FALSE);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
} else {
/* swap with front of queue */
sexp_car(sexp_global(ctx, SEXP_G_THREADS_FRONT)) = ctx;
/* rotate front of queue to back */
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK))
= sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_global(ctx, SEXP_G_THREADS_FRONT)
= sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_FRONT));
sexp_global(ctx, SEXP_G_THREADS_BACK)
= sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK));
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = SEXP_NULL;
}
} else {
/* no threads to dequeue */
res = ctx;
/* prefer a thread we can wait on instead of spinning */
if (sexp_context_refuel(ctx) <= 0) {
for (ls1=paused; sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
evt = sexp_context_event(sexp_car(ls1));
if (sexp_fixnump(evt) || sexp_portp(evt)) {
res = sexp_car(ls1);
break;
}
}
}
}
if (sexp_context_waitp(res)) {
/* the only thread available was waiting */
if (sexp_pairp(paused)
&& sexp_context_before(sexp_car(paused), sexp_context_timeval(res))) {
tmp = res;
res = sexp_car(paused);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(paused);
if (sexp_not(sexp_memq(ctx, tmp, paused)))
sexp_insert_timed(ctx, tmp, tmp);
} else {
sexp_delete_list(ctx, SEXP_G_THREADS_PAUSED, res);
}
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
usecs = 0;
if ((sexp_context_timeval(res).tv_sec == 0)
&& (sexp_context_timeval(res).tv_usec == 0)) {
/* no timeout, wait for default 10ms */
usecs = 10*1000;
} else {
/* wait until the next timeout */
gettimeofday(&tval, NULL);
if (tval.tv_sec <= sexp_context_timeval(res).tv_sec) {
usecs = (sexp_context_timeval(res).tv_sec - tval.tv_sec) * 1000000;
if (tval.tv_usec < sexp_context_timeval(res).tv_usec || usecs > 0)
usecs += sexp_context_timeval(res).tv_usec - tval.tv_usec;
}
}
/* take a nap to avoid busy looping */
usleep(usecs);
sexp_context_waitp(res) = 0;
sexp_context_timeoutp(res) = 1;
}
sexp_gc_release1(ctx);
return res;
}
sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
int i, k;
struct timeval tval;
struct pollfd *pfds;
useconds_t usecs = 0;
sexp res, ls1, ls2, runner, paused, front, pollfds;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
/* check signals */
if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) {
runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
if (! sexp_contextp(runner)) { /* ensure the runner exists */
if (sexp_envp(runner)) {
tmp = sexp_env_cell(runner, (tmp=sexp_intern(ctx, "signal-runner", -1)), 0);
if (sexp_pairp(tmp) && sexp_procedurep(sexp_cdr(tmp))) {
runner = sexp_make_thread(ctx, self, 2, sexp_cdr(tmp), SEXP_FALSE);
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = runner;
sexp_thread_start(ctx, self, 1, runner);
}
}
} else if (sexp_context_waitp(runner)) { /* wake it if it's sleeping */
sexp_context_waitp(runner) = 0;
sexp_thread_start(ctx, self, 1, runner);
}
}
/* check blocked fds */
pollfds = sexp_global(ctx, SEXP_G_THREADS_POLL_FDS);
if (sexp_pollfdsp(ctx, pollfds) && sexp_pollfds_num_fds(pollfds) > 0) {
pfds = sexp_pollfds_fds(pollfds);
k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), 0);
unblock_io_threads:
for (i=sexp_pollfds_num_fds(pollfds)-1; i>=0 && k>0; --i) {
if (pfds[i].revents > 0) { /* free all threads blocked on this fd */
k--;
pfds[i].events = 0; /* FIXME: delete from queue completely */
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
/* FIXME distinguish input and output on the same fd */
if (sexp_portp(sexp_context_event(sexp_car(ls2)))
&& sexp_port_fileno(sexp_context_event(sexp_car(ls2))) == pfds[i].fd) {
sexp_context_waitp(sexp_car(ls2)) = 0;
sexp_context_timeoutp(sexp_car(ls2)) = 0;
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
tmp = sexp_cdr(ls2);
sexp_cdr(ls2) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
ls2 = tmp;
} else {
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
}
}
}
}
/* if we've terminated, check threads joining us */
if (sexp_context_refuel(ctx) <= 0) {
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
if (sexp_context_event(sexp_car(ls2)) == ctx) {
sexp_context_waitp(sexp_car(ls2)) = 0;
sexp_context_timeoutp(sexp_car(ls2)) = 0;
if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = sexp_cdr(ls2);
else
sexp_cdr(ls1) = sexp_cdr(ls2);
tmp = sexp_cdr(ls2);
sexp_cdr(ls2) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
ls2 = tmp;
} else {
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
}
}
/* check timeouts */
if (sexp_pairp(paused)) {
if (gettimeofday(&tval, NULL) == 0) {
ls1 = SEXP_NULL;
ls2 = paused;
while (sexp_pairp(ls2) && sexp_context_before(sexp_car(ls2), tval)) {
sexp_context_timeoutp(sexp_car(ls2)) = 1;
sexp_context_waitp(ctx) = 0;
ls1 = ls2;
ls2 = sexp_cdr(ls2);
}
if (sexp_pairp(ls1)) {
sexp_cdr(ls1) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused;
} else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused;
}
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2;
}
}
}
/* dequeue next thread */
if (sexp_pairp(front)) {
res = sexp_car(front);
if ((sexp_context_refuel(ctx) <= 0) || sexp_context_waitp(ctx)) {
/* either terminated or paused */
sexp_global(ctx, SEXP_G_THREADS_FRONT) = sexp_cdr(front);
if (! sexp_pairp(sexp_cdr(front)))
sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
} else {
/* swap with front of queue */
sexp_car(sexp_global(ctx, SEXP_G_THREADS_FRONT)) = ctx;
/* rotate front of queue to back */
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK))
= sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_global(ctx, SEXP_G_THREADS_FRONT)
= sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_FRONT));
sexp_global(ctx, SEXP_G_THREADS_BACK)
= sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK));
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = SEXP_NULL;
}
} else {
res = ctx;
}
if (sexp_context_waitp(res)) {
/* the only thread available was waiting */
if (sexp_pairp(paused)
&& sexp_context_before(sexp_car(paused), sexp_context_timeval(res))) {
tmp = res;
res = sexp_car(paused);
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(paused);
if (sexp_not(sexp_memq(ctx, tmp, paused)))
sexp_insert_timed(ctx, tmp, tmp);
}
usecs = 0;
if ((sexp_context_timeval(res).tv_sec == 0)
&& (sexp_context_timeval(res).tv_usec == 0)) {
/* no timeout, wait for default 10ms */
usecs = 10*1000;
} else {
/* wait until the next timeout */
gettimeofday(&tval, NULL);
if (tval.tv_sec <= sexp_context_timeval(res).tv_sec) {
usecs = (sexp_context_timeval(res).tv_sec - tval.tv_sec) * 1000000;
if (tval.tv_usec < sexp_context_timeval(res).tv_usec || usecs > 0)
usecs += sexp_context_timeval(res).tv_usec - tval.tv_usec;
}
}
/* either wait on an fd, or just sleep */
pollfds = sexp_global(res, SEXP_G_THREADS_POLL_FDS);
if (sexp_portp(sexp_context_event(res)) && sexp_pollfdsp(ctx, pollfds)) {
if ((k = poll(sexp_pollfds_fds(pollfds), sexp_pollfds_num_fds(pollfds), usecs/1000)) > 0) {
pfds = sexp_pollfds_fds(pollfds);
goto unblock_io_threads;
}
} else {
usleep(usecs);
sexp_context_waitp(res) = 0;
sexp_context_timeoutp(res) = 1;
}
}
sexp_gc_release1(ctx);
return res;
}
sexp sexp_thread_timeoutp (sexp ctx sexp_api_params(self, n)) {
return sexp_make_boolean(sexp_context_timeoutp(ctx));
}
