/[cmucl]/src/lisp/backtrace.c
ViewVC logotype

Contents of /src/lisp/backtrace.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (show annotations)
Mon Feb 1 19:27:07 2010 UTC (4 years, 2 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-03, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, cross-sparc-branch-base, intl-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.20: +1 -23 lines
File MIME type: text/plain
Simplify UNICODE conditionalization by using convert_lisp_string
everywhere, not just for unicode.  Non-unicode takes a small hit from
doing an unnecessary strcpy, but that should not be critical.
1 /* $Header: /tiger/var/lib/cvsroots/cmucl/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)) */

  ViewVC Help
Powered by ViewVC 1.1.5