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"
32 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
33 * better not change. */
37 struct call_frame *old_cont;
43 lispobj other_state[5];
48 struct call_frame *frame;
59 int pc; /* Note: this is the trace file offset, not the actual pc. */
62 #define HEADER_LENGTH(header) ((header)>>8)
64 static int previous_info(struct call_info *info);
67 code_pointer(lispobj object)
69 lispobj *headerp, header;
72 headerp = (lispobj *) native_pointer(object);
74 type = widetag_of(header);
77 case CODE_HEADER_WIDETAG:
79 case RETURN_PC_HEADER_WIDETAG:
80 case SIMPLE_FUN_HEADER_WIDETAG:
81 case CLOSURE_FUN_HEADER_WIDETAG:
82 len = HEADER_LENGTH(header);
92 return (struct code *) headerp;
96 cs_valid_pointer_p(struct call_frame *pointer)
98 return (((char *) CONTROL_STACK_START <= (char *) pointer) &&
99 ((char *) pointer < (char *) current_control_stack_pointer));
103 call_info_from_lisp_state(struct call_info *info)
105 info->frame = (struct call_frame *)current_control_frame_pointer;
106 info->interrupted = 0;
115 call_info_from_context(struct call_info *info, os_context_t *context)
119 info->interrupted = 1;
120 if (lowtag_of(*os_context_register_addr(context, reg_CODE))
121 == FUN_POINTER_LOWTAG) {
122 /* We tried to call a function, but crapped out before $CODE could
123 * be fixed up. Probably an undefined function. */
125 (struct call_frame *)(*os_context_register_addr(context,
127 info->lra = (lispobj)(*os_context_register_addr(context, reg_LRA));
128 info->code = code_pointer(info->lra);
129 pc = (unsigned long)native_pointer(info->lra);
133 (struct call_frame *)(*os_context_register_addr(context, reg_CFP));
135 code_pointer(*os_context_register_addr(context, reg_CODE));
137 pc = *os_context_pc_addr(context);
139 if (info->code != NULL)
140 info->pc = pc - (unsigned long) info->code -
142 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
144 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
151 previous_info(struct call_info *info)
153 struct call_frame *this_frame;
154 struct thread *thread=arch_os_get_current_thread();
157 if (!cs_valid_pointer_p(info->frame)) {
158 printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame);
162 this_frame = info->frame;
163 info->lra = this_frame->saved_lra;
164 info->frame = this_frame->old_cont;
165 info->interrupted = 0;
167 if (info->frame == NULL || info->frame == this_frame)
170 if (info->lra == NIL) {
171 /* We were interrupted. Find the correct signal context. */
172 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
174 os_context_t *context =
175 thread->interrupt_contexts[free];
176 if ((struct call_frame *)(*os_context_register_addr(context,
179 call_info_from_context(info, context);
185 info->code = code_pointer(info->lra);
186 if (info->code != NULL)
187 info->pc = (unsigned long)native_pointer(info->lra) -
188 (unsigned long)info->code -
190 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
192 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
202 backtrace(int nframes)
204 struct call_info info;
206 call_info_from_lisp_state(&info);
209 printf("<Frame 0x%08x%s, ", (unsigned long) info.frame,
210 info.interrupted ? " [interrupted]" : "");
212 if (info.code != (struct code *) 0) {
215 printf("CODE: 0x%08X, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG);
218 function = info.code->entry_points;
220 function = ((struct code *)info.code)->entry_points;
222 while (function != NIL) {
223 struct simple_fun *header;
226 header = (struct simple_fun *) native_pointer(function);
229 if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
232 object = (lispobj *) native_pointer(name);
234 if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
235 struct symbol *symbol;
237 symbol = (struct symbol *) object;
238 object = (lispobj *) native_pointer(symbol->name);
240 if (widetag_of(*object) == SIMPLE_STRING_WIDETAG) {
241 struct vector *string;
243 string = (struct vector *) object;
244 printf("%s, ", (char *) string->data);
246 printf("(Not simple string??\?), ");
248 printf("(Not other pointer??\?), ");
251 function = header->next;
255 printf("CODE: ???, ");
258 printf("LRA: 0x%08x, ", (unsigned long)info.lra);
260 printf("<no LRA>, ");
263 printf("PC: 0x%x>\n", info.pc);
265 printf("PC: ??\?>\n");
267 } while (--nframes > 0 && previous_info(&info));
273 backtrace(int nframes)
275 printf("Can't backtrace on this hardware platform.\n");