[slime-devel] gdb support for cmucl/sparc

[Raymond Toy]

Here are a couple of replacement functions that make slime disassemble
work with cmucl/sparc.  The disassembly works for me on cmucl/sparc.
The foreign source location appears to work, but the only foreign
function I've been able to test with is call_into_lisp which doesn't
have any line info.  But slime recognizes that and prints a message to
that affect.

Ray

> (defun frame-ip (frame)
>   "Return the (absolute) instruction pointer and the relative pc of FRAME."
>   (if (not frame)
>       (sys:int-sap (ldb (byte vm:word-bits 0) -1))
>       (let ((debug-fun (di::frame-debug-function frame)))
>         (etypecase debug-fun
>           (di::compiled-debug-function 
>            (let* ((code-loc (di:frame-code-location frame))
>                   (component (di::compiled-debug-function-component debug-fun))
>                   (pc (di::compiled-code-location-pc code-loc))
>                   (ip (sys:without-gcing
>                        (sys:sap-int
>                         (sys:sap+ (kernel:code-instructions component) pc)))))
>              (values ip pc)))
>           (di::interpreted-debug-function
>            (sys:int-sap (ldb (byte vm:word-bits 0) -1)))
>           (di::bogus-debug-function
>            #-x86
>            (let* ((real (di::frame-real-frame (di::frame-up frame)))
>                   (fp (di::frame-pointer real)))
>              #+(or)
>              (progn
>                (format *debug-io* "Frame-real-frame = ~S~%" real)
>                (format *debug-io* "fp = ~S~%" fp)
>                (format *debug-io* "lra = ~S~%"
>                        (kernel:stack-ref fp vm::lra-save-offset)))
>              (values 
>               (sys:int-sap
>                (kernel:get-lisp-obj-address
>                 (kernel:stack-ref fp vm::lra-save-offset)))
>               0))
>            #+x86
>            (let ((fp (di::frame-pointer (di:frame-up frame))))
>              (multiple-value-bind (ra ofp) (di::x86-call-context fp)
>                (declare (ignore ofp))
>                (values ra 0))))))))
> 
> (defun foreign-frame-p (frame)
>   #-x86
>   (let ((ip (frame-ip frame)))
>     (and (sys:system-area-pointer-p ip)
>          (typep (di::frame-debug-function frame) 'di::bogus-debug-function)))
>   #+x86
>   (let ((ip (frame-ip frame)))
>     (and (sys:system-area-pointer-p ip)
>          (multiple-value-bind (pc code)
>              (di::compute-lra-data-from-pc ip)
>            (declare (ignore pc))
>            (not code)))))
> 
> (defun gdb-exec (cmd)
>   (with-temporary-file (file filename)
>     (write-string cmd file)
>     (force-output file)
>     (let* ((output (make-string-output-stream))
>            ;; gdb on sparc needs to know the executable to find the
>            ;; symbols.  Without this, gdb can't disassemble anything.
>            ;; NOTE: We assume that the first entry in
>            ;; lisp::*cmucl-lib* is the bin directory where lisp is
>            ;; located.  If this is not true, we'll have to do
>            ;; something better to find the lisp executable.
>            (lisp-path
>             #+sparc
>              (list
>               (namestring
>                (probe-file
>                 (merge-pathnames "lisp"
>                                  (car (lisp::parse-unix-search-path lisp::*cmucl-lib*))))))
>              #-sparc
>              nil)
>            (proc (ext:run-program "gdb" `(, at lisp-path "-batch" "-x" ,filename) 
>                                   :wait t
>                                   :output output)))
>       (assert (eq (ext:process-status proc) :exited))
>       (assert (eq (ext:process-exit-code proc) 0))
>       (get-output-stream-string output))))