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