2 * simple backtrace facility
6 * This software is part of the SBCL system. See the README file for
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.
16 /* needed if we want dladdr() and Dl_Info from glibc's dlfcn.h */
25 #include "interrupt.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"
35 #include "gc-internal.h"
38 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
43 sbcl_putwc(wchar_t c
, FILE *file
)
45 #ifdef LISP_FEATURE_OS_PROVIDES_PUTWC
56 unsigned int decode_elsewhere_pc(lispobj packed_integer
)
58 struct varint_unpacker unpacker
;
60 varint_unpacker_init(&unpacker
, packed_integer
);
61 varint_unpack(&unpacker
, &value
);
65 struct compiled_debug_fun
*
66 debug_function_from_pc (struct code
* code
, void *pc
)
68 uword_t code_header_len
= sizeof(lispobj
) * code_header_words(code
->header
);
70 = (uword_t
) pc
- (uword_t
) code
- code_header_len
;
71 struct compiled_debug_fun
*df
;
72 struct compiled_debug_info
*di
;
76 if (!instancep(code
->debug_info
))
79 di
= (struct compiled_debug_info
*) native_pointer(code
->debug_info
);
81 if (!instancep(di
->fun_map
))
84 v
= VECTOR(di
->fun_map
);
86 len
= fixnum_value(v
->length
);
88 if (!instancep(v
->data
[0]))
91 df
= (struct compiled_debug_fun
*) native_pointer(v
->data
[0]);
96 for (i
= 1;; i
+= 2) {
100 return ((struct compiled_debug_fun
*) native_pointer(v
->data
[i
- 1]));
102 if (offset
>= (uword_t
)decode_elsewhere_pc(df
->encoded_locs
)) {
103 struct compiled_debug_fun
*p
104 = ((struct compiled_debug_fun
*) native_pointer(v
->data
[i
+ 1]));
105 next_pc
= decode_elsewhere_pc(p
->encoded_locs
);
107 next_pc
= fixnum_value(v
->data
[i
]);
109 if (offset
< next_pc
)
110 return ((struct compiled_debug_fun
*) native_pointer(v
->data
[i
- 1]));
117 print_string (struct vector
*vector
)
119 int tag
= widetag_of(vector
->header
);
124 int n = fixnum_value(vector->length); \
125 TYPE *data = (TYPE *) vector->data; \
126 for (i = 0; i < n; i++) { \
127 wchar_t c = (wchar_t) data[i]; \
128 if (c == '\\' || c == '"') \
130 sbcl_putwc(c, stdout); \
135 case SIMPLE_BASE_STRING_WIDETAG
:
138 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
139 case SIMPLE_CHARACTER_STRING_WIDETAG
:
144 printf("<??? type %d>", tag
);
149 static int string_equal (struct vector
*vector
, char *string
)
151 if (widetag_of(vector
->header
) != SIMPLE_BASE_STRING_WIDETAG
)
153 return !strcmp((char *) vector
->data
, string
);
157 print_entry_name (lispobj name
)
161 while (name
!= NIL
) {
163 printf("%p: unexpected lowtag while printing a cons\n",
167 print_entry_name(CONS(name
)->car
);
168 name
= CONS(name
)->cdr
;
173 } else if (lowtag_of(name
) == OTHER_POINTER_LOWTAG
) {
174 lispobj
*object
= native_pointer(name
);
175 if (widetag_of(*object
) == SYMBOL_WIDETAG
) {
176 struct symbol
*symbol
= (struct symbol
*) object
;
177 if (symbol
->package
!= NIL
) {
179 = (struct package
*) native_pointer(symbol
->package
);
180 struct vector
*pkg_name
= VECTOR(pkg
->_name
);
181 if (string_equal(pkg_name
, "COMMON-LISP"))
183 else if (string_equal(pkg_name
, "COMMON-LISP-USER")) {
184 fputs("CL-USER::", stdout
);
186 else if (string_equal(pkg_name
, "KEYWORD")) {
189 print_string(pkg_name
);
193 print_string(VECTOR(symbol
->name
));
194 } else if (widetag_of(*object
) == SIMPLE_BASE_STRING_WIDETAG
195 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
196 || widetag_of(*object
) == SIMPLE_CHARACTER_STRING_WIDETAG
200 print_string((struct vector
*)object
);
203 printf("<??? type %d>", (int) widetag_of(*object
));
206 printf("<??? lowtag %d>", (int) lowtag_of(name
));
211 print_entry_points (struct code
*code
)
213 int n_funs
= code_n_funs(code
);
214 for_each_simple_fun(index
, fun
, code
, 0, {
215 if (widetag_of(fun
->header
) != SIMPLE_FUN_WIDETAG
) {
216 printf("%p: bogus function entry", fun
);
219 print_entry_name(fun
->name
);
220 if ((index
+ 1) < n_funs
) printf (", ");
225 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
227 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
228 * better not change. */
231 #ifndef LISP_FEATURE_ALPHA
232 struct call_frame
*old_cont
;
238 lispobj other_state
[5];
242 #ifndef LISP_FEATURE_ALPHA
243 struct call_frame
*frame
;
248 #ifndef LISP_FEATURE_ALPHA
254 int pc
; /* Note: this is the trace file offset, not the actual pc. */
257 #define HEADER_LENGTH(header) ((header)>>8)
259 static int previous_info(struct call_info
*info
);
262 code_pointer(lispobj object
)
264 lispobj
*headerp
, header
;
267 headerp
= native_pointer(object
);
269 type
= widetag_of(header
);
272 case CODE_HEADER_WIDETAG
:
274 case RETURN_PC_WIDETAG
:
275 case SIMPLE_FUN_WIDETAG
:
276 len
= HEADER_LENGTH(header
);
286 return (struct code
*) headerp
;
290 cs_valid_pointer_p(struct call_frame
*pointer
)
292 struct thread
*thread
=arch_os_get_current_thread();
293 return (((char *) thread
->control_stack_start
<= (char *) pointer
) &&
294 ((char *) pointer
< (char *) access_control_stack_pointer(thread
)));
298 call_info_from_lisp_state(struct call_info
*info
)
300 info
->frame
= (struct call_frame
*)access_control_frame_pointer(arch_os_get_current_thread());
301 info
->interrupted
= 0;
310 call_info_from_context(struct call_info
*info
, os_context_t
*context
)
314 info
->interrupted
= 1;
315 #if !defined(LISP_FEATURE_ARM) && !defined(LISP_FEATURE_ARM64)
316 if (functionp(*os_context_register_addr(context
, reg_CODE
))) {
317 /* We tried to call a function, but crapped out before $CODE could
318 * be fixed up. Probably an undefined function. */
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
);
329 (struct call_frame
*)(uword_t
)
330 (*os_context_register_addr(context
, reg_CFP
));
332 code_pointer(*os_context_register_addr(context
, reg_CODE
));
334 pc
= *os_context_pc_addr(context
);
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
));
341 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
348 previous_info(struct call_info
*info
)
350 struct call_frame
*this_frame
;
351 struct thread
*thread
=arch_os_get_current_thread();
355 if (!cs_valid_pointer_p(info
->frame
)) {
356 printf("Bogus callee value (0x%lx).\n", (long)info
->frame
);
360 this_frame
= info
->frame
;
361 info
->lra
= this_frame
->saved_lra
;
362 info
->frame
= this_frame
->old_cont
;
363 info
->interrupted
= 0;
365 if (info
->frame
== NULL
|| info
->frame
== this_frame
)
369 /* We were interrupted. Find the correct signal context. */
370 free_ici
= fixnum_value(read_TLS(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
))
377 call_info_from_context(info
, context
);
381 } else if (fixnump(lra
)) {
382 info
->code
= (struct code
*)native_pointer(this_frame
->code
);
383 info
->pc
= (uword_t
)(info
->code
+ lra
);
386 info
->code
= code_pointer(lra
);
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
));
394 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
404 lisp_backtrace(int nframes
)
406 struct call_info info
;
408 call_info_from_lisp_state(&info
);
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
);
419 print_entry_points((struct code
*)info
.code
);
421 printf(" %p", (void*)((uword_t
) info
.code
| OTHER_POINTER_LOWTAG
));
424 printf("CODE = ???");
425 printf("%s fp = %p", info
.interrupted
? " [interrupted]" : "",
429 printf(" LRA = %p", (void*)info
.lra
);
434 printf(" pc = %p", (void*)(long)info
.pc
);
437 } while (i
++ < nframes
&& previous_info(&info
));
443 altstack_pointer_p (void *p
) {
444 #ifndef LISP_FEATURE_WIN32
445 void* stack_start
= ((char*)arch_os_get_current_thread()) + dynamic_values_bytes
;
446 void* stack_end
= (char*)stack_start
+ 32*SIGSTKSZ
;
448 return (p
> stack_start
&& p
<= stack_end
);
450 /* Win32 doesn't do altstack */
456 stack_pointer_p (void *p
)
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*);
463 struct thread
*thread
= arch_os_get_current_thread();
465 if (altstack_pointer_p(p
))
468 if (altstack_pointer_p(&p
)) {
469 stack_start
= (void *) thread
->control_stack_start
;
471 /* Use the current frame address, since there should be no
472 * relevant frames below. */
475 return p
>= stack_start
476 && p
< (void *) thread
->control_stack_end
477 && (((uword_t
) p
) & (stack_alignment
-1)) == 0;
481 ra_pointer_p (void *ra
)
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
);
490 x86_call_context (void *fp
, void **ra
, void **ocfp
)
496 if (!stack_pointer_p(fp
))
499 c_ocfp
= *((void **) fp
);
500 c_ra
= *((void **) fp
+ 1);
502 c_valid_p
= (c_ocfp
> fp
503 && stack_pointer_p(c_ocfp
)
504 && ra_pointer_p(c_ra
));
507 *ra
= c_ra
, *ocfp
= c_ocfp
;
515 describe_thread_state(void)
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
));
530 printf("Specials:\n");
531 printf(" *GC-INHIBIT* = %s\n", (read_TLS(GC_INHIBIT
, thread
) == T
) ? "T" : "NIL");
532 printf(" *GC-PENDING* = %s\n", (read_TLS(GC_PENDING
, thread
) == T
) ? "T" : "NIL");
533 printf(" *INTERRUPTS-ENABLED* = %s\n", (read_TLS(INTERRUPTS_ENABLED
, thread
) == T
) ? "T" : "NIL");
534 #ifdef STOP_FOR_GC_PENDING
535 printf(" *STOP-FOR-GC-PENDING* = %s\n", (read_TLS(STOP_FOR_GC_PENDING
, thread
) == T
) ? "T" : "NIL");
537 printf("Pending handler = %p\n", data
->pending_handler
);
540 void print_backtrace_frame(void *pc
, void *fp
, int i
) {
544 p
= (lispobj
*) component_ptr_from_pc((lispobj
*) pc
);
547 struct code
*cp
= (struct code
*) p
;
548 struct compiled_debug_fun
*df
= debug_function_from_pc(cp
, pc
);
550 print_entry_name(df
->name
);
552 print_entry_points(cp
);
553 printf(", pc = %p, fp = %p", pc
, fp
);
555 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
557 if (dladdr(pc
, &info
)) {
558 printf("Foreign function %s, pc = %p, fp = %p", info
.dli_sname
, pc
, fp
);
561 printf("Foreign function, pc = %p, fp = %p", pc
, fp
);
567 /* This function has been split from lisp_backtrace() to enable Lisp
568 * backtraces from gdb with call backtrace_from_fp(...). Useful for
569 * example when debugging threading deadlocks.
572 backtrace_from_fp(void *fp
, int nframes
, int start
)
576 for (; i
< nframes
; ++i
) {
580 if (!x86_call_context(fp
, &ra
, &next_fp
))
582 print_backtrace_frame(ra
, next_fp
, i
);
587 void backtrace_from_context(os_context_t
*context
, int nframes
) {
588 #ifdef LISP_FEATURE_X86
589 void *fp
= (void *)*os_context_register_addr(context
,reg_EBP
);
590 #elif defined (LISP_FEATURE_X86_64)
591 void *fp
= (void *)*os_context_register_addr(context
,reg_RBP
);
593 print_backtrace_frame((void *)*os_context_pc_addr(context
), fp
, 0);
594 backtrace_from_fp(fp
, nframes
- 1, 1);
598 lisp_backtrace(int nframes
)
600 struct thread
*thread
=arch_os_get_current_thread();
601 int free_ici
= fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX
,thread
));
604 os_context_t
*context
= thread
->interrupt_contexts
[free_ici
- 1];
605 backtrace_from_context(context
, nframes
);
609 #ifdef LISP_FEATURE_X86
610 asm("movl %%ebp,%0" : "=g" (fp
));
611 #elif defined (LISP_FEATURE_X86_64)
612 asm("movq %%rbp,%0" : "=g" (fp
));
614 backtrace_from_fp(fp
, nframes
, 0);