From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 31 Aug 2005 14:52:22 +0000 (+0000)
Subject: 0.9.4.19:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e44ca193db33af531e30413546d6820163102e44;p=sbcl.git

0.9.4.19:
	Show foreign function names in LDB stacktraces when
        LISP_FEATURE_OS_PROVIDES_DLADDR.
---

diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c
index 624ffcf..471e84d 100644
--- a/src/runtime/backtrace.c
+++ b/src/runtime/backtrace.c
@@ -32,6 +32,12 @@
 #include "genesis/primitive-objects.h"
 #include "thread.h"
 
+#ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
+/* __USE_GNU needed if we want dladdr() and Dl_Info from glibc. */
+#define __USE_GNU
+#include "dlfcn.h"
+#endif
+
 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 
 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
@@ -481,10 +487,20 @@ backtrace(int nframes)
         print_entry_name(df->name);
       else
         print_entry_points(cp);
-    } else
-      printf("Foreign fp = 0x%lx, ra = 0x%lx",
-             (unsigned long) next_fp,
-             (unsigned long) ra);
+    } else {
+#ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
+        Dl_info info;
+        if (dladdr(ra, &info)) {
+            printf("Foreign function %s, fp = 0x%lx, ra = 0x%lx",
+                   info.dli_sname,
+                   (unsigned long) next_fp,
+                   (unsigned long) ra);
+        } else
+#endif
+        printf("Foreign fp = 0x%lx, ra = 0x%lx",
+               (unsigned long) next_fp,
+               (unsigned long) ra);
+    }
 
     putchar('\n');
     fp = next_fp;
diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index cc1adc6..c1d4f15 100644
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -115,9 +115,9 @@
   (setf *all-failures* (append failures *all-failures*)))
 
 (defun unexpected-failures ()
-  (remove-if (lambda (x) 
-                (or (eq (car x) :expected-failure) 
-		    (eq (car x) :unexpected-success)))
+  (remove-if (lambda (x)
+               (or (eq (car x) :expected-failure)
+                   (eq (car x) :unexpected-success)))
              *all-failures*))
 
 (defun setup-cl-user ()
diff --git a/version.lisp-expr b/version.lisp-expr
index e715610..3025ea7 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.4.18"
+"0.9.4.19"