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