0.9.4.68:

[sbcl.git] / src / runtime / backtrace.c

diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c
index e4784a2..45a3ce5 100644 (file)
--- 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
@@ -127,15 +133,16 @@ call_info_from_context(struct call_info *info, os_context_t *context)
         /* We tried to call a function, but crapped out before $CODE could
          * be fixed up. Probably an undefined function. */
         info->frame =
-            (struct call_frame *)(*os_context_register_addr(context,
-                                                            reg_OCFP));
+            (struct call_frame *)(unsigned long)
+                (*os_context_register_addr(context, reg_OCFP));
         info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA));
         info->code = code_pointer(info->lra);
         pc = (unsigned long)native_pointer(info->lra);
     }
     else {
         info->frame =
-            (struct call_frame *)(*os_context_register_addr(context, reg_CFP));
+            (struct call_frame *)(unsigned long)
+                (*os_context_register_addr(context, reg_CFP));
         info->code =
             code_pointer(*os_context_register_addr(context, reg_CODE));
         info->lra = NIL;
@@ -178,8 +185,8 @@ previous_info(struct call_info *info)
         while (free-- > 0) {
             os_context_t *context =
                 thread->interrupt_contexts[free];
-            if ((struct call_frame *)(*os_context_register_addr(context,
-                                                                reg_CFP))
+            if ((struct call_frame *)(unsigned long)
+                    (*os_context_register_addr(context, reg_CFP))
                 == info->frame) {
                 call_info_from_context(info, context);
                 break;
@@ -279,8 +286,8 @@ static int
 stack_pointer_p (void *p)
 {
   return (p < (void *) arch_os_get_current_thread()->control_stack_end
-         && p > (void *) &p
-         && (((unsigned long) p) & 3) == 0);
+          && p > (void *) &p
+          && (((unsigned long) p) & 3) == 0);
 }
 
 static int
@@ -307,11 +314,11 @@ x86_call_context (void *fp, void **ra, void **ocfp)
   lisp_ra   = *((void **) fp - 2);
 
   lisp_valid_p = (lisp_ocfp > fp
-                 && stack_pointer_p(lisp_ocfp)
-                 && ra_pointer_p(lisp_ra));
+                  && stack_pointer_p(lisp_ocfp)
+                  && ra_pointer_p(lisp_ra));
   c_valid_p = (c_ocfp > fp
-              && stack_pointer_p(c_ocfp)
-              && ra_pointer_p(c_ra));
+               && stack_pointer_p(c_ocfp)
+               && ra_pointer_p(c_ra));
 
   if (lisp_valid_p && c_valid_p) {
     void *lisp_path_fp;
@@ -372,7 +379,7 @@ debug_function_from_pc (struct code* code, void *pc)
 
   for (i = 1;; i += 2) {
     unsigned next_pc;
-                 
+
     if (i == len)
       return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1]));
 
@@ -426,7 +433,6 @@ print_entry_name (lispobj name)
       printf("\"%s\"", (char *) string->data);
 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
     } else if (widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG) {
-      struct vector *string = (struct vector *) object;
       printf("<oops, a unicode string>");                           /* FIXME */
 #endif
     } else
@@ -443,7 +449,7 @@ print_entry_points (struct code *code)
   while (function != NIL) {
     struct simple_fun *header = (struct simple_fun *) native_pointer(function);
     print_entry_name(header->name);
-      
+
     function = header->next;
     if (function != NIL)
       printf (", ");
@@ -468,7 +474,7 @@ backtrace(int nframes)
     lispobj *p;
     void *ra;
     void *next_fp;
-      
+
     if (!x86_call_context(fp, &ra, &next_fp))
       break;
 
@@ -482,10 +488,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;