X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fbacktrace.c;h=07af8fe5fdaf1de050add9b38333e27f1e0c7d38;hb=e663f81f7297ab9f53b38d5f0975152de3557e69;hp=e4784a2d31455b1d261426bb759ae784942f787d;hpb=f9ab6e62f6bc391395323ebc0906987d419725ad;p=sbcl.git diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index e4784a2..07af8fe 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; @@ -178,8 +186,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; @@ -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); + && p > (void *) &p + && (((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); } @@ -307,11 +322,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 +387,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])); @@ -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,34 +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) { - struct vector *string = (struct vector *) object; - 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 @@ -443,7 +504,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 +529,7 @@ backtrace(int nframes) lispobj *p; void *ra; void *next_fp; - + if (!x86_call_context(fp, &ra, &next_fp)) break; @@ -482,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;