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.
22 #include "interrupt.h"
24 #ifdef LISP_FEATURE_GENCGC
25 #include "gencgc-alloc-region.h"
27 #include "genesis/static-symbols.h"
28 #include "genesis/primitive-objects.h"
31 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
33 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
34 * better not change. */
37 #ifndef LISP_FEATURE_ALPHA
38 struct call_frame
*old_cont
;
44 lispobj other_state
[5];
48 #ifndef LISP_FEATURE_ALPHA
49 struct call_frame
*frame
;
54 #ifndef LISP_FEATURE_ALPHA
60 int pc
; /* Note: this is the trace file offset, not the actual pc. */
63 #define HEADER_LENGTH(header) ((header)>>8)
65 static int previous_info(struct call_info
*info
);
68 code_pointer(lispobj object
)
70 lispobj
*headerp
, header
;
73 headerp
= (lispobj
*) native_pointer(object
);
75 type
= widetag_of(header
);
78 case CODE_HEADER_WIDETAG
:
80 case RETURN_PC_HEADER_WIDETAG
:
81 case SIMPLE_FUN_HEADER_WIDETAG
:
82 len
= HEADER_LENGTH(header
);
92 return (struct code
*) headerp
;
96 cs_valid_pointer_p(struct call_frame
*pointer
)
98 struct thread
*thread
=arch_os_get_current_thread();
99 return (((char *) thread
->control_stack_start
<= (char *) pointer
) &&
100 ((char *) pointer
< (char *) current_control_stack_pointer
));
104 call_info_from_lisp_state(struct call_info
*info
)
106 info
->frame
= (struct call_frame
*)current_control_frame_pointer
;
107 info
->interrupted
= 0;
116 call_info_from_context(struct call_info
*info
, os_context_t
*context
)
120 info
->interrupted
= 1;
121 if (lowtag_of(*os_context_register_addr(context
, reg_CODE
))
122 == FUN_POINTER_LOWTAG
) {
123 /* We tried to call a function, but crapped out before $CODE could
124 * be fixed up. Probably an undefined function. */
126 (struct call_frame
*)(*os_context_register_addr(context
,
128 info
->lra
= (lispobj
)(*os_context_register_addr(context
, reg_LRA
));
129 info
->code
= code_pointer(info
->lra
);
130 pc
= (unsigned long)native_pointer(info
->lra
);
134 (struct call_frame
*)(*os_context_register_addr(context
, reg_CFP
));
136 code_pointer(*os_context_register_addr(context
, reg_CODE
));
138 pc
= *os_context_pc_addr(context
);
140 if (info
->code
!= NULL
)
141 info
->pc
= pc
- (unsigned long) info
->code
-
142 #ifndef LISP_FEATURE_ALPHA
143 (HEADER_LENGTH(info
->code
->header
) * sizeof(lispobj
));
145 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
152 previous_info(struct call_info
*info
)
154 struct call_frame
*this_frame
;
155 struct thread
*thread
=arch_os_get_current_thread();
158 if (!cs_valid_pointer_p(info
->frame
)) {
159 printf("Bogus callee value (0x%08lx).\n", (unsigned long)info
->frame
);
163 this_frame
= info
->frame
;
164 info
->lra
= this_frame
->saved_lra
;
165 info
->frame
= this_frame
->old_cont
;
166 info
->interrupted
= 0;
168 if (info
->frame
== NULL
|| info
->frame
== this_frame
)
171 if (info
->lra
== NIL
) {
172 /* We were interrupted. Find the correct signal context. */
173 free
= SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,thread
)>>2;
175 os_context_t
*context
=
176 thread
->interrupt_contexts
[free
];
177 if ((struct call_frame
*)(*os_context_register_addr(context
,
180 call_info_from_context(info
, context
);
186 info
->code
= code_pointer(info
->lra
);
187 if (info
->code
!= NULL
)
188 info
->pc
= (unsigned long)native_pointer(info
->lra
) -
189 (unsigned long)info
->code
-
190 #ifndef LISP_FEATURE_ALPHA
191 (HEADER_LENGTH(info
->code
->header
) * sizeof(lispobj
));
193 (HEADER_LENGTH(((struct code
*)info
->code
)->header
) * sizeof(lispobj
));
203 backtrace(int nframes
)
205 struct call_info info
;
207 call_info_from_lisp_state(&info
);
210 printf("<Frame 0x%08lx%s, ", (unsigned long) info
.frame
,
211 info
.interrupted
? " [interrupted]" : "");
213 if (info
.code
!= (struct code
*) 0) {
216 printf("CODE: 0x%08lX, ", (unsigned long) info
.code
| OTHER_POINTER_LOWTAG
);
218 #ifndef LISP_FEATURE_ALPHA
219 function
= info
.code
->entry_points
;
221 function
= ((struct code
*)info
.code
)->entry_points
;
223 while (function
!= NIL
) {
224 struct simple_fun
*header
;
227 header
= (struct simple_fun
*) native_pointer(function
);
230 if (lowtag_of(name
) == OTHER_POINTER_LOWTAG
) {
233 object
= (lispobj
*) native_pointer(name
);
235 if (widetag_of(*object
) == SYMBOL_HEADER_WIDETAG
) {
236 struct symbol
*symbol
;
238 symbol
= (struct symbol
*) object
;
239 object
= (lispobj
*) native_pointer(symbol
->name
);
241 if (widetag_of(*object
) == SIMPLE_BASE_STRING_WIDETAG
) {
242 struct vector
*string
;
244 string
= (struct vector
*) object
;
245 printf("%s, ", (char *) string
->data
);
247 /* FIXME: broken from (VECTOR NIL) */
248 printf("(Not simple string??\?), ");
250 printf("(Not other pointer??\?), ");
253 function
= header
->next
;
257 printf("CODE: ???, ");
260 printf("LRA: 0x%08lx, ", (unsigned long)info
.lra
);
262 printf("<no LRA>, ");
265 printf("PC: 0x%x>\n", info
.pc
);
267 printf("PC: ??\?>\n");
269 } while (--nframes
> 0 && previous_info(&info
));
277 backtrace(int nframes
)
279 printf("Can't backtrace on this hardware platform.\n");