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"
37 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
42 sbcl_putwc(wchar_t c
, FILE *file
)
44 #ifdef LISP_FEATURE_OS_PROVIDES_PUTWC
55 struct compiled_debug_fun
*
56 debug_function_from_pc (struct code
* code
, void *pc
)
58 uword_t code_header_len
= sizeof(lispobj
) * code_header_words(code
->header
);
60 = (uword_t
) pc
- (uword_t
) code
- code_header_len
;
61 struct compiled_debug_fun
*df
;
62 struct compiled_debug_info
*di
;
66 if (lowtag_of(code
->debug_info
) != INSTANCE_POINTER_LOWTAG
)
69 di
= (struct compiled_debug_info
*) native_pointer(code
->debug_info
);
71 if (lowtag_of(di
->fun_map
) != INSTANCE_POINTER_LOWTAG
)
74 v
= (struct vector
*) native_pointer(di
->fun_map
);
76 len
= fixnum_value(v
->length
);
78 if (lowtag_of(v
->data
[0]) != INSTANCE_POINTER_LOWTAG
)
81 df
= (struct compiled_debug_fun
*) native_pointer(v
->data
[0]);
86 for (i
= 1;; i
+= 2) {
90 return ((struct compiled_debug_fun
*) native_pointer(v
->data
[i
- 1]));
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
);
97 next_pc
= fixnum_value(v
->data
[i
]);
100 return ((struct compiled_debug_fun
*) native_pointer(v
->data
[i
- 1]));
107 print_string (lispobj
*object
)
109 int tag
= widetag_of(*object
);
110 struct vector
*vector
= (struct vector
*) object
;
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 == '"') \
121 sbcl_putwc(c, stdout); \
126 case SIMPLE_BASE_STRING_WIDETAG
:
129 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
130 case SIMPLE_CHARACTER_STRING_WIDETAG
:
135 printf("<??? type %d>", tag
);
140 static int string_equal (lispobj
*object
, char *string
)
142 int tag
= widetag_of(*object
);
143 struct vector
*vector
= (struct vector
*) object
;
145 if (tag
!= SIMPLE_BASE_STRING_WIDETAG
)
147 return !strcmp((char *) vector
->data
, string
);
151 print_entry_name (lispobj name
)
153 if (lowtag_of (name
) == LIST_POINTER_LOWTAG
) {
155 while (name
!= NIL
) {
156 if (lowtag_of (name
) != LIST_POINTER_LOWTAG
) {
157 printf("%p: unexpected lowtag while printing a cons\n",
161 struct cons
*cons
= (struct cons
*) native_pointer(name
);
162 print_entry_name(cons
->car
);
168 } else if (lowtag_of(name
) == OTHER_POINTER_LOWTAG
) {
169 lispobj
*object
= native_pointer(name
);
170 if (widetag_of(*object
) == SYMBOL_HEADER_WIDETAG
) {
171 struct symbol
*symbol
= (struct symbol
*) object
;
172 if (symbol
->package
!= NIL
) {
174 = (struct package
*) native_pointer(symbol
->package
);
175 lispobj pkg_name
= pkg
->_name
;
176 if (string_equal(native_pointer(pkg_name
), "COMMON-LISP"))
178 else if (string_equal(native_pointer(pkg_name
), "COMMON-LISP-USER")) {
179 fputs("CL-USER::", stdout
);
181 else if (string_equal(native_pointer(pkg_name
), "KEYWORD")) {
184 print_string(native_pointer(pkg_name
));
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
195 print_string(object
);
198 printf("<??? type %d>", (int) widetag_of(*object
));
201 printf("<??? lowtag %d>", (int) lowtag_of(name
));
206 print_entry_points (struct code
*code
)
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
);
214 print_entry_name(fun
->name
);
215 if ((index
+ 1) < n_funs
) printf (", ");
220 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
222 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
223 * better not change. */
226 #ifndef LISP_FEATURE_ALPHA
227 struct call_frame
*old_cont
;
233 lispobj other_state
[5];
237 #ifndef LISP_FEATURE_ALPHA
238 struct call_frame
*frame
;
243 #ifndef LISP_FEATURE_ALPHA
249 int pc
; /* Note: this is the trace file offset, not the actual pc. */
252 #define HEADER_LENGTH(header) ((header)>>8)
254 static int previous_info(struct call_info
*info
);
257 code_pointer(lispobj object
)
259 lispobj
*headerp
, header
;
262 headerp
= native_pointer(object
);
264 type
= widetag_of(header
);
267 case CODE_HEADER_WIDETAG
:
269 case RETURN_PC_HEADER_WIDETAG
:
270 case SIMPLE_FUN_HEADER_WIDETAG
:
271 len
= HEADER_LENGTH(header
);
281 return (struct code
*) headerp
;
285 cs_valid_pointer_p(struct call_frame
*pointer
)
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
)));
293 call_info_from_lisp_state(struct call_info
*info
)
295 info
->frame
= (struct call_frame
*)access_control_frame_pointer(arch_os_get_current_thread());
296 info
->interrupted
= 0;
305 call_info_from_context(struct call_info
*info
, os_context_t
*context
)
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. */
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
);
325 (struct call_frame
*)(uword_t
)
326 (*os_context_register_addr(context
, reg_CFP
));
328 code_pointer(*os_context_register_addr(context
, reg_CODE
));
330 pc
= *os_context_pc_addr(context
);
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
));
337 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
344 previous_info(struct call_info
*info
)
346 struct call_frame
*this_frame
;
347 struct thread
*thread
=arch_os_get_current_thread();
351 if (!cs_valid_pointer_p(info
->frame
)) {
352 printf("Bogus callee value (0x%lx).\n", (long)info
->frame
);
356 this_frame
= info
->frame
;
357 info
->lra
= this_frame
->saved_lra
;
358 info
->frame
= this_frame
->old_cont
;
359 info
->interrupted
= 0;
361 if (info
->frame
== NULL
|| info
->frame
== this_frame
)
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
))
373 call_info_from_context(info
, context
);
377 } else if (fixnump(lra
)) {
378 info
->code
= (struct code
*)native_pointer(this_frame
->code
);
379 info
->pc
= (uword_t
)(info
->code
+ lra
);
382 info
->code
= code_pointer(lra
);
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
));
390 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
400 lisp_backtrace(int nframes
)
402 struct call_info info
;
404 call_info_from_lisp_state(&info
);
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
);
415 print_entry_points((struct code
*)info
.code
);
417 printf(" %p", (void*)((uword_t
) info
.code
| OTHER_POINTER_LOWTAG
));
420 printf("CODE = ???");
421 printf("%s fp = %p", info
.interrupted
? " [interrupted]" : "",
425 printf(" LRA = %p", (void*)info
.lra
);
430 printf(" pc = %p", (void*)(long)info
.pc
);
433 } while (i
++ < nframes
&& previous_info(&info
));
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
;
444 return (p
> stack_start
&& p
<= stack_end
);
446 /* Win32 doesn't do altstack */
452 stack_pointer_p (void *p
)
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*);
459 struct thread
*thread
= arch_os_get_current_thread();
461 if (altstack_pointer_p(p
))
464 if (altstack_pointer_p(&p
)) {
465 stack_start
= (void *) thread
->control_stack_start
;
467 /* Use the current frame address, since there should be no
468 * relevant frames below. */
471 return p
>= stack_start
472 && p
< (void *) thread
->control_stack_end
473 && (((uword_t
) p
) & (stack_alignment
-1)) == 0;
477 ra_pointer_p (void *ra
)
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
);
486 x86_call_context (void *fp
, void **ra
, void **ocfp
)
492 if (!stack_pointer_p(fp
))
495 c_ocfp
= *((void **) fp
);
496 c_ra
= *((void **) fp
+ 1);
498 c_valid_p
= (c_ocfp
> fp
499 && stack_pointer_p(c_ocfp
)
500 && ra_pointer_p(c_ra
));
503 *ra
= c_ra
, *ocfp
= c_ocfp
;
511 describe_thread_state(void)
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
));
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");
536 printf("Pending handler = %p\n", data
->pending_handler
);
539 void print_backtrace_frame(void *pc
, void *fp
, int i
) {
543 p
= (lispobj
*) component_ptr_from_pc((lispobj
*) pc
);
546 struct code
*cp
= (struct code
*) p
;
547 struct compiled_debug_fun
*df
= debug_function_from_pc(cp
, pc
);
549 print_entry_name(df
->name
);
551 print_entry_points(cp
);
552 printf(", pc = %p, fp = %p", pc
, fp
);
554 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
556 if (dladdr(pc
, &info
)) {
557 printf("Foreign function %s, pc = %p, fp = %p", info
.dli_sname
, pc
, fp
);
560 printf("Foreign function, pc = %p, fp = %p", pc
, fp
);
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.
571 backtrace_from_fp(void *fp
, int nframes
, int start
)
575 for (; i
< nframes
; ++i
) {
579 if (!x86_call_context(fp
, &ra
, &next_fp
))
581 print_backtrace_frame(ra
, next_fp
, i
);
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
);
592 print_backtrace_frame((void *)*os_context_pc_addr(context
), fp
, 0);
593 backtrace_from_fp(fp
, nframes
- 1, 1);
597 lisp_backtrace(int nframes
)
599 struct thread
*thread
=arch_os_get_current_thread();
600 int free_ici
= fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,thread
));
603 os_context_t
*context
= thread
->interrupt_contexts
[free_ici
- 1];
604 backtrace_from_context(context
, nframes
);
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
));
613 backtrace_from_fp(fp
, nframes
, 0);