fixing scheduling of threads generated by eval

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);

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)

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;

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 res = sexp_make_boolean(ctx == thread);
+  for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread))
     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);
-    }
-  }
   /* return true if terminating self */
-  return sexp_make_boolean(ctx == thread);
+  return res;
 }
 
 static void sexp_insert_timed (sexp ctx, sexp thread, sexp timeout) {

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
 

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,10 +1335,16 @@ sexp sexp_vm (sexp ctx, sexp proc) {
 
  end_loop:
 #if SEXP_USE_GREEN_THREADS
-  if (ctx != root_thread) { /* don't return from child threads */
+  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);
   sexp_context_top(ctx) = top;