Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

committing incomplete changes for merge (stupid hg)

Browse source
This commit is contained in:
Alex Shinn 2010-08-17 21:06:45 +09:00
parent 7dd6be4b21
commit 3acae168fc
3 changed files with 39 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
include/chibi/sexp.h
View file

@ -22,6 +22,7 @@ extern "C" {
#endif
#if SEXP_USE_GREEN_THREADS
#include <sys/time.h>
#include <sys/errno.h>
#endif
#endif
@ -887,6 +888,8 @@ enum sexp_context_globals {
SEXP_G_THREADS_LOCAL,
SEXP_G_THREADS_SIGNALS,
SEXP_G_THREADS_SIGNAL_RUNNER,
SEXP_G_THREADS_POLL_FDS,
SEXP_G_THREADS_BLOCKER,
#endif
SEXP_G_NUM_GLOBALS
};

14
lib/srfi/18/threads.c
View file

@ -275,6 +275,10 @@ static sexp sexp_get_signal_handler (sexp ctx sexp_api_params(self, n), sexp sig
return sexp_vector_ref(sexp_global(ctx, SEXP_G_SIGNAL_HANDLERS), signum);
}
static sexp sexp_blocker (sexp ctx sexp_api_params(self, n), sexp port) {
return SEXP_VOID;
}
sexp sexp_scheduler (sexp ctx sexp_api_params(self, n), sexp root_thread) {
struct timeval tval;
sexp res, ls1, ls2, runner, paused, front;
@ -284,7 +288,7 @@ sexp sexp_scheduler (sexp ctx sexp_api_params(self, n), sexp root_thread) {
front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
/* check for signals */
/* 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 */
@ -302,6 +306,10 @@ sexp sexp_scheduler (sexp ctx sexp_api_params(self, n), sexp root_thread) {
}
}
/* check blocked fds */
/* if () { */
/* } */
/* if we've terminated, check threads joining us */
if (sexp_context_refuel(ctx) <= 0) {
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) {
@ -411,7 +419,9 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
sexp_define_foreign(ctx, env, "get-signal-handler", 1, sexp_get_signal_handler);
sexp_global(ctx, SEXP_G_THREADS_SCHEDULER)
= sexp_make_foreign(ctx, "scheduler", 0, 0, (sexp_proc1)sexp_scheduler, SEXP_FALSE);
= sexp_make_foreign(ctx, "scheduler", 1, 0, (sexp_proc1)sexp_scheduler, SEXP_FALSE);
sexp_global(ctx, SEXP_G_THREADS_BLOCKER)
= sexp_make_foreign(ctx, "blocker", 1, 0, (sexp_proc1)sexp_blocker, SEXP_FALSE);
/* remember the env to lookup the runner later */
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env;

26
vm.c
View file

@ -1303,14 +1303,36 @@ sexp sexp_vm (sexp ctx, sexp proc) {
_ARG1 = sexp_read_utf8_char(ctx, _ARG1, i);
else
#endif
_ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i);
if (i == EOF) {
#if SEXP_USE_GREEN_THREADS
if ((errno == EAGAIN)
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1);
fuel = 0;
ip--; /* try again */
} else
#endif
_ARG1 = SEXP_EOF;
} else
_ARG1 = sexp_make_character(i);
break;
case SEXP_OP_PEEK_CHAR:
if (! sexp_iportp(_ARG1))
sexp_raise("peek-char: not an input-port", sexp_list1(ctx, _ARG1));
i = sexp_read_char(ctx, _ARG1);
sexp_push_char(ctx, i, _ARG1);
_ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i);
if (i == EOF) {
#if SEXP_USE_GREEN_THREADS
if ((errno == EAGAIN)
&& sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG1);
fuel = 0;
ip--; /* try again */
} else
#endif
_ARG1 = SEXP_EOF;
} else
_ARG1 = sexp_make_character(i);
break;
case SEXP_OP_YIELD:
fuel = 0;