ref: bbfee60f6716dce8cf7a802c044cf7d0fe8bb6f2
dir: /src/plan9/lsd.sl/
#!/bin/sl -i
(defstruct reg name type addr size)
(defstruct symbol 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."
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."
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))
(note (io-readall notef)))
(io-close notef)
note)
(λ (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."
(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 (readsym symbol . rest)
(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-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.")
(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 (new . args)
(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)))
(def (status)
(let* ((sf (procfile 'status))
(stats (read-all sf)))
(io-close sf)
(caddr stats)))
(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)
(reverse!
(map (λ (f) (frame-locals f (reverse! (frame-locals f))) f)
(ctrace))))
(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."
(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)
"Continue program execution. Return the next instruction
address to be executed or `NIL` if the program has exited."
(let ((addr (curPC)))
(when (has? bptbl addr) (step))
(startstop)
(curPC)))
(def (func)
"Continue program execution until the current function returns."
(let* ((bp (frame-retpc (car (_stk))))
(o (bpsave bp)))
(writecore bp bpinst)
(cont)
(writecore bp o))
(curPC))
(def (line)
"Step one line of the source code.
This will step into functions not over."
(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"
(let ((f (car (_stk))))
(line)
(if (equal? f (car (_stk)))
(curPC)
(begin (func)
(line)))))
(def (asmlist (n 5) (addr (curPC)))
"Return a list of the next `n` disassembled instructions starting at `addr`.
Each element in the list has the form `(address . instr)` where `instr`
is the disassembled instruction at the `address`.
Examples: just like `(asm)` but returns a list instead of printing."
(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"
(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."
(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 (Bline)
"Step forward one line of source code and then plumb the
new line (make a bee line) to your editor."
(line)
(Bsrc))
(def (Bover)
"Same as Bline but with `over`"
(over)
(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\""
(if line
(lsd-file2pc f line)
(let ((s (str-split f ":")))
(when (/= (length s) 2) (error "invalid file"))
(let ((line (str->num (cadr s))))
(unless line (error "bad line number"))
(lsd-file2pc (car s) line)))))
(def (sym-find s)
"Return a symbol from the attached proc's symbol table or NIL.
Input is a sym.
Examples:
#;> (sym-find 'strecpy)
#(symbol \"strecpy\" #\\T 2276784)"
(let* ((find (λ (tbl k) (and (has? tbl k) (get tbl k)))))
(or (find (global-text globals) s)
(find (global-data globals) s))))
(def (sym-addr s)
"Return the address of a symbol from the attached proc's
symbol table or NIL. Input is a sym."
(symbol-addr (sym-find 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)))
(let* ((proc (cadr *argv*))
(pid (str->num proc)))
(if pid (lsd pid) (lsd proc)))