ref: b78c9edfb4e91efa4aa61e09feaf3da4848342b0
dir: /src/plan9/lsd.sl/
#!/bin/sl -i
(doc-group lsd
"Debugging functionality.")
(defstruct reg
"A register of the processor.
All registers are exposed as top-level symbols. The fields are
internal. The top-level symbol `registers` is a list of all
available registers. To read the value of a register use `reg-read`
Examples:
`(reg-read AX)`"
:doc-group lsd
:doc-see reg-read
:doc-see registers
name type addr size)
(defstruct symbol
"A symbol of the process.
Name is a string denoting the symbol, type is a character as
described in a.out(6), and address is the location of the symbol in
the process address space"
:doc-group lsd
name type addr)
(defstruct global
"All the global symbols, separated into text and data symbols.
The text and data fields are both tables from strings to symbols."
:doc-group lsd
:doc-see symbol
text data)
(defstruct frame
"A stack frame.
Sym is the enclosing function symbol and instruction address of the
frame. Retpc is the return instruction address. Sp is the stack
pointer value. Locals are all the local symbols."
:doc-group lsd
:doc-see symbol
sym retpc sp locals)
(def tracers (table
"386" (λ () (lsd-ctrace (curPC) (reg-read SP) (u64 0)))
"68020" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read A7)))
"amd64" (λ () (lsd-ctrace (curPC) (reg-read SP) (u64 0)))
"arm" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read R14)))
"arm64" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read R30)))
"mips" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read R31)))
"power" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read LR)))
"power64" (λ () (lsd-ctrace (curPC) (reg-read SP) (reg-read LR)))))
(def coref NIL)
(def regsf NIL)
(def fpregsf NIL)
(def proc-stdin NIL)
(def pids NIL)
(def pid -1)
(def bptbl (table))
(def ctrace (get tracers (os-getenv "objtype")))
(def (procfile s . flags)
(when (< pid 0) (error "no active process"))
(let {[path (str "/proc/" pid "/" s)]}
(apply file (cons path flags))))
(def (writectl msg)
(let {[ctlf (procfile 'ctl :write)]}
(io-write ctlf msg)
(io-close ctlf)))
(def (exited)
(when (< pid 0) (error "no active pid"))
(princ "process " pid " exited\n")
(set! pids (cdr pids))
(set! pid (if pids (car pids) -1))
(set! bptbl (table))
(detach))
(def (readnote)
(trycatch
(let {[notef (procfile 'note :read)]}
(prog1 (io-readall notef)
(io-close notef)))
(λ (e) (if (and (eq? (car e) 'io-error)
(= (str-find (cadr e) "could not open") 0))
(exited)
(raise e)))))
(def (start) (writectl "start"))
(def (startstop) (writectl "startstop") (readnote))
(def (stop) (writectl "stop") (readnote))
(def (waitstop)
(unless (eq? (status) 'Stopped)
(princ "Waiting... " status "\n")
(stop)))
(def (follow addr)
"Return a list of the next possible executing instructions."
:doc-group lsd
(lsd-follow addr))
(defmacro (io-pread f off . rest)
`(begin (io-seek ,f ,off)
(io-read ,f ,.rest)))
(defmacro (io-pwrite f off . rest)
`(begin (io-seek ,f ,off)
(io-write ,f ,.rest)
(io-flush ,f)))
(defmacro (core-read addr . rest)
`(begin (unless coref (error "not attached to proc"))
(io-pread coref ,addr ,.rest)))
(defmacro (core-write addr . rest)
`(begin (unless coref (error "not attached to proc"))
(io-pwrite coref ,addr ,.rest)))
(def (reg-read reg)
"Read the value of a register.
Examples:
(reg-read AX) ; read the return register on amd64
(reg-read PC) ; read the current instruction address."
:doc-group lsd
:doc-see reg
:doc-see registers
(unless regsf (error "not attached to proc"))
(let {[f (case (reg-type reg)
((:gpreg) regsf)
((:fpreg) fpregsf))]}
(io-pread f (reg-addr reg) (reg-size reg))))
(defmacro (symbol-read symbol . rest)
"Read the value from the core file at the symbol's address."
:doc-group lsd
:doc-see local-symbol
:doc-see global-symbol
`(core-read (symbol-addr ,symbol) ,.rest))
(def (symbol-find s)
"Return a symbol, searching first in the local stack frame then
in the global symbol table.
Input is a string."
:doc-group lsd
(or (local-symbol s)
(global-symbol s)))
(def (instr-addr loc)
«Return the program instruction address corresponding to a location.
A location can be:
1. A string that refers to a symbol (such as a function) in
the process's symbol table,
2. A string of the form "file:line" used to find a program
address corresponding to given line of source code,
3. A number which is the address itself,
4. A symbol in which case the symbol's address is used.
Examples:
(instr-addr "strecpy") → 2276985; look up a symbol
(instr-addr "/sys/src/cmd/ls.c:75") → 2097311; source code address»
:doc-see filepc
:doc-see symbol
:doc-group lsd
(def (str-addr s)
(trycatch
(filepc s)
(λ (e) (when (eq? (car e) 'io-error) (raise e))
(let {[symb (global-symbol s :text T)]}
(if symb
(symbol-addr symb)
(error "could not find symbol " s))))))
(cond ((str? loc) (str-addr loc))
((num? loc) (ptr loc))
((symbol? loc) (symbol-addr loc))
(else (error "str|num|symbol"))))
(def (bpsave a) (core-read a 'u8 (length bpinst)))
(def (bpset at)
"Set a breakpoint at the location.
Location is as in instr"
:doc-see instr
:doc-see bpdel
:doc-group lsd
(waitstop)
(let {[addr (instr-addr at)]}
(when (has? bptbl addr)
(error "breakpoint already set at " at))
(put! bptbl addr (bpsave addr))
(core-write addr bpinst)))
(def (bpdel at)
"Delete a breakpoint at the location.
Location is as in instr"
:doc-see instr
:doc-see bpdel
:doc-group lsd
(waitstop)
(let {[addr (instr-addr at)]}
(unless (has? bptbl addr)
(error "breakpoint not set at " at))
(core-write addr (get bptbl addr))
(del! bptbl addr)))
(def (detach)
(when regsf (io-close regsf))
(when fpregsf (io-close fpregsf))
(when coref (io-close coref))
(void))
(def (attach)
(detach)
(set! regsf (procfile 'regs :read :write))
(set! fpregsf (procfile 'fpregs :read :write))
(set! coref (procfile 'mem :read :write))
(set! pids (cons pid pids))
(void))
(def (status)
"Return the running status of the process."
:doc-group lsd
(let {[sf (procfile 'status)]}
(prog1 (caddr (read-all sf))
(io-close sf))))
(def (_stk (:level 0) (:n NIL))
"Return the call stack in the form of a list of stack frames.
Optionally specify what level of the stack to return, starting at
the innermost level and how many levels to display."
:doc-group lsd
:doc-see frame
(let {[s (list-tail (reverse! (ctrace)) level)]}
(if n (list-head s n) s)))
(def (stk (:level 0) (:n NIL) (:locals NIL))
"Print the stack trace optionally showing local auto values.
Bugs:
Prints the values of parameters and autos as unsigned
64 bit integers, not as their actual types."
:doc-group lsd
:doc-see _stk
:doc-see lstk
(def (go pc fs)
(if (not fs) pc
(let* {[f (car fs)]
[fsym (frame-sym f)]}
(receive (params autos)
(partition (λ (x) (equal? #\p (symbol-type x)))
(frame-locals f))
(set! params (sort params #.< :key symbol-addr))
(set! autos (sort autos #.> :key symbol-addr))
(princ (symbol-name fsym) "(")
(princ
(str-join
(map (λ (p)
(str (symbol-name p) "=" (symbol-read p 'ptr)))
params)
", "))
(princ ")+" (ptr (- pc (symbol-addr fsym))) " ")
(princ (src pc) "\n")
(when locals
(for-each (λ (l) (princ " "
(symbol-name l)
"="
(symbol-read l 'ptr)
"\n"))
autos))
(go (frame-retpc f) (cdr fs))))))
(let* {[tos (go (curPC) (_stk :level level :n n))]
[topsym (lsd-findsym tos)]}
(princ (symbol-name topsym)
"+"
(ptr (- tos (symbol-addr topsym)))
" "
(src tos)
"\n")))
(def (lstk (:level 0) (:n NIL))
"Print the stack trace showing local auto values."
:doc-group lsd
:doc-see _stk
:doc-see stk
(stk :locals T :level level :n n))
(def (curPC) (if (>= pid 0)
(ptr (reg-read PC))
(error "No active process")))
(def (step (n 1))
"Step `n` assembly instructions. Return the next instruction address
to be executed or `NIL` if the program has exited."
:doc-group lsd
(if (= n 0)
(curPC)
(let* {[addr (curPC)]
[on-bp (has? bptbl addr)]}
(when on-bp (core-write addr (get bptbl addr)))
(let* {[fs (follow addr)]
[os (map bpsave fs)]}
(for-each (λ (f) (core-write f bpinst)) fs)
(startstop)
(for-each (λ (f o) (core-write f o)) fs os)
(when on-bp (core-write addr bpinst))
(step (1- n))))))
(def (cont (:print T))
"Continue program execution.
Return the next instruction address to be executed or `void` if the
program has exited. Optionally print any notes that may have caused
the program to stop."
:doc-group lsd
(when (has? bptbl (curPC)) (step))
(let {[note (startstop)]}
(and print (not (void? note)) (princ note "\n")))
(trycatch
(let {[pc (curPC)]}
(and print (princ pc "\n")))
(λ (_) (void))))
(def (func)
"Continue program execution until the current function returns."
:doc-group lsd
(let* {[bp (frame-retpc (car (_stk)))]
[o (bpsave bp)]}
(core-write bp bpinst)
(cont :print NIL)
(core-write bp o))
(curPC))
(def (line)
"Step one line of the source code.
Note: This will step into functions not over."
:doc-group lsd
(let {[orig (src)]}
(def (go)
(step)
(if (not (equal? orig (src)))
(curPC)
(go)))
(go)))
(def (over)
"Step one line of source code, going over a function call, not in.
Bugs:
Stepping over a function call will remain on the same line
whenever there is an assignment of the return value. You will
have to step twice in that case."
:doc-group lsd
(let {[f (car (_stk))]}
(line)
(if (equal? f (car (_stk)))
(curPC)
(func))))
(def (asmlist (n 5) (addr (reg-read PC)))
"Return a list of the next `n` disassembled instructions starting at
`addr`. Just like `(asm)` but returns a list instead of printing.
Each element in the list has the form `(address . instr)` where
`instr` is the disassembled instruction at the `address`."
:doc-group lsd
(if (<= n 0)
()
(let {[on-bp (has? bptbl addr)]}
(when on-bp (core-write addr (get bptbl addr)))
(let {[instr (lsd-das addr)]
[isize (lsd-instsize addr)]}
(when on-bp (core-write addr bpinst))
(cons (cons (ptr addr) instr) (asmlist (1- n) (+ addr isize)))))))
(def (asm (n 5) (addr (reg-read PC)))
«Print the next `n` disassembled instructions at `addr`.
Examples:
(asm) ; print out 5 from current program instruction.
(asm 10) ; print out 10 from current program instruction.
(asm 3 (instr-addr "strecpy")) ; 3 instructions from strecpy»
:doc-group lsd
(for-each (λ (i) (princ (car i) "\t" (cdr i) "\n"))
(asmlist n addr)))
(def (src (addr (curPC)))
"Return a string of the filename and line number corresponding to the
instruction address."
:doc-group lsd
(when addr (lsd-fileline addr)))
(def (Bsrc (addr (curPC)))
"Send a plumb message of the filename and line number corresponding to
the instruction address so that the source code can be viewed in your
text editor."
(let {[s (src addr)]
[plumbf (file "/mnt/plumb/send" :write)]}
(io-write plumbf
(str "plumb\n\n"
(path-cwd)
"\ntext\n\n"
(length s)
"\n"
s))
(io-close plumbf)))
(def (B stepper)
"Step forward using the stepper and then plumb the new line to your
editor.
Examples:
(B line) ; step one line and then see
(B cont) ; continue and then see where you stop"
:doc-group lsd
(stepper)
(Bsrc))
(def (filepc f (line NIL))
«Return the instruction address corresponding to a filename and line
number. It is the inverse of `(src addr)`.
Examples:
(filepc "/sys/src/cmd/cat.c:5") → 2097192
(filepc "/sys/src/cmd/cat.c" 5) → 2097192
(src 2097192) → "/sys/src/cmd/cat.c:5"»
:doc-group lsd
(if line
(lsd-file2pc f line)
(let {[s (str-split f ":")]}
(unless (= (length s) 2) (error «invalid "file:line" format»))
(let {[line (str->num (cadr s))]}
(unless line (error "bad line number"))
(lsd-file2pc (car s) line)))))
(def (global-symbol s (:text NIL) (:data NIL))
«Return a symbol from the attached proc's symbol table or `NIL`.
Input is a `str`. Optionally specify whether to search only text
symbols or data symbols. The default is to search both.
Examples:
(global-symbol "strecpy") → #(symbol "strecpy" #\T 2276784)»
:doc-group lsd
(def (find tbl k) (and (has? tbl k) (get tbl k)))
(and (not text) (not data) (set! text T) (set! data T))
(or (and text (find (global-text globals) s))
(and data (find (global-data globals) s))))
(def (local-symbol s (:level 0))
«Return a local symbol from the attached proc's current stack frame
or `NIL`. Input is a `str`. Optionally specify what level of the
stack frame to search.
Examples:
(local-symbol "i") → #(symbol "i" #\a 140737488350940)
(symbol-read (local-symbol "argc") 's32) → #s32(2)»
:doc-group lsd
:doc-see _stk
(find s
(frame-locals (car (_stk :level level)))
:key symbol-name))
(add-exit-hook
(λ (s)
(when proc-stdin (io-close proc-stdin))
(detach)
(lsd-cleanup)
(for-each (λ (p) (princ "echo kill > /proc/" p "/ctl\n"))
pids)))
(def (new . args)
«Start a new process for debugging.
Args will be passed unparsed as the argument vector to the executable.
Examples:
(new) ; new process with no arguments
(new "-v" "/sys/src/cmd/sl/slmain.c") ; two arguments.»
:doc-group lsd
(let {[v (apply lsd-new args)]}
(when proc-stdin (io-close proc-stdin))
(set! bptbl (table))
(set! pid (aref v 0))
(set! proc-stdin (aref v 1))
(attach)
(map bpset (follow (symbol-addr (global-symbol "main"))))
(startstop)
pid))
(def (lsd a)
"Entry point to lsd. Load the symbol table, the registers and
attach to a process if one is running."
:doc-group lsd
(let* {[v (lsd-load a)]
[f (λ (symbol tbl) (put! tbl (symbol-name symbol) symbol))]
[text (foldl f (table) (aref v 3))]
[data (foldl f (table) (aref v 4))]}
(set! pid (aref v 0))
(set! registers (reverse! (aref v 1)))
(set! bpinst (aref v 2))
(set! globals (make-global :text text :data data)))
(if (>= pid 0) (attach) (void)))
(def (usage)
(princ "usage: " (car *argv*) " [pid | textfile]\n")
(exit))
(when (str-find (car *argv*) "lsd")
(unless (cdr *argv*) (usage))
(let* {[proc (cadr *argv*)]
[pid (str->num proc)]}
(if pid (lsd pid) (lsd proc))))
(set! top-level-exception-handler
(λ (e) (with-output-to *stderr*
(print-exception e))))