src/runtime/backtrace.c

   1 /*
   2  * simple backtrace facility
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   9  * This software is derived from the CMU CL system, which was
  10  * written at Carnegie Mellon University and released into the
  11  * public domain. The software is in the public domain and is
  12  * provided with absolutely no warranty. See the COPYING and CREDITS
  13  * files for more information.
  14  */
  15
  16 /* needed if we want dladdr() and Dl_Info from glibc's dlfcn.h */
  17 #define _GNU_SOURCE
  18
  19 #include <stdio.h>
  20 #include <signal.h>
  21 #include "sbcl.h"
  22 #include "runtime.h"
  23 #include "globals.h"
  24 #include "os.h"
  25 #include "interrupt.h"
  26 #include "lispregs.h"
  27 #include <wchar.h>
  28 #include "arch.h"
  29 #include "genesis/compiled-debug-fun.h"
  30 #include "genesis/compiled-debug-info.h"
  31 #include "genesis/package.h"
  32 #include "genesis/static-symbols.h"
  33 #include "genesis/primitive-objects.h"
  34 #include "thread.h"
  35
  36 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
  37 # include <dlfcn.h>
  38 #endif
  39
  40 static void
  41 sbcl_putwc(wchar_t c, FILE *file)
  42 {
  43 #ifdef LISP_FEATURE_OS_PROVIDES_PUTWC
  44     putwc(c, file);
  45 #else
  46     if (c < 256) {
  47         fputc(c, file);
  48     } else {
  49         fputc('?', file);
  50     }
  51 #endif
  52 }
  53
  54 struct compiled_debug_fun *
  55 debug_function_from_pc (struct code* code, void *pc)
  56 {
  57     uword_t code_header_len = sizeof(lispobj) * code_header_words(code->header);
  58     uword_t offset
  59         = (uword_t) pc - (uword_t) code - code_header_len;
  60     struct compiled_debug_fun *df;
  61     struct compiled_debug_info *di;
  62     struct vector *v;
  63     int i, len;
  64
  65     if (lowtag_of(code->debug_info) != INSTANCE_POINTER_LOWTAG)
  66         return NULL;
  67
  68     di = (struct compiled_debug_info *) native_pointer(code->debug_info);
  69
  70     if (lowtag_of(di->fun_map) != INSTANCE_POINTER_LOWTAG)
  71         return NULL;
  72
  73     v = (struct vector *) native_pointer(di->fun_map);
  74
  75     len = fixnum_value(v->length);
  76
  77     if (lowtag_of(v->data[0]) != INSTANCE_POINTER_LOWTAG)
  78         return NULL;
  79
  80     df = (struct compiled_debug_fun *) native_pointer(v->data[0]);
  81
  82     if (len == 1)
  83         return df;
  84
  85     for (i = 1;; i += 2) {
  86         unsigned next_pc;
  87
  88         if (i == len)
  89             return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1]));
  90
  91         if (offset >= (uword_t)fixnum_value(df->elsewhere_pc)) {
  92             struct compiled_debug_fun *p
  93                 = ((struct compiled_debug_fun *) native_pointer(v->data[i + 1]));
  94             next_pc = fixnum_value(p->elsewhere_pc);
  95         } else
  96             next_pc = fixnum_value(v->data[i]);
  97
  98         if (offset < next_pc)
  99             return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1]));
 100     }
 101
 102     return NULL;
 103 }
 104
 105 static void
 106 print_string (lispobj *object)
 107 {
 108   int tag = widetag_of(*object);
 109   struct vector *vector = (struct vector *) object;
 110
 111 #define doit(TYPE)                              \
 112   do {                                          \
 113     int i;                                      \
 114     int n = fixnum_value(vector->length);       \
 115     TYPE *data = (TYPE *) vector->data;         \
 116     for (i = 0; i < n; i++) {                   \
 117       wchar_t c = (wchar_t) data[i];            \
 118       if (c == '\\' || c == '"')                \
 119         putchar('\\');                          \
 120       sbcl_putwc(c, stdout);                    \
 121     }                                           \
 122   } while (0)
 123
 124   switch (tag) {
 125   case SIMPLE_BASE_STRING_WIDETAG:
 126     doit(unsigned char);
 127     break;
 128 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 129   case SIMPLE_CHARACTER_STRING_WIDETAG:
 130     doit(unsigned int);
 131     break;
 132 #endif
 133   default:
 134     printf("<??? type %d>", tag);
 135   }
 136 #undef doit
 137 }
 138
 139 static int string_equal (lispobj *object, char *string)
 140 {
 141     int tag = widetag_of(*object);
 142     struct vector *vector = (struct vector *) object;
 143
 144     if (tag != SIMPLE_BASE_STRING_WIDETAG)
 145         return 0;
 146     return !strcmp((char *) vector->data, string);
 147 }
 148
 149 static void
 150 print_entry_name (lispobj name)
 151 {
 152     if (lowtag_of (name) == LIST_POINTER_LOWTAG) {
 153         putchar('(');
 154         while (name != NIL) {
 155             if (lowtag_of (name) != LIST_POINTER_LOWTAG) {
 156                 printf("%p: unexpected lowtag while printing a cons\n",
 157                        (void*)name);
 158                 return;
 159             }
 160             struct cons *cons = (struct cons *) native_pointer(name);
 161             print_entry_name(cons->car);
 162             name = cons->cdr;
 163             if (name != NIL)
 164                 putchar(' ');
 165         }
 166         putchar(')');
 167     } else if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
 168         lispobj *object = (lispobj *) native_pointer(name);
 169         if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
 170             struct symbol *symbol = (struct symbol *) object;
 171             if (symbol->package != NIL) {
 172                 struct package *pkg
 173                     = (struct package *) native_pointer(symbol->package);
 174                 lispobj pkg_name = pkg->_name;
 175                 if (string_equal(native_pointer(pkg_name), "COMMON-LISP"))
 176                     ;
 177                 else if (string_equal(native_pointer(pkg_name), "COMMON-LISP-USER")) {
 178                     fputs("CL-USER::", stdout);
 179                 }
 180                 else if (string_equal(native_pointer(pkg_name), "KEYWORD")) {
 181                     putchar(':');
 182                 } else {
 183                     print_string(native_pointer(pkg_name));
 184                     fputs("::", stdout);
 185                 }
 186             }
 187             print_string(native_pointer(symbol->name));
 188         } else if (widetag_of(*object) == SIMPLE_BASE_STRING_WIDETAG
 189 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 190                    || widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG
 191 #endif
 192             ) {
 193             putchar('"');
 194             print_string(object);
 195             putchar('"');
 196         } else {
 197             printf("<??? type %d>", (int) widetag_of(*object));
 198         }
 199     } else {
 200         printf("<??? lowtag %d>", (int) lowtag_of(name));
 201     }
 202 }
 203
 204 static void
 205 print_entry_points (struct code *code)
 206 {
 207     lispobj function = code->entry_points;
 208
 209     while (function != NIL) {
 210         if (lowtag_of(function) != FUN_POINTER_LOWTAG) {
 211             printf("%p: bogus function entry", (void *) function);
 212             return;
 213         }
 214         struct simple_fun *header = (struct simple_fun *) native_pointer(function);
 215         print_entry_name(header->name);
 216
 217         function = header->next;
 218         if (function != NIL)
 219             printf (", ");
 220     }
 221 }
 222
 223
 224 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 225
 226 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
 227  * better not change. */
 228
 229 struct call_frame {
 230 #ifndef LISP_FEATURE_ALPHA
 231         struct call_frame *old_cont;
 232 #else
 233         u32 old_cont;
 234 #endif
 235         lispobj saved_lra;
 236         lispobj code;
 237         lispobj other_state[5];
 238 };
 239
 240 struct call_info {
 241 #ifndef LISP_FEATURE_ALPHA
 242     struct call_frame *frame;
 243 #else
 244     u32 frame;
 245 #endif
 246     int interrupted;
 247 #ifndef LISP_FEATURE_ALPHA
 248     struct code *code;
 249 #else
 250     u32 code;
 251 #endif
 252     lispobj lra;
 253     int pc; /* Note: this is the trace file offset, not the actual pc. */
 254 };
 255
 256 #define HEADER_LENGTH(header) ((header)>>8)
 257
 258 static int previous_info(struct call_info *info);
 259
 260 static struct code *
 261 code_pointer(lispobj object)
 262 {
 263     lispobj *headerp, header;
 264     int type, len;
 265
 266     headerp = (lispobj *) native_pointer(object);
 267     header = *headerp;
 268     type = widetag_of(header);
 269
 270     switch (type) {
 271         case CODE_HEADER_WIDETAG:
 272             break;
 273         case RETURN_PC_HEADER_WIDETAG:
 274         case SIMPLE_FUN_HEADER_WIDETAG:
 275             len = HEADER_LENGTH(header);
 276             if (len == 0)
 277                 headerp = NULL;
 278             else
 279                 headerp -= len;
 280             break;
 281         default:
 282             headerp = NULL;
 283     }
 284
 285     return (struct code *) headerp;
 286 }
 287
 288 static boolean
 289 cs_valid_pointer_p(struct call_frame *pointer)
 290 {
 291     struct thread *thread=arch_os_get_current_thread();
 292     return (((char *) thread->control_stack_start <= (char *) pointer) &&
 293             ((char *) pointer < (char *) access_control_stack_pointer(thread)));
 294 }
 295
 296 static void
 297 call_info_from_lisp_state(struct call_info *info)
 298 {
 299     info->frame = (struct call_frame *)access_control_frame_pointer(arch_os_get_current_thread());
 300     info->interrupted = 0;
 301     info->code = NULL;
 302     info->lra = 0;
 303     info->pc = 0;
 304
 305     previous_info(info);
 306 }
 307
 308 static void
 309 call_info_from_context(struct call_info *info, os_context_t *context)
 310 {
 311     uword_t pc;
 312
 313     info->interrupted = 1;
 314 #if !defined(LISP_FEATURE_ARM) && !defined(LISP_FEATURE_ARM64)
 315     if (lowtag_of(*os_context_register_addr(context, reg_CODE))
 316         == FUN_POINTER_LOWTAG) {
 317         /* We tried to call a function, but crapped out before $CODE could
 318          * be fixed up. Probably an undefined function. */
 319         info->frame =
 320             (struct call_frame *)(uword_t)
 321                 (*os_context_register_addr(context, reg_OCFP));
 322         info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA));
 323         info->code = code_pointer(info->lra);
 324         pc = (uword_t)native_pointer(info->lra);
 325     } else
 326 #endif
 327     {
 328         info->frame =
 329             (struct call_frame *)(uword_t)
 330                 (*os_context_register_addr(context, reg_CFP));
 331         info->code =
 332             code_pointer(*os_context_register_addr(context, reg_CODE));
 333         info->lra = NIL;
 334         pc = *os_context_pc_addr(context);
 335     }
 336     if (info->code != NULL)
 337         info->pc = pc - (uword_t) info->code -
 338 #ifndef LISP_FEATURE_ALPHA
 339             (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
 340 #else
 341             (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
 342 #endif
 343     else
 344         info->pc = 0;
 345 }
 346
 347 static int
 348 previous_info(struct call_info *info)
 349 {
 350     struct call_frame *this_frame;
 351     struct thread *thread=arch_os_get_current_thread();
 352     int free_ici;
 353     lispobj lra;
 354
 355     if (!cs_valid_pointer_p(info->frame)) {
 356         printf("Bogus callee value (0x%08lx).\n", (uword_t)info->frame);
 357         return 0;
 358     }
 359
 360     this_frame = info->frame;
 361     info->lra = this_frame->saved_lra;
 362     info->frame = this_frame->old_cont;
 363     info->interrupted = 0;
 364
 365     if (info->frame == NULL || info->frame == this_frame)
 366         return 0;
 367     lra = info->lra;
 368     if (lra == NIL) {
 369         /* We were interrupted. Find the correct signal context. */
 370         free_ici = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
 371         while (free_ici-- > 0) {
 372             os_context_t *context =
 373                 thread->interrupt_contexts[free_ici];
 374             if ((struct call_frame *)(uword_t)
 375                 (*os_context_register_addr(context, reg_CFP))
 376                 == info->frame) {
 377                 call_info_from_context(info, context);
 378                 break;
 379             }
 380         }
 381     } else if (fixnump(lra)) {
 382         info->code = native_pointer(this_frame->code);
 383         info->pc = (uword_t)(info->code + lra);
 384         info->lra = NIL;
 385     } else {
 386         info->code = code_pointer(lra);
 387
 388         if (info->code != NULL)
 389             info->pc = (uword_t)native_pointer(info->lra) -
 390                 (uword_t)info->code -
 391 #ifndef LISP_FEATURE_ALPHA
 392                 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
 393 #else
 394         (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
 395 #endif
 396         else
 397             info->pc = 0;
 398     }
 399
 400     return 1;
 401 }
 402
 403 void
 404 lisp_backtrace(int nframes)
 405 {
 406     struct call_info info;
 407     int i = 0;
 408     call_info_from_lisp_state(&info);
 409
 410     do {
 411         printf("%4d: ", i);
 412
 413         if (info.code != (struct code *) 0) {
 414             struct compiled_debug_fun *df ;
 415             if (info.lra != NIL &&
 416                 (df = debug_function_from_pc((struct code *)info.code, (void *)info.lra)))
 417                 print_entry_name(df->name);
 418             else
 419                 print_entry_points((struct code *)info.code);
 420
 421             printf(" %p", (uword_t) info.code | OTHER_POINTER_LOWTAG);
 422         }
 423         else
 424             printf("CODE = ???");
 425         printf("%s fp = %p", info.interrupted ? " [interrupted]" : "",
 426                info.frame);
 427
 428         if (info.lra != NIL)
 429             printf(" LRA = %p", info.lra);
 430         else
 431             printf(" <no LRA>");
 432
 433         if (info.pc)
 434             printf(" pc = %p", info.pc);
 435         putchar('\n');
 436
 437     } while (i++ < nframes && previous_info(&info));
 438 }
 439
 440 #else
 441
 442 static int
 443 altstack_pointer_p (void *p) {
 444 #ifndef LISP_FEATURE_WIN32
 445     void* stack_start = ((void *)arch_os_get_current_thread()) + dynamic_values_bytes;
 446     void* stack_end = stack_start + 32*SIGSTKSZ;
 447
 448     return (p > stack_start && p <= stack_end);
 449 #else
 450     /* Win32 doesn't do altstack */
 451     return 0;
 452 #endif
 453 }
 454
 455 static int
 456 stack_pointer_p (void *p)
 457 {
 458     /* we are using sizeof(long) here, because that is the right value on both
 459      * x86 and x86-64.  (But note that false positives would not cause much harm
 460      * given the heuristical nature of x86_call_context.) */
 461     uword_t stack_alignment = sizeof(void*);
 462     void *stack_start;
 463     struct thread *thread = arch_os_get_current_thread();
 464
 465     if (altstack_pointer_p(p))
 466         return 1;
 467
 468     if (altstack_pointer_p(&p)) {
 469         stack_start = (void *) thread->control_stack_start;
 470     } else {
 471         /* Use the current frame address, since there should be no
 472          * relevant frames below. */
 473         stack_start = &p;
 474     }
 475     return p >= stack_start
 476         && p < (void *) thread->control_stack_end
 477         && (((uword_t) p) & (stack_alignment-1)) == 0;
 478 }
 479
 480 static int
 481 ra_pointer_p (void *ra)
 482 {
 483   /* the check against 4096 is still a mystery to everyone interviewed about
 484    * it, but recent changes to sb-sprof seem to suggest that such values
 485    * do occur sometimes. */
 486   return ((uword_t) ra) > 4096 && !stack_pointer_p (ra);
 487 }
 488
 489 static int
 490 x86_call_context (void *fp, void **ra, void **ocfp)
 491 {
 492   void *c_ocfp;
 493   void *c_ra;
 494   int c_valid_p;
 495
 496   if (!stack_pointer_p(fp))
 497     return 0;
 498
 499   c_ocfp    = *((void **) fp);
 500   c_ra      = *((void **) fp + 1);
 501
 502   c_valid_p = (c_ocfp > fp
 503                && stack_pointer_p(c_ocfp)
 504                && ra_pointer_p(c_ra));
 505
 506   if (c_valid_p)
 507     *ra = c_ra, *ocfp = c_ocfp;
 508   else
 509     return 0;
 510
 511   return 1;
 512 }
 513
 514 void
 515 describe_thread_state(void)
 516 {
 517     sigset_t mask;
 518     struct thread *thread = arch_os_get_current_thread();
 519     struct interrupt_data *data = thread->interrupt_data;
 520 #ifndef LISP_FEATURE_WIN32
 521     get_current_sigmask(&mask);
 522     printf("Signal mask:\n");
 523     printf(" SIGALRM = %d\n", sigismember(&mask, SIGALRM));
 524     printf(" SIGINT = %d\n", sigismember(&mask, SIGINT));
 525     printf(" SIGPROF = %d\n", sigismember(&mask, SIGPROF));
 526 #ifdef SIG_STOP_FOR_GC
 527     printf(" SIG_STOP_FOR_GC = %d\n", sigismember(&mask, SIG_STOP_FOR_GC));
 528 #endif
 529 #endif
 530     printf("Specials:\n");
 531     printf(" *GC-INHIBIT* = %s\n", (SymbolValue(GC_INHIBIT, thread) == T) ? "T" : "NIL");
 532     printf(" *GC-PENDING* = %s\n",
 533            (SymbolValue(GC_PENDING, thread) == T) ?
 534            "T" : ((SymbolValue(GC_PENDING, thread) == NIL) ?
 535                   "NIL" : ":IN-PROGRESS"));
 536     printf(" *INTERRUPTS-ENABLED* = %s\n", (SymbolValue(INTERRUPTS_ENABLED, thread) == T) ? "T" : "NIL");
 537 #ifdef STOP_FOR_GC_PENDING
 538     printf(" *STOP-FOR-GC-PENDING* = %s\n", (SymbolValue(STOP_FOR_GC_PENDING, thread) == T) ? "T" : "NIL");
 539 #endif
 540     printf("Pending handler = %p\n", data->pending_handler);
 541 }
 542
 543 void print_backtrace_frame(void *pc, void *fp, int i) {
 544     lispobj *p;
 545     printf("%4d: ", i);
 546
 547     p = (lispobj *) component_ptr_from_pc((lispobj *) pc);
 548
 549     if (p) {
 550         struct code *cp = (struct code *) p;
 551         struct compiled_debug_fun *df = debug_function_from_pc(cp, pc);
 552         if (df)
 553             print_entry_name(df->name);
 554         else
 555             print_entry_points(cp);
 556         printf(", pc = %p, fp = %p", pc, fp);
 557     } else {
 558 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
 559         Dl_info info;
 560         if (dladdr(pc, &info)) {
 561             printf("Foreign function %s, pc = %p, fp = %p", info.dli_sname, pc, fp);
 562         } else
 563 #endif
 564             printf("Foreign function, pc = %p, fp = %p", pc, fp);
 565     }
 566
 567     putchar('\n');
 568 }
 569
 570 /* This function has been split from lisp_backtrace() to enable Lisp
 571  * backtraces from gdb with call backtrace_from_fp(...). Useful for
 572  * example when debugging threading deadlocks.
 573  */
 574 void
 575 backtrace_from_fp(void *fp, int nframes, int start)
 576 {
 577   int i = start;
 578
 579   for (; i < nframes; ++i) {
 580     void *ra;
 581     void *next_fp;
 582
 583     if (!x86_call_context(fp, &ra, &next_fp))
 584       break;
 585     print_backtrace_frame(ra, next_fp, i);
 586     fp = next_fp;
 587   }
 588 }
 589
 590 void backtrace_from_context(os_context_t *context, int nframes) {
 591 #ifdef LISP_FEATURE_X86
 592     void *fp = (void *)*os_context_register_addr(context,reg_EBP);
 593 #elif defined (LISP_FEATURE_X86_64)
 594     void *fp = (void *)*os_context_register_addr(context,reg_RBP);
 595 #endif
 596     print_backtrace_frame((void *)*os_context_pc_addr(context), fp, 0);
 597     backtrace_from_fp(fp, nframes - 1, 1);
 598 }
 599
 600 void
 601 lisp_backtrace(int nframes)
 602 {
 603     struct thread *thread=arch_os_get_current_thread();
 604     int free_ici = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
 605
 606     if (free_ici) {
 607         os_context_t *context = thread->interrupt_contexts[free_ici - 1];
 608         backtrace_from_context(context, nframes);
 609     } else {
 610         void *fp;
 611
 612 #ifdef LISP_FEATURE_X86
 613         asm("movl %%ebp,%0" : "=g" (fp));
 614 #elif defined (LISP_FEATURE_X86_64)
 615         asm("movq %%rbp,%0" : "=g" (fp));
 616 #endif
 617         backtrace_from_fp(fp, nframes, 0);
 618     }
 619 }
 620 #endif