From 7df0ec6aedf3fd0fe933e7361dedcbfd4f936bf5 Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Mon, 25 Nov 2019 20:00:13 -0600
Subject: [PATCH] Fix up debug/step and janet_step.

Also allow debugging on all signals, including errors.
This is gated behind (setdyn :debug true) in the repl.
---
 examples/debug.janet |  3 +++
 src/boot/boot.janet  | 53 +++++++++++++++++++++++---------------------
 src/core/vm.c        | 15 +++++++++----
 3 files changed, 42 insertions(+), 29 deletions(-)

diff --git a/examples/debug.janet b/examples/debug.janet
index a723f05e..35467368 100644
--- a/examples/debug.janet
+++ b/examples/debug.janet
@@ -6,3 +6,6 @@
   (for i 0 10 (print i)))
 
 (debug/fbreak myfn 3)
+
+# Enable debugging in repl with
+# (setdyn :debug true)
diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index f2a78098..ec98a691 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -1751,6 +1751,7 @@
   (defn eval1 [source]
     (def source (if expand (expand source) source))
     (var good true)
+    (var resumeval nil)
     (def f
       (fiber/new
         (fn []
@@ -1769,8 +1770,8 @@
     (fiber/setenv f env)
     (while (let [fs (fiber/status f)]
              (and (not= :dead fs) (not= :error fs)))
-      (def res (resume f nil))
-      (when good (when going (onstatus f res)))))
+      (def res (resume f resumeval))
+      (when good (when going (set resumeval (onstatus f res))))))
 
   # Loop
   (def buf @"")
@@ -2065,7 +2066,7 @@
   "Run a repl. The first parameter is an optional function to call to
   get a chunk of source code that should return nil for end of file.
   The second parameter is a function that is called when a signal is
-  caught. Lastly, one can provide an optional environment table to run
+  caught. One can provide an optional environment table to run
   the repl in."
   [&opt chunks onsignal env]
   (default env (make-env))
@@ -2076,32 +2077,34 @@
                                        buf)))
   (defn make-onsignal
     [e level]
-    (fn [f x]
-      (case (fiber/status f)
-        :dead (do
-                (pp x)
-                (put e '_ @{:value x}))
-        :debug (let [nextenv (make-env env)]
-                 (put nextenv :fiber f)
-                 (put nextenv :debug-level level)
-                 (debug/stacktrace f x)
-                 (defn debugger-chunks [buf p]
-                   (def status (parser/state p :delimiters))
-                   (def c ((parser/where p) 0))
-                   (def prompt (string "debug[" level "]:" c ":" status "> "))
-                   (getline prompt buf))
-                 (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
-                 (print "exiting debug[" level "]")
-                 (def lastval (get-in nextenv ['_ :value] (nextenv :resume-value)))
-                 (pp lastval)
-                 (put e '_ @{:value lastval}))
-        (debug/stacktrace f x))))
 
-  (default onsignal (make-onsignal env 1))
+    (defn enter-debugger
+      [f x]
+      (def nextenv (make-env env))
+      (put nextenv :fiber f)
+      (put nextenv :debug-level level)
+      (put nextenv :signal x)
+      (debug/stacktrace f x)
+      (defn debugger-chunks [buf p]
+        (def status (parser/state p :delimiters))
+        (def c ((parser/where p) 0))
+        (def prompt (string "debug[" level "]:" c ":" status "> "))
+        (getline prompt buf))
+      (print "entering debug[" level "] - (quit) to exit")
+      (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
+      (print "exiting debug[" level "]")
+      (nextenv :resume-value))
+
+    (fn [f x]
+      (if (= :dead (fiber/status f))
+        (do (pp x) (put e '_ @{:value x}))
+        (if (e :debug)
+          (enter-debugger f x)
+          (do (debug/stacktrace f x) nil)))))
 
   (run-context {:env env
                 :chunks chunks
-                :on-status onsignal
+                :on-status (or onsignal (make-onsignal env 1))
                 :source "repl"}))
 
 # Clean up some extra defs
diff --git a/src/core/vm.c b/src/core/vm.c
index 4c9446fd..0cc69324 100644
--- a/src/core/vm.c
+++ b/src/core/vm.c
@@ -1010,8 +1010,16 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
  * 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;
+    /* No finished or currently alive fibers. */
+    JanetFiberStatus status = janet_fiber_status(fiber);
+    if (status == JANET_STATUS_ALIVE ||
+            status == JANET_STATUS_DEAD ||
+            status == JANET_STATUS_ERROR) {
+        janet_panicf("cannot step fiber with status :%s", janet_status_names[status]);
+    }
+
+    /* Get PC for setting breakpoints */
+    uint32_t *pc = janet_stack_frame(fiber->data + fiber->frame)->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,
@@ -1049,13 +1057,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
     }
 
     /* Go */
-    JanetSignal signal = run_vm(fiber, in, janet_fiber_status(fiber));
+    JanetSignal signal = janet_continue(fiber, in, out);
 
     /* Restore */
     if (nexta) *nexta = olda;
     if (nextb) *nextb = oldb;
 
-    *out = *janet_vm_return_reg;
     return signal;
 }