Add janet_interpreter_interrupt for custom scheduling.

This would allow an embedder to suspend the current Janet fiber
via an external event like a signal, other thread, or really anything.
This is a useful primitive for custom schedulers that would call
janet_interpreter_interupt periodically (say, in an interval with SIG_ALRM),
do some work, and then use janet_continue on the janet_root_fiber, or
for embedding into other soft-realtime applications like a game. To say,
only allow about 5ms per frame of interpreter time.

meson.build

@@ -74,6 +74,7 @@ conf.set('JANET_NO_PROCESSES', not get_option('processes'))
 conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
 conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
 conf.set('JANET_NO_THREADS', get_option('threads'))
+conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
 if get_option('os_name') != ''
   conf.set('JANET_OS_NAME', get_option('os_name'))
 endif

meson_options.txt

@@ -18,6 +18,7 @@ option('umask', type : 'boolean', value : true)
 option('realpath', type : 'boolean', value : true)
 option('simple_getline', type : 'boolean', value : false)
 option('epoll', type : 'boolean', value : false)
+option('interpreter_interrupt', type : 'boolean', value : false)
 
 option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
 option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

src/conf/janetconf.h

@@ -48,6 +48,7 @@
 /* #define JANET_OS_NAME my-custom-os */
 /* #define JANET_ARCH_NAME pdp-8 */
 /* #define JANET_EV_NO_EPOLL */
+/* #define JANET_NO_INTERPRETER_INTERRUPT */
 
 /* Custom vm allocator support */
 /* #include <mimalloc.h> */

src/core/state.c

@@ -28,6 +28,10 @@
 
 JANET_THREAD_LOCAL JanetVM janet_vm;
 
+JanetVM *janet_local_vm(void) {
+    return &janet_vm;
+}
+
 JanetVM *janet_vm_alloc(void) {
     JanetVM *mem = janet_malloc(sizeof(JanetVM));
     if (NULL == mem) {
@@ -47,3 +51,14 @@ void janet_vm_save(JanetVM *into) {
 void janet_vm_load(JanetVM *from) {
     janet_vm = *from;
 }
+
+/* Trigger suspension of the Janet vm by trying to
+ * exit the interpeter loop when convenient. You can optionally
+ * use NULL to interrupt the current VM when convenient */
+void janet_interpreter_interrupt(JanetVM *vm) {
+    if (NULL == vm) {
+        janet_vm.auto_suspend = 1;
+    } else {
+        vm->auto_suspend = 1;
+    }
+}

src/core/state.h

@@ -72,6 +72,10 @@ struct JanetVM {
     /* How many VM stacks have been entered */
     int stackn;
 
+    /* If this flag is true, suspend on function calls and backwards jumps.
+     * When this occurs, this flag will be reset to 0. */
+    int auto_suspend;
+
     /* The current running fiber on the current thread.
      * Set and unset by janet_run. */
     JanetFiber *fiber;

src/core/vm.c

@@ -111,6 +111,17 @@
         janet_panicf("expected %T, got %v", (TS), (X)); \
     } \
 } while (0)
+#ifdef JANET_NO_INTERPRETER_INTERRUPT
+#define vm_maybe_auto_suspend(COND)
+#else
+#define vm_maybe_auto_suspend(COND) do { \
+    if ((COND) && janet_vm.auto_suspend) { \
+        janet_vm.auto_suspend = 0; \
+        fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
+        vm_return(JANET_SIGNAL_EVENT, janet_wrap_nil()); \
+    } \
+} while (0)
+#endif
 
 /* Templates for certain patterns in opcodes */
 #define vm_binop_immediate(op)\
@@ -746,11 +757,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_JUMP)
     pc += DS;
+    vm_maybe_auto_suspend(DS < 0);
     vm_next();
 
     VM_OP(JOP_JUMP_IF)
     if (janet_truthy(stack[A])) {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     } else {
         pc++;
     }
@@ -761,12 +774,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         pc++;
     } else {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     }
     vm_next();
 
     VM_OP(JOP_JUMP_IF_NIL)
     if (janet_checktype(stack[A], JANET_NIL)) {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     } else {
         pc++;
     }
@@ -777,6 +792,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         pc++;
     } else {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     }
     vm_next();
 
@@ -950,6 +966,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_checkgc_pcnext();
 
     VM_OP(JOP_CALL) {
+        vm_maybe_auto_suspend(1);
         Janet callee = stack[E];
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
@@ -989,6 +1006,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     }
 
     VM_OP(JOP_TAILCALL) {
+        vm_maybe_auto_suspend(1);
         Janet callee = stack[D];
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
@@ -1035,6 +1053,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_RESUME) {
         Janet retreg;
+        vm_maybe_auto_suspend(1);
         vm_assert_type(stack[B], JANET_FIBER);
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
         if (janet_check_can_resume(child, &retreg)) {
@@ -1519,6 +1538,9 @@ int janet_init(void) {
     /* Core env */
     janet_vm.core_env = NULL;
 
+    /* Auto suspension */
+    janet_vm.auto_suspend = 0;
+
     /* Dynamic bindings */
     janet_vm.top_dyns = NULL;
 

src/include/janet.h

@@ -1660,9 +1660,11 @@ JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *i
 JANET_API int janet_init(void);
 JANET_API void janet_deinit(void);
 JANET_API JanetVM *janet_vm_alloc(void);
+JANET_API JanetVM *janet_local_vm(void);
 JANET_API void janet_vm_free(JanetVM *vm);
 JANET_API void janet_vm_save(JanetVM *into);
 JANET_API void janet_vm_load(JanetVM *from);
+JANET_API void janet_interpreter_interrupt(JanetVM *vm);
 JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
 JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);