Add debug/step to single step a fiber.

Very useful for implementing debuggers.

examples/debugger.janet

@@ -69,7 +69,8 @@
   (def sourcemap (dasm 'sourcemap))
   (var last-loc [-2 -2])
   (print "\n  function:   " (dasm 'name) " [" (in dasm 'source "") "]")
-  (printf "  constants:  %.4Q\n" (dasm 'constants))
+  (when-let [constants (dasm 'constants)]
+    (printf "  constants:  %.4Q\n" constants))
   (printf "  slots:      %.4Q\n\n" (frame :slots))
   (def padding (string/repeat " " 20))
   (loop [i :range [0 (length bytecode)]

src/core/cfuns.c

@@ -100,9 +100,9 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
     int32_t len = janet_v_count(args);
     JanetSlot t = janetc_gettarget(opts);
     janetc_emit_ssu(opts.compiler, JOP_SIGNAL, t,
-            (len == 1) ? args[0] : janetc_cslot(janet_wrap_nil()),
-            JANET_SIGNAL_DEBUG,
-            1);
+                    (len == 1) ? args[0] : janetc_cslot(janet_wrap_nil()),
+                    JANET_SIGNAL_DEBUG,
+                    1);
     return t;
 }
 static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {

src/core/debug.c

@@ -313,6 +313,14 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
+static Janet cfun_debug_step(int32_t argc, Janet *argv) {
+    janet_arity(argc, 1, 2);
+    JanetFiber *fiber = janet_getfiber(argv, 0);
+    Janet out = janet_wrap_nil();
+    janet_step(fiber, argc == 1 ? janet_wrap_nil() : argv[1], &out);
+    return out;
+}
+
 static const JanetReg debug_cfuns[] = {
     {
         "debug/break", cfun_debug_break,
@@ -381,6 +389,13 @@ static const JanetReg debug_cfuns[] = {
              "the fiber handling the error can see which fiber raised the signal. This function should "
              "be used mostly for debugging purposes.")
     },
+    {
+        "debug/step", cfun_debug_step,
+        JDOC("(debug/step fiber &opt x)\n\n"
+             "Run a fiber for one virtual instruction of the Janet machine. Can optionally "
+             "pass in a value that will be passed as the resuming value. Returns the signal value, "
+             "which will usually be nil, as breakpoints raise nil signals.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/vm.c

@@ -1004,6 +1004,61 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     VM_END()
 }
 
+/*
+ * Execute a single instruction in the fiber. Does this by inspecting
+ * the fiber, setting a breakpoint at the next instruction, executing, and
+ * reseting breakpoints to how they were prior. Yes, it's a bit hacky.
+ */
+JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
+    Janet *stack = fiber->data + fiber->frame;
+    uint32_t *pc = janet_stack_frame(stack)->pc;
+
+    /* Check current opcode (sans debug flag). This tells us where the next or next two candidate
+     * instructions will be. Usually it's the next instruction in memory,
+     * but for branching instructions it is also the target of the branch. */
+    uint32_t *nexta = NULL, *nextb = NULL, olda, oldb;
+
+    /* Set temporary breakpoints */
+    switch (*pc & 0x7F) {
+        default:
+            nexta = pc + 1;
+            break;
+        /* These we just ignore for now. Supporting them means
+         * we could step into and out of functions (including JOP_CALL). */
+        case JOP_RETURN_NIL:
+        case JOP_RETURN:
+        case JOP_ERROR:
+        case JOP_TAILCALL:
+            break;
+        case JOP_JUMP:
+            nexta = pc + DS;
+            break;
+        case JOP_JUMP_IF:
+        case JOP_JUMP_IF_NOT:
+            nexta = pc + 1;
+            nextb = pc + ES;
+            break;
+    }
+    if (nexta) {
+        olda = *nexta;
+        *nexta |= 0x80;
+    }
+    if (nextb) {
+        oldb = *nextb;
+        *nextb |= 0x80;
+    }
+
+    /* Go */
+    JanetSignal signal = run_vm(fiber, in, janet_fiber_status(fiber));
+
+    /* Restore */
+    if (nexta) *nexta = olda;
+    if (nextb) *nextb = oldb;
+
+    *out = *janet_vm_return_reg;
+    return signal;
+}
+
 Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Check entry conditions */
     if (!janet_vm_fiber)

src/include/janet.h

@@ -1298,6 +1298,7 @@ JANET_API int janet_init(void);
 JANET_API void janet_deinit(void);
 JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
+JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
 JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);