From c568b864cdc7aac49b0635a8ca497d5f66921c46 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Fri, 21 Nov 2003 04:33:24 +0000 Subject: [PATCH] From Helmut Eller on cmucl-imp: a little patch to get nicer names for foreign functions in the backtrace. I slightly frobbed the order of the displayed info to display the function first. Suggestions welcome for a nicer arrangement. --- code/debug-int.lisp | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/code/debug-int.lisp b/code/debug-int.lisp index a60f9cf5c..de87d2d8b 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")) -- GitLab