Add first iteration of call hooks.

Hooks are per thread (not per fiber) for performance, and are exposed as
callback functions. Hooks cannot be nested, so hooks are disabled inside
other hooks.

src/core/debug.c

@@ -428,6 +428,16 @@ JANET_CORE_FN(cfun_debug_step,
     return out;
 }
 
+JANET_CORE_FN(cfun_debug_hook,
+              "(debug/hook hookfn)",
+              "Add a hook that will be called on certain runtime events.") {
+    janet_arity(argc, 0, 1);
+    JanetFunction *func = janet_optfunction(argv, argc, 0, NULL);
+    janet_vm.hook = func;
+    janet_vm.hook_reset = func;
+    return janet_wrap_nil();
+}
+
 /* Module entry point */
 void janet_lib_debug(JanetTable *env) {
     JanetRegExt debug_cfuns[] = {
@@ -440,6 +450,7 @@ void janet_lib_debug(JanetTable *env) {
         JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
         JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
         JANET_CORE_REG("debug/step", cfun_debug_step),
+        JANET_CORE_REG("debug/hook", cfun_debug_hook),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, debug_cfuns);

src/core/gc.c

@@ -591,6 +591,8 @@ void janet_collect(void) {
 #ifdef JANET_EV
     janet_ev_mark();
 #endif
+    if (janet_vm.hook != NULL) janet_mark(janet_wrap_function(janet_vm.hook));
+    if (janet_vm.hook_reset != NULL) janet_mark(janet_wrap_function(janet_vm.hook_reset));
     janet_mark_fiber(janet_vm.root_fiber);
     for (i = 0; i < orig_rootcount; i++)
         janet_mark(janet_vm.roots[i]);

src/core/state.h

@@ -87,6 +87,10 @@ struct JanetVM {
     /* How many VM stacks have been entered */
     int stackn;
 
+    /* Debug hook for advanced tracing */
+    JanetFunction *hook;
+    JanetFunction *hook_reset; /* In case of error/signal inside a hook */
+
     /* If this flag is true, suspend on function calls and backwards jumps.
      * When this occurs, this flag will be reset to 0. */
     volatile JanetAtomicInt auto_suspend;

src/core/vm.c

@@ -80,12 +80,22 @@
     func = janet_stack_frame(stack)->func; \
 } while (0)
 #define vm_return(sig, val) do { \
-    janet_vm.return_reg[0] = (val); \
+    Janet val2 = (val); \
+    janet_vm.return_reg[0] = val2; \
     vm_commit(); \
+    if (janet_vm.hook) { \
+        vm_do_hook_return(val2); \
+        janet_vm.return_reg[0] = val2; \
+    } \
     return (sig); \
 } while (0)
 #define vm_return_no_restore(sig, val) do { \
-    janet_vm.return_reg[0] = (val); \
+    Janet val2 = (val); \
+    janet_vm.return_reg[0] = val2; \
+    if (janet_vm.hook) { \
+        vm_do_hook_return(val2); \
+        janet_vm.return_reg[0] = val2; \
+    } \
     return (sig); \
 } while (0)
 
@@ -280,6 +290,36 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
     return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
 }
 
+static void vm_do_hook(int32_t argc, const Janet *argv) {
+    JanetFunction *old_hook = janet_vm.hook;
+    janet_vm.hook = NULL;
+    janet_call(old_hook, argc, argv);
+    janet_vm.hook = old_hook;
+}
+
+static void vm_do_hook_call(Janet callee, int32_t argc, const Janet *argv) {
+    Janet argvv[3];
+    argvv[0] = janet_ckeywordv("call");
+    argvv[1] = callee;
+    argvv[2] = janet_wrap_tuple(janet_tuple_n(argv, argc));
+    vm_do_hook(3, argvv);
+}
+
+static void vm_do_hook_tailcall(Janet callee, int32_t argc, const Janet *argv) {
+    Janet argvv[3];
+    argvv[0] = janet_ckeywordv("tailcall");
+    argvv[1] = callee;
+    argvv[2] = janet_wrap_tuple(janet_tuple_n(argv, argc));
+    vm_do_hook(3, argvv);
+}
+
+static void vm_do_hook_return(Janet result) {
+    Janet argvv[2];
+    argvv[0] = janet_ckeywordv("return");
+    argvv[1] = result;
+    vm_do_hook(2, argvv);
+}
+
 /* Method lookup could potentially handle tables specially... */
 static Janet method_to_fun(Janet method, Janet obj) {
     return janet_get(obj, method);
@@ -663,6 +703,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
         vm_restore();
         stack[A] = retval;
+        if (janet_vm.hook) {
+            vm_do_hook_return(retval);
+        }
         vm_checkgc_pcnext();
     }
 
@@ -673,6 +716,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
         vm_restore();
         stack[A] = retval;
+        if (janet_vm.hook) {
+            vm_do_hook_return(retval);
+        }
         vm_checkgc_pcnext();
     }
 
@@ -1013,6 +1059,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
         }
+        if (janet_vm.hook) {
+            vm_commit();
+            vm_do_hook_call(callee, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
+        }
         if (janet_checktype(callee, JANET_KEYWORD)) {
             vm_commit();
             callee = resolve_method(callee, fiber);
@@ -1039,10 +1089,16 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             janet_fiber_popframe(fiber);
             stack = fiber->data + fiber->frame;
             stack[A] = ret;
+            if (janet_vm.hook) {
+                vm_do_hook_return(stack[A]);
+            }
             vm_checkgc_pcnext();
         } else {
             vm_commit();
             stack[A] = call_nonfn(fiber, callee);
+            if (janet_vm.hook) {
+                vm_do_hook_return(stack[A]);
+            }
             vm_pcnext();
         }
     }
@@ -1053,6 +1109,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
         }
+        if (janet_vm.hook) {
+            vm_commit();
+            vm_do_hook_tailcall(callee, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
+        }
         if (janet_checktype(callee, JANET_KEYWORD)) {
             vm_commit();
             callee = resolve_method(callee, fiber);
@@ -1089,6 +1149,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             }
             vm_restore();
             stack[A] = retreg;
+            if (janet_vm.hook) {
+                vm_do_hook_return(stack[A]);
+            }
             vm_checkgc_pcnext();
         }
     }
@@ -1440,6 +1503,8 @@ void janet_restore(JanetTryState *state) {
     janet_vm.fiber = state->vm_fiber;
     janet_vm.signal_buf = state->vm_jmp_buf;
     janet_vm.return_reg = state->vm_return_reg;
+    /* In case of error/signal thrown when inside a temporarily disabled hook */
+    janet_vm.hook = janet_vm.hook_reset;
 }
 
 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
@@ -1631,6 +1696,10 @@ int janet_init(void) {
     /* Dynamic bindings */
     janet_vm.top_dyns = NULL;
 
+    /* Hooks */
+    janet_vm.hook = NULL;
+    janet_vm.hook_reset = NULL;
+
     /* Seed RNG */
     janet_rng_seed(janet_default_rng(), 0);