diff --git a/code/debug-int.lisp b/code/debug-int.lisp index a60f9cf5cc3bec7ad2680198cd10530f7fcee268..de87d2d8b93dfffce00011499a87dae0516bbef2 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.105 2003/08/24 07:52:56 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.106 2003/11/21 04:33:24 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1238,6 +1238,34 @@ (if up-frame (1+ (frame-number up-frame)) 0) escaped)))))) +#+(and x86 linux) +(defun find-foreign-function-name (address) + "Return a string describing the foreign function near ADDRESS" + (let ((addr (sys:sap-int address))) + (alien:with-alien ((info (alien:struct dl-info + (filename c-call:c-string) + (base alien:unsigned) + (symbol c-call:c-string) + (symbol-address alien:unsigned))) + (dladdr (function alien:unsigned alien:unsigned + (* (alien:struct dl-info))) + :extern "dladdr")) + (let ((err (alien:alien-funcall dladdr addr (alien:addr info)))) + (cond ((zerop err) + "Foreign function call land") + (t + (format nil "~A+#x~x [#x~X] ~A" + (alien:slot info 'symbol) + (- addr (alien:slot info 'symbol-address)) + addr + (alien:slot info 'filename) + ))))))) + +#+(and x86 (not linux)) +(defun find-foreign-function-name (ra) + (declare (ignore ra)) + "Foreign function call land") + #+x86 (defun compute-calling-frame (caller ra up-frame) (declare (type system:system-area-pointer caller ra)) @@ -1277,7 +1305,7 @@ "The Undefined Function")) (:foreign-function (make-bogus-debug-function - "Foreign function call land")) + (find-foreign-function-name ra))) ((nil) (make-bogus-debug-function "Bogus stack frame"))