0.9.2.42:
[sbcl/lichteblau.git] / src / runtime / backtrace.c
blob09179c7831ce7df5dbeb61005993aa8669fe0ab6
1 /*
2 * simple backtrace facility
3 */
5 /*
6 * This software is part of the SBCL system. See the README file for
7 * more information.
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 #include <stdio.h>
17 #include <signal.h>
18 #include "sbcl.h"
19 #include "runtime.h"
20 #include "globals.h"
21 #include "os.h"
22 #include "interrupt.h"
23 #include "lispregs.h"
24 #ifdef LISP_FEATURE_GENCGC
25 #include "gencgc-alloc-region.h"
26 #endif
27 #include "genesis/static-symbols.h"
28 #include "genesis/primitive-objects.h"
29 #include "thread.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. */
36 struct call_frame {
37 #ifndef LISP_FEATURE_ALPHA
38 struct call_frame *old_cont;
39 #else
40 u32 old_cont;
41 #endif
42 lispobj saved_lra;
43 lispobj code;
44 lispobj other_state[5];
47 struct call_info {
48 #ifndef LISP_FEATURE_ALPHA
49 struct call_frame *frame;
50 #else
51 u32 frame;
52 #endif
53 int interrupted;
54 #ifndef LISP_FEATURE_ALPHA
55 struct code *code;
56 #else
57 u32 code;
58 #endif
59 lispobj lra;
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);
67 static struct code *
68 code_pointer(lispobj object)
70 lispobj *headerp, header;
71 int type, len;
73 headerp = (lispobj *) native_pointer(object);
74 header = *headerp;
75 type = widetag_of(header);
77 switch (type) {
78 case CODE_HEADER_WIDETAG:
79 break;
80 case RETURN_PC_HEADER_WIDETAG:
81 case SIMPLE_FUN_HEADER_WIDETAG:
82 len = HEADER_LENGTH(header);
83 if (len == 0)
84 headerp = NULL;
85 else
86 headerp -= len;
87 break;
88 default:
89 headerp = NULL;
92 return (struct code *) headerp;
95 static boolean
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));
103 static void
104 call_info_from_lisp_state(struct call_info *info)
106 info->frame = (struct call_frame *)current_control_frame_pointer;
107 info->interrupted = 0;
108 info->code = NULL;
109 info->lra = 0;
110 info->pc = 0;
112 previous_info(info);
115 static void
116 call_info_from_context(struct call_info *info, os_context_t *context)
118 unsigned long pc;
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. */
125 info->frame =
126 (struct call_frame *)(*os_context_register_addr(context,
127 reg_OCFP));
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);
132 else {
133 info->frame =
134 (struct call_frame *)(*os_context_register_addr(context, reg_CFP));
135 info->code =
136 code_pointer(*os_context_register_addr(context, reg_CODE));
137 info->lra = NIL;
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));
144 #else
145 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
146 #endif
147 else
148 info->pc = 0;
151 static int
152 previous_info(struct call_info *info)
154 struct call_frame *this_frame;
155 struct thread *thread=arch_os_get_current_thread();
156 int free;
158 if (!cs_valid_pointer_p(info->frame)) {
159 printf("Bogus callee value (0x%08lx).\n", (unsigned long)info->frame);
160 return 0;
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)
169 return 0;
171 if (info->lra == NIL) {
172 /* We were interrupted. Find the correct signal context. */
173 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
174 while (free-- > 0) {
175 os_context_t *context =
176 thread->interrupt_contexts[free];
177 if ((struct call_frame *)(*os_context_register_addr(context,
178 reg_CFP))
179 == info->frame) {
180 call_info_from_context(info, context);
181 break;
185 else {
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));
192 #else
193 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
194 #endif
195 else
196 info->pc = 0;
199 return 1;
202 void
203 backtrace(int nframes)
205 struct call_info info;
207 call_info_from_lisp_state(&info);
209 do {
210 printf("<Frame 0x%08lx%s, ", (unsigned long) info.frame,
211 info.interrupted ? " [interrupted]" : "");
213 if (info.code != (struct code *) 0) {
214 lispobj function;
216 printf("CODE: 0x%08lX, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG);
218 #ifndef LISP_FEATURE_ALPHA
219 function = info.code->entry_points;
220 #else
221 function = ((struct code *)info.code)->entry_points;
222 #endif
223 while (function != NIL) {
224 struct simple_fun *header;
225 lispobj name;
227 header = (struct simple_fun *) native_pointer(function);
228 name = header->name;
230 if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
231 lispobj *object;
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);
246 } else
247 /* FIXME: broken from (VECTOR NIL) */
248 printf("(Not simple string??\?), ");
249 } else
250 printf("(Not other pointer??\?), ");
253 function = header->next;
256 else
257 printf("CODE: ???, ");
259 if (info.lra != NIL)
260 printf("LRA: 0x%08lx, ", (unsigned long)info.lra);
261 else
262 printf("<no LRA>, ");
264 if (info.pc)
265 printf("PC: 0x%x>\n", info.pc);
266 else
267 printf("PC: ??\?>\n");
269 } while (--nframes > 0 && previous_info(&info));
272 #else
276 void
277 backtrace(int nframes)
279 printf("Can't backtrace on this hardware platform.\n");
282 #endif