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 "arch.h"
  26 #include "gencgc-alloc-region.h"
  27 #include "genesis/compiled-debug-fun.h"
  28 #include "genesis/compiled-debug-info.h"
  29 #include "genesis/package.h"
  30 #endif
  31 #include "genesis/static-symbols.h"
  32 #include "genesis/primitive-objects.h"
  33 #include "thread.h"
  34
  35 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
  36 /* __USE_GNU needed if we want dladdr() and Dl_Info from glibc. */
  37 #define __USE_GNU
  38 #include "dlfcn.h"
  39 #endif
  40
  41 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
  42
  43 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
  44  * better not change. */
  45
  46 struct call_frame {
  47 #ifndef LISP_FEATURE_ALPHA
  48         struct call_frame *old_cont;
  49 #else
  50         u32 old_cont;
  51 #endif
  52         lispobj saved_lra;
  53         lispobj code;
  54         lispobj other_state[5];
  55 };
  56
  57 struct call_info {
  58 #ifndef LISP_FEATURE_ALPHA
  59     struct call_frame *frame;
  60 #else
  61     u32 frame;
  62 #endif
  63     int interrupted;
  64 #ifndef LISP_FEATURE_ALPHA
  65     struct code *code;
  66 #else
  67     u32 code;
  68 #endif
  69     lispobj lra;
  70     int pc; /* Note: this is the trace file offset, not the actual pc. */
  71 };
  72
  73 #define HEADER_LENGTH(header) ((header)>>8)
  74
  75 static int previous_info(struct call_info *info);
  76
  77 static struct code *
  78 code_pointer(lispobj object)
  79 {
  80     lispobj *headerp, header;
  81     int type, len;
  82
  83     headerp = (lispobj *) native_pointer(object);
  84     header = *headerp;
  85     type = widetag_of(header);
  86
  87     switch (type) {
  88         case CODE_HEADER_WIDETAG:
  89             break;
  90         case RETURN_PC_HEADER_WIDETAG:
  91         case SIMPLE_FUN_HEADER_WIDETAG:
  92             len = HEADER_LENGTH(header);
  93             if (len == 0)
  94                 headerp = NULL;
  95             else
  96                 headerp -= len;
  97             break;
  98         default:
  99             headerp = NULL;
 100     }
 101
 102     return (struct code *) headerp;
 103 }
 104
 105 static boolean
 106 cs_valid_pointer_p(struct call_frame *pointer)
 107 {
 108     struct thread *thread=arch_os_get_current_thread();
 109     return (((char *) thread->control_stack_start <= (char *) pointer) &&
 110             ((char *) pointer < (char *) current_control_stack_pointer));
 111 }
 112
 113 static void
 114 call_info_from_lisp_state(struct call_info *info)
 115 {
 116     info->frame = (struct call_frame *)current_control_frame_pointer;
 117     info->interrupted = 0;
 118     info->code = NULL;
 119     info->lra = 0;
 120     info->pc = 0;
 121
 122     previous_info(info);
 123 }
 124
 125 static void
 126 call_info_from_context(struct call_info *info, os_context_t *context)
 127 {
 128     unsigned long pc;
 129
 130     info->interrupted = 1;
 131     if (lowtag_of(*os_context_register_addr(context, reg_CODE))
 132         == FUN_POINTER_LOWTAG) {
 133         /* We tried to call a function, but crapped out before $CODE could
 134          * be fixed up. Probably an undefined function. */
 135         info->frame =
 136             (struct call_frame *)(unsigned long)
 137                 (*os_context_register_addr(context, reg_OCFP));
 138         info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA));
 139         info->code = code_pointer(info->lra);
 140         pc = (unsigned long)native_pointer(info->lra);
 141     }
 142     else {
 143         info->frame =
 144             (struct call_frame *)(unsigned long)
 145                 (*os_context_register_addr(context, reg_CFP));
 146         info->code =
 147             code_pointer(*os_context_register_addr(context, reg_CODE));
 148         info->lra = NIL;
 149         pc = *os_context_pc_addr(context);
 150     }
 151     if (info->code != NULL)
 152         info->pc = pc - (unsigned long) info->code -
 153 #ifndef LISP_FEATURE_ALPHA
 154             (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
 155 #else
 156             (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
 157 #endif
 158     else
 159         info->pc = 0;
 160 }
 161
 162 static int
 163 previous_info(struct call_info *info)
 164 {
 165     struct call_frame *this_frame;
 166     struct thread *thread=arch_os_get_current_thread();
 167     int free;
 168
 169     if (!cs_valid_pointer_p(info->frame)) {
 170         printf("Bogus callee value (0x%08lx).\n", (unsigned long)info->frame);
 171         return 0;
 172     }
 173
 174     this_frame = info->frame;
 175     info->lra = this_frame->saved_lra;
 176     info->frame = this_frame->old_cont;
 177     info->interrupted = 0;
 178
 179     if (info->frame == NULL || info->frame == this_frame)
 180         return 0;
 181
 182     if (info->lra == NIL) {
 183         /* We were interrupted. Find the correct signal context. */
 184         free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
 185         while (free-- > 0) {
 186             os_context_t *context =
 187                 thread->interrupt_contexts[free];
 188             if ((struct call_frame *)(unsigned long)
 189                     (*os_context_register_addr(context, reg_CFP))
 190                 == info->frame) {
 191                 call_info_from_context(info, context);
 192                 break;
 193             }
 194         }
 195     }
 196     else {
 197         info->code = code_pointer(info->lra);
 198         if (info->code != NULL)
 199             info->pc = (unsigned long)native_pointer(info->lra) -
 200                 (unsigned long)info->code -
 201 #ifndef LISP_FEATURE_ALPHA
 202                 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
 203 #else
 204                 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
 205 #endif
 206         else
 207             info->pc = 0;
 208     }
 209
 210     return 1;
 211 }
 212
 213 void
 214 backtrace(int nframes)
 215 {
 216     struct call_info info;
 217
 218     call_info_from_lisp_state(&info);
 219
 220     do {
 221         printf("<Frame 0x%08lx%s, ", (unsigned long) info.frame,
 222                 info.interrupted ? " [interrupted]" : "");
 223
 224         if (info.code != (struct code *) 0) {
 225             lispobj function;
 226
 227             printf("CODE: 0x%08lX, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG);
 228
 229 #ifndef LISP_FEATURE_ALPHA
 230             function = info.code->entry_points;
 231 #else
 232             function = ((struct code *)info.code)->entry_points;
 233 #endif
 234             while (function != NIL) {
 235                 struct simple_fun *header;
 236                 lispobj name;
 237
 238                 header = (struct simple_fun *) native_pointer(function);
 239                 name = header->name;
 240
 241                 if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
 242                     lispobj *object;
 243
 244                     object = (lispobj *) native_pointer(name);
 245
 246                     if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
 247                         struct symbol *symbol;
 248
 249                         symbol = (struct symbol *) object;
 250                         object = (lispobj *) native_pointer(symbol->name);
 251                     }
 252                     if (widetag_of(*object) == SIMPLE_BASE_STRING_WIDETAG) {
 253                         struct vector *string;
 254
 255                         string = (struct vector *) object;
 256                         printf("%s, ", (char *) string->data);
 257                     } else
 258                         /* FIXME: broken from (VECTOR NIL) */
 259                         printf("(Not simple string??\?), ");
 260                 } else
 261                     printf("(Not other pointer??\?), ");
 262
 263
 264                 function = header->next;
 265             }
 266         }
 267         else
 268             printf("CODE: ???, ");
 269
 270         if (info.lra != NIL)
 271             printf("LRA: 0x%08lx, ", (unsigned long)info.lra);
 272         else
 273             printf("<no LRA>, ");
 274
 275         if (info.pc)
 276             printf("PC: 0x%x>\n", info.pc);
 277         else
 278             printf("PC: ??\?>\n");
 279
 280     } while (--nframes > 0 && previous_info(&info));
 281 }
 282
 283 #else
 284
 285 static int
 286 stack_pointer_p (void *p)
 287 {
 288   return (p < (void *) arch_os_get_current_thread()->control_stack_end
 289           && p > (void *) &p
 290           && (((unsigned long) p) & 3) == 0);
 291 }
 292
 293 static int
 294 ra_pointer_p (void *ra)
 295 {
 296   return ((unsigned long) ra) > 4096 && !stack_pointer_p (ra);
 297 }
 298
 299 static int
 300 x86_call_context (void *fp, void **ra, void **ocfp)
 301 {
 302   void *lisp_ocfp;
 303   void *lisp_ra;
 304   void *c_ocfp;
 305   void *c_ra;
 306   int lisp_valid_p, c_valid_p;
 307
 308   if (!stack_pointer_p(fp))
 309     return 0;
 310
 311   c_ocfp    = *((void **) fp);
 312   c_ra      = *((void **) fp + 1);
 313   lisp_ocfp = *((void **) fp - 1);
 314   lisp_ra   = *((void **) fp - 2);
 315
 316   lisp_valid_p = (lisp_ocfp > fp
 317                   && stack_pointer_p(lisp_ocfp)
 318                   && ra_pointer_p(lisp_ra));
 319   c_valid_p = (c_ocfp > fp
 320                && stack_pointer_p(c_ocfp)
 321                && ra_pointer_p(c_ra));
 322
 323   if (lisp_valid_p && c_valid_p) {
 324     void *lisp_path_fp;
 325     void *c_path_fp;
 326     void *dummy;
 327
 328     int lisp_path_p = x86_call_context(lisp_ocfp, &lisp_path_fp, &dummy);
 329     int c_path_p = x86_call_context(c_ocfp, &c_path_fp, &dummy);
 330
 331     if (lisp_path_p && c_path_p) {
 332 #if defined __FreeBSD__ && __FreeBSD_version > 400000
 333       if (lisp_ocfp > c_ocfp)
 334         *ra = lisp_ra, *ocfp = lisp_ocfp;
 335       else
 336         *ra = c_ra, *ocfp = c_ocfp;
 337 #else
 338       *ra = lisp_ra, *ocfp = lisp_ocfp;
 339 #endif
 340     }
 341     else if (lisp_path_p)
 342       *ra = lisp_ra, *ocfp = lisp_ocfp;
 343     else if (c_path_p)
 344       *ra = c_ra, *ocfp = c_ocfp;
 345     else
 346       return 0;
 347   }
 348   else if (lisp_valid_p)
 349     *ra = lisp_ra, *ocfp = lisp_ocfp;
 350   else if (c_valid_p)
 351     *ra = c_ra, *ocfp = c_ocfp;
 352   else
 353     return 0;
 354
 355   return 1;
 356 }
 357
 358 struct compiled_debug_fun *
 359 debug_function_from_pc (struct code* code, void *pc)
 360 {
 361   unsigned long code_header_len = sizeof(lispobj) * HeaderValue(code->header);
 362   unsigned long offset
 363     = (unsigned long) pc - (unsigned long) code - code_header_len;
 364   struct compiled_debug_fun *df;
 365   struct compiled_debug_info *di;
 366   struct vector *v;
 367   int i, len;
 368
 369   if (lowtag_of(code->debug_info) != INSTANCE_POINTER_LOWTAG)
 370     return 0;
 371
 372   di = (struct compiled_debug_info *) native_pointer(code->debug_info);
 373   v = (struct vector *) native_pointer(di->fun_map);
 374   len = fixnum_value(v->length);
 375   df = (struct compiled_debug_fun *) native_pointer(v->data[0]);
 376
 377   if (len == 1)
 378     return df;
 379
 380   for (i = 1;; i += 2) {
 381     unsigned next_pc;
 382
 383     if (i == len)
 384       return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1]));
 385
 386     if (offset >= fixnum_value(df->elsewhere_pc)) {
 387       struct compiled_debug_fun *p
 388         = ((struct compiled_debug_fun *) native_pointer(v->data[i + 1]));
 389       next_pc = fixnum_value(p->elsewhere_pc);
 390     } else
 391       next_pc = fixnum_value(v->data[i]);
 392
 393     if (offset < next_pc)
 394       return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1]));
 395   }
 396
 397   return NULL;
 398 }
 399
 400 static void
 401 print_entry_name (lispobj name)
 402 {
 403   if (lowtag_of (name) == LIST_POINTER_LOWTAG) {
 404     putchar('(');
 405     while (name != NIL) {
 406       struct cons *cons = (struct cons *) native_pointer(name);
 407       print_entry_name(cons->car);
 408       name = cons->cdr;
 409       if (name != NIL)
 410         putchar(' ');
 411     }
 412     putchar(')');
 413   } else if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
 414     lispobj *object = (lispobj *) native_pointer(name);
 415
 416     if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
 417       struct symbol *symbol = (struct symbol *) object;
 418       struct vector *string;
 419
 420       if (symbol->package != NIL) {
 421         struct package *pkg
 422           = (struct package *) native_pointer(symbol->package);
 423         lispobj pkg_name = pkg->_name;
 424         string = (struct vector *) native_pointer(pkg_name);
 425         printf("%s::", (char *) string->data);
 426       }
 427
 428       object = (lispobj *) native_pointer(symbol->name);
 429       string = (struct vector *) object;
 430       printf("%s", (char *) string->data);
 431     } else if (widetag_of(*object) == SIMPLE_BASE_STRING_WIDETAG) {
 432       struct vector *string = (struct vector *) object;
 433       printf("\"%s\"", (char *) string->data);
 434 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
 435     } else if (widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG) {
 436       printf("<oops, a unicode string>");                           /* FIXME */
 437 #endif
 438     } else
 439       printf("<??? type %d>", (int) widetag_of(*object));
 440   } else
 441     printf("<??? lowtag %d>", (int) lowtag_of(name));
 442 }
 443
 444 static void
 445 print_entry_points (struct code *code)
 446 {
 447   lispobj function = code->entry_points;
 448
 449   while (function != NIL) {
 450     struct simple_fun *header = (struct simple_fun *) native_pointer(function);
 451     print_entry_name(header->name);
 452
 453     function = header->next;
 454     if (function != NIL)
 455       printf (", ");
 456   }
 457 }
 458
 459 void
 460 backtrace(int nframes)
 461 {
 462   void *fp;
 463   int i;
 464
 465 #if defined(LISP_FEATURE_X86)
 466   asm("movl %%ebp,%0" : "=g" (fp));
 467 #elif defined (LISP_FEATURE_X86_64)
 468   asm("movq %%rbp,%0" : "=g" (fp));
 469 #else
 470 #error "How did we get here?"
 471 #endif
 472
 473   for (i = 0; i < nframes; ++i) {
 474     lispobj *p;
 475     void *ra;
 476     void *next_fp;
 477
 478     if (!x86_call_context(fp, &ra, &next_fp))
 479       break;
 480
 481     printf("%4d: ", i);
 482
 483     p = (lispobj *) component_ptr_from_pc((lispobj *) ra);
 484     if (p) {
 485       struct code *cp = (struct code *) p;
 486       struct compiled_debug_fun *df = debug_function_from_pc(cp, ra);
 487       if (df)
 488         print_entry_name(df->name);
 489       else
 490         print_entry_points(cp);
 491     } else {
 492 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
 493         Dl_info info;
 494         if (dladdr(ra, &info)) {
 495             printf("Foreign function %s, fp = 0x%lx, ra = 0x%lx",
 496                    info.dli_sname,
 497                    (unsigned long) next_fp,
 498                    (unsigned long) ra);
 499         } else
 500 #endif
 501         printf("Foreign fp = 0x%lx, ra = 0x%lx",
 502                (unsigned long) next_fp,
 503                (unsigned long) ra);
 504     }
 505
 506     putchar('\n');
 507     fp = next_fp;
 508   }
 509 }
 510
 511 #endif