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"
27 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
28 * better not change. */
32 struct call_frame *old_cont;
38 lispobj other_state[5];
43 struct call_frame *frame;
54 int pc; /* Note: this is the trace file offset, not the actual pc. */
57 #define HEADER_LENGTH(header) ((header)>>8)
59 static int previous_info(struct call_info *info);
62 code_pointer(lispobj object)
64 lispobj *headerp, header;
67 headerp = (lispobj *) native_pointer(object);
69 type = widetag_of(header);
72 case CODE_HEADER_WIDETAG:
74 case RETURN_PC_HEADER_WIDETAG:
75 case SIMPLE_FUN_HEADER_WIDETAG:
76 case CLOSURE_FUN_HEADER_WIDETAG:
77 len = HEADER_LENGTH(header);
87 return (struct code *) headerp;
91 cs_valid_pointer_p(struct call_frame *pointer)
93 return (((char *) CONTROL_STACK_START <= (char *) pointer) &&
94 ((char *) pointer < (char *) current_control_stack_pointer));
98 call_info_from_lisp_state(struct call_info *info)
100 info->frame = (struct call_frame *)current_control_frame_pointer;
101 info->interrupted = 0;
110 call_info_from_context(struct call_info *info, os_context_t *context)
114 info->interrupted = 1;
115 if (lowtag_of(*os_context_register_addr(context, reg_CODE))
116 == FUN_POINTER_LOWTAG) {
117 /* We tried to call a function, but crapped out before $CODE could
118 * be fixed up. Probably an undefined function. */
120 (struct call_frame *)(*os_context_register_addr(context,
122 info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA));
123 info->code = code_pointer(info->lra);
124 pc = (unsigned long)native_pointer(info->lra);
128 (struct call_frame *)(*os_context_register_addr(context, reg_CFP));
130 code_pointer(*os_context_register_addr(context, reg_CODE));
132 pc = *os_context_pc_addr(context);
134 if (info->code != NULL)
135 info->pc = pc - (unsigned long) info->code -
137 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
139 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
146 previous_info(struct call_info *info)
148 struct call_frame *this_frame;
151 if (!cs_valid_pointer_p(info->frame)) {
152 printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame);
156 this_frame = info->frame;
157 info->lra = this_frame->saved_lra;
158 info->frame = this_frame->old_cont;
159 info->interrupted = 0;
161 if (info->frame == NULL || info->frame == this_frame)
164 if (info->lra == NIL) {
165 /* We were interrupted. Find the correct signal context. */
166 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
168 os_context_t *context =
169 lisp_interrupt_contexts[free];
170 if ((struct call_frame *)(*os_context_register_addr(context,
173 call_info_from_context(info, context);
179 info->code = code_pointer(info->lra);
180 if (info->code != NULL)
181 info->pc = (unsigned long)native_pointer(info->lra) -
182 (unsigned long)info->code -
184 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
186 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
196 backtrace(int nframes)
198 struct call_info info;
200 call_info_from_lisp_state(&info);
203 printf("<Frame 0x%08x%s, ", (unsigned long) info.frame,
204 info.interrupted ? " [interrupted]" : "");
206 if (info.code != (struct code *) 0) {
209 printf("CODE: 0x%08X, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG);
212 function = info.code->entry_points;
214 function = ((struct code *)info.code)->entry_points;
216 while (function != NIL) {
217 struct simple_fun *header;
220 header = (struct simple_fun *) native_pointer(function);
223 if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
226 object = (lispobj *) native_pointer(name);
228 if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
229 struct symbol *symbol;
231 symbol = (struct symbol *) object;
232 object = (lispobj *) native_pointer(symbol->name);
234 if (widetag_of(*object) == SIMPLE_STRING_WIDETAG) {
235 struct vector *string;
237 string = (struct vector *) object;
238 printf("%s, ", (char *) string->data);
240 printf("(Not simple string??\?), ");
242 printf("(Not other pointer??\?), ");
245 function = header->next;
249 printf("CODE: ???, ");
252 printf("LRA: 0x%08x, ", (unsigned long)info.lra);
254 printf("<no LRA>, ");
257 printf("PC: 0x%x>\n", info.pc);
259 printf("PC: ??\?>\n");
261 } while (--nframes > 0 && previous_info(&info));
267 backtrace(int nframes)
269 printf("Can't backtrace on this hardware platform.\n");