1 | /* |
---|
2 | Copyright (C) 1994-2001 Digitool, Inc |
---|
3 | This file is part of OpenMCL. |
---|
4 | |
---|
5 | OpenMCL is licensed under the terms of the Lisp Lesser GNU Public |
---|
6 | License , known as the LLGPL and distributed with OpenMCL as the |
---|
7 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
8 | which is distributed with OpenMCL as the file "LGPL". Where these |
---|
9 | conflict, the preamble takes precedence. |
---|
10 | |
---|
11 | OpenMCL is referenced in the preamble as the "LIBRARY." |
---|
12 | |
---|
13 | The LLGPL is also available online at |
---|
14 | http://opensource.franz.com/preamble.html |
---|
15 | */ |
---|
16 | |
---|
17 | #include "lisp.h" |
---|
18 | #include "lisp-exceptions.h" |
---|
19 | #include "lisp_globals.h" |
---|
20 | #include "area.h" |
---|
21 | #include "Threads.h" |
---|
22 | #include <ctype.h> |
---|
23 | #include <stdio.h> |
---|
24 | #include <stddef.h> |
---|
25 | #include <string.h> |
---|
26 | #include <stdarg.h> |
---|
27 | #include <errno.h> |
---|
28 | #include <stdio.h> |
---|
29 | |
---|
30 | #ifndef WINDOWS |
---|
31 | #include <sys/socket.h> |
---|
32 | #endif |
---|
33 | #include <sys/stat.h> |
---|
34 | |
---|
35 | |
---|
36 | typedef enum { |
---|
37 | debug_continue, /* stay in the repl */ |
---|
38 | debug_exit_success, /* return 0 from lisp_Debugger */ |
---|
39 | debug_exit_fail, /* return non-zero from lisp_Debugger */ |
---|
40 | debug_kill |
---|
41 | } debug_command_return; |
---|
42 | |
---|
43 | |
---|
44 | |
---|
45 | typedef debug_command_return (*debug_command) (ExceptionInformation *, |
---|
46 | siginfo_t *, |
---|
47 | int); |
---|
48 | |
---|
49 | #define DEBUG_COMMAND_FLAG_REQUIRE_XP 1 /* function */ |
---|
50 | #define DEBUG_COMMAND_FLAG_AUX_REGNO (2 | DEBUG_COMMAND_FLAG_REQUIRE_XP) |
---|
51 | #define DEBUG_COMMAND_FLAG_AUX_SPR (4 | DEBUG_COMMAND_FLAG_REQUIRE_XP) |
---|
52 | #define DEBUG_COMMAND_REG_FLAGS 7 |
---|
53 | #define DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY 8 |
---|
54 | #define DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG 16 |
---|
55 | |
---|
56 | typedef struct { |
---|
57 | debug_command f; |
---|
58 | char *help_text; |
---|
59 | unsigned flags; |
---|
60 | char *aux_prompt; |
---|
61 | int c; |
---|
62 | } debug_command_entry; |
---|
63 | |
---|
64 | |
---|
65 | extern |
---|
66 | debug_command_entry debug_command_entries[]; |
---|
67 | |
---|
68 | |
---|
69 | #if defined(LINUX) || defined(SOLARIS) |
---|
70 | #define fpurge __fpurge |
---|
71 | #endif |
---|
72 | |
---|
73 | #ifdef WINDOWS |
---|
74 | void |
---|
75 | fpurge (FILE* file) |
---|
76 | { |
---|
77 | } |
---|
78 | #endif |
---|
79 | |
---|
80 | int |
---|
81 | readc() |
---|
82 | { |
---|
83 | int c; |
---|
84 | |
---|
85 | fflush(stderr); |
---|
86 | while (1) { |
---|
87 | c = getchar(); |
---|
88 | switch(c) { |
---|
89 | case '\n': |
---|
90 | continue; |
---|
91 | case EOF: |
---|
92 | if (ferror(stdin)) { |
---|
93 | if ((errno == EINTR) || (errno == EIO)) { |
---|
94 | continue; |
---|
95 | } |
---|
96 | } |
---|
97 | /* fall through */ |
---|
98 | default: |
---|
99 | return c; |
---|
100 | } |
---|
101 | } |
---|
102 | } |
---|
103 | |
---|
104 | #ifdef X8664 |
---|
105 | #ifdef LINUX |
---|
106 | char* Iregnames[] = {"r8 ","r9 ","r10","r11","r12","r13","r14","r15", |
---|
107 | "rdi","rsi","rbp", "rbx", "rdx", "rax", "rcx","rsp"}; |
---|
108 | #endif |
---|
109 | #ifdef SOLARIS |
---|
110 | char* Iregnames[] = {"r15 ","r14 ","r13","r12","r11","r10","r9 ","r8 ", |
---|
111 | "rdi","rsi","rbp", "rbx", "rdx", "rcx", "rcx","rsp"}; |
---|
112 | #endif |
---|
113 | #ifdef FREEBSD |
---|
114 | char* Iregnames[] = {"???", "rdi", "rsi", "rdx", "rcx", "r8 ", "r9 ", "rax", |
---|
115 | "rbx", "rbp", "r10", "r11", "r12", "r13", "r14", "r15", |
---|
116 | "???", "???", "???", "???", "???", "???", "???", "rsp"}; |
---|
117 | #endif |
---|
118 | #ifdef DARWIN |
---|
119 | char* Iregnames[] = {"rax", "rbx", "rcx", "rdx", "rdi", "rsi", |
---|
120 | "rbp", "rsp", "r8 ", "r9 ", "r10", "r11", "r12", "r13", |
---|
121 | "r14", "r15", "rip", "rfl"}; |
---|
122 | #endif |
---|
123 | #ifdef WINDOWS |
---|
124 | char* Iregnames[] = {"rax ","rcx ","rdx","rbx","rsp","rrbp","rsi","rdi", |
---|
125 | "r8","r9","r10", "r11", "r12", "r13", "r14","r15"}; |
---|
126 | #endif |
---|
127 | #endif |
---|
128 | |
---|
129 | void |
---|
130 | show_lisp_register(ExceptionInformation *xp, char *label, int r) |
---|
131 | { |
---|
132 | |
---|
133 | extern char* print_lisp_object(LispObj); |
---|
134 | |
---|
135 | LispObj val = xpGPR(xp, r); |
---|
136 | |
---|
137 | #ifdef PPC |
---|
138 | fprintf(stderr, "r%02d (%s) = %s\n", r, label, print_lisp_object(val)); |
---|
139 | #endif |
---|
140 | #ifdef X86 |
---|
141 | fprintf(stderr, "%%%s (%s) = %s\n",Iregnames[r], label, print_lisp_object(val)); |
---|
142 | #endif |
---|
143 | |
---|
144 | } |
---|
145 | |
---|
146 | |
---|
147 | void |
---|
148 | describe_memfault(ExceptionInformation *xp, siginfo_t *info) |
---|
149 | { |
---|
150 | #ifdef PPC |
---|
151 | void *addr = (void *)xpDAR(xp); |
---|
152 | natural dsisr = xpDSISR(xp); |
---|
153 | |
---|
154 | fprintf(stderr, "%s operation to %s address 0x%lx\n", |
---|
155 | dsisr & (1<<25) ? "Write" : "Read", |
---|
156 | dsisr & (1<<27) ? "protected" : "unmapped", |
---|
157 | addr); |
---|
158 | #endif |
---|
159 | } |
---|
160 | |
---|
161 | #ifdef PPC |
---|
162 | void |
---|
163 | describe_ppc_illegal(ExceptionInformation *xp) |
---|
164 | { |
---|
165 | pc where = xpPC(xp); |
---|
166 | opcode the_uuo = *where, instr2; |
---|
167 | Boolean described = false; |
---|
168 | |
---|
169 | if (IS_UUO(the_uuo)) { |
---|
170 | unsigned |
---|
171 | minor = UUO_MINOR(the_uuo), |
---|
172 | rt = 0x1f & (the_uuo >> 21), |
---|
173 | ra = 0x1f & (the_uuo >> 16), |
---|
174 | rb = 0x1f & (the_uuo >> 11), |
---|
175 | errnum = 0x3ff & (the_uuo >> 16); |
---|
176 | |
---|
177 | switch(minor) { |
---|
178 | case UUO_INTERR: |
---|
179 | switch (errnum) { |
---|
180 | case error_udf_call: |
---|
181 | fprintf(stderr, "ERROR: undefined function call: %s\n", |
---|
182 | print_lisp_object(xpGPR(xp,fname))); |
---|
183 | described = true; |
---|
184 | break; |
---|
185 | |
---|
186 | default: |
---|
187 | fprintf(stderr, "ERROR: lisp error %d\n", errnum); |
---|
188 | described = true; |
---|
189 | break; |
---|
190 | } |
---|
191 | break; |
---|
192 | |
---|
193 | default: |
---|
194 | break; |
---|
195 | } |
---|
196 | } |
---|
197 | if (!described) { |
---|
198 | fprintf(stderr, "Illegal instruction (0x%08x) at 0x%lx\n", |
---|
199 | the_uuo, where); |
---|
200 | } |
---|
201 | } |
---|
202 | #endif |
---|
203 | |
---|
204 | #ifdef PPC |
---|
205 | void |
---|
206 | describe_ppc_trap(ExceptionInformation *xp) |
---|
207 | { |
---|
208 | pc where = xpPC(xp); |
---|
209 | opcode the_trap = *where, instr; |
---|
210 | int err_arg1, err_arg2, ra, rs; |
---|
211 | char *name = NULL; |
---|
212 | Boolean identified = false; |
---|
213 | |
---|
214 | if ((the_trap & OP_MASK) == OP(major_opcode_TRI)) { |
---|
215 | /* TWI/TDI. If the RA field is "nargs", that means that the |
---|
216 | instruction is either a number-of-args check or an |
---|
217 | event-poll. Otherwise, the trap is some sort of |
---|
218 | typecheck. */ |
---|
219 | |
---|
220 | if (RA_field(the_trap) == nargs) { |
---|
221 | switch (TO_field(the_trap)) { |
---|
222 | case TO_NE: |
---|
223 | if (xpGPR(xp, nargs) < D_field(the_trap)) { |
---|
224 | fprintf(stderr, "Too few arguments (no opt/rest)\n"); |
---|
225 | } else { |
---|
226 | fprintf(stderr, "Too many arguments (no opt/rest)\n"); |
---|
227 | } |
---|
228 | identified = true; |
---|
229 | break; |
---|
230 | |
---|
231 | case TO_GT: |
---|
232 | fprintf(stderr, "Event poll !\n"); |
---|
233 | identified = true; |
---|
234 | break; |
---|
235 | |
---|
236 | case TO_HI: |
---|
237 | fprintf(stderr, "Too many arguments (with opt)\n"); |
---|
238 | identified = true; |
---|
239 | break; |
---|
240 | |
---|
241 | case TO_LT: |
---|
242 | fprintf(stderr, "Too few arguments (with opt/rest/key)\n"); |
---|
243 | identified = true; |
---|
244 | break; |
---|
245 | |
---|
246 | default: /* some weird trap, not ours. */ |
---|
247 | identified = false; |
---|
248 | break; |
---|
249 | } |
---|
250 | } else { |
---|
251 | /* A type or boundp trap of some sort. */ |
---|
252 | switch (TO_field(the_trap)) { |
---|
253 | case TO_EQ: |
---|
254 | /* Boundp traps are of the form: |
---|
255 | treqi rX,unbound |
---|
256 | where some preceding instruction is of the form: |
---|
257 | lwz/ld rX,symbol.value(rY). |
---|
258 | The error message should try to say that rY is unbound. */ |
---|
259 | |
---|
260 | if (D_field(the_trap) == unbound) { |
---|
261 | #ifdef PPC64 |
---|
262 | instr = scan_for_instr(LD_instruction(RA_field(the_trap), |
---|
263 | unmasked_register, |
---|
264 | offsetof(lispsymbol,vcell)-fulltag_misc), |
---|
265 | D_RT_IMM_MASK, |
---|
266 | where); |
---|
267 | #else |
---|
268 | instr = scan_for_instr(LWZ_instruction(RA_field(the_trap), |
---|
269 | unmasked_register, |
---|
270 | offsetof(lispsymbol,vcell)-fulltag_misc), |
---|
271 | D_RT_IMM_MASK, |
---|
272 | where); |
---|
273 | #endif |
---|
274 | if (instr) { |
---|
275 | ra = RA_field(instr); |
---|
276 | if (lisp_reg_p(ra)) { |
---|
277 | fprintf(stderr, "Unbound variable: %s\n", |
---|
278 | print_lisp_object(xpGPR(xp,ra))); |
---|
279 | identified = true; |
---|
280 | } |
---|
281 | } |
---|
282 | } |
---|
283 | break; |
---|
284 | |
---|
285 | case TO_NE: |
---|
286 | /* A type check. If the type (the immediate field of the trap |
---|
287 | instruction) is a header type, an "lbz |
---|
288 | rX,misc_header_offset(rY)" should precede it, in which case |
---|
289 | we say that "rY is not of header type <type>." If the type |
---|
290 | is not a header type, then rX should have been set by a |
---|
291 | preceding "clrlwi rX,rY,29/30". In that case, scan |
---|
292 | backwards for an RLWINM instruction that set rX and report |
---|
293 | that rY isn't of the indicated type. */ |
---|
294 | err_arg2 = D_field(the_trap); |
---|
295 | if (nodeheader_tag_p(err_arg2) || |
---|
296 | immheader_tag_p(err_arg2)) { |
---|
297 | instr = scan_for_instr(LBZ_instruction(RA_field(the_trap), |
---|
298 | unmasked_register, |
---|
299 | misc_subtag_offset), |
---|
300 | D_RT_IMM_MASK, |
---|
301 | where); |
---|
302 | if (instr) { |
---|
303 | ra = RA_field(instr); |
---|
304 | if (lisp_reg_p(ra)) { |
---|
305 | fprintf(stderr, "value 0x%lX is not of the expected header type 0x%02X\n", xpGPR(xp, ra), err_arg2); |
---|
306 | identified = true; |
---|
307 | } |
---|
308 | } |
---|
309 | } else { |
---|
310 | /* Not a header type, look for rlwinm whose RA field matches the_trap's */ |
---|
311 | instr = scan_for_instr((OP(major_opcode_RLWINM) | (the_trap & RA_MASK)), |
---|
312 | (OP_MASK | RA_MASK), |
---|
313 | where); |
---|
314 | if (instr) { |
---|
315 | rs = RS_field(instr); |
---|
316 | if (lisp_reg_p(rs)) { |
---|
317 | fprintf(stderr, "value 0x%lX is not of the expected type 0x%02X\n", |
---|
318 | xpGPR(xp, rs), err_arg2); |
---|
319 | identified = true; |
---|
320 | } |
---|
321 | } |
---|
322 | } |
---|
323 | break; |
---|
324 | } |
---|
325 | } |
---|
326 | } else { |
---|
327 | /* a "TW <to>,ra,rb" instruction." |
---|
328 | twltu sp,rN is stack-overflow on SP. |
---|
329 | twgeu rX,rY is subscript out-of-bounds, which was preceded |
---|
330 | by an "lwz rM,misc_header_offset(rN)" instruction. |
---|
331 | rM may or may not be the same as rY, but no other header |
---|
332 | would have been loaded before the trap. */ |
---|
333 | switch (TO_field(the_trap)) { |
---|
334 | case TO_LO: |
---|
335 | if (RA_field(the_trap) == sp) { |
---|
336 | fprintf(stderr, "Stack overflow! Run away! Run away!\n"); |
---|
337 | identified = true; |
---|
338 | } |
---|
339 | break; |
---|
340 | |
---|
341 | case (TO_HI|TO_EQ): |
---|
342 | instr = scan_for_instr(OP(major_opcode_LWZ) | (D_MASK & misc_header_offset), |
---|
343 | (OP_MASK | D_MASK), |
---|
344 | where); |
---|
345 | if (instr) { |
---|
346 | ra = RA_field(instr); |
---|
347 | if (lisp_reg_p(ra)) { |
---|
348 | fprintf(stderr, "Bad index %d for vector %lX length %d\n", |
---|
349 | unbox_fixnum(xpGPR(xp, RA_field(the_trap))), |
---|
350 | xpGPR(xp, ra), |
---|
351 | unbox_fixnum(xpGPR(xp, RB_field(the_trap)))); |
---|
352 | identified = true; |
---|
353 | } |
---|
354 | } |
---|
355 | break; |
---|
356 | } |
---|
357 | } |
---|
358 | |
---|
359 | if (!identified) { |
---|
360 | fprintf(stderr, "Unknown trap: 0x%08x\n", the_trap); |
---|
361 | } |
---|
362 | |
---|
363 | |
---|
364 | } |
---|
365 | #endif |
---|
366 | |
---|
367 | debug_command_return |
---|
368 | debug_lisp_registers(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
369 | { |
---|
370 | #ifdef PPC |
---|
371 | TCR *xpcontext = (TCR *)ptr_from_lispobj(xpGPR(xp, rcontext)); |
---|
372 | |
---|
373 | fprintf(stderr, "rcontext = 0x%lX ", xpcontext); |
---|
374 | if (!active_tcr_p(xpcontext)) { |
---|
375 | fprintf(stderr, "(INVALID)\n"); |
---|
376 | } else { |
---|
377 | fprintf(stderr, "\nnargs = %d\n", xpGPR(xp, nargs) >> fixnumshift); |
---|
378 | show_lisp_register(xp, "fn", fn); |
---|
379 | show_lisp_register(xp, "arg_z", arg_z); |
---|
380 | show_lisp_register(xp, "arg_y", arg_y); |
---|
381 | show_lisp_register(xp, "arg_x", arg_x); |
---|
382 | show_lisp_register(xp, "temp0", temp0); |
---|
383 | show_lisp_register(xp, "temp1/next_method_context", temp1); |
---|
384 | show_lisp_register(xp, "temp2/nfn", temp2); |
---|
385 | show_lisp_register(xp, "temp3/fname", temp3); |
---|
386 | /* show_lisp_register(xp, "new_fn", new_fn); */ |
---|
387 | show_lisp_register(xp, "save0", save0); |
---|
388 | show_lisp_register(xp, "save1", save1); |
---|
389 | show_lisp_register(xp, "save2", save2); |
---|
390 | show_lisp_register(xp, "save3", save3); |
---|
391 | show_lisp_register(xp, "save4", save4); |
---|
392 | show_lisp_register(xp, "save5", save5); |
---|
393 | show_lisp_register(xp, "save6", save6); |
---|
394 | show_lisp_register(xp, "save7", save7); |
---|
395 | } |
---|
396 | #endif |
---|
397 | #ifdef X8664 |
---|
398 | |
---|
399 | show_lisp_register(xp, "arg_z", Iarg_z); |
---|
400 | show_lisp_register(xp, "arg_y", Iarg_y); |
---|
401 | show_lisp_register(xp, "arg_x", Iarg_x); |
---|
402 | fprintf(stderr,"------\n"); |
---|
403 | show_lisp_register(xp, "fn", Ifn); |
---|
404 | fprintf(stderr,"------\n"); |
---|
405 | show_lisp_register(xp, "save0", Isave0); |
---|
406 | show_lisp_register(xp, "save1", Isave1); |
---|
407 | show_lisp_register(xp, "save2", Isave2); |
---|
408 | show_lisp_register(xp, "save3", Isave3); |
---|
409 | fprintf(stderr,"------\n"); |
---|
410 | show_lisp_register(xp, "temp0", Itemp0); |
---|
411 | show_lisp_register(xp, "temp1", Itemp1); |
---|
412 | show_lisp_register(xp, "temp2", Itemp2); |
---|
413 | fprintf(stderr,"------\n"); |
---|
414 | if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) { |
---|
415 | fprintf(stderr,"%%cx (nargs) = %d (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs)&0xffff)); |
---|
416 | } |
---|
417 | #endif |
---|
418 | return debug_continue; |
---|
419 | } |
---|
420 | |
---|
421 | #ifdef PPC |
---|
422 | debug_command_return |
---|
423 | debug_advance_pc(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
424 | { |
---|
425 | adjust_exception_pc(xp,4); |
---|
426 | return debug_continue; |
---|
427 | } |
---|
428 | #endif |
---|
429 | |
---|
430 | debug_command_return |
---|
431 | debug_identify_exception(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
432 | { |
---|
433 | #ifdef PPC |
---|
434 | pc program_counter = xpPC(xp); |
---|
435 | opcode instruction = 0; |
---|
436 | |
---|
437 | switch (arg) { |
---|
438 | case SIGILL: |
---|
439 | case SIGTRAP: |
---|
440 | instruction = *program_counter; |
---|
441 | if (major_opcode_p(instruction, major_opcode_TRI) || |
---|
442 | X_opcode_p(instruction,major_opcode_X31,minor_opcode_TR)) { |
---|
443 | describe_ppc_trap(xp); |
---|
444 | } else { |
---|
445 | describe_ppc_illegal(xp); |
---|
446 | } |
---|
447 | break; |
---|
448 | case SIGSEGV: |
---|
449 | case SIGBUS: |
---|
450 | describe_memfault(xp, info); |
---|
451 | break; |
---|
452 | default: |
---|
453 | break; |
---|
454 | } |
---|
455 | #endif |
---|
456 | return debug_continue; |
---|
457 | } |
---|
458 | |
---|
459 | char * |
---|
460 | debug_get_string_value(char *prompt) |
---|
461 | { |
---|
462 | static char buf[128]; |
---|
463 | char *p; |
---|
464 | |
---|
465 | do { |
---|
466 | fpurge(stdin); |
---|
467 | fprintf(stderr, "\n %s :",prompt); |
---|
468 | buf[0] = 0; |
---|
469 | fgets(buf, sizeof(buf)-1, stdin); |
---|
470 | } while (0); |
---|
471 | p = strchr(buf, '\n'); |
---|
472 | if (p) { |
---|
473 | *p = 0; |
---|
474 | return buf; |
---|
475 | } |
---|
476 | return NULL; |
---|
477 | } |
---|
478 | |
---|
479 | natural |
---|
480 | debug_get_natural_value(char *prompt) |
---|
481 | { |
---|
482 | char s[32]; |
---|
483 | int n; |
---|
484 | natural val; |
---|
485 | |
---|
486 | do { |
---|
487 | fpurge(stdin); |
---|
488 | fprintf(stderr, "\n %s :", prompt); |
---|
489 | fgets(s, 24, stdin); |
---|
490 | n = sscanf(s, "%lu", &val); |
---|
491 | } while (n != 1); |
---|
492 | return val; |
---|
493 | } |
---|
494 | |
---|
495 | unsigned |
---|
496 | debug_get_u5_value(char *prompt) |
---|
497 | { |
---|
498 | char s[32]; |
---|
499 | int n; |
---|
500 | unsigned val; |
---|
501 | |
---|
502 | do { |
---|
503 | fpurge(stdin); |
---|
504 | fprintf(stderr, "\n %s :", prompt); |
---|
505 | fgets(s, 24, stdin); |
---|
506 | n = sscanf(s, "%i", &val); |
---|
507 | } while ((n != 1) || (val > 31)); |
---|
508 | return val; |
---|
509 | } |
---|
510 | |
---|
511 | debug_command_return |
---|
512 | debug_show_symbol(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
513 | { |
---|
514 | char *pname = debug_get_string_value("symbol name"); |
---|
515 | |
---|
516 | if (pname != NULL) { |
---|
517 | plsym(xp, pname); |
---|
518 | } |
---|
519 | return debug_continue; |
---|
520 | } |
---|
521 | |
---|
522 | debug_command_return |
---|
523 | debug_thread_info(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
524 | { |
---|
525 | TCR * tcr = get_tcr(false); |
---|
526 | |
---|
527 | if (tcr) { |
---|
528 | area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area; |
---|
529 | |
---|
530 | fprintf(stderr, "Current Thread Context Record (tcr) = 0x%lx\n", tcr); |
---|
531 | fprintf(stderr, "Control (C) stack area: low = 0x%lx, high = 0x%lx\n", |
---|
532 | cs_area->low, cs_area->high); |
---|
533 | fprintf(stderr, "Value (lisp) stack area: low = 0x%lx, high = 0x%lx\n", |
---|
534 | vs_area->low, vs_area->high); |
---|
535 | fprintf(stderr, "Exception stack pointer = 0x%lx\n", |
---|
536 | #ifdef PPC |
---|
537 | xpGPR(xp,1) |
---|
538 | #endif |
---|
539 | #ifdef X86 |
---|
540 | xpGPR(xp,Isp) |
---|
541 | #endif |
---|
542 | ); |
---|
543 | } |
---|
544 | return debug_continue; |
---|
545 | } |
---|
546 | |
---|
547 | |
---|
548 | #ifdef WINDOWS |
---|
549 | debug_command_return |
---|
550 | debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
551 | { |
---|
552 | } |
---|
553 | #else |
---|
554 | debug_command_return |
---|
555 | debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
556 | { |
---|
557 | char buf[32]; |
---|
558 | natural val; |
---|
559 | |
---|
560 | sprintf(buf, "value for GPR %d", arg); |
---|
561 | val = debug_get_natural_value(buf); |
---|
562 | set_xpGPR(xp, arg, val); |
---|
563 | return debug_continue; |
---|
564 | } |
---|
565 | #endif |
---|
566 | |
---|
567 | debug_command_return |
---|
568 | debug_show_registers(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
569 | { |
---|
570 | int a, b, c, d, i; |
---|
571 | |
---|
572 | #ifdef PPC |
---|
573 | #ifdef PPC64 |
---|
574 | for (a = 0, b = 16; a < 16; a++, b++) { |
---|
575 | fprintf(stderr,"r%02d = 0x%016lX r%02d = 0x%016lX\n", |
---|
576 | a, xpGPR(xp, a), |
---|
577 | b, xpGPR(xp, b)); |
---|
578 | } |
---|
579 | |
---|
580 | fprintf(stderr, "\n PC = 0x%016lX LR = 0x%016lX\n", |
---|
581 | xpPC(xp), xpLR(xp)); |
---|
582 | fprintf(stderr, "CTR = 0x%016lX CCR = 0x%08X\n", |
---|
583 | xpCTR(xp), xpCCR(xp)); |
---|
584 | fprintf(stderr, "XER = 0x%08X MSR = 0x%016lX\n", |
---|
585 | xpXER(xp), xpMSR(xp)); |
---|
586 | fprintf(stderr,"DAR = 0x%016lX DSISR = 0x%08X\n", |
---|
587 | xpDAR(xp), xpDSISR(xp)); |
---|
588 | #else |
---|
589 | for (a = 0, b = 8, c = 16, d = 24; a < 8; a++, b++, c++, d++) { |
---|
590 | fprintf(stderr,"r%02d = 0x%08X r%02d = 0x%08X r%02d = 0x%08X r%02d = 0x%08X\n", |
---|
591 | a, xpGPR(xp, a), |
---|
592 | b, xpGPR(xp, b), |
---|
593 | c, xpGPR(xp, c), |
---|
594 | d, xpGPR(xp, d)); |
---|
595 | } |
---|
596 | fprintf(stderr, "\n PC = 0x%08X LR = 0x%08X CTR = 0x%08X CCR = 0x%08X\n", |
---|
597 | xpPC(xp), xpLR(xp), xpCTR(xp), xpCCR(xp)); |
---|
598 | fprintf(stderr, "XER = 0x%08X MSR = 0x%08X DAR = 0x%08X DSISR = 0x%08X\n", |
---|
599 | xpXER(xp), xpMSR(xp), xpDAR(xp), xpDSISR(xp)); |
---|
600 | #endif |
---|
601 | #endif |
---|
602 | |
---|
603 | #ifdef X8664 |
---|
604 | fprintf(stderr,"%rax = 0x%016llX %r8 = 0x%016llX\n", xpGPR(xp,REG_RAX),xpGPR(xp,REG_R8)); |
---|
605 | fprintf(stderr,"%rcx = 0x%016llX %r9 = 0x%016llX\n", xpGPR(xp,REG_RCX),xpGPR(xp,REG_R9)); |
---|
606 | fprintf(stderr,"%rdx = 0x%016llX %r10 = 0x%016llX\n", xpGPR(xp,REG_RDX),xpGPR(xp,REG_R10)); |
---|
607 | fprintf(stderr,"%rbx = 0x%016llX %r11 = 0x%016llX\n", xpGPR(xp,REG_RBX),xpGPR(xp,REG_R11)); |
---|
608 | fprintf(stderr,"%rsp = 0x%016llX %r12 = 0x%016llX\n", xpGPR(xp,REG_RSP),xpGPR(xp,REG_R12)); |
---|
609 | fprintf(stderr,"%rbp = 0x%016llX %r13 = 0x%016llX\n", xpGPR(xp,REG_RBP),xpGPR(xp,REG_R13)); |
---|
610 | fprintf(stderr,"%rsi = 0x%016llX %r14 = 0x%016llX\n", xpGPR(xp,REG_RSI),xpGPR(xp,REG_R14)); |
---|
611 | fprintf(stderr,"%rdi = 0x%016llX %r15 = 0x%016llX\n", xpGPR(xp,REG_RDI),xpGPR(xp,REG_R15)); |
---|
612 | fprintf(stderr,"%rip = 0x%016llX %rflags = 0x%016lX\n", |
---|
613 | xpGPR(xp, Iip), eflags_register(xp)); |
---|
614 | #endif |
---|
615 | return debug_continue; |
---|
616 | } |
---|
617 | |
---|
618 | debug_command_return |
---|
619 | debug_show_fpu(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
620 | { |
---|
621 | double *dp; |
---|
622 | int *np, i; |
---|
623 | #ifdef PPC |
---|
624 | dp = xpFPRvector(xp); |
---|
625 | np = (int *) dp; |
---|
626 | |
---|
627 | for (i = 0; i < 32; i++) { |
---|
628 | fprintf(stderr, "f%02d : 0x%08X%08X (%f)\n", i, *np++, *np++, *dp++); |
---|
629 | } |
---|
630 | fprintf(stderr, "FPSCR = %08X\n", xpFPSCR(xp)); |
---|
631 | #endif |
---|
632 | #ifdef X8664 |
---|
633 | #ifdef LINUX |
---|
634 | struct _libc_xmmreg * xmmp = &(xp->uc_mcontext.fpregs->_xmm[0]); |
---|
635 | #endif |
---|
636 | #ifdef DARWIN |
---|
637 | struct xmm { |
---|
638 | char fpdata[16]; |
---|
639 | }; |
---|
640 | struct xmm *xmmp = (struct xmm *)(xpFPRvector(xp)); |
---|
641 | #endif |
---|
642 | #ifdef WINDOWS |
---|
643 | struct xmm { |
---|
644 | char fpdata[16]; |
---|
645 | }; |
---|
646 | struct xmm *xmmp; /* XXX: actually get them */ |
---|
647 | #endif |
---|
648 | #ifdef FREEBSD |
---|
649 | struct xmmacc *xmmp = xpXMMregs(xp); |
---|
650 | #endif |
---|
651 | float *sp; |
---|
652 | |
---|
653 | |
---|
654 | for (i = 0; i < 16; i++, xmmp++) { |
---|
655 | sp = (float *) xmmp; |
---|
656 | dp = (double *) xmmp; |
---|
657 | np = (int *) xmmp; |
---|
658 | fprintf(stderr, "f%02d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np, (double)(*sp), np[1], np[0], *dp); |
---|
659 | } |
---|
660 | fprintf(stderr, "mxcsr = 0x%08x\n", |
---|
661 | #ifdef LINUX |
---|
662 | xp->uc_mcontext.fpregs->mxcsr |
---|
663 | #endif |
---|
664 | #ifdef DARWIN |
---|
665 | UC_MCONTEXT(xp)->__fs.__fpu_mxcsr |
---|
666 | #endif |
---|
667 | #ifdef FREEBSD |
---|
668 | (((struct savefpu *)(&(xp)->uc_mcontext.mc_fpstate))->sv_env.en_mxcsr) |
---|
669 | #endif |
---|
670 | #ifdef WINDOWS |
---|
671 | 0 /* XXX: get from somewhere */ |
---|
672 | #endif |
---|
673 | ); |
---|
674 | #endif |
---|
675 | return debug_continue; |
---|
676 | } |
---|
677 | |
---|
678 | debug_command_return |
---|
679 | debug_kill_process(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
680 | return debug_kill; |
---|
681 | } |
---|
682 | |
---|
683 | debug_command_return |
---|
684 | debug_win(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
685 | return debug_exit_success; |
---|
686 | } |
---|
687 | |
---|
688 | debug_command_return |
---|
689 | debug_lose(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
690 | return debug_exit_fail; |
---|
691 | } |
---|
692 | |
---|
693 | debug_command_return |
---|
694 | debug_help(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
695 | debug_command_entry *entry; |
---|
696 | |
---|
697 | for (entry = debug_command_entries; entry->f; entry++) { |
---|
698 | /* If we have an XP or don't need one, call the function */ |
---|
699 | if (xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) { |
---|
700 | fprintf(stderr, "(%c) %s\n", entry->c, entry->help_text); |
---|
701 | } |
---|
702 | } |
---|
703 | return debug_continue; |
---|
704 | } |
---|
705 | |
---|
706 | |
---|
707 | |
---|
708 | |
---|
709 | debug_command_return |
---|
710 | debug_backtrace(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
711 | { |
---|
712 | extern LispObj current_stack_pointer(); |
---|
713 | extern void plbt_sp(LispObj); |
---|
714 | extern void plbt(ExceptionInformation *); |
---|
715 | |
---|
716 | if (xp) { |
---|
717 | plbt(xp); |
---|
718 | } else { |
---|
719 | plbt_sp(current_stack_pointer()); |
---|
720 | } |
---|
721 | return debug_continue; |
---|
722 | } |
---|
723 | |
---|
724 | debug_command_return |
---|
725 | debug_thread_reset(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
726 | { |
---|
727 | reset_lisp_process(xp); |
---|
728 | return debug_exit_success; |
---|
729 | } |
---|
730 | |
---|
731 | |
---|
732 | debug_command_entry debug_command_entries[] = |
---|
733 | { |
---|
734 | {debug_set_gpr, |
---|
735 | "Set specified GPR to new value", |
---|
736 | DEBUG_COMMAND_FLAG_AUX_REGNO, |
---|
737 | "GPR to set (0-31) ?", |
---|
738 | 'G'}, |
---|
739 | #ifdef PPC |
---|
740 | {debug_advance_pc, |
---|
741 | "Advance the program counter by one instruction (use with caution!)", |
---|
742 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY, |
---|
743 | NULL, |
---|
744 | 'A'}, |
---|
745 | {debug_identify_exception, |
---|
746 | "Describe the current exception in greater detail", |
---|
747 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY | |
---|
748 | DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG, |
---|
749 | NULL, |
---|
750 | 'D'}, |
---|
751 | #endif |
---|
752 | {debug_show_registers, |
---|
753 | "Show raw GPR/SPR register values", |
---|
754 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
755 | NULL, |
---|
756 | 'R'}, |
---|
757 | {debug_lisp_registers, |
---|
758 | "Show Lisp values of tagged registers", |
---|
759 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
760 | NULL, |
---|
761 | 'L'}, |
---|
762 | {debug_show_fpu, |
---|
763 | "Show FPU registers", |
---|
764 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
765 | NULL, |
---|
766 | 'F'}, |
---|
767 | {debug_show_symbol, |
---|
768 | "Find and describe symbol matching specified name", |
---|
769 | 0, |
---|
770 | NULL, |
---|
771 | 'S'}, |
---|
772 | {debug_backtrace, |
---|
773 | "Show backtrace", |
---|
774 | 0, |
---|
775 | NULL, |
---|
776 | 'B'}, |
---|
777 | {debug_thread_info, |
---|
778 | "Show info about current thread", |
---|
779 | 0, |
---|
780 | NULL, |
---|
781 | 'T'}, |
---|
782 | {debug_win, |
---|
783 | "Exit from this debugger, asserting that any exception was handled", |
---|
784 | 0, |
---|
785 | NULL, |
---|
786 | 'X'}, |
---|
787 | #ifdef DARWIN |
---|
788 | {debug_lose, |
---|
789 | "Propagate the exception to another handler (debugger or OS)", |
---|
790 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY, |
---|
791 | NULL, |
---|
792 | 'P'}, |
---|
793 | #endif |
---|
794 | #if 0 |
---|
795 | {debug_thread_reset, |
---|
796 | "Reset current thread (as if in response to stack overflow)", |
---|
797 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
798 | NULL, |
---|
799 | 'T'}, |
---|
800 | #endif |
---|
801 | {debug_kill_process, |
---|
802 | "Kill OpenMCL process", |
---|
803 | 0, |
---|
804 | NULL, |
---|
805 | 'K'}, |
---|
806 | {debug_help, |
---|
807 | "Show this help", |
---|
808 | 0, |
---|
809 | NULL, |
---|
810 | '?'}, |
---|
811 | /* end-of-table */ |
---|
812 | {NULL, |
---|
813 | NULL, |
---|
814 | 0, |
---|
815 | NULL, |
---|
816 | 0} |
---|
817 | }; |
---|
818 | |
---|
819 | debug_command_return |
---|
820 | apply_debug_command(ExceptionInformation *xp, int c, siginfo_t *info, int why) |
---|
821 | { |
---|
822 | if (c == EOF) { |
---|
823 | return debug_kill; |
---|
824 | } else { |
---|
825 | debug_command_entry *entry; |
---|
826 | debug_command f; |
---|
827 | c = toupper(c); |
---|
828 | |
---|
829 | for (entry = debug_command_entries; f = entry->f; entry++) { |
---|
830 | if (toupper(entry->c) == c) { |
---|
831 | /* If we have an XP or don't need one, call the function */ |
---|
832 | if ((xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) && |
---|
833 | ((why > debug_entry_exception) || |
---|
834 | !(entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY))) { |
---|
835 | int arg = 0; |
---|
836 | if ((entry->flags & DEBUG_COMMAND_REG_FLAGS) |
---|
837 | == DEBUG_COMMAND_FLAG_AUX_REGNO) { |
---|
838 | arg = debug_get_u5_value("register number"); |
---|
839 | } |
---|
840 | if (entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG) { |
---|
841 | arg = why; |
---|
842 | } |
---|
843 | return (f)(xp, info, arg); |
---|
844 | } |
---|
845 | break; |
---|
846 | } |
---|
847 | } |
---|
848 | return debug_continue; |
---|
849 | } |
---|
850 | } |
---|
851 | |
---|
852 | debug_identify_function(ExceptionInformation *xp, siginfo_t *info) |
---|
853 | { |
---|
854 | #ifdef PPC |
---|
855 | if (xp) { |
---|
856 | if (active_tcr_p((TCR *)(ptr_from_lispobj(xpGPR(xp, rcontext))))) { |
---|
857 | LispObj f = xpGPR(xp, fn), codev; |
---|
858 | pc where = xpPC(xp); |
---|
859 | |
---|
860 | if (!(codev = register_codevector_contains_pc(f, where))) { |
---|
861 | f = xpGPR(xp, nfn); |
---|
862 | codev = register_codevector_contains_pc(f, where); |
---|
863 | } |
---|
864 | if (codev) { |
---|
865 | fprintf(stderr, " While executing: %s\n", print_lisp_object(f)); |
---|
866 | } |
---|
867 | } else { |
---|
868 | fprintf(stderr, " In foreign code at address 0x%08lx\n", xpPC(xp)); |
---|
869 | } |
---|
870 | } |
---|
871 | #endif |
---|
872 | } |
---|
873 | |
---|
874 | #ifndef WINDOWS |
---|
875 | extern pid_t main_thread_pid; |
---|
876 | #endif |
---|
877 | |
---|
878 | OSStatus |
---|
879 | lisp_Debugger(ExceptionInformation *xp, |
---|
880 | siginfo_t *info, |
---|
881 | int why, |
---|
882 | Boolean in_foreign_code, |
---|
883 | char *message, |
---|
884 | ...) |
---|
885 | { |
---|
886 | va_list args; |
---|
887 | debug_command_return state = debug_continue; |
---|
888 | |
---|
889 | if (threads_initialized) { |
---|
890 | suspend_other_threads(false); |
---|
891 | } |
---|
892 | |
---|
893 | va_start(args,message); |
---|
894 | vfprintf(stderr, message, args); |
---|
895 | fprintf(stderr, "\n"); |
---|
896 | va_end(args); |
---|
897 | if (in_foreign_code) { |
---|
898 | fprintf(stderr, "Exception occurred while executing foreign code\n"); |
---|
899 | } |
---|
900 | |
---|
901 | if (lisp_global(BATCH_FLAG)) { |
---|
902 | abort(); |
---|
903 | } |
---|
904 | if (xp) { |
---|
905 | if (why > debug_entry_exception) { |
---|
906 | debug_identify_exception(xp, info, why); |
---|
907 | } |
---|
908 | debug_identify_function(xp, info); |
---|
909 | } |
---|
910 | fprintf(stderr, "? for help\n"); |
---|
911 | while (state == debug_continue) { |
---|
912 | #ifdef WINDOWS |
---|
913 | fprintf(stderr, "[%d] OpenMCL kernel debugger: ", GetCurrentProcessId()); |
---|
914 | #else |
---|
915 | fprintf(stderr, "[%d] OpenMCL kernel debugger: ", main_thread_pid); |
---|
916 | #endif |
---|
917 | state = apply_debug_command(xp, readc(), info, why); |
---|
918 | } |
---|
919 | switch (state) { |
---|
920 | case debug_exit_success: |
---|
921 | if (threads_initialized) { |
---|
922 | resume_other_threads(false); |
---|
923 | } |
---|
924 | return 0; |
---|
925 | case debug_exit_fail: |
---|
926 | if (threads_initialized) { |
---|
927 | resume_other_threads(false); |
---|
928 | } |
---|
929 | return -1; |
---|
930 | case debug_kill: |
---|
931 | terminate_lisp(); |
---|
932 | } |
---|
933 | } |
---|
934 | |
---|
935 | void |
---|
936 | Bug(ExceptionInformation *xp, const char *format, ...) |
---|
937 | { |
---|
938 | va_list args; |
---|
939 | char s[512]; |
---|
940 | |
---|
941 | va_start(args, format); |
---|
942 | vsnprintf(s, sizeof(s),format, args); |
---|
943 | va_end(args); |
---|
944 | lisp_Debugger(xp, NULL, debug_entry_bug, false, s); |
---|
945 | |
---|
946 | } |
---|
947 | |
---|
948 | void |
---|
949 | FBug(ExceptionInformation *xp, const char *format, ...) |
---|
950 | { |
---|
951 | va_list args; |
---|
952 | char s[512]; |
---|
953 | |
---|
954 | va_start(args, format); |
---|
955 | vsnprintf(s, sizeof(s),format, args); |
---|
956 | va_end(args); |
---|
957 | lisp_Debugger(xp, NULL, debug_entry_bug, true, s); |
---|
958 | |
---|
959 | } |
---|
960 | |
---|
961 | void |
---|
962 | lisp_bug(char *string) |
---|
963 | { |
---|
964 | Bug(NULL, "Bug in OpenMCL system code:\n%s", string); |
---|
965 | } |
---|
966 | |
---|