Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 06:39:17 +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 #endif
#if SEXP_USE_GREEN_THREADS #if SEXP_USE_GREEN_THREADS
#include <sys/time.h> #include <sys/time.h>
#include <sys/errno.h>
#endif #endif
#endif #endif
@ -887,6 +888,8 @@ enum sexp_context_globals {
SEXP_G_THREADS_LOCAL, SEXP_G_THREADS_LOCAL,
SEXP_G_THREADS_SIGNALS, SEXP_G_THREADS_SIGNALS,
SEXP_G_THREADS_SIGNAL_RUNNER, SEXP_G_THREADS_SIGNAL_RUNNER,
SEXP_G_THREADS_POLL_FDS,
SEXP_G_THREADS_BLOCKER,
#endif #endif
SEXP_G_NUM_GLOBALS 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); 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) { sexp sexp_scheduler (sexp ctx sexp_api_params(self, n), sexp root_thread) {
struct timeval tval; struct timeval tval;
sexp res, ls1, ls2, runner, paused, front; 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); front = sexp_global(ctx, SEXP_G_THREADS_FRONT);
paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED); paused = sexp_global(ctx, SEXP_G_THREADS_PAUSED);
/* check for signals */ /* check signals */
if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) { if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) != SEXP_ZERO) {
runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER); runner = sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER);
if (! sexp_contextp(runner)) { /* ensure the runner exists */ 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 we've terminated, check threads joining us */
if (sexp_context_refuel(ctx) <= 0) { if (sexp_context_refuel(ctx) <= 0) {
for (ls1=SEXP_NULL, ls2=paused; sexp_pairp(ls2); ) { 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_define_foreign(ctx, env, "get-signal-handler", 1, sexp_get_signal_handler);
sexp_global(ctx, SEXP_G_THREADS_SCHEDULER) 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 */ /* remember the env to lookup the runner later */
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env; 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); _ARG1 = sexp_read_utf8_char(ctx, _ARG1, i);
else else
#endif #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; break;
case SEXP_OP_PEEK_CHAR: case SEXP_OP_PEEK_CHAR:
if (! sexp_iportp(_ARG1)) if (! sexp_iportp(_ARG1))
sexp_raise("peek-char: not an input-port", sexp_list1(ctx, _ARG1)); sexp_raise("peek-char: not an input-port", sexp_list1(ctx, _ARG1));
i = sexp_read_char(ctx, _ARG1); i = sexp_read_char(ctx, _ARG1);
sexp_push_char(ctx, i, _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; break;
case SEXP_OP_YIELD: case SEXP_OP_YIELD:
fuel = 0; fuel = 0;