X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fbacktrace.c;h=b4503ad8b37a08764724b75a479f6f2b054de71b;hb=077b294463eb6819c0eba67bb8ce71ec66d61ba8;hp=624ffcf39face5760f6cece86b86964ff2155913;hpb=b3e3fbe7d381147fccc8a3027cb6fae923e57d13;p=sbcl.git diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index 624ffcf..b4503ad 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -22,6 +22,7 @@ #include "interrupt.h" #include "lispregs.h" #ifdef LISP_FEATURE_GENCGC +#include #include "arch.h" #include "gencgc-alloc-region.h" #include "genesis/compiled-debug-fun.h" @@ -32,6 +33,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 +134,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; @@ -157,7 +165,7 @@ previous_info(struct call_info *info) { struct call_frame *this_frame; struct thread *thread=arch_os_get_current_thread(); - int free; + int free_ici; if (!cs_valid_pointer_p(info->frame)) { printf("Bogus callee value (0x%08lx).\n", (unsigned long)info->frame); @@ -174,12 +182,12 @@ previous_info(struct call_info *info) if (info->lra == NIL) { /* We were interrupted. Find the correct signal context. */ - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2; - while (free-- > 0) { + free_ici = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)); + while (free_ici-- > 0) { os_context_t *context = - thread->interrupt_contexts[free]; - if ((struct call_frame *)(*os_context_register_addr(context, - reg_CFP)) + thread->interrupt_contexts[free_ici]; + if ((struct call_frame *)(unsigned long) + (*os_context_register_addr(context, reg_CFP)) == info->frame) { call_info_from_context(info, context); break; @@ -278,14 +286,21 @@ backtrace(int nframes) static int stack_pointer_p (void *p) { + /* we are using sizeof(long) here, because that is the right value on both + * x86 and x86-64. (But note that false positives would not cause much harm + * given the heuristical nature of x86_call_context.) */ + unsigned long stack_alignment = sizeof(long); return (p < (void *) arch_os_get_current_thread()->control_stack_end && p > (void *) &p - && (((unsigned long) p) & 3) == 0); + && (((unsigned long) p) & (stack_alignment-1)) == 0); } static int ra_pointer_p (void *ra) { + /* the check against 4096 is still a mystery to everyone interviewed about + * it, but recent changes to sb-sprof seem to suggest that such values + * do occur sometimes. */ return ((unsigned long) ra) > 4096 && !stack_pointer_p (ra); } @@ -391,6 +406,54 @@ debug_function_from_pc (struct code* code, void *pc) } static void +sbcl_putwc(wchar_t c, FILE *file) +{ +#ifdef LISP_FEATURE_OS_PROVIDES_PUTWC + putwc(c, file); +#else + if (c < 256) { + fputc(c, file); + } else { + fputc('?', file); + } +#endif +} + +static void +print_string (lispobj *object) +{ + int tag = widetag_of(*object); + struct vector *vector = (struct vector *) object; + +#define doit(TYPE) \ + do { \ + int i; \ + int n = fixnum_value(vector->length); \ + TYPE *data = (TYPE *) vector->data; \ + for (i = 0; i < n; i++) { \ + wchar_t c = (wchar_t) data[i]; \ + if (c == '\\' || c == '"') \ + putchar('\\'); \ + sbcl_putwc(c, stdout); \ + } \ + } while (0) + + switch (tag) { + case SIMPLE_BASE_STRING_WIDETAG: + doit(unsigned char); + break; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: + doit(unsigned int); + break; +#endif + default: + printf("", tag); + } +#undef doit +} + +static void print_entry_name (lispobj name) { if (lowtag_of (name) == LIST_POINTER_LOWTAG) { @@ -405,33 +468,32 @@ print_entry_name (lispobj name) putchar(')'); } else if (lowtag_of(name) == OTHER_POINTER_LOWTAG) { lispobj *object = (lispobj *) native_pointer(name); - if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) { struct symbol *symbol = (struct symbol *) object; - struct vector *string; - if (symbol->package != NIL) { struct package *pkg = (struct package *) native_pointer(symbol->package); lispobj pkg_name = pkg->_name; - string = (struct vector *) native_pointer(pkg_name); - printf("%s::", (char *) string->data); + print_string(native_pointer(pkg_name)); + fputs("::", stdout); } - - object = (lispobj *) native_pointer(symbol->name); - string = (struct vector *) object; - printf("%s", (char *) string->data); + print_string(native_pointer(symbol->name)); } else if (widetag_of(*object) == SIMPLE_BASE_STRING_WIDETAG) { - struct vector *string = (struct vector *) object; - printf("\"%s\"", (char *) string->data); + putchar('"'); + print_string(object); + putchar('"'); #ifdef SIMPLE_CHARACTER_STRING_WIDETAG - } else if (widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG) { - printf(""); /* FIXME */ + } else if (widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG) { + putchar('"'); + print_string(object); + putchar('"'); #endif - } else + } else { printf("", (int) widetag_of(*object)); - } else + } + } else { printf("", (int) lowtag_of(name)); + } } static void @@ -481,10 +543,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;