cb9cd8cf7738554de4dd05e333af089bf98c2406
[projects/cmucl/cmucl.git] / src / lisp / backtrace.c
1 /* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/backtrace.c,v 1.21 2010/02/01 19:27:07 rtoy Rel $
2  *
3  * Simple backtrace facility.  More or less from Rob's lisp version.
4  */
5
6 #include <stdio.h>
7 #include <signal.h>
8 #include "lisp.h"
9 #include "internals.h"
10 #include "globals.h"
11 #include "os.h"
12 #include "interrupt.h"
13 #include "lispregs.h"
14
15 #if !(defined(i386) || defined(__x86_64))
16
17 /* Sigh ... I know what the call frame looks like and it had
18    better not change. */
19
20 struct call_frame {
21 #ifndef alpha
22     struct call_frame *old_cont;
23 #else
24     u32 old_cont;
25 #endif
26     lispobj saved_lra;
27     lispobj code;
28     lispobj other_state[5];
29 };
30
31 struct call_info {
32 #ifndef alpha
33     struct call_frame *frame;
34 #else
35     u32 frame;
36 #endif
37     int interrupted;
38 #ifndef alpha
39     struct code *code;
40 #else
41     u32 code;
42 #endif
43     lispobj lra;
44     int pc;                     /* Note: this is the trace file offset, not the actual pc. */
45 };
46
47 #define HEADER_LENGTH(header) ((header)>>8)
48
49 static int previous_info(struct call_info *info);
50
51 static struct code *
52 code_pointer(lispobj object)
53 {
54     lispobj *headerp, header;
55     int type, len;
56
57     headerp = (lispobj *) PTR(object);
58     header = *headerp;
59     type = TypeOf(header);
60
61     switch (type) {
62       case type_CodeHeader:
63           break;
64       case type_ReturnPcHeader:
65       case type_FunctionHeader:
66       case type_ClosureFunctionHeader:
67           len = HEADER_LENGTH(header);
68           if (len == 0)
69               headerp = NULL;
70           else
71               headerp -= len;
72           break;
73       default:
74           headerp = NULL;
75     }
76
77     return (struct code *) headerp;
78 }
79
80 static boolean
81 cs_valid_pointer_p(struct call_frame *pointer)
82 {
83     return (((char *) control_stack <= (char *) pointer) &&
84             ((char *) pointer < (char *) current_control_stack_pointer));
85 }
86
87 static void
88 info_from_lisp_state(struct call_info *info)
89 {
90     info->frame = (struct call_frame *) current_control_frame_pointer;
91     info->interrupted = 0;
92     info->code = NULL;
93     info->lra = 0;
94     info->pc = 0;
95
96     previous_info(info);
97 }
98
99 static void
100 info_from_sigcontext(struct call_info *info, os_context_t * csp)
101 {
102     unsigned long pc;
103
104     info->interrupted = 1;
105     if (LowtagOf(SC_REG(csp, reg_CODE)) == type_FunctionPointer) {
106         /* We tried to call a function, but crapped out before $CODE could be fixed up.  Probably an undefined function. */
107         info->frame = (struct call_frame *) SC_REG(csp, reg_OCFP);
108         info->lra = (lispobj) SC_REG(csp, reg_LRA);
109         info->code = code_pointer(info->lra);
110         pc = (unsigned long) PTR(info->lra);
111     } else {
112         info->frame = (struct call_frame *) SC_REG(csp, reg_CFP);
113         info->code = code_pointer(SC_REG(csp, reg_CODE));
114         info->lra = NIL;
115         pc = SC_PC(csp);
116     }
117     if (info->code != NULL)
118         info->pc = pc - (unsigned long) info->code -
119 #ifndef alpha
120             (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
121 #else
122             (HEADER_LENGTH(((struct code *) info->code)->header) * sizeof(lispobj));
123 #endif
124     else
125         info->pc = 0;
126 }
127
128 static int
129 previous_info(struct call_info *info)
130 {
131     struct call_frame *this_frame;
132     int free;
133     os_context_t *csp;
134
135     if (!cs_valid_pointer_p(info->frame)) {
136         printf("Bogus callee value (0x%08lx).\n", (unsigned long) info->frame);
137         return 0;
138     }
139
140     this_frame = info->frame;
141     info->lra = this_frame->saved_lra;
142     info->frame = this_frame->old_cont;
143     info->interrupted = 0;
144
145     if (info->frame == NULL || info->frame == this_frame)
146         return 0;
147
148     if (info->lra == NIL) {
149         /* We were interrupted.  Find the correct sigcontext. */
150         free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2;
151         while (free-- > 0) {
152             csp = lisp_interrupt_contexts[free];
153             if ((struct call_frame *) (SC_REG(csp, reg_CFP)) == info->frame) {
154                 info_from_sigcontext(info, csp);
155                 break;
156             }
157         }
158     } else {
159         info->code = code_pointer(info->lra);
160         if (info->code != NULL)
161             info->pc = (unsigned long) PTR(info->lra) -
162                 (unsigned long) info->code -
163 #ifndef alpha
164                 (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
165 #else
166                 (HEADER_LENGTH(((struct code *) info->code)->header) * sizeof(lispobj));
167 #endif
168         else
169             info->pc = 0;
170     }
171
172     return 1;
173 }
174
175 void
176 backtrace(int nframes)
177 {
178     struct call_info info;
179
180     info_from_lisp_state(&info);
181
182     do {
183         printf("<Frame 0x%08lx%s, ", (unsigned long) info.frame,
184                info.interrupted ? " [interrupted]" : "");
185
186         if (info.code != (struct code *) 0) {
187             lispobj function;
188
189             printf("CODE: 0x%08lX, ",
190                    (unsigned long) info.code | type_OtherPointer);
191
192 #ifndef alpha
193             function = info.code->entry_points;
194 #else
195             function = ((struct code *) info.code)->entry_points;
196 #endif
197             while (function != NIL) {
198                 struct function *header;
199                 lispobj name;
200
201                 header = (struct function *) PTR(function);
202                 name = header->name;
203
204                 if (LowtagOf(name) == type_OtherPointer) {
205                     lispobj *object;
206
207                     object = (lispobj *) PTR(name);
208
209                     if (TypeOf(*object) == type_SymbolHeader) {
210                         struct symbol *symbol;
211
212                         symbol = (struct symbol *) object;
213                         object = (lispobj *) PTR(symbol->name);
214                     }
215                     if (TypeOf(*object) == type_SimpleString) {
216                         struct vector *string;
217                         char c_string[1000];
218                         string = (struct vector *) object;
219                         convert_lisp_string(c_string, string->data, string->length >> 2);
220                         printf("%s, ", c_string);
221                     } else
222                         printf("(Not simple string??\?), ");
223                 } else
224                     printf("(Not other pointer??\?), ");
225
226
227                 function = header->next;
228             }
229         } else
230             printf("CODE: ???, ");
231
232         if (info.lra != NIL)
233             printf("LRA: 0x%08lx, ", (unsigned long) info.lra);
234         else
235             printf("<no LRA>, ");
236
237         if (info.pc)
238             printf("PC: 0x%x>\n", info.pc);
239         else
240             printf("PC: ??\?>\n");
241
242     } while (--nframes > 0 && previous_info(&info));
243 }
244
245 #else /* (defined(i386) || defined(__x86_64)) */
246
247 #include "x86-validate.h"
248 #include "gc.h"
249
250 #define VM_OCFP_SAVE_OFFSET             0
251 #define VM_RETURN_PC_SAVE_OFFSET        1
252
253 static int
254 stack_pointer_p(unsigned long p)
255 {
256     return (p < CONTROL_STACK_START + control_stack_size
257             && p > (unsigned long) &p && (p & 3) == 0);
258 }
259
260 static int
261 ra_pointer_p(unsigned long ra)
262 {
263     return ra > 4096 && !stack_pointer_p(ra);
264 }
265
266 static unsigned long
267 deref(unsigned long p, int offset)
268 {
269     return *((unsigned long *) p + offset);
270 }
271
272 static void
273 print_entry_name(lispobj name)
274 {
275     if (LowtagOf(name) == type_ListPointer) {
276         putchar('(');
277         while (name != NIL) {
278             struct cons *cons = (struct cons *) PTR(name);
279
280             print_entry_name(cons->car);
281             name = cons->cdr;
282             if (name != NIL)
283                 putchar(' ');
284         }
285         putchar(')');
286     } else if (LowtagOf(name) == type_OtherPointer) {
287         lispobj *object = (lispobj *) PTR(name);
288
289         if (TypeOf(*object) == type_SymbolHeader) {
290             struct symbol *symbol = (struct symbol *) object;
291             struct vector *string;
292             char c_string[1000];
293
294             if (symbol->package != NIL) {
295                 struct instance *pkg = (struct instance *) PTR(symbol->package);
296                 lispobj pkg_name = pkg->slots[2];
297
298                 string = (struct vector *) PTR(pkg_name);
299                 convert_lisp_string(c_string, string->data, string->length >> 2);
300                 printf("%s:;", c_string);
301             }
302
303             object = (lispobj *) PTR(symbol->name);
304             string = (struct vector *) object;
305             convert_lisp_string(c_string, string->data, string->length >> 2);
306             printf("%s:;", c_string);
307         } else if (TypeOf(*object) == type_SimpleString) {
308             struct vector *string = (struct vector *) object;
309             char c_string[1000];
310             convert_lisp_string(c_string, string->data, string->length >> 2);
311             printf("\"%s\"", c_string);
312         } else
313             printf("<??? type %d>", (int) TypeOf(*object));
314     } else
315         printf("<??? lowtag %d>", (int) LowtagOf(name));
316 }
317
318 static void
319 print_entry_points(struct code *code)
320 {
321     lispobj function = code->entry_points;
322
323     while (function != NIL) {
324         struct function *header = (struct function *) PTR(function);
325
326         print_entry_name(header->name);
327
328         function = header->next;
329         if (function != NIL)
330             printf(", ");
331     }
332 }
333
334 /* See also X86-CALL-CONTEXT in code:debug-int.  */
335
336 static int
337 x86_call_context(unsigned long fp, unsigned long *ra, unsigned long *ocfp)
338 {
339     unsigned long lisp_ocfp, lisp_ra, c_ocfp, c_ra;
340     int lisp_valid_p, c_valid_p;
341
342     if (!stack_pointer_p(fp))
343         return 0;
344
345     lisp_ocfp = deref(fp, -(1 + VM_OCFP_SAVE_OFFSET));
346     lisp_ra = deref(fp, -(1 + VM_RETURN_PC_SAVE_OFFSET));
347     c_ocfp = deref(fp, 0);
348     c_ra = deref(fp, 1);
349
350     lisp_valid_p = (lisp_ocfp > fp && stack_pointer_p(lisp_ocfp)
351                     && ra_pointer_p(lisp_ra));
352     c_valid_p = (c_ocfp > fp && stack_pointer_p(c_ocfp)
353                  && ra_pointer_p(c_ra));
354
355     if (lisp_valid_p && c_valid_p) {
356         unsigned long lisp_path_fp, c_path_fp, dummy;
357         int lisp_path_p = x86_call_context(lisp_ocfp, &lisp_path_fp, &dummy);
358         int c_path_p = x86_call_context(c_ocfp, &c_path_fp, &dummy);
359
360         if (lisp_path_p && c_path_p) {
361 #if defined __FreeBSD__ && __FreeBSD_version > 400000
362             if (lisp_ocfp > c_ocfp)
363                 *ra = lisp_ra, *ocfp = lisp_ocfp;
364             else
365                 *ra = c_ra, *ocfp = c_ocfp;
366 #else
367             *ra = lisp_ra, *ocfp = lisp_ocfp;
368 #endif
369         } else if (lisp_path_p)
370             *ra = lisp_ra, *ocfp = lisp_ocfp;
371         else if (c_path_p)
372             *ra = c_ra, *ocfp = c_ocfp;
373         else
374             return 0;
375     } else if (lisp_valid_p)
376         *ra = lisp_ra, *ocfp = lisp_ocfp;
377     else if (c_valid_p)
378         *ra = c_ra, *ocfp = c_ocfp;
379     else
380         return 0;
381
382     return 1;
383 }
384
385 struct compiled_debug_info {
386     lispobj header;
387     lispobj layout;
388     lispobj name;
389     lispobj source;
390     lispobj package;
391     lispobj function_map;
392 };
393
394 struct compiled_debug_function {
395     lispobj header;
396     lispobj layout;
397     lispobj name;
398     lispobj kind;
399     lispobj variables;
400     lispobj blocks;
401     lispobj tlf_number;
402     lispobj arguments;
403     lispobj returns;
404     lispobj return_pc;
405     lispobj old_fp;
406     lispobj nfp;
407     lispobj start_pc;
408     lispobj elsewhere_pc;
409 };
410
411 static int
412 array_of_type_p(lispobj obj, int type)
413 {
414     return (LowtagOf(obj) == type_OtherPointer
415             && TypeOf(*(lispobj *) PTR(obj)) == type);
416 }
417
418 struct compiled_debug_function *
419 debug_function_from_pc(struct code *code, unsigned long pc)
420 {
421     unsigned long code_header_len = sizeof(lispobj) * HeaderValue(code->header);
422     unsigned long offset = pc - (unsigned long) code - code_header_len;
423
424     if (LowtagOf(code->debug_info) == type_InstancePointer) {
425         struct compiled_debug_info *di
426
427             = (struct compiled_debug_info *) PTR(code->debug_info);
428
429         if (array_of_type_p(di->function_map, type_SimpleVector)) {
430             struct vector *v = (struct vector *) PTR(di->function_map);
431             long i, len = fixnum_value(v->length);
432             struct compiled_debug_function *df
433                 = (struct compiled_debug_function *) PTR(v->data[0]);
434
435             if (len == 1)
436                 return df;
437             else {
438                 int elsewhere_p = offset >= fixnum_value(df->elsewhere_pc);
439
440                 for (i = 1;; i += 2) {
441                     unsigned long next_pc;
442
443                     if (i == len)
444                         return ((struct compiled_debug_function *)
445                                 PTR(v->data[i - 1]));
446
447                     if (elsewhere_p) {
448                         struct compiled_debug_function *p
449                             = ((struct compiled_debug_function *)
450                                PTR(v->data[i + 1]));
451
452                         next_pc = fixnum_value(p->elsewhere_pc);
453                     } else
454                         next_pc = fixnum_value(v->data[i]);
455
456                     if (offset < next_pc)
457                         return ((struct compiled_debug_function *)
458                                 PTR(v->data[i - 1]));
459                 }
460             }
461         }
462             else if (array_of_type_p(di->function_map,
463                                      type_SimpleArrayUnsignedByte8)) {
464             /* Minimal debug info as described in debug-int.lisp.
465                Not implemented.  */
466         }
467     }
468
469     return NULL;
470 }
471
472 void
473 backtrace(int nframes)
474 {
475     unsigned long fp;
476     int i;
477
478     __asm__("movl %%ebp,%0":"=g"(fp));
479
480     for (i = 0; i < nframes; ++i) {
481         lispobj *p;
482         unsigned long ra, next_fp;
483
484         if (!x86_call_context(fp, &ra, &next_fp))
485             break;
486
487         printf("%4d: ", i);
488
489         p = (lispobj *) component_ptr_from_pc((lispobj *) ra);
490         if (p && TypeOf(*p) == type_CodeHeader) {
491             struct code *cp = (struct code *) p;
492             struct compiled_debug_function *df;
493
494             df = debug_function_from_pc(cp, ra);
495             if (df)
496                 print_entry_name(df->name);
497             else
498                 print_entry_points(cp);
499         } else if (p)
500             printf("<Not implemented, type = %d>", (int) TypeOf(*p));
501         else
502             printf("Foreign fp = 0x%lx, ra = 0x%lx", next_fp, ra);
503
504         putchar('\n');
505         fp = next_fp;
506     }
507 }
508
509 #endif /* (defined(i386) || defined(__x86_64)) */