shithub: sl

--- a/src/plan9/lsd.sl

+++ b/src/plan9/lsd.sl

@@ -37,7 +37,6 @@

   sym retpc sp locals)

 (def coref NIL)

-(def textf NIL)

 (def regsf NIL)

 (def fpregsf NIL)

 (def proc-stdin NIL)

@@ -94,15 +93,20 @@

   (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)

+  "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)

@@ -110,15 +114,23 @@

     (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."

+  "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 (hex n) (str "0x" (num->str n 16)))

+(def (hex n)

+  "Display an integer in hex format."

+  :doc-group lsd

+  (str "0x" (num->str n 16)))

-(def (oct n) (str "0" (num->str n 8)))

+(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)))

@@ -188,7 +200,6 @@

   (when regsf (io-close regsf))

   (when fpregsf (io-close fpregsf))

   (when coref (io-close coref))

-  (when textf (io-close textf))

   (void))

 (def (attach)

@@ -196,10 +207,12 @@

   (set! regsf (procfile 'regs :read :write))

   (set! fpregsf (procfile 'fpregs :read :write))

   (set! coref (procfile 'mem :read :write))

-  (set! textf (procfile 'text :read))

+  (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))))

@@ -216,13 +229,16 @@

 (def ctrace (get tracers (os-getenv "objtype")))

-(def (_stk)

-  "Return the call stack in the form of a list of stack frames."

+(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

-  (reverse! (ctrace)))

+  (let {[s (list-tail (reverse! (ctrace)) level)]}

+    (if n (list-head s n) s)))

-(def (stk (:locals NIL))

+(def (stk (:level 0) (:n NIL) (:locals NIL))

   "Print the stack trace optionally showing local auto values.

    Bugs:

@@ -258,7 +274,7 @@

                                     "\n"))

                       autos))

           (go (frame-retpc f) (cdr fs))))))

-  (let* {[tos (go (curPC) (_stk))]

+  (let* {[tos (go (curPC) (_stk :level level :n n))]

          [topsym (lsd-findsym tos)]}

     (princ (symbol-name topsym)

"+"

@@ -267,12 +283,12 @@

            (src tos)

            "\n")))

-(def (lstk)

+(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))

+  (stk :locals T :level level :n n))

 (def (curPC) (and (>= pid 0) (readreg PC)))

@@ -341,7 +357,7 @@

         (curPC)

         (func))))

-(def (asmlist (n 5) (addr (curPC)))

+(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.

@@ -357,7 +373,7 @@

           (when on-bp (writecore addr bpinst))

           (cons (cons addr instr) (asmlist (1- n) (+ addr isize)))))))

-(def (asm (n 5) (addr (curPC)))

+(def (asm (n 5) (addr (readreg PC)))

   "Print the next `n` disassembled instructions at `addr`.

    Examples:

@@ -432,9 +448,10 @@

   (or (find (global-text globals) s)

       (find (global-data globals) s)))

-(def (sym-local 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`.

+   or `NIL`.  Input is a `sym`.  Optionally specify what level of the

+   stack frame to search.

    Examples:

@@ -441,16 +458,18 @@

        (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)))

+          (frame-locals (car (_stk :level level)))

           :key symbol-name)))

-(def (sym-addr s)

+(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."

+   or NIL.  Input is a sym.  Optionally specify whether to search the

+   local stack frame for the symbol."

   :doc-group lsd

-  (symbol-addr (sym-global s)))

+  (symbol-addr ((if local sym-local sym-global) s)))

 (add-exit-hook

   (λ (s)

@@ -478,10 +497,12 @@

     (attach)

     (map bpset (follow (sym-addr 'main)))

     (startstop)

-    (set! pids (cons pid pids))

     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))]

@@ -492,6 +513,16 @@

     (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))))