Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-14 00:17:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing scheduling of threads generated by eval

Browse source
This commit is contained in:
Alex Shinn 2010-08-16 15:14:00 +00:00
parent 710a6b48aa
commit 98681871c4
6 changed files with 21 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -1728,9 +1728,11 @@ sexp sexp_eval_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp env) {
err_handler = sexp_cdr(sexp_global(ctx, SEXP_G_ERR_HANDLER));
sexp_cdr(sexp_global(ctx, SEXP_G_ERR_HANDLER)) = SEXP_FALSE;
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), env, 0);
sexp_context_child(ctx) = ctx2;
res = sexp_compile(ctx2, obj);
if (! sexp_exceptionp(res))
res = sexp_apply(ctx2, res, SEXP_NULL);
sexp_context_child(ctx) = SEXP_FALSE;
sexp_cdr(sexp_global(ctx, SEXP_G_ERR_HANDLER)) = err_handler;
sexp_context_top(ctx) = top;
sexp_context_last_fp(ctx) = sexp_context_last_fp(ctx2);

3
include/chibi/sexp.h
View file

@ -337,7 +337,7 @@ struct sexp_struct {
#endif
char tailp, tracep, timeoutp, waitp;
sexp_uint_t pos, depth, last_fp;
sexp bc, lambda, stack, env, fv, parent, globals,
sexp bc, lambda, stack, env, fv, parent, child, globals,
proc, name, specific, event;
} context;
} value;
@ -746,6 +746,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_context_pos(x) ((x)->value.context.pos)
#define sexp_context_lambda(x) ((x)->value.context.lambda)
#define sexp_context_parent(x) ((x)->value.context.parent)
#define sexp_context_child(x) ((x)->value.context.child)
#define sexp_context_saves(x) ((x)->value.context.saves)
#define sexp_context_tailp(x) ((x)->value.context.tailp)
#define sexp_context_tracep(x) ((x)->value.context.tracep)

4
lib/chibi/signal.c
View file

@ -65,10 +65,10 @@ static sexp sexp_set_signal_action (sexp ctx, sexp self, sexp signum, sexp newac
static void sexp_init_signals (sexp ctx, sexp env) {
call_sigaction.sa_sigaction = sexp_call_sigaction;
#if SEXP_USE_GREEN_THREADS
call_sigaction.sa_flags = SA_SIGINFO /* | SA_NODEFER */;
call_sigaction.sa_flags = SA_SIGINFO | SA_RESTART /* | SA_NODEFER */;
sigfillset(&call_sigaction.sa_mask);
#else
call_sigaction.sa_flags = SA_SIGINFO | SA_NODEFER;
call_sigaction.sa_flags = SA_SIGINFO | SA_RESTART | SA_NODEFER;
#endif
call_sigdefault.sa_handler = SIG_DFL;
call_sigignore.sa_handler = SIG_IGN;

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

@ -84,30 +84,11 @@ sexp sexp_thread_start (sexp ctx sexp_api_params(self, n), sexp thread) {
}
sexp sexp_thread_terminate (sexp ctx sexp_api_params(self, n), sexp thread) {
sexp ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_context_refuel(thread) = 0;
for ( ; sexp_pairp(ls2) && (sexp_car(ls2) != thread); ls2=sexp_cdr(ls2))
ls1 = ls2;
if (sexp_pairp(ls2)) {
if (ls1 == SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_FRONT) = sexp_cdr(ls2);
else /* splice */
sexp_cdr(ls1) = sexp_cdr(ls2);
if (ls2 == sexp_global(ctx, SEXP_G_THREADS_BACK))
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
} else { /* check for paused threads */
ls1=SEXP_NULL, ls2=sexp_global(ctx, SEXP_G_THREADS_PAUSED);
for ( ; sexp_pairp(ls2) && (sexp_car(ls2) != thread); ls2=sexp_cdr(ls2))
ls1 = ls2;
if (sexp_pairp(ls2)) {
if (ls1 == SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
else /* splice */
sexp_cdr(ls1) = sexp_cdr(ls2);
}
}
sexp res = sexp_make_boolean(ctx == thread);
for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread))
sexp_context_refuel(thread) = 0;
/* return true if terminating self */
return sexp_make_boolean(ctx == thread);
return res;
}
static void sexp_insert_timed (sexp ctx, sexp thread, sexp timeout) {

2
sexp.c
View file

@ -114,7 +114,7 @@ static struct sexp_type_struct _sexp_type_specs[] = {
_DEF_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, "sequence", NULL),
_DEF_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, "literal", NULL),
_DEF_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), "stack", NULL),
_DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 11, 11, 0, 0, sexp_sizeof(context), 0, 0, "context", NULL),
_DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 12, 12, 0, 0, sexp_sizeof(context), 0, 0, "context", NULL),
};
#undef _DEF_TYPE

13
vm.c
View file

@ -536,6 +536,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
cp = sexp_procedure_vars(self);
}
fuel = sexp_context_refuel(ctx);
if (fuel <= 0) goto end_loop;
}
#endif
#if SEXP_USE_DEBUG_VM
@ -1334,9 +1335,15 @@ sexp sexp_vm (sexp ctx, sexp proc) {
end_loop:
#if SEXP_USE_GREEN_THREADS
if (ctx != root_thread) { /* don't return from child threads */
sexp_context_refuel(ctx) = fuel = 0;
goto loop;
if (ctx != root_thread) {
if (sexp_context_refuel(root_thread) <= 0) {
/* the root already terminated */
_ARG1 = SEXP_VOID;
} else {
/* don't return from child threads */
sexp_context_refuel(ctx) = fuel = 0;
goto loop;
}
}
#endif
sexp_gc_release3(ctx);