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.

.github/workflows/test.yml

@@ -38,6 +38,9 @@ jobs:
       - name: Test the project
         shell: cmd
         run: build_win test
+      - name: Test installer build
+        shell: cmd
+        run: build_win dist
 
   test-windows-min:
     name: Build and test on Windows Minimal build

CHANGELOG.md

@@ -1,7 +1,7 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## 1.37.0 - 2024-12-05
+## 1.37.1 - 2024-12-05
 - Fix meson cross compilation
 - Update timeout documentation for networking APIs: timeouts raise errors and do not return nil.
 - Add `janet_addtimeout_nil(double sec);` to the C API.

build_win.bat

@@ -138,7 +138,8 @@ if defined APPVEYOR_REPO_TAG_NAME (
     set RELEASE_VERSION=%JANET_VERSION%
 )
 if defined CI (
-    set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
+    set WIXBIN="%WIX%bin\"
+    echo WIXBIN = %WIXBIN%
 ) else (
     set WIXBIN=
 )

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.37.0')
+  version : '1.37.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

src/conf/janetconf.h

@@ -5,9 +5,9 @@
 
 #define JANET_VERSION_MAJOR 1
 #define JANET_VERSION_MINOR 37
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.37.0"
+#define JANET_VERSION "1.37.1"
 
 /* #define JANET_BUILD "local" */
 

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