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