mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-23 06:50:26 +00:00
Code Issues 1 Releases Wiki Activity

Lots of work on improving debugging.

Browse Source 
doc macro can take no arguments and print out
all bindings. Fix an issues with the vm skipping
over a breakpoint in some situations.

Add examples/debugger.janet for proof of concept
debugger.
This commit is contained in:
Calvin Rose 2019-11-24 17:45:53 -06:00
parent 8372d1e499
commit d37c43716a
7 changed files with 306 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
examples/debug.janet Normal file
View File

@ -0,0 +1,8 @@
# Load this file and run (myfn) to see the debugger
(defn myfn
[]
(debug)
(for i 0 10 (print i)))
(debug/fbreak myfn 3)

136
examples/debugger.janet Normal file
View File

@ -0,0 +1,136 @@
###
### A useful debugger library for Janet. Should be used
### inside a debug repl.
###
(defn .fiber
"Get the current fiber being debugged."
[]
(if-let [entry (dyn '_fiber)]
(entry :value)
(dyn :fiber)))
(defn .stack
"Print the current fiber stack"
[]
(print)
(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 .quit
"Resume (dyn :fiber) with the value passed to it after exiting the debugger."
[&opt val]
(setdyn :exit true)
(setdyn :resume-value val)
nil)
(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 "") "]")
(printf " constants: %.4Q\n" (dasm 'constants))
(printf " slots: %.4Q\n\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) "> " " "))
(printf "\e[33m%.20s\e[0m" (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\e[33m" all-source "\e[0m\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 .clear
"Clear the current breakpoint"
[]
(def frame (-> (.fiber) debug/stack first))
(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))

217
src/boot/boot.janet
View File

@ -1308,6 +1308,30 @@
###
###
(defn- env-walk
[pred &opt env]
(default env (fiber/getenv (fiber/current)))
(def envs @[])
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
(def ret-set @{})
(loop [envi :in envs
k :keys envi
:when (pred k)]
(put ret-set k true))
(sort (keys ret-set)))
(defn all-bindings
"Get all symbols available in an enviroment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk symbol? env))
(defn all-dynamics
"Get all dynamic bindings in an environment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk keyword? env))
(defn doc-format
"Reformat text to wrap at a given line."
[text]
@ -1346,35 +1370,59 @@
buf)
(defn- print-index
"Print bindings in the current environment given a filter function"
[fltr]
(def bindings (filter fltr (all-bindings)))
(def dynamics (map describe (filter fltr (all-dynamics))))
(print)
(print (doc-format (string "Bindings:\n\n" (string/join bindings " "))))
(print)
(print (doc-format (string "Dynamics:\n\n" (string/join dynamics " "))))
(print))
(defn doc*
"Get the documentation for a symbol in a given environment."
[sym]
(def x (dyn sym))
(if (not x)
(print "symbol " sym " not found.")
[&opt sym]
(cond
(string? sym)
(print-index (fn [x] (string/find sym x)))
sym
(do
(def bind-type
(string " "
(cond
(x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
(x :macro) :macro
(type (x :value)))
"\n"))
(def sm (x :source-map))
(def d (x :doc))
(print "\n\n"
(if d bind-type "")
(if-let [[path line col] sm]
(string " " path " on line " line ", column " col "\n") "")
(if (or d sm) "\n" "")
(if d (doc-format d) "no documentation found.")
"\n\n"))))
(def x (dyn sym))
(if (not x)
(print "symbol " sym " not found.")
(do
(def bind-type
(string " "
(cond
(x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
(x :macro) :macro
(type (x :value)))
"\n"))
(def sm (x :source-map))
(def d (x :doc))
(print "\n\n"
(if d bind-type "")
(if-let [[path line col] sm]
(string " " path " on line " line ", column " col "\n") "")
(if (or d sm) "\n" "")
(if d (doc-format d) "no documentation found.")
"\n\n"))))
# else
(print-index identity)))
(defmacro doc
"Shows documentation for the given symbol."
[sym]
[&opt sym]
~(,doc* ',sym))
(put _env 'env-walk nil)
(put _env 'print-index nil)
###
###
### Macro Expansion
@ -1719,8 +1767,10 @@
(on-compile-error msg errf where))))
(or guard :a)))
(fiber/setenv f env)
(def res (resume f nil))
(when good (if going (onstatus f res))))
(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)))))
# Loop
(def buf @"")
@ -1746,14 +1796,16 @@
(when (= (parser/status p) :error)
(on-parse-error p where))
env)
(in env :exit-value env))
(defn quit
"Tries to exit from the current repl or context. Does not always exit the application.
Works by setting the :exit dynamic binding to true."
[]
Works by setting the :exit dynamic binding to true. Passing a non-nil value here will cause the outer
run-context to return that value."
[&opt value]
(setdyn :exit true)
"Bye!")
(setdyn :exit-value value)
nil)
(defn eval-string
"Evaluates a string in the current environment. If more control over the
@ -1908,8 +1960,11 @@
(def f (if (= (type path) :core/file)
path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(put env :current-file (string path))
(def spath (string path))
(put env :current-file (if-not path-is-file spath))
(put env :source (if-not path-is-file spath path))
(defn chunks [buf _] (file/read f 2048 buf))
(defn bp [&opt x y]
(def ret (bad-parse x y))
@ -1921,19 +1976,20 @@
ret)
(unless f
(error (string "could not find file " path)))
(run-context {:env env
:chunks chunks
:on-parse-error bp
:on-compile-error bc
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(debug/stacktrace f x)
(if exit-on-error (os/exit 1))))
:evaluator evaluator
:expander expander
:source (or source (if (= f path) "<anonymous>" path))})
(when (not= f path) (file/close f))
env)
(def nenv
(run-context {:env env
:chunks chunks
:on-parse-error bp
:on-compile-error bc
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(debug/stacktrace f x)
(if exit-on-error (os/exit 1))))
:evaluator evaluator
:expander expander
:source (if path-is-file "<anonymous>" spath)}))
(if-not path-is-file (file/close f))
nenv)
(def module/loaders
"A table of loading method names to loading functions.
@ -1943,7 +1999,6 @@
:source (fn [path args]
(put module/loading path true)
(def newenv (dofile path ;args))
(put newenv :source path)
(put module/loading path nil)
newenv)
:image (fn [path &] (load-image (slurp path)))})
@ -2000,73 +2055,57 @@
[& modules]
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
###
###
### REPL
###
###
(defn repl
"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."
caught. Lastly, one can provide an optional environment table to run
the repl in."
[&opt chunks onsignal env]
(def level (+ (dyn :debug-level 0) 1))
(default env (make-env))
(default chunks (fn [buf p] (getline (string "repl:"
((parser/where p) 0)
":"
(parser/state p :delimiters) "> ")
buf)))
(default onsignal (fn [f x]
(case (fiber/status f)
:dead (do
(pp x)
(put env '_ @{:value x}))
:debug (let [nextenv (make-env env)]
(put nextenv '_fiber @{:value f})
(setdyn :debug-level level)
(debug/stacktrace f x)
(print ```
(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))))
entering debugger - (quit) or Ctrl-D to exit
_fiber is bound to the suspended fiber
(default onsignal (make-onsignal env 1))
```)
(repl (fn [buf p]
(def status (parser/state p :delimiters))
(def c ((parser/where p) 0))
(def prompt (string "debug[" level "]:" c ":" status "> "))
(getline prompt buf))
onsignal nextenv))
(debug/stacktrace f x))))
(run-context {:env env
:chunks chunks
:on-status onsignal
:source "repl"}))
(defn- env-walk
[pred &opt env]
(default env (fiber/getenv (fiber/current)))
(def envs @[])
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
(def ret-set @{})
(loop [envi :in envs
k :keys envi
:when (pred k)]
(put ret-set k true))
(sort (keys ret-set)))
(defn all-bindings
"Get all symbols available in an enviroment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk symbol? env))
(defn all-dynamics
"Get all dynamic bindings in an environment. Defaults to the current
fiber's environment."
[&opt env]
(env-walk keyword? env))
# Clean up some extra defs
(put _env 'boot/opts nil)
(put _env 'env-walk nil)
(put _env '_env nil)
###

2
src/core/bytecode.c
View File

@ -203,7 +203,7 @@ int32_t janet_verify(JanetFuncDef *def) {
/* Allocate an empty funcdef. This function may have added functionality
* as commonalities between asm and compile arise. */
JanetFuncDef *janet_funcdef_alloc() {
JanetFuncDef *janet_funcdef_alloc(void) {
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
def->environments = NULL;
def->constants = NULL;

15
src/core/cfuns.c
View File

@ -27,10 +27,6 @@
#include "vector.h"
#endif
static int fixarity0(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 0;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@ -101,8 +97,13 @@ static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
}
static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
(void)args;
janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24));
return janetc_cslot(janet_wrap_nil());
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);
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
@ -270,7 +271,7 @@ static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
/* Arranged by tag */
static const JanetFunOptimizer optimizers[] = {
{fixarity0, do_debug},
{maxarity1, do_debug},
{fixarity1, do_error},
{minarity2, do_apply},
{maxarity1, do_yield},

10
src/core/corelib.c
View File

@ -953,7 +953,7 @@ static const uint32_t error_asm[] = {
};
static const uint32_t debug_asm[] = {
JOP_SIGNAL | (2 << 24),
JOP_RETURN_NIL
JOP_RETURN
};
static const uint32_t yield_asm[] = {
JOP_SIGNAL | (3 << 24),
@ -1002,17 +1002,17 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"fiber is in a state that can be resumed, resuming the current fiber will "
"first resume fiber."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug)\n\n"
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns nil."));
"the running state of the current fiber. Returns the value passed in by resume."));
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield x)\n\n"
JDOC("(yield &opt x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));

33
src/core/vm.c
View File

@ -490,21 +490,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
* waiting to be resumed. In those cases, use input and increment pc. We
* DO NOT use input when resuming a fiber that has been interrupted at a
* breakpoint. */
uint8_t first_opcode;
if (status != JANET_STATUS_NEW &&
((*pc & 0xFF) == JOP_SIGNAL ||
(*pc & 0xFF) == JOP_PROPAGATE ||
(*pc & 0xFF) == JOP_RESUME)) {
stack[A] = in;
pc++;
first_opcode = *pc & 0xFF;
} else if (status == JANET_STATUS_DEBUG) {
first_opcode = *pc & 0x7F;
} else {
first_opcode = *pc & 0xFF;
}
/* The first opcode to execute. If the first opcode has
* the breakpoint bit set and we were in the debug state, skip
* that first breakpoint. */
uint8_t first_opcode = (status == JANET_STATUS_DEBUG)
? (*pc & 0x7F)
: (*pc & 0xFF);
/* Main interpreter loop. Semantically is a switch on
* (*pc & 0xFF) inside of an infinite loop. */
VM_START();
@ -894,7 +893,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
JanetFiber *f = janet_unwrap_fiber(fv);
JanetFiberStatus sub_status = janet_fiber_status(f);
if (sub_status > JANET_STATUS_USER9) {
vm_throw("cannot propagate from new or alive fiber");
vm_commit();
janet_panicf("cannot propagate from fiber with status :%s",
janet_status_names[sub_status]);
}
janet_vm_fiber->child = f;
vm_return((int) sub_status, stack[B]);
@ -949,8 +950,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
VM_OP(JOP_MAKE_TABLE) {
int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart;
if (count & 1)
vm_throw("expected even number of arguments to table constructor");
if (count & 1) {
vm_commit();
janet_panicf("expected even number of arguments to table constructor, got %d", count);
}
JanetTable *table = janet_table(count / 2);
for (int32_t i = 0; i < count; i += 2)
janet_table_put(table, mem[i], mem[i + 1]);
@ -962,8 +965,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
VM_OP(JOP_MAKE_STRUCT) {
int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart;
if (count & 1)
vm_throw("expected even number of arguments to struct constructor");
if (count & 1) {
vm_commit();
janet_panicf("expected even number of arguments to struct constructor, got %d", count);
}
JanetKV *st = janet_struct_begin(count / 2);
for (int32_t i = 0; i < count; i += 2)
janet_struct_put(st, mem[i], mem[i + 1]);
@ -1045,7 +1050,9 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
if (old_status == JANET_STATUS_ALIVE ||
old_status == JANET_STATUS_DEAD ||
old_status == JANET_STATUS_ERROR) {
*out = janet_cstringv("cannot resume alive, dead, or errored fiber");
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
janet_status_names[old_status]);
*out = janet_wrap_string(str);
return JANET_SIGNAL_ERROR;
}