mirror of
https://github.com/janet-lang/janet
synced 2025-01-25 22:56:52 +00:00
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.
This commit is contained in:
parent
a0a980e0ef
commit
7df0ec6aed
@ -6,3 +6,6 @@
|
|||||||
(for i 0 10 (print i)))
|
(for i 0 10 (print i)))
|
||||||
|
|
||||||
(debug/fbreak myfn 3)
|
(debug/fbreak myfn 3)
|
||||||
|
|
||||||
|
# Enable debugging in repl with
|
||||||
|
# (setdyn :debug true)
|
||||||
|
@ -1751,6 +1751,7 @@
|
|||||||
(defn eval1 [source]
|
(defn eval1 [source]
|
||||||
(def source (if expand (expand source) source))
|
(def source (if expand (expand source) source))
|
||||||
(var good true)
|
(var good true)
|
||||||
|
(var resumeval nil)
|
||||||
(def f
|
(def f
|
||||||
(fiber/new
|
(fiber/new
|
||||||
(fn []
|
(fn []
|
||||||
@ -1769,8 +1770,8 @@
|
|||||||
(fiber/setenv f env)
|
(fiber/setenv f env)
|
||||||
(while (let [fs (fiber/status f)]
|
(while (let [fs (fiber/status f)]
|
||||||
(and (not= :dead fs) (not= :error fs)))
|
(and (not= :dead fs) (not= :error fs)))
|
||||||
(def res (resume f nil))
|
(def res (resume f resumeval))
|
||||||
(when good (when going (onstatus f res)))))
|
(when good (when going (set resumeval (onstatus f res))))))
|
||||||
|
|
||||||
# Loop
|
# Loop
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
@ -2065,7 +2066,7 @@
|
|||||||
"Run a repl. The first parameter is an optional function to call to
|
"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.
|
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
|
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."
|
the repl in."
|
||||||
[&opt chunks onsignal env]
|
[&opt chunks onsignal env]
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
@ -2076,32 +2077,34 @@
|
|||||||
buf)))
|
buf)))
|
||||||
(defn make-onsignal
|
(defn make-onsignal
|
||||||
[e level]
|
[e level]
|
||||||
(fn [f x]
|
|
||||||
(case (fiber/status f)
|
(defn enter-debugger
|
||||||
:dead (do
|
[f x]
|
||||||
(pp x)
|
(def nextenv (make-env env))
|
||||||
(put e '_ @{:value x}))
|
|
||||||
:debug (let [nextenv (make-env env)]
|
|
||||||
(put nextenv :fiber f)
|
(put nextenv :fiber f)
|
||||||
(put nextenv :debug-level level)
|
(put nextenv :debug-level level)
|
||||||
|
(put nextenv :signal x)
|
||||||
(debug/stacktrace f x)
|
(debug/stacktrace f x)
|
||||||
(defn debugger-chunks [buf p]
|
(defn debugger-chunks [buf p]
|
||||||
(def status (parser/state p :delimiters))
|
(def status (parser/state p :delimiters))
|
||||||
(def c ((parser/where p) 0))
|
(def c ((parser/where p) 0))
|
||||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||||
(getline prompt buf))
|
(getline prompt buf))
|
||||||
|
(print "entering debug[" level "] - (quit) to exit")
|
||||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
||||||
(print "exiting debug[" level "]")
|
(print "exiting debug[" level "]")
|
||||||
(def lastval (get-in nextenv ['_ :value] (nextenv :resume-value)))
|
(nextenv :resume-value))
|
||||||
(pp lastval)
|
|
||||||
(put e '_ @{:value lastval}))
|
|
||||||
(debug/stacktrace f x))))
|
|
||||||
|
|
||||||
(default onsignal (make-onsignal env 1))
|
(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
|
(run-context {:env env
|
||||||
:chunks chunks
|
:chunks chunks
|
||||||
:on-status onsignal
|
:on-status (or onsignal (make-onsignal env 1))
|
||||||
:source "repl"}))
|
:source "repl"}))
|
||||||
|
|
||||||
# Clean up some extra defs
|
# Clean up some extra defs
|
||||||
|
@ -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.
|
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
|
||||||
*/
|
*/
|
||||||
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
||||||
Janet *stack = fiber->data + fiber->frame;
|
/* No finished or currently alive fibers. */
|
||||||
uint32_t *pc = janet_stack_frame(stack)->pc;
|
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
|
/* 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,
|
* 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 */
|
/* Go */
|
||||||
JanetSignal signal = run_vm(fiber, in, janet_fiber_status(fiber));
|
JanetSignal signal = janet_continue(fiber, in, out);
|
||||||
|
|
||||||
/* Restore */
|
/* Restore */
|
||||||
if (nexta) *nexta = olda;
|
if (nexta) *nexta = olda;
|
||||||
if (nextb) *nextb = oldb;
|
if (nextb) *nextb = oldb;
|
||||||
|
|
||||||
*out = *janet_vm_return_reg;
|
|
||||||
return signal;
|
return signal;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user