ref: 253107e36cdb715a21c1fc47cd119702f1a11285
dir: /src/plan9/lsd.lsp/
(defstruct reg name type addr size)
(defstruct sym name type addr)
(defstruct global text data)
(defstruct frame loc retpc sp locals)
(def coref NIL)
(def textf NIL)
(def regsf NIL)
(def fpregsf NIL)
(def proc-stdin NIL)
(def pids ())
(def bptbl (table))
(def (procfile s . flags)
(let ((path (string "/proc/" pid "/" s)))
(apply file (cons path flags))))
(def (writectl msg)
(let ((ctlf (procfile 'ctl :write)))
(io-write ctlf msg)
(io-close ctlf)))
(def (clearnote)
(let ((notef (procfile 'note :read)))
(io-readall notef)
(io-close notef)))
(def (start) (writectl "start"))
(def (startstop) (writectl "startstop") (clearnote))
(def (stop) (writectl "stop") (clearnote))
(def (follow addr) (reverse (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 sym . rest)
(unless coref (error "not attached to proc"))
(apply readcore (cons (sym-addr sym) rest)))
(def (bpset loc)
(if (< pid 0) (error "no running process"))
(let ((addr (cond ((eq? (typeof loc) 'symbol)
(sym-addr (get (global-text globals) loc)))
((number? loc) (u64 loc))
(else (error "symbol or number")))))
(unless (eq? (status) 'Stopped)
(begin
(princ "Waiting... " status "\n")
(stop)))
(if (has? bptbl addr)
(error "breakpoint already set at " loc))
(put! bptbl addr (readcore addr 'byte (length bpinst)))
(writecore addr bpinst)))
(def (detach)
(if regsf (io-close regsf))
(if fpregsf (io-close fpregsf))
(if coref (io-close coref))
(if 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)))
(if proc-stdin (io-close proc-stdin))
(set! bptbl (table))
(set! pid (aref v 0))
(set! proc-stdin (aref v 1))
(attach)
(bpset (car (follow (sym-addr (get (global-text globals) 'main)))))
(startstop)
(set! pids (cons pid pids))
pid))
(def (load a)
(let* ((v (lsd-load a))
(f (λ (sym tbl) (put! tbl (symbol (sym-name sym)) sym)))
(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)))
(if (>= pid 0) (attach)))
(def (status)
(let ((sf (procfile 'status)))
(read sf)
(read sf)
(let ((stat (read sf)))
(io-close sf)
stat)))
(def tracers (table
"amd64" (λ () (lsd-ctrace (readreg PC) (readreg SP) (u64 0)))
"arm64" (λ () (lsd-ctrace (readreg PC) (readreg SP) (readreg R30)))))
(def _stk (get tracers (os-getenv "objtype")))
(def (step)
(let* ((addr (readreg PC))
(on-bp (has? bptbl addr)))
(if on-bp (writecore addr (get bptbl addr)))
(let* ((f (follow addr))
(o (map (λ (a) (readcore a 'byte (length bpinst))) f)))
(for-each (λ (a) (writecore a bpinst)) f)
(startstop)
(map writecore f o)
(if on-bp (writecore addr bpinst))
(readreg PC))))
(def (cont)
(let ((addr (readreg PC)))
(if (has? bptbl addr) (step))
(startstop)))
(def (at-exit s)
(if proc-stdin (io-close proc-stdin))
(detach)
(lsd-cleanup)
(for-each (λ (p) (princ "echo kill > /proc/" p "/ctl\n")) pids))
(add-exit-hook at-exit)
(let* ((proc (cadr *argv*))
(pid (string->number proc)))
(if pid (load pid) (load proc)))
(repl)