diff --git a/src/core/debug.c b/src/core/debug.c index 2cbd6aa3..69bd14cc 100644 --- a/src/core/debug.c +++ b/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); diff --git a/src/core/gc.c b/src/core/gc.c index a9ff0bf7..a0e3b63f 100644 --- a/src/core/gc.c +++ b/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]); diff --git a/src/core/state.h b/src/core/state.h index 5d9192c4..fc4157e4 100644 --- a/src/core/state.h +++ b/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; diff --git a/src/core/vm.c b/src/core/vm.c index ccbc87e2..e0e37446 100644 --- a/src/core/vm.c +++ b/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);