ref: daf109ca9fc190db105b7dc75e2bd84c13dba312
parent: 80771da12a271c80a9786f299ec464a7dbd11800
author: spew <spew@cbza.org>
date: Sun Apr 6 14:35:29 EDT 2025
lsd: switch to using strings to refer to symbols, various cleanups
--- a/src/plan9/lsd.c
+++ b/src/plan9/lsd.c
@@ -462,9 +462,12 @@
}
sl_purefn
-BUILTIN("lsd-ptrsize", lsd_ptrsize)+BUILTIN("lsd-ptr", lsd_ptr) {+ sl_v ptrsym;
+
USED(args);
argcount(nargs, 0);
- return sizeof(void*) == 4 ? sl_u32sym : sl_u64sym;
+ ptrsym = sizeof(void*) == 4 ? sl_u32sym : sl_u64sym;
+ return sym_value(ptrsym);
}
--- a/src/plan9/lsd.sl
+++ b/src/plan9/lsd.sl
@@ -8,51 +8,65 @@
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`
+ available registers. To read the value of a register use `reg-read`
Examples:
- `(readreg AX)`"
+ `(reg-read AX)`"
:doc-group lsd
- :doc-see readreg
+ :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"
+
+ 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."
+ 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."
+
+ 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 ptr (lsd-ptr))
(def (procfile s . flags)
- (when (< pid 0) (error "no active pid"))
+ (when (< pid 0) (error "no active process"))
(let {[path (str "/proc/" pid "/" s)]}(apply file (cons path flags))))
@@ -82,6 +96,10 @@
(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."
@@ -88,30 +106,30 @@
:doc-group lsd
(lsd-follow addr))
-(def (io-pread f off rest)
- (io-seek f off)
- (apply io-read (cons f rest)))
+(defmacro (io-pread f off . rest)
+ `(begin (io-seek ,f ,off)
+ (io-read ,f ,.rest)))
-(def (io-pwrite f off rest)
- (io-seek f off)
- (apply io-write (cons f rest))
- (io-flush f))
+(defmacro (io-pwrite f off . rest)
+ `(begin (io-seek ,f ,off)
+ (io-write ,f ,.rest)
+ (io-flush ,f)))
-(def (readcore addr . rest)
- (unless coref (error "not attached to proc"))
- (io-pread coref addr rest))
+(defmacro (core-read addr . rest)
+ `(begin (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))
+(defmacro (core-write addr . rest)
+ `(begin (unless coref (error "not attached to proc"))
+ (io-pwrite coref ,addr ,.rest)))
-(def (readreg reg)
+(def (reg-read reg)
"Read the value of a register.
Examples:
- (readreg AX) ; read the return register on amd64
- (readreg PC) ; read the current instruction address."
+ (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
@@ -119,44 +137,55 @@
(let {[f (case (reg-type reg)((:gpreg) regsf)
((:fpreg) fpregsf))]}
- (io-pread f (reg-addr reg) (list (reg-size reg)))))
+ (io-pread f (reg-addr reg) (reg-size reg))))
-(def (symbol-read symbol . rest)
+(defmacro (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"))))
+ :doc-see local-symbol
+ :doc-see global-symbol
+ `(core-read (symbol-addr ,symbol) ,.rest))
-(def (read-loc loc sz)
- (readcore (loc->addr loc) sz))
+(def (str->symbol s)
+ (or (local-symbol s)
+ (global-symbol s)))
-(def (c-ptr loc) (read-loc loc ptrsz))
+(def (str->addr s (:str->symbol str->symbol))
+ "Return the address corresponding to a source code line or symbol.
+
+ Input is a string. By default str->symbol is used to lookup
+ symbols in the local stack frame and then the global text and data
+ symbol tables."
+ :doc-see loc->addr
+ :doc-see str->symbol
+ :doc-group lsd
+ (trycatch
+ (filepc s)
+ (λ (e) (when (eq? (car e) 'io-error) (raise e))
+ (let {[symb (symbol-addr (str->symbol s))]}+ (if symb
+ (symbol-addr symb)
+ (error "could not find symbol " s))))))
-(def (c-int loc) (read-loc loc 's32))
+(def (loc->addr loc (:str->symbol str->symbol))
+ «Return the address of a location.
-(def c-long c-int)
+ A location refers to either
+ 1. A string that refers to a symbol in the process's
+ symbol table or call stack,
+ 2. A string of the form "file:line" used to look up
+ an instruction address corresponding to source code,
+ 3. A number which is an address in the process's address space,
+ 4. A symbol in which case the symbol's address is used.
-(def (c-uint loc) (read-loc loc 'u32))
+ By default str->symbol is used to find the corresponding symbol
+ which searches the local call stack then global text symbols then
+ global data symbols.»
+ (cond ((str? loc) (str->addr loc :str->symbol str->symbol))
+ ((num? loc) (ptr loc))
+ ((symbol? loc) (symbol-addr loc))
+ (else (error "str|num|symbol"))))
-(def (c-str loc)
- (def (go a)
- (let {[v (readcore a 'utf8)]}- (if (= v (utf8 0))
- ()
- (cons v (go (1+ a))))))
- (apply arr (cons 'utf8 (go (c-ptr (loc->addr loc))))))
-
(def (hex n)
"Display an integer in hex format."
:doc-group lsd
@@ -167,70 +196,38 @@
:doc-group lsd
(str "0" (num->str n 8)))
-(def (bpsave a) (readcore a 'u8 (length bpinst)))
+(def (bpsave a) (core-read a 'u8 (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)))))
+(def (bpset loc)
+ "Set a breakpoint at the location.
-(doc-for (bpset loc)
- «Set a breakpoint.
+ Location is as in loc->addr"
+ :doc-see loc->addr
+ :doc-see bpdel
+ :doc-group lsd
+ (def (txtsymb s) (symbol-addr (global-symbol s :text T)))
+ (waitstop)
+ (let {[addr (loc->addr loc :str->symbol txtsymb)]}+ (when (has? bptbl addr)
+ (error "breakpoint already set at " loc))
+ (put! bptbl addr (bpsave addr))
+ (core-write addr bpinst)))
- The location can be one of the following:
+(def (bpdel loc)
+ "Delete a breakpoint at the location.
- 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.
+ Location is as in loc->addr"
+ :doc-see loc->addr
+ :doc-see bpdel
+ :doc-group lsd
+ (def (txtsymb s) (symbol-addr (global-symbol s :text T)))
+ (waitstop)
+ (let {[addr (loc->addr loc :str->symbol txtsymb)]}+ (unless (has? bptbl addr)
+ (error "breakpoint not set at " loc))
+ (core-write addr (get bptbl addr))
+ (del! bptbl addr)))
- 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))
@@ -252,20 +249,6 @@
(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
@@ -298,7 +281,7 @@
(princ
(str-join
(map (λ (p)
- (str (symbol-name p) "=" (hex (symbol-read p 'u64))))
+ (str (symbol-name p) "=" (hex (symbol-read p 'u64))))
params)
", "))
(princ ")+" (hex (- pc (symbol-addr fsym))) " ")
@@ -327,7 +310,9 @@
:doc-see stk
(stk :locals T :level level :n n))
-(def (curPC) (and (>= pid 0) (readreg PC)))
+(def (curPC) (if (>= pid 0)
+ (reg-read PC)
+ (error "No active process")))
(def (step (n 1))
"Step `n` assembly instructions. Return the next instruction address
@@ -337,24 +322,29 @@
(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)
+ (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)
- (map writecore f o)
- (when on-bp (writecore addr bpinst))
+ (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 `NIL` if the program has exited."
+ "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")))
- (let {[pc (curPC)]}- (and print pc (princ (hex pc) "\n"))))
+ (trycatch
+ (let {[pc (curPC)]}+ (and print pc (princ (hex pc) "\n")))
+ (λ (_) (void))))
(def (func)
"Continue program execution until the current function returns."
@@ -361,15 +351,15 @@
:doc-group lsd
(let* {[bp (frame-retpc (car (_stk)))][o (bpsave bp)]}
- (writecore bp bpinst)
+ (core-write bp bpinst)
(cont :print NIL)
- (writecore bp o))
+ (core-write bp o))
(curPC))
(def (line)
"Step one line of the source code.
- This will step into functions not over."
+ Note: This will step into functions not over."
:doc-group lsd
(let {[orig (src)]}(def (go)
@@ -394,7 +384,7 @@
(curPC)
(func))))
-(def (asmlist (n 5) (addr (readreg PC)))
+(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.
@@ -404,13 +394,13 @@
(if (<= n 0)
()
(let {[on-bp (has? bptbl addr)]}- (when on-bp (writecore addr (get bptbl addr)))
+ (when on-bp (core-write addr (get bptbl addr)))
(let {[instr (lsd-das addr)][isize (lsd-instsize addr)]}
- (when on-bp (writecore addr bpinst))
+ (when on-bp (core-write addr bpinst))
(cons (cons addr instr) (asmlist (1- n) (+ addr isize)))))))
-(def (asm (n 5) (addr (readreg PC)))
+(def (asm (n 5) (addr (reg-read PC)))
"Print the next `n` disassembled instructions at `addr`.
Examples:
@@ -417,7 +407,7 @@
(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"
+ (asm 3 (str->addr "strecpy")) ; 3 instructions from strecpy"
:doc-group lsd
(for-each (λ (i) (princ (hex (car i)) "\t" (cdr i) "\n"))
(asmlist n addr)))
@@ -473,41 +463,38 @@
(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`.
+(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:
- (sym-global 'strecpy) → #(symbol "strecpy" #\T 2276784)»
+ (global-symbol "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)))
+ (when (and (eq? text NIL) (eq? data NIL))
+ (set! text T)
+ (set! data T))
+ (or (and text (find (global-text globals) s))
+ (and data (find (global-data globals) s))))
-(def (sym-local s (:level 0))
+(def (local-symbol 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
+ or `NIL`. Input is a `str`. 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)»
+ (local-symbol "i") → #(symbol "i" #\a 140737488350940)
+ (symbol-read (local-symbol "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)))
+ (find s
+ (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))
@@ -532,7 +519,7 @@
(set! pid (aref v 0))
(set! proc-stdin (aref v 1))
(attach)
- (map bpset (follow (sym-addr 'main)))
+ (map bpset (follow (symbol-addr (global-symbol "main"))))
(startstop)
pid))
@@ -541,7 +528,7 @@
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))]
+ [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))
--
⑨