/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.228 by sboukarev, Sun Aug 29 00:00:09 2010 UTC revision 1.229 by sboukarev, Tue Aug 31 23:44:40 2010 UTC
# Line 1863  Try to create a informative message." Line 1863  Try to create a informative message."
1863               (values ip pc)))               (values ip pc)))
1864            (di::interpreted-debug-function -1)            (di::interpreted-debug-function -1)
1865            (di::bogus-debug-function            (di::bogus-debug-function
1866             #-x86 -1             #-x86
1867               (let* ((real (di::frame-real-frame (di::frame-up frame)))
1868                      (fp (di::frame-pointer real)))
1869                 ;;#+(or)
1870                 (progn
1871                   (format *debug-io* "Frame-real-frame = ~S~%" real)
1872                   (format *debug-io* "fp = ~S~%" fp)
1873                   (format *debug-io* "lra = ~S~%"
1874                           (kernel:stack-ref fp vm::lra-save-offset)))
1875                 (values
1876                  (sys:int-sap
1877                   (- (kernel:get-lisp-obj-address
1878                       (kernel:stack-ref fp vm::lra-save-offset))
1879                      (- (ash vm:function-code-offset vm:word-shift)
1880                         vm:function-pointer-type)))
1881                  0))
1882             #+x86             #+x86
1883             (let ((fp (di::frame-pointer (di:frame-up frame))))             (let ((fp (di::frame-pointer (di:frame-up frame))))
1884               (multiple-value-bind (ra ofp) (di::x86-call-context fp)               (multiple-value-bind (ra ofp) (di::x86-call-context fp)
# Line 1943  Try to create a informative message." Line 1958  Try to create a informative message."
1958      (write-string cmd file)      (write-string cmd file)
1959      (force-output file)      (force-output file)
1960      (let* ((output (make-string-output-stream))      (let* ((output (make-string-output-stream))
1961               ;; gdb on sparc needs to know the executable to find the
1962               ;; symbols.  Without this, gdb can't disassemble anything.
1963               ;; NOTE: We assume that the first entry in
1964               ;; lisp::*cmucl-lib* is the bin directory where lisp is
1965               ;; located.  If this is not true, we'll have to do
1966               ;; something better to find the lisp executable.
1967               (lisp-path
1968                #+sparc
1969                 (list
1970                  (namestring
1971                   (probe-file
1972                    (merge-pathnames "lisp" (car (lisp::parse-unix-search-path
1973                                                  lisp::*cmucl-lib*))))))
1974                 #-sparc
1975                 nil)
1976             (proc (ext:run-program *gdb-program-name*             (proc (ext:run-program *gdb-program-name*
1977                                    `("-batch" "-x" ,filename)                                    `(,@lisp-path "-batch" "-x" ,filename)
1978                                    :wait t                                    :wait t
1979                                    :output output)))                                    :output output)))
1980        (assert (eq (ext:process-status proc) :exited))        (assert (eq (ext:process-status proc) :exited))
# Line 1952  Try to create a informative message." Line 1982  Try to create a informative message."
1982        (get-output-stream-string output))))        (get-output-stream-string output))))
1983    
1984  (defun foreign-frame-p (frame)  (defun foreign-frame-p (frame)
1985    #-x86 nil    #-x86
1986    #+x86 (let ((ip (frame-ip frame)))    (let ((ip (frame-ip frame)))
1987            (and (sys:system-area-pointer-p ip)      (and (sys:system-area-pointer-p ip)
1988                 (multiple-value-bind (pc code)           (typep (di::frame-debug-function frame) 'di::bogus-debug-function)))
1989                     (di::compute-lra-data-from-pc ip)    #+x86
1990                   (declare (ignore pc))    (let ((ip (frame-ip frame)))
1991                   (not code)))))      (and (sys:system-area-pointer-p ip)
1992             (multiple-value-bind (pc code)
1993                 (di::compute-lra-data-from-pc ip)
1994               (declare (ignore pc))
1995               (not code)))))
1996    
1997  (defun foreign-frame-source-location (frame)  (defun foreign-frame-source-location (frame)
1998    (let ((ip (sys:sap-int (frame-ip frame))))    (let ((ip (sys:sap-int (frame-ip frame))))

Legend:
Removed from v.1.228  
changed lines
  Added in v.1.229

  ViewVC Help
Powered by ViewVC 1.1.5