1
0
mirror of https://github.com/janet-lang/janet synced 2024-12-25 07:50:27 +00:00

Add debugger to the core repl.

Debugger functions are prefixed by periods.
This commit is contained in:
Calvin Rose 2020-04-10 17:01:41 -05:00
parent 3b0e6357ad
commit e1f4cadf41
4 changed files with 174 additions and 6 deletions

View File

@ -2,6 +2,8 @@
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## Unreleased - ??? ## 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. - Add `sort-by` and `sorted-by` to core.
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
- Add `math/erf` - Add `math/erf`

View File

@ -1,20 +1,18 @@
### ###
### A useful debugger library for Janet. Should be used ### 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 (defn .fiber
"Get the current fiber being debugged." "Get the current fiber being debugged."
[] []
(if-let [entry (dyn '_fiber)] (dyn :fiber))
(entry :value)
(dyn :fiber)))
(defn .stack (defn .stack
"Print the current fiber stack" "Print the current fiber stack"
[] []
(print) (print)
(debug/stacktrace (.fiber) "") (with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
(print)) (print))
(defn .frame (defn .frame

10
janet.1
View File

@ -96,6 +96,10 @@ Delete everything before the cursor on the input line.
.BR Ctrl\-W .BR Ctrl\-W
Delete one word before the cursor. Delete one word before the cursor.
.TP 16
.BR Ctrl\-G
Show documentation for the current symbol under the cursor.
.TP 16 .TP 16
.BR Alt\-B/Alt\-F .BR Alt\-B/Alt\-F
Move cursor backwards and forwards one word. 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 Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
arguments are executed before later ones. 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 .TP
.BR \-n .BR \-n
Disable ANSI colors in the repl. Has no effect if no repl is run. Disable ANSI colors in the repl. Has no effect if no repl is run.

View File

@ -2269,6 +2269,157 @@
[& modules] [& modules]
~(do ,;(map |~(,import* ,(string $) :prefix "") 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 ### REPL
@ -2301,6 +2452,7 @@
(put nextenv :fiber f) (put nextenv :fiber f)
(put nextenv :debug-level level) (put nextenv :debug-level level)
(put nextenv :signal x) (put nextenv :signal x)
(merge-into nextenv debugger-env)
(debug/stacktrace f x) (debug/stacktrace f x)
(eflush) (eflush)
(defn debugger-chunks [buf p] (defn debugger-chunks [buf p]
@ -2327,6 +2479,8 @@
:on-status (or onsignal (make-onsignal env 1)) :on-status (or onsignal (make-onsignal env 1))
:source "repl"})) :source "repl"}))
(put _env 'debugger-env nil)
### ###
### ###
### CLI Tool Main ### CLI Tool Main
@ -2370,6 +2524,7 @@
(var *handleopts* true) (var *handleopts* true)
(var *exit-on-error* true) (var *exit-on-error* true)
(var *colorize* true) (var *colorize* true)
(var *debug* false)
(var *compile-only* false) (var *compile-only* false)
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp)) (if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
@ -2385,6 +2540,7 @@
-v : Print the version string -v : Print the version string
-s : Use raw stdin instead of getline like functionality -s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet -e code : Execute a string of janet
-d : Set the debug flag in the repl
-r : Enter the repl after running all scripts -r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent) -p : Keep on executing if there is a top level error (persistent)
-q : Hide prompt, logo, and repl output (quiet) -q : Hide prompt, logo, and repl output (quiet)
@ -2417,7 +2573,8 @@
"e" (fn [i &] "e" (fn [i &]
(set *no-file* false) (set *no-file* false)
(eval-string (in args (+ i 1))) (eval-string (in args (+ i 1)))
2)}) 2)
"d" (fn [&] (set *debug* true) 1)})
(defn- dohandler [n i &] (defn- dohandler [n i &]
(def h (in handlers n)) (def h (in handlers n))
@ -2476,6 +2633,7 @@
(file/flush stdout) (file/flush stdout)
(file/read stdin :line buf)) (file/read stdin :line buf))
(def env (make-env)) (def env (make-env))
(if *debug* (put env :debug true))
(def getter (if *raw-stdin* getstdin getline)) (def getter (if *raw-stdin* getstdin getline))
(defn getchunk [buf p] (defn getchunk [buf p]
(getter (prompter p) buf env)) (getter (prompter p) buf env))