diff --git a/CHANGELOG.md b/CHANGELOG.md index 49fce35b..ca4976d2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add debugger to core. The debugger functions are only available + in a debug repl, and are prefixed by a `.`. - Add `sort-by` and `sorted-by` to core. - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. - Add `math/erf` diff --git a/examples/debugger.janet b/examples/debugger.janet index bcc0dcd9..588e55f3 100644 --- a/examples/debugger.janet +++ b/examples/debugger.janet @@ -1,20 +1,18 @@ ### ### A useful debugger library for Janet. Should be used -### inside a debug repl. +### inside a debug repl. This has been moved into the core. ### (defn .fiber "Get the current fiber being debugged." [] - (if-let [entry (dyn '_fiber)] - (entry :value) - (dyn :fiber))) + (dyn :fiber)) (defn .stack "Print the current fiber stack" [] (print) - (debug/stacktrace (.fiber) "") + (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) (print)) (defn .frame diff --git a/janet.1 b/janet.1 index dfc415ee..5f8a9c02 100644 --- a/janet.1 +++ b/janet.1 @@ -96,6 +96,10 @@ Delete everything before the cursor on the input line. .BR Ctrl\-W Delete one word before the cursor. +.TP 16 +.BR Ctrl\-G +Show documentation for the current symbol under the cursor. + .TP 16 .BR Alt\-B/Alt\-F Move cursor backwards and forwards one word. @@ -148,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier arguments are executed before later ones. +.TP +.BR \-d +Enable debug mode. On all terminating signals as well the debug signal, this will +cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a +default repl. + .TP .BR \-n Disable ANSI colors in the repl. Has no effect if no repl is run. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 82f5d806..47a00b8a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2269,6 +2269,157 @@ [& modules] ~(do ,;(map |~(,import* ,(string $) :prefix "") modules))) +### +### +### Debugger +### +### + +(defn .fiber + "Get the current fiber being debugged." + [] + (dyn :fiber)) + +(defn .stack + "Print the current fiber stack" + [] + (print) + (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) + (print)) + +(defn .frame + "Show a stack frame" + [&opt n] + (def stack (debug/stack (.fiber))) + (in stack (or n 0))) + +(defn .fn + "Get the current function" + [&opt n] + (in (.frame n) :function)) + +(defn .slots + "Get an array of slots in a stack frame" + [&opt n] + (in (.frame n) :slots)) + +(defn .slot + "Get the value of the nth slot." + [&opt nth frame-idx] + (in (.slots frame-idx) (or nth 0))) + +(defn .disasm + "Gets the assembly for the current function." + [&opt n] + (def frame (.frame n)) + (def func (frame :function)) + (disasm func)) + +(defn .bytecode + "Get the bytecode for the current function." + [&opt n] + ((.disasm n) 'bytecode)) + +(defn .ppasm + "Pretty prints the assembly for the current function" + [&opt n] + (def frame (.frame n)) + (def func (frame :function)) + (def dasm (disasm func)) + (def bytecode (dasm 'bytecode)) + (def pc (frame :pc)) + (def sourcemap (dasm 'sourcemap)) + (var last-loc [-2 -2]) + (print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]") + (when-let [constants (dasm 'constants)] + (printf " constants: %.4q" constants)) + (printf " slots: %.4q\n" (frame :slots)) + (def padding (string/repeat " " 20)) + (loop [i :range [0 (length bytecode)] + :let [instr (bytecode i)]] + (prin (if (= (tuple/type instr) :brackets) "*" " ")) + (prin (if (= i pc) "> " " ")) + (prinf "%.20s" (string (string/join (map string instr) " ") padding)) + (when sourcemap + (let [[sl sc] (sourcemap i) + loc [sl sc]] + (when (not= loc last-loc) + (set last-loc loc) + (prin " # line " sl ", column " sc)))) + (print)) + (print)) + +(defn .source + "Show the source code for the function being debugged." + [&opt n] + (def frame (.frame n)) + (def s (frame :source)) + (def all-source (slurp s)) + (print "\n" all-source "\n")) + +(defn .breakall + "Set breakpoints on all instructions in the current function." + [&opt n] + (def fun (.fn n)) + (def bytecode (.bytecode n)) + (for i 0 (length bytecode) + (debug/fbreak fun i)) + (print "Set " (length bytecode) " breakpoints in " fun)) + +(defn .clearall + "Clear all breakpoints on the current function." + [&opt n] + (def fun (.fn n)) + (def bytecode (.bytecode n)) + (for i 0 (length bytecode) + (debug/unfbreak fun i)) + (print "Cleared " (length bytecode) " breakpoints in " fun)) + +(defn .break + "Set breakpoint at the current pc." + [] + (def frame (.frame)) + (def fun (frame :function)) + (def pc (frame :pc)) + (debug/fbreak fun pc) + (print "Set breakpoint in " fun " at pc=" pc)) + +(defn .clear + "Clear the current breakpoint" + [] + (def frame (.frame)) + (def fun (frame :function)) + (def pc (frame :pc)) + (debug/unfbreak fun pc) + (print "Cleared breakpoint in " fun " at pc=" pc)) + +(defn .next + "Go to the next breakpoint." + [&opt n] + (var res nil) + (for i 0 (or n 1) + (set res (resume (.fiber)))) + res) + +(defn .nextc + "Go to the next breakpoint, clearing the current breakpoint." + [&opt n] + (.clear) + (.next n)) + +(defn .step + "Execute the next n instructions." + [&opt n] + (var res nil) + (for i 0 (or n 1) + (set res (debug/step (.fiber)))) + res) + +(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env))) +(def- debugger-env @{}) +(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil)) +(put _env 'debugger-keys nil) + ### ### ### REPL @@ -2301,6 +2452,7 @@ (put nextenv :fiber f) (put nextenv :debug-level level) (put nextenv :signal x) + (merge-into nextenv debugger-env) (debug/stacktrace f x) (eflush) (defn debugger-chunks [buf p] @@ -2327,6 +2479,8 @@ :on-status (or onsignal (make-onsignal env 1)) :source "repl"})) +(put _env 'debugger-env nil) + ### ### ### CLI Tool Main @@ -2370,6 +2524,7 @@ (var *handleopts* true) (var *exit-on-error* true) (var *colorize* true) + (var *debug* false) (var *compile-only* false) (if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp)) @@ -2385,6 +2540,7 @@ -v : Print the version string -s : Use raw stdin instead of getline like functionality -e code : Execute a string of janet + -d : Set the debug flag in the repl -r : Enter the repl after running all scripts -p : Keep on executing if there is a top level error (persistent) -q : Hide prompt, logo, and repl output (quiet) @@ -2417,7 +2573,8 @@ "e" (fn [i &] (set *no-file* false) (eval-string (in args (+ i 1))) - 2)}) + 2) + "d" (fn [&] (set *debug* true) 1)}) (defn- dohandler [n i &] (def h (in handlers n)) @@ -2476,6 +2633,7 @@ (file/flush stdout) (file/read stdin :line buf)) (def env (make-env)) + (if *debug* (put env :debug true)) (def getter (if *raw-stdin* getstdin getline)) (defn getchunk [buf p] (getter (prompter p) buf env))