ref: 4f0538a0ae8bc62d076cfd5c60885fe66179e178
dir: /src/plan9/lsd.sl/
#!/bin/sl -i
(defstruct reg
"A register of the process. The fields are internal. To read the
value of a register use `readreg`"
: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. Loc 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
loc retpc sp locals)
(def coref NIL)
(def textf 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 (readtext addr . rest)
(unless textf (error "not attached to proc"))
(io-pread textf addr rest))
(def (writecore addr . rest)
(unless coref (error "not attached to proc"))
(io-pwrite coref addr rest))
(def (readreg reg)
(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)
"Reads the value from the core file at the symbol's address."
:doc-group lsd
:doc-see sym-local
(unless coref (error "not attached to proc"))
(apply readcore (cons (symbol-addr symbol) rest)))
(def (hex n) (str "0x" (num->str n 16)))
(def (oct n) (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))
(when textf (io-close textf))
(void))
(def (attach)
(detach)
(set! regsf (procfile 'regs :read :write))
(set! fpregsf (procfile 'fpregs :read :write))
(set! coref (procfile 'mem :read :write))
(set! textf (procfile 'text :read))
(void))
(def (status)
(let {[sf (procfile 'status)]}
(prog1 (caddr (read-all sf))
(io-close sf))))
(def tracers (table
"386" (λ () (lsd-ctrace (curPC) (readreg SP) (u64 0)))
"amd64" (λ () (lsd-ctrace (curPC) (readreg SP) (u64 0)))
"arm64" (λ () (lsd-ctrace (curPC) (readreg SP) (readreg R30)))))
(def ctrace (get tracers (os-getenv "objtype")))
(def (_stk)
"Return the call stack in the form of a list of stack frames."
:doc-group lsd
:doc-see frame
(reverse! (ctrace)))
(def (stk)
"Pretty print the stack trace without showing locals. Still WIP."
:doc-group lsd
:doc-see _stk
(def (go 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 (frame-loc f))
"(" params ")\n")))
(for-each go (_stk)))
(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 (curPC)))
"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 (curPC)))
"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)
"Return a local symbol from the attached proc's current stack frame or
`NIL`. Input is a `sym`.
Examples:
(sym-local 'i) → #(symbol \"i\" #\\a 140737488350940)
(symbol-read (sym-local 'argc) 's32) → #s32(2)"
:doc-group lsd
(let {[ss (str s)]}
(find ss
(frame-locals (car (_stk)))
:key symbol-name)))
(def (sym-addr s)
"Return the address of a symbol from the attached proc's symbol table
or NIL. Input is a sym."
:doc-group lsd
(symbol-addr (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)
(bpset (car (follow (symbol-addr (get (global-text globals) 'main)))))
(startstop)
(set! pids (cons pid pids))
pid))
(def (lsd a)
(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 (aref v 1))
(set! bpinst (aref v 2))
(set! globals (make-global :text text :data data)))
(and (>= pid 0) (attach)))
(let* {[proc (cadr *argv*)]
[pid (str->num proc)]}
(if pid (lsd pid) (lsd proc)))