0.pre8.28
[sbcl.git] / src / runtime / backtrace.c
1 /*
2  * simple backtrace facility
3  */
4
5 /*
6  * This software is part of the SBCL system. See the README file for
7  * more information.
8  *
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.
14  */
15
16 #include <stdio.h>
17 #include <signal.h>
18 #include "runtime.h"
19 #include "sbcl.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
30 #ifndef __i386__
31
32 /* KLUDGE: Sigh ... I know what the call frame looks like and it had
33  * better not change. */
34
35 struct call_frame {
36 #ifndef alpha
37         struct call_frame *old_cont;
38 #else
39         u32 old_cont;
40 #endif
41         lispobj saved_lra;
42         lispobj code;
43         lispobj other_state[5];
44 };
45
46 struct call_info {
47 #ifndef alpha
48     struct call_frame *frame;
49 #else
50     u32 frame;
51 #endif
52     int interrupted;
53 #ifndef alpha
54     struct code *code;
55 #else
56     u32 code;
57 #endif
58     lispobj lra;
59     int pc; /* Note: this is the trace file offset, not the actual pc. */
60 };
61
62 #define HEADER_LENGTH(header) ((header)>>8)
63
64 static int previous_info(struct call_info *info);
65
66 static struct code *
67 code_pointer(lispobj object)
68 {
69     lispobj *headerp, header;
70     int type, len;
71
72     headerp = (lispobj *) native_pointer(object);
73     header = *headerp;
74     type = widetag_of(header);
75
76     switch (type) {
77         case CODE_HEADER_WIDETAG:
78             break;
79         case RETURN_PC_HEADER_WIDETAG:
80         case SIMPLE_FUN_HEADER_WIDETAG:
81         case CLOSURE_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;
90     }
91
92     return (struct code *) headerp;
93 }
94
95 static boolean
96 cs_valid_pointer_p(struct call_frame *pointer)
97 {
98     return (((char *) CONTROL_STACK_START <= (char *) pointer) &&
99             ((char *) pointer < (char *) current_control_stack_pointer));
100 }
101
102 static void
103 call_info_from_lisp_state(struct call_info *info)
104 {
105     info->frame = (struct call_frame *)current_control_frame_pointer;
106     info->interrupted = 0;
107     info->code = NULL;
108     info->lra = 0;
109     info->pc = 0;
110
111     previous_info(info);
112 }
113
114 static void
115 call_info_from_context(struct call_info *info, os_context_t *context)
116 {
117     unsigned long pc;
118
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. */
124         info->frame =
125             (struct call_frame *)(*os_context_register_addr(context,
126                                                             reg_OCFP));
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);
130     }
131     else {
132         info->frame =
133             (struct call_frame *)(*os_context_register_addr(context, reg_CFP));
134         info->code =
135             code_pointer(*os_context_register_addr(context, reg_CODE));
136         info->lra = NIL;
137         pc = *os_context_pc_addr(context);
138     }
139     if (info->code != NULL)
140         info->pc = pc - (unsigned long) info->code -
141 #ifndef alpha
142             (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
143 #else
144             (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
145 #endif
146     else
147         info->pc = 0;
148 }
149
150 static int
151 previous_info(struct call_info *info)
152 {
153     struct call_frame *this_frame;
154     struct thread *thread=arch_os_get_current_thread();
155     int free;
156
157     if (!cs_valid_pointer_p(info->frame)) {
158         printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame);
159         return 0;
160     }
161
162     this_frame = info->frame;
163     info->lra = this_frame->saved_lra;
164     info->frame = this_frame->old_cont;
165     info->interrupted = 0;
166
167     if (info->frame == NULL || info->frame == this_frame)
168         return 0;
169
170     if (info->lra == NIL) {
171         /* We were interrupted. Find the correct signal context. */
172         free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
173         while (free-- > 0) {
174             os_context_t *context = 
175                 thread->interrupt_contexts[free];
176             if ((struct call_frame *)(*os_context_register_addr(context,
177                                                                 reg_CFP))
178                 == info->frame) {
179                 call_info_from_context(info, context);
180                 break;
181             }
182         }
183     }
184     else {
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 -
189 #ifndef alpha
190                 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
191 #else
192                 (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj));
193 #endif
194         else
195             info->pc = 0;
196     }
197
198     return 1;
199 }
200
201 void
202 backtrace(int nframes)
203 {
204     struct call_info info;
205         
206     call_info_from_lisp_state(&info);
207
208     do {
209         printf("<Frame 0x%08x%s, ", (unsigned long) info.frame,
210                 info.interrupted ? " [interrupted]" : "");
211
212         if (info.code != (struct code *) 0) {
213             lispobj function;
214
215             printf("CODE: 0x%08X, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG);
216
217 #ifndef alpha
218             function = info.code->entry_points;
219 #else
220             function = ((struct code *)info.code)->entry_points;
221 #endif
222             while (function != NIL) {
223                 struct simple_fun *header;
224                 lispobj name;
225
226                 header = (struct simple_fun *) native_pointer(function);
227                 name = header->name;
228
229                 if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
230                     lispobj *object;
231
232                     object = (lispobj *) native_pointer(name);
233
234                     if (widetag_of(*object) == SYMBOL_HEADER_WIDETAG) {
235                         struct symbol *symbol;
236
237                         symbol = (struct symbol *) object;
238                         object = (lispobj *) native_pointer(symbol->name);
239                     }
240                     if (widetag_of(*object) == SIMPLE_STRING_WIDETAG) {
241                         struct vector *string;
242
243                         string = (struct vector *) object;
244                         printf("%s, ", (char *) string->data);
245                     } else
246                         printf("(Not simple string??\?), ");
247                 } else
248                     printf("(Not other pointer??\?), ");
249
250
251                 function = header->next;
252             }
253         }
254         else
255             printf("CODE: ???, ");
256
257         if (info.lra != NIL)
258             printf("LRA: 0x%08x, ", (unsigned long)info.lra);
259         else
260             printf("<no LRA>, ");
261
262         if (info.pc)
263             printf("PC: 0x%x>\n", info.pc);
264         else
265             printf("PC: ??\?>\n");
266
267     } while (--nframes > 0 && previous_info(&info));
268 }
269
270 #else
271
272 void
273 backtrace(int nframes)
274 {
275     printf("Can't backtrace on this hardware platform.\n");
276 }
277
278 #endif