diff --git a/eval.c b/eval.c index 5fe9e2bc..c0c7e166 100644 --- a/eval.c +++ b/eval.c @@ -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); diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index a8e67513..7484d9c6 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -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) diff --git a/lib/chibi/signal.c b/lib/chibi/signal.c index 37fce4c2..7202d96e 100644 --- a/lib/chibi/signal.c +++ b/lib/chibi/signal.c @@ -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; diff --git a/lib/srfi/18/threads.c b/lib/srfi/18/threads.c index 970af517..b84d59f4 100644 --- a/lib/srfi/18/threads.c +++ b/lib/srfi/18/threads.c @@ -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) { diff --git a/sexp.c b/sexp.c index c7ae13ec..db4c91fe 100644 --- a/sexp.c +++ b/sexp.c @@ -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 diff --git a/vm.c b/vm.c index afd18f7f..acbea8b2 100644 --- a/vm.c +++ b/vm.c @@ -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);