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