mirror of
https://github.com/janet-lang/janet
synced 2024-12-23 15:00:27 +00:00
Lots of work on improving debugging.
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:
parent
8372d1e499
commit
d37c43716a
8
examples/debug.janet
Normal file
8
examples/debug.janet
Normal 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
136
examples/debugger.janet
Normal 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))
|
@ -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
|
(defn doc-format
|
||||||
"Reformat text to wrap at a given line."
|
"Reformat text to wrap at a given line."
|
||||||
[text]
|
[text]
|
||||||
@ -1346,9 +1370,27 @@
|
|||||||
|
|
||||||
buf)
|
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*
|
(defn doc*
|
||||||
"Get the documentation for a symbol in a given environment."
|
"Get the documentation for a symbol in a given environment."
|
||||||
[sym]
|
[&opt sym]
|
||||||
|
|
||||||
|
(cond
|
||||||
|
(string? sym)
|
||||||
|
(print-index (fn [x] (string/find sym x)))
|
||||||
|
|
||||||
|
sym
|
||||||
|
(do
|
||||||
(def x (dyn sym))
|
(def x (dyn sym))
|
||||||
(if (not x)
|
(if (not x)
|
||||||
(print "symbol " sym " not found.")
|
(print "symbol " sym " not found.")
|
||||||
@ -1370,11 +1412,17 @@
|
|||||||
(if d (doc-format d) "no documentation found.")
|
(if d (doc-format d) "no documentation found.")
|
||||||
"\n\n"))))
|
"\n\n"))))
|
||||||
|
|
||||||
|
# else
|
||||||
|
(print-index identity)))
|
||||||
|
|
||||||
(defmacro doc
|
(defmacro doc
|
||||||
"Shows documentation for the given symbol."
|
"Shows documentation for the given symbol."
|
||||||
[sym]
|
[&opt sym]
|
||||||
~(,doc* ',sym))
|
~(,doc* ',sym))
|
||||||
|
|
||||||
|
(put _env 'env-walk nil)
|
||||||
|
(put _env 'print-index nil)
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### Macro Expansion
|
### Macro Expansion
|
||||||
@ -1719,8 +1767,10 @@
|
|||||||
(on-compile-error msg errf where))))
|
(on-compile-error msg errf where))))
|
||||||
(or guard :a)))
|
(or guard :a)))
|
||||||
(fiber/setenv f env)
|
(fiber/setenv f env)
|
||||||
|
(while (let [fs (fiber/status f)]
|
||||||
|
(and (not= :dead fs) (not= :error fs)))
|
||||||
(def res (resume f nil))
|
(def res (resume f nil))
|
||||||
(when good (if going (onstatus f res))))
|
(when good (when going (onstatus f res)))))
|
||||||
|
|
||||||
# Loop
|
# Loop
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
@ -1746,14 +1796,16 @@
|
|||||||
(when (= (parser/status p) :error)
|
(when (= (parser/status p) :error)
|
||||||
(on-parse-error p where))
|
(on-parse-error p where))
|
||||||
|
|
||||||
env)
|
(in env :exit-value env))
|
||||||
|
|
||||||
(defn quit
|
(defn quit
|
||||||
"Tries to exit from the current repl or context. Does not always exit the application.
|
"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)
|
(setdyn :exit true)
|
||||||
"Bye!")
|
(setdyn :exit-value value)
|
||||||
|
nil)
|
||||||
|
|
||||||
(defn eval-string
|
(defn eval-string
|
||||||
"Evaluates a string in the current environment. If more control over the
|
"Evaluates a string in the current environment. If more control over the
|
||||||
@ -1908,8 +1960,11 @@
|
|||||||
(def f (if (= (type path) :core/file)
|
(def f (if (= (type path) :core/file)
|
||||||
path
|
path
|
||||||
(file/open path :rb)))
|
(file/open path :rb)))
|
||||||
|
(def path-is-file (= f path))
|
||||||
(default env (make-env))
|
(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 chunks [buf _] (file/read f 2048 buf))
|
||||||
(defn bp [&opt x y]
|
(defn bp [&opt x y]
|
||||||
(def ret (bad-parse x y))
|
(def ret (bad-parse x y))
|
||||||
@ -1921,6 +1976,7 @@
|
|||||||
ret)
|
ret)
|
||||||
(unless f
|
(unless f
|
||||||
(error (string "could not find file " path)))
|
(error (string "could not find file " path)))
|
||||||
|
(def nenv
|
||||||
(run-context {:env env
|
(run-context {:env env
|
||||||
:chunks chunks
|
:chunks chunks
|
||||||
:on-parse-error bp
|
:on-parse-error bp
|
||||||
@ -1931,9 +1987,9 @@
|
|||||||
(if exit-on-error (os/exit 1))))
|
(if exit-on-error (os/exit 1))))
|
||||||
:evaluator evaluator
|
:evaluator evaluator
|
||||||
:expander expander
|
:expander expander
|
||||||
:source (or source (if (= f path) "<anonymous>" path))})
|
:source (if path-is-file "<anonymous>" spath)}))
|
||||||
(when (not= f path) (file/close f))
|
(if-not path-is-file (file/close f))
|
||||||
env)
|
nenv)
|
||||||
|
|
||||||
(def module/loaders
|
(def module/loaders
|
||||||
"A table of loading method names to loading functions.
|
"A table of loading method names to loading functions.
|
||||||
@ -1943,7 +1999,6 @@
|
|||||||
:source (fn [path args]
|
:source (fn [path args]
|
||||||
(put module/loading path true)
|
(put module/loading path true)
|
||||||
(def newenv (dofile path ;args))
|
(def newenv (dofile path ;args))
|
||||||
(put newenv :source path)
|
|
||||||
(put module/loading path nil)
|
(put module/loading path nil)
|
||||||
newenv)
|
newenv)
|
||||||
:image (fn [path &] (load-image (slurp path)))})
|
:image (fn [path &] (load-image (slurp path)))})
|
||||||
@ -2000,73 +2055,57 @@
|
|||||||
[& modules]
|
[& modules]
|
||||||
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
|
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
|
||||||
|
|
||||||
|
###
|
||||||
|
###
|
||||||
|
### REPL
|
||||||
|
###
|
||||||
|
###
|
||||||
|
|
||||||
(defn repl
|
(defn repl
|
||||||
"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."
|
caught. Lastly, one can provide an optional environment table to run
|
||||||
|
the repl in."
|
||||||
[&opt chunks onsignal env]
|
[&opt chunks onsignal env]
|
||||||
(def level (+ (dyn :debug-level 0) 1))
|
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(default chunks (fn [buf p] (getline (string "repl:"
|
(default chunks (fn [buf p] (getline (string "repl:"
|
||||||
((parser/where p) 0)
|
((parser/where p) 0)
|
||||||
":"
|
":"
|
||||||
(parser/state p :delimiters) "> ")
|
(parser/state p :delimiters) "> ")
|
||||||
buf)))
|
buf)))
|
||||||
(default onsignal (fn [f x]
|
(defn make-onsignal
|
||||||
|
[e level]
|
||||||
|
(fn [f x]
|
||||||
(case (fiber/status f)
|
(case (fiber/status f)
|
||||||
:dead (do
|
:dead (do
|
||||||
(pp x)
|
(pp x)
|
||||||
(put env '_ @{:value x}))
|
(put e '_ @{:value x}))
|
||||||
:debug (let [nextenv (make-env env)]
|
:debug (let [nextenv (make-env env)]
|
||||||
(put nextenv '_fiber @{:value f})
|
(put nextenv :fiber f)
|
||||||
(setdyn :debug-level level)
|
(put nextenv :debug-level level)
|
||||||
(debug/stacktrace f x)
|
(debug/stacktrace f x)
|
||||||
(print ```
|
(defn debugger-chunks [buf p]
|
||||||
|
|
||||||
entering debugger - (quit) or Ctrl-D to exit
|
|
||||||
_fiber is bound to the suspended fiber
|
|
||||||
|
|
||||||
```)
|
|
||||||
(repl (fn [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))
|
||||||
onsignal nextenv))
|
(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))))
|
(debug/stacktrace f x))))
|
||||||
|
|
||||||
|
(default onsignal (make-onsignal env 1))
|
||||||
|
|
||||||
(run-context {:env env
|
(run-context {:env env
|
||||||
:chunks chunks
|
:chunks chunks
|
||||||
:on-status onsignal
|
:on-status onsignal
|
||||||
:source "repl"}))
|
: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
|
# Clean up some extra defs
|
||||||
(put _env 'boot/opts nil)
|
(put _env 'boot/opts nil)
|
||||||
(put _env 'env-walk nil)
|
|
||||||
(put _env '_env nil)
|
(put _env '_env nil)
|
||||||
|
|
||||||
###
|
###
|
||||||
|
@ -203,7 +203,7 @@ int32_t janet_verify(JanetFuncDef *def) {
|
|||||||
|
|
||||||
/* Allocate an empty funcdef. This function may have added functionality
|
/* Allocate an empty funcdef. This function may have added functionality
|
||||||
* as commonalities between asm and compile arise. */
|
* 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));
|
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
|
||||||
def->environments = NULL;
|
def->environments = NULL;
|
||||||
def->constants = NULL;
|
def->constants = NULL;
|
||||||
|
@ -27,10 +27,6 @@
|
|||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
|
||||||
(void) opts;
|
|
||||||
return janet_v_count(args) == 0;
|
|
||||||
}
|
|
||||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) == 1;
|
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) {
|
static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||||
(void)args;
|
(void)args;
|
||||||
janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24));
|
int32_t len = janet_v_count(args);
|
||||||
return janetc_cslot(janet_wrap_nil());
|
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) {
|
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||||
@ -270,7 +271,7 @@ static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
|||||||
|
|
||||||
/* Arranged by tag */
|
/* Arranged by tag */
|
||||||
static const JanetFunOptimizer optimizers[] = {
|
static const JanetFunOptimizer optimizers[] = {
|
||||||
{fixarity0, do_debug},
|
{maxarity1, do_debug},
|
||||||
{fixarity1, do_error},
|
{fixarity1, do_error},
|
||||||
{minarity2, do_apply},
|
{minarity2, do_apply},
|
||||||
{maxarity1, do_yield},
|
{maxarity1, do_yield},
|
||||||
|
@ -953,7 +953,7 @@ static const uint32_t error_asm[] = {
|
|||||||
};
|
};
|
||||||
static const uint32_t debug_asm[] = {
|
static const uint32_t debug_asm[] = {
|
||||||
JOP_SIGNAL | (2 << 24),
|
JOP_SIGNAL | (2 << 24),
|
||||||
JOP_RETURN_NIL
|
JOP_RETURN
|
||||||
};
|
};
|
||||||
static const uint32_t yield_asm[] = {
|
static const uint32_t yield_asm[] = {
|
||||||
JOP_SIGNAL | (3 << 24),
|
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 "
|
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||||
"first resume fiber."));
|
"first resume fiber."));
|
||||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||||
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||||
JDOC("(debug)\n\n"
|
JDOC("(debug &opt x)\n\n"
|
||||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
"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,
|
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||||
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||||
JDOC("(error e)\n\n"
|
JDOC("(error e)\n\n"
|
||||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||||
janet_quick_asm(env, JANET_FUN_YIELD,
|
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||||
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
"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 "
|
"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 "
|
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||||
"return the value that was passed to resume."));
|
"return the value that was passed to resume."));
|
||||||
|
@ -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
|
* 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
|
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||||
* breakpoint. */
|
* breakpoint. */
|
||||||
|
uint8_t first_opcode;
|
||||||
if (status != JANET_STATUS_NEW &&
|
if (status != JANET_STATUS_NEW &&
|
||||||
((*pc & 0xFF) == JOP_SIGNAL ||
|
((*pc & 0xFF) == JOP_SIGNAL ||
|
||||||
(*pc & 0xFF) == JOP_PROPAGATE ||
|
(*pc & 0xFF) == JOP_PROPAGATE ||
|
||||||
(*pc & 0xFF) == JOP_RESUME)) {
|
(*pc & 0xFF) == JOP_RESUME)) {
|
||||||
stack[A] = in;
|
stack[A] = in;
|
||||||
pc++;
|
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
|
/* Main interpreter loop. Semantically is a switch on
|
||||||
* (*pc & 0xFF) inside of an infinite loop. */
|
* (*pc & 0xFF) inside of an infinite loop. */
|
||||||
VM_START();
|
VM_START();
|
||||||
@ -894,7 +893,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
JanetFiber *f = janet_unwrap_fiber(fv);
|
JanetFiber *f = janet_unwrap_fiber(fv);
|
||||||
JanetFiberStatus sub_status = janet_fiber_status(f);
|
JanetFiberStatus sub_status = janet_fiber_status(f);
|
||||||
if (sub_status > JANET_STATUS_USER9) {
|
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;
|
janet_vm_fiber->child = f;
|
||||||
vm_return((int) sub_status, stack[B]);
|
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) {
|
VM_OP(JOP_MAKE_TABLE) {
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1) {
|
||||||
vm_throw("expected even number of arguments to table constructor");
|
vm_commit();
|
||||||
|
janet_panicf("expected even number of arguments to table constructor, got %d", count);
|
||||||
|
}
|
||||||
JanetTable *table = janet_table(count / 2);
|
JanetTable *table = janet_table(count / 2);
|
||||||
for (int32_t i = 0; i < count; i += 2)
|
for (int32_t i = 0; i < count; i += 2)
|
||||||
janet_table_put(table, mem[i], mem[i + 1]);
|
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) {
|
VM_OP(JOP_MAKE_STRUCT) {
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1) {
|
||||||
vm_throw("expected even number of arguments to struct constructor");
|
vm_commit();
|
||||||
|
janet_panicf("expected even number of arguments to struct constructor, got %d", count);
|
||||||
|
}
|
||||||
JanetKV *st = janet_struct_begin(count / 2);
|
JanetKV *st = janet_struct_begin(count / 2);
|
||||||
for (int32_t i = 0; i < count; i += 2)
|
for (int32_t i = 0; i < count; i += 2)
|
||||||
janet_struct_put(st, mem[i], mem[i + 1]);
|
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 ||
|
if (old_status == JANET_STATUS_ALIVE ||
|
||||||
old_status == JANET_STATUS_DEAD ||
|
old_status == JANET_STATUS_DEAD ||
|
||||||
old_status == JANET_STATUS_ERROR) {
|
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;
|
return JANET_SIGNAL_ERROR;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user