(#.lra-save-offset
(setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
-(defun foreign-function-debug-name (sap)
- (multiple-value-bind (name file base offset) (foreign-symbol-in-address sap)
+(defun foreign-function-backtrace-name (sap)
+ (let ((name (foreign-symbol-in-address sap)))
(if name
- (format nil "foreign function: ~A [~A: #x~X + #x~X]" name file base offset)
+ (format nil "foreign function: ~A" name)
(format nil "foreign function: #x~X" (sap-int sap)))))
;;; This returns a frame for the one existing in time immediately
"undefined function"))
(:foreign-function
(make-bogus-debug-fun
- (foreign-function-debug-name (int-sap (get-lisp-obj-address lra)))))
+ (foreign-function-backtrace-name
+ (int-sap (get-lisp-obj-address lra)))))
((nil)
(make-bogus-debug-fun
"bogus stack frame"))
(make-bogus-debug-fun
"undefined function"))
(:foreign-function
- (make-bogus-debug-fun (foreign-function-debug-name ra)))
+ (make-bogus-debug-fun
+ (foreign-function-backtrace-name ra)))
((nil)
(make-bogus-debug-fun
"bogus stack frame"))
"Finds the PC for the return from an assembly routine properly.
For some architectures (such as PPC) this will not be the $LRA
register."
- (let ((return-machine-address
- ;; This conditional logic should probably go into
- ;; architecture specific files somehow.
- #!+ppc (sap-int (sb!vm::context-lr scp))
- #!+sparc (+ (sb!vm:context-register scp sb!vm::lip-offset) 8)
- #!-(or ppc sparc) (- (sb!vm:context-register scp sb!vm::lra-offset)
- sb!vm:other-pointer-lowtag))
- (code-header-len (* (get-header-data code)
- sb!vm:n-word-bytes)))
- (values (- return-machine-address
- (- (get-lisp-obj-address code)
- sb!vm:other-pointer-lowtag)
- code-header-len)
- return-machine-address)))
+ (let ((return-machine-address (sb!vm::return-machine-address scp))
+ (code-header-len (* (get-header-data code) sb!vm:n-word-bytes)))
+ (values (- return-machine-address
+ (- (get-lisp-obj-address code)
+ sb!vm:other-pointer-lowtag)
+ code-header-len)
+ return-machine-address)))
;;; Find the code object corresponding to the object represented by
;;; bits and return it. We assume bogus functions correspond to the
;;; instruction.
(defun make-bogus-lra (real-lra &optional known-return-p)
(without-gcing
+ ;; These are really code labels, not variables: but this way we get
+ ;; their addresses.
(let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts"))
(src-end (foreign-symbol-address "fun_end_breakpoint_end"))
(trap-loc (foreign-symbol-address "fun_end_breakpoint_trap"))