ref: 32a1b47da6fe0e872c66d2721ff221ff1a5e8ba8
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 `readreg`
Examples:
`(readreg AX)`"
:doc-group lsd
:doc-see readreg
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 syms 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 coref NIL)
(def regsf NIL)
(def fpregsf NIL)
(def proc-stdin NIL)
(def pids NIL)
(def bptbl (table))
(def (procfile s . flags)
(when (< pid 0) (error "no active pid"))
(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 (follow addr)
"Return a list of the next possible executing instructions."
:doc-group lsd
(lsd-follow addr))
(def (io-pread f off rest)
(io-seek f off)
(apply io-read (cons f rest)))
(def (io-pwrite f off rest)
(io-seek f off)
(apply io-write (cons f rest))
(io-flush f))
(def (readcore addr . rest)
(unless coref (error "not attached to proc"))
(io-pread coref addr rest))
(def (writecore addr . rest)
(unless coref (error "not attached to proc"))
(io-pwrite coref addr rest))
(def (readreg reg)
"Read the value of a register.
Examples:
(readreg AX) ; read the return register on amd64
(readreg 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) (list (reg-size reg)))))
(def (symbol-read symbol . rest)
"Read the value from the core file at the symbol's address."
:doc-group lsd
:doc-see sym-local
:doc-see sym-global
:doc-see sym-addr
(unless coref (error "not attached to proc"))
(apply readcore (cons (symbol-addr symbol) rest)))
(def (loc->addr loc)
(cond ((sym? loc) (symbol-addr
(or (sym-local loc)
(sym-global loc))))
((num? loc) (u64 loc))
((symbol? loc) (symbol-addr loc))
(else (error "sym|num|symbol"))))
(def (read-loc loc sz)
(readcore (loc->addr loc) sz))
(def (c-ptr loc) (read-loc loc ptrsz))
(def (c-int loc) (read-loc loc 's32))
(def c-long c-int)
(def (c-uint loc) (read-loc loc 'u32))
(def (c-str loc)
(def (go a)
(let {[v (readcore a 'byte)]}
(if (= v (byte 0))
()
(cons v (go (1+ a))))))
(apply arr (cons 'byte (go (c-ptr (loc->addr loc))))))
(def (hex n)
"Display an integer in hex format."
:doc-group lsd
(str "0x" (num->str n 16)))
(def (oct n)
"Display an integer in octal format."
:doc-group lsd
(str "0" (num->str n 8)))
(def (bpsave a) (readcore a 'byte (length bpinst)))
(let {[bp_init (λ (loc)
(when (< pid 0) (error "no running process"))
(unless (eq? (status) 'Stopped)
(begin (princ "Waiting... " status "\n")
(stop)))
(cond ((sym? loc) (symbol-addr
(get (global-text globals) loc)))
((num? loc) (u64 loc))
((symbol? loc) (symbol-addr loc))
((str? loc) (filepc loc))
(else (error "sym|num|symbol|file:line"))))]}
(set! bpset (λ (loc)
(let {[addr (bp_init loc)]}
(when (has? bptbl addr)
(error "breakpoint already set at " loc))
(put! bptbl addr (bpsave addr))
(writecore addr bpinst))))
(set! bpdel (λ (loc)
(let {[addr (bp_init loc)]}
(unless (has? bptbl addr)
(error "breakpoint not set at " loc))
(writecore addr (get bptbl addr))
(del! bptbl addr)))))
(doc-for (bpset loc)
«Set a breakpoint.
The location can be one of the following:
1. A sym, in which case the address will be retrieved from
the global text symbols of the process,
2. A num which is the address at which to place the break.
3. An LSD symbol in which the case the symbol's address is used.
4. A string of the form "file:line" which specifies a line in a
file of source code.
Examples:
(bpset 'strcpy) ; breakpoint on strcpy function.
(bpset (curPC)) ; breakpoint on current instruction.
(bpset "/sys/src/cmd/cat.c:26") ; breakpoint on line 26.»
:doc-group lsd)
(doc-for (bpdel loc)
«Delete a breakpoint.
The location can be one of the following:
1. A sym, in which case the address will be retrieved from
the global text symbols of the process,
2. A num which is the address at which to place the break.
3. An LSD symbol in which the case the symbol's address is used.
4. A string of the form "file:line" which specifies a line in a
file of source code.
Examples:
(bpdel 'strcpy) ; remove breakpoint on strcpy function.
(bpdel (curPC)) ; remove breakpoint on current instruction.
(bpdel "/sys/src/cmd/cat.c:26") ; remove breakpoint on line 26.»
:doc-group lsd)
(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 tracers (table
"386" (λ () (lsd-ctrace (curPC) (readreg SP) (u64 0)))
"68020" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg A7)))
"amd64" (λ () (lsd-ctrace (curPC) (readreg SP) (u64 0)))
"arm" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg R14)))
"arm64" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg R30)))
"mips" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg R31)))
"power" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg LR)))
"power64" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg LR)))))
(def ctrace (get tracers (os-getenv "objtype")))
(def ptrsz (lsd-ptrsize))
(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) "=" (hex (symbol-read p 'u64))))
params)
", "))
(princ ")+" (hex (- pc (symbol-addr fsym))) " ")
(princ (src pc) "\n")
(when locals
(for-each (λ (l) (princ " "
(symbol-name l)
"="
(hex (symbol-read l 'u64))
"\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)
"+"
(hex (- 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) (and (>= pid 0) (readreg PC)))
(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 (writecore addr (get bptbl addr)))
(let* {[f (follow addr)]
[o (map bpsave f)]}
(for-each (λ (a) (writecore a bpinst)) f)
(startstop)
(map writecore f o)
(when on-bp (writecore addr bpinst))
(step (1- n))))))
(def (cont (:print T))
"Continue program execution. Return the next instruction address to be
executed or `NIL` if the program has exited."
:doc-group lsd
(when (has? bptbl (curPC)) (step))
(let {[note (startstop)]}
(and print (not (void? note)) (princ note "\n")))
(let {[pc (curPC)]}
(and print pc (princ (hex pc) "\n"))))
(def (func)
"Continue program execution until the current function returns."
:doc-group lsd
(let* {[bp (frame-retpc (car (_stk)))]
[o (bpsave bp)]}
(writecore bp bpinst)
(cont :print NIL)
(writecore bp o))
(curPC))
(def (line)
"Step one line of the source code.
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 (readreg 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 (writecore addr (get bptbl addr)))
(let {[instr (lsd-das addr)]
[isize (lsd-instsize addr)]}
(when on-bp (writecore addr bpinst))
(cons (cons addr instr) (asmlist (1- n) (+ addr isize)))))))
(def (asm (n 5) (addr (readreg 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 (sym-addr 'strecpy)) ; 3 instructions from strecpy"
:doc-group lsd
(for-each (λ (i) (princ (hex (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 (sym-global s)
«Return a symbol from the attached proc's symbol table or `NIL`. Input
is a `sym`.
Examples:
(sym-global 'strecpy) → #(symbol "strecpy" #\T 2276784)»
:doc-group lsd
(def (find tbl k) (and (has? tbl k) (get tbl k)))
(or (find (global-text globals) s)
(find (global-data globals) s)))
(def (sym-local s (:level 0))
«Return a local symbol from the attached proc's current stack frame
or `NIL`. Input is a `sym`. Optionally specify what level of the
stack frame to search.
Examples:
(sym-local 'i) → #(symbol "i" #\a 140737488350940)
(symbol-read (sym-local 'argc) 's32) → #s32(2)»
:doc-group lsd
:doc-see _stk
(let {[ss (str s)]}
(find ss
(frame-locals (car (_stk :level level)))
:key symbol-name)))
(def (sym-addr s (:local NIL))
"Return the address of a symbol from the attached proc's symbol table
or NIL. Input is a sym. Optionally specify whether to search the
local stack frame for the symbol."
:doc-group lsd
(symbol-addr ((if local sym-local sym-global) s)))
(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 (sym-addr '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 (sym (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)))
(and (>= pid 0) (attach)))
(def (usage)
(princ "usage: " (car *argv*) " [pid | textfile]\n")
(exit))
(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))))