1 | /* |
---|
2 | Copyright (C) 2009 Clozure Associates |
---|
3 | Copyright (C) 1994-2001 Digitool, Inc |
---|
4 | This file is part of Clozure CL. |
---|
5 | |
---|
6 | Clozure CL is licensed under the terms of the Lisp Lesser GNU Public |
---|
7 | License , known as the LLGPL and distributed with Clozure CL as the |
---|
8 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
9 | which is distributed with Clozure CL as the file "LGPL". Where these |
---|
10 | conflict, the preamble takes precedence. |
---|
11 | |
---|
12 | Clozure CL is referenced in the preamble as the "LIBRARY." |
---|
13 | |
---|
14 | The LLGPL is also available online at |
---|
15 | http://opensource.franz.com/preamble.html |
---|
16 | */ |
---|
17 | |
---|
18 | #include "lisp.h" |
---|
19 | #include "lisp-exceptions.h" |
---|
20 | #include "lisp_globals.h" |
---|
21 | #include "area.h" |
---|
22 | #include "threads.h" |
---|
23 | #include <ctype.h> |
---|
24 | #include <stdio.h> |
---|
25 | #include <stddef.h> |
---|
26 | #include <string.h> |
---|
27 | #include <stdarg.h> |
---|
28 | #include <errno.h> |
---|
29 | #include <stdio.h> |
---|
30 | |
---|
31 | #ifdef WINDOWS |
---|
32 | #include <fcntl.h> |
---|
33 | #else |
---|
34 | #include <sys/socket.h> |
---|
35 | #include <dlfcn.h> |
---|
36 | #endif |
---|
37 | #include <sys/stat.h> |
---|
38 | |
---|
39 | FILE *dbgout = NULL; |
---|
40 | |
---|
41 | typedef enum { |
---|
42 | debug_continue, /* stay in the repl */ |
---|
43 | debug_exit_success, /* return 0 from lisp_Debugger */ |
---|
44 | debug_exit_fail, /* return non-zero from lisp_Debugger */ |
---|
45 | debug_kill |
---|
46 | } debug_command_return; |
---|
47 | |
---|
48 | #ifdef SVN_REVISION |
---|
49 | #define xstr(s) str(s) |
---|
50 | #define str(s) #s |
---|
51 | char *kernel_svn_revision = xstr(SVN_REVISION); |
---|
52 | #undef xstr |
---|
53 | #undef str |
---|
54 | #else |
---|
55 | char *kernel_svn_revision = "unknown"; |
---|
56 | #endif |
---|
57 | |
---|
58 | Boolean |
---|
59 | open_debug_output(int fd) |
---|
60 | { |
---|
61 | FILE *f = fdopen(fd, "w"); |
---|
62 | |
---|
63 | if (f) { |
---|
64 | if (setvbuf(f, NULL, _IONBF, 0) == 0) { |
---|
65 | #ifdef WINDOWS |
---|
66 | if (fileno(stdin) < 0) { |
---|
67 | stdin->_file = 0; |
---|
68 | } |
---|
69 | #endif |
---|
70 | dbgout = f; |
---|
71 | return true; |
---|
72 | } |
---|
73 | fclose(f); |
---|
74 | } |
---|
75 | return false; |
---|
76 | } |
---|
77 | |
---|
78 | |
---|
79 | typedef debug_command_return (*debug_command) (ExceptionInformation *, |
---|
80 | siginfo_t *, |
---|
81 | int); |
---|
82 | |
---|
83 | #define DEBUG_COMMAND_FLAG_REQUIRE_XP 1 /* function */ |
---|
84 | #define DEBUG_COMMAND_FLAG_AUX_REGNO (2 | DEBUG_COMMAND_FLAG_REQUIRE_XP) |
---|
85 | #define DEBUG_COMMAND_FLAG_AUX_SPR (4 | DEBUG_COMMAND_FLAG_REQUIRE_XP) |
---|
86 | #define DEBUG_COMMAND_REG_FLAGS 7 |
---|
87 | #define DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY 8 |
---|
88 | #define DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG 16 |
---|
89 | |
---|
90 | typedef struct { |
---|
91 | debug_command f; |
---|
92 | char *help_text; |
---|
93 | unsigned flags; |
---|
94 | char *aux_prompt; |
---|
95 | int c; |
---|
96 | } debug_command_entry; |
---|
97 | |
---|
98 | |
---|
99 | extern |
---|
100 | debug_command_entry debug_command_entries[]; |
---|
101 | |
---|
102 | Boolean lisp_debugger_in_foreign_code = false; |
---|
103 | |
---|
104 | #ifndef WINDOWS |
---|
105 | Boolean |
---|
106 | stdin_is_dev_null() |
---|
107 | { |
---|
108 | struct stat fd0stat, devnullstat; |
---|
109 | |
---|
110 | if (fstat(fileno(stdin),&fd0stat)) { |
---|
111 | return true; |
---|
112 | } |
---|
113 | if (stat("/dev/null",&devnullstat)) { |
---|
114 | return true; |
---|
115 | } |
---|
116 | return ((fd0stat.st_ino == devnullstat.st_ino) && |
---|
117 | (fd0stat.st_dev == devnullstat.st_dev)); |
---|
118 | } |
---|
119 | #endif |
---|
120 | |
---|
121 | #ifdef WINDOWS |
---|
122 | Boolean |
---|
123 | stdin_is_dev_null() |
---|
124 | { |
---|
125 | HANDLE stdIn; |
---|
126 | stdIn = GetStdHandle(STD_INPUT_HANDLE); |
---|
127 | return (stdIn == NULL); |
---|
128 | } |
---|
129 | #endif |
---|
130 | |
---|
131 | |
---|
132 | |
---|
133 | |
---|
134 | char * |
---|
135 | foreign_name_and_offset(natural addr, int *delta) |
---|
136 | { |
---|
137 | #ifndef WINDOWS |
---|
138 | Dl_info info; |
---|
139 | #endif |
---|
140 | char *ret = NULL; |
---|
141 | |
---|
142 | if (delta) { |
---|
143 | *delta = 0; |
---|
144 | } |
---|
145 | #ifndef WINDOWS |
---|
146 | #ifndef ANDROID |
---|
147 | if (dladdr((void *)addr, &info)) { |
---|
148 | ret = (char *)info.dli_sname; |
---|
149 | if (delta) { |
---|
150 | *delta = ((natural)addr - (natural)info.dli_saddr); |
---|
151 | } |
---|
152 | } |
---|
153 | #endif |
---|
154 | #endif |
---|
155 | return ret; |
---|
156 | } |
---|
157 | |
---|
158 | |
---|
159 | #if defined(LINUX) || defined(SOLARIS) |
---|
160 | #define fpurge __fpurge |
---|
161 | #endif |
---|
162 | |
---|
163 | #ifdef WINDOWS |
---|
164 | void |
---|
165 | fpurge (FILE* file) |
---|
166 | { |
---|
167 | } |
---|
168 | #endif |
---|
169 | |
---|
170 | int |
---|
171 | readc() |
---|
172 | { |
---|
173 | unsigned tries = 1000; |
---|
174 | int c; |
---|
175 | |
---|
176 | while (tries) { |
---|
177 | c = getchar(); |
---|
178 | switch(c) { |
---|
179 | case '\n': |
---|
180 | continue; |
---|
181 | case '\r': |
---|
182 | continue; |
---|
183 | case EOF: |
---|
184 | if (ferror(stdin)) { |
---|
185 | if ((errno == EINTR) || (errno == EIO)) { |
---|
186 | clearerr(stdin); |
---|
187 | tries--; |
---|
188 | continue; |
---|
189 | } |
---|
190 | } |
---|
191 | /* fall through */ |
---|
192 | default: |
---|
193 | return c; |
---|
194 | } |
---|
195 | } |
---|
196 | return EOF; |
---|
197 | } |
---|
198 | |
---|
199 | #ifdef X8664 |
---|
200 | #ifdef LINUX |
---|
201 | char* Iregnames[] = {"r8 ","r9 ","r10","r11","r12","r13","r14","r15", |
---|
202 | "rdi","rsi","rbp", "rbx", "rdx", "rax", "rcx","rsp"}; |
---|
203 | #endif |
---|
204 | #ifdef SOLARIS |
---|
205 | char* Iregnames[] = {"r15 ","r14 ","r13","r12","r11","r10","r9 ","r8 ", |
---|
206 | "rdi","rsi","rbp", "rbx", "rdx", "rcx", "rcx","rsp"}; |
---|
207 | #endif |
---|
208 | #ifdef FREEBSD |
---|
209 | char* Iregnames[] = {"???", "rdi", "rsi", "rdx", "rcx", "r8 ", "r9 ", "rax", |
---|
210 | "rbx", "rbp", "r10", "r11", "r12", "r13", "r14", "r15", |
---|
211 | "???", "???", "???", "???", "???", "???", "???", "rsp"}; |
---|
212 | #endif |
---|
213 | #ifdef DARWIN |
---|
214 | char* Iregnames[] = {"rax", "rbx", "rcx", "rdx", "rdi", "rsi", |
---|
215 | "rbp", "rsp", "r8 ", "r9 ", "r10", "r11", "r12", "r13", |
---|
216 | "r14", "r15", "rip", "rfl"}; |
---|
217 | #endif |
---|
218 | #ifdef WINDOWS |
---|
219 | char* Iregnames[] = {"rax ","rcx ","rdx","rbx","rsp","rrbp","rsi","rdi", |
---|
220 | "r8","r9","r10", "r11", "r12", "r13", "r14","r15"}; |
---|
221 | #endif |
---|
222 | #endif |
---|
223 | |
---|
224 | #ifdef X8632 |
---|
225 | #ifdef DARWIN |
---|
226 | char *Iregnames[] = {"eax", "ebx", "ecx", "edx", "edi", "esi", |
---|
227 | "ebp", "???", "efl", "eip"}; |
---|
228 | #endif |
---|
229 | #ifdef LINUX |
---|
230 | char *Iregnames[] = {"???", "???", "???", "???", |
---|
231 | "edi", "esi", "ebp", "esp", |
---|
232 | "ebx", "edx", "ecx", "eax", |
---|
233 | "???", "???", "eip", "???", "efl"}; |
---|
234 | #endif |
---|
235 | #ifdef WINDOWS |
---|
236 | char *Iregnames[] = {"edi", "esi", "ebx", "edx", "ecx", "eax", |
---|
237 | "ebp", "eip", "???", "efl", "esp"}; |
---|
238 | #endif |
---|
239 | #ifdef FREEBSD |
---|
240 | char *Iregnames[] = {"???", "???", "???", "???", "???" |
---|
241 | "edi", "esi", "ebp", "ebx", "edx", |
---|
242 | "ecx", "eax", "???", "???", "eip", |
---|
243 | "???", "efl", "esp"}; |
---|
244 | #endif |
---|
245 | #ifdef SOLARIS |
---|
246 | char *Iregnames[] = {"???", "???", "???", "???", "???", |
---|
247 | "edi", "esi", "ebp", "???", "ebx", |
---|
248 | "edx", "ecx", "eax", "???", "???", |
---|
249 | "eip", "???", "efl", "esp"}; |
---|
250 | #endif |
---|
251 | #endif |
---|
252 | |
---|
253 | #ifdef X8632 |
---|
254 | int bit_for_regnum(int r) |
---|
255 | { |
---|
256 | switch (r) { |
---|
257 | case REG_EAX: return 1<<0; |
---|
258 | case REG_ECX: return 1<<1; |
---|
259 | case REG_EDX: return 1<<2; |
---|
260 | case REG_EBX: return 1<<3; |
---|
261 | case REG_ESP: return 1<<4; |
---|
262 | case REG_EBP: return 1<<5; |
---|
263 | case REG_ESI: return 1<<6; |
---|
264 | case REG_EDI: return 1<<7; |
---|
265 | } |
---|
266 | } |
---|
267 | #endif |
---|
268 | |
---|
269 | void |
---|
270 | show_lisp_register(ExceptionInformation *xp, char *label, int r) |
---|
271 | { |
---|
272 | |
---|
273 | extern char* print_lisp_object(LispObj); |
---|
274 | |
---|
275 | LispObj val = xpGPR(xp, r); |
---|
276 | |
---|
277 | #ifdef PPC |
---|
278 | fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val)); |
---|
279 | #endif |
---|
280 | #ifdef X8664 |
---|
281 | fprintf(dbgout, "%%%s (%s) = %s\n",Iregnames[r], label, print_lisp_object(val)); |
---|
282 | #endif |
---|
283 | #ifdef X8632 |
---|
284 | { |
---|
285 | TCR *tcr = get_tcr(false); |
---|
286 | char *s; |
---|
287 | |
---|
288 | if (r == REG_EDX && (xpGPR(xp, REG_EFL) & EFL_DF)) |
---|
289 | s = "marked as unboxed (DF set)"; |
---|
290 | else if (tcr && (tcr->node_regs_mask & bit_for_regnum(r)) == 0) |
---|
291 | s = "marked as unboxed (node_regs_mask)"; |
---|
292 | else |
---|
293 | s = print_lisp_object(val); |
---|
294 | |
---|
295 | fprintf(dbgout, "%%%s (%s) = %s\n", Iregnames[r], label, s); |
---|
296 | } |
---|
297 | #endif |
---|
298 | #ifdef ARM |
---|
299 | fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val)); |
---|
300 | #endif |
---|
301 | } |
---|
302 | |
---|
303 | void |
---|
304 | describe_siginfo(siginfo_t *info) |
---|
305 | { |
---|
306 | #if defined(WINDOWS) || defined(FREEBSD) || defined(DARWIN) |
---|
307 | /* |
---|
308 | * It's not surprising that Windows doesn't have this signal stuff. |
---|
309 | * It is somewhat surprising that FreeBSD 6.x lacks the si_code |
---|
310 | * constants. (Subsequent FreeBSD versions define them, though.) |
---|
311 | * |
---|
312 | * On Darwin, recall that we handle exceptions at the Mach level, |
---|
313 | * and build a "fake" signal context ourselves. We don't try very |
---|
314 | * hard to translate the Mach exception information to Unix-style |
---|
315 | * information, so avoid printing out possibly-misleading garbage. |
---|
316 | * (bsd/dev/i386/unix_signal.c from the xnu sources is where that |
---|
317 | * happens for Mac OS X's own Mach-exception-to-Unix-signal |
---|
318 | * translation. |
---|
319 | */ |
---|
320 | #else |
---|
321 | if (info->si_code > 0) { |
---|
322 | if (info->si_signo == SIGSEGV) { |
---|
323 | switch (info->si_code) { |
---|
324 | case SEGV_MAPERR: |
---|
325 | fprintf(dbgout, "address not mapped to object\n"); |
---|
326 | break; |
---|
327 | case SEGV_ACCERR: |
---|
328 | fprintf(dbgout, "invalid permissions for mapped object\n"); |
---|
329 | break; |
---|
330 | default: |
---|
331 | fprintf(dbgout, "unexpected si_code value: %d\n", info->si_code); |
---|
332 | break; |
---|
333 | } |
---|
334 | } else if (info->si_signo == SIGBUS) { |
---|
335 | switch (info->si_code) { |
---|
336 | case BUS_ADRALN: |
---|
337 | fprintf(dbgout, "invalid address alignment\n"); |
---|
338 | break; |
---|
339 | case BUS_ADRERR: |
---|
340 | fprintf(dbgout, "non-existent physical address"); |
---|
341 | break; |
---|
342 | case BUS_OBJERR: |
---|
343 | fprintf(dbgout, "object-specific hardware error"); |
---|
344 | break; |
---|
345 | default: |
---|
346 | fprintf(dbgout, "unexpected si_code value: %d\n", info->si_code); |
---|
347 | } |
---|
348 | } |
---|
349 | } |
---|
350 | #endif |
---|
351 | } |
---|
352 | |
---|
353 | void |
---|
354 | describe_memfault(ExceptionInformation *xp, siginfo_t *info) |
---|
355 | { |
---|
356 | #ifdef PPC |
---|
357 | void *addr = (void *)xpDAR(xp); |
---|
358 | natural dsisr = xpDSISR(xp); |
---|
359 | |
---|
360 | fprintf(dbgout, "%s operation to %s address 0x%lx\n", |
---|
361 | dsisr & (1<<25) ? "Write" : "Read", |
---|
362 | dsisr & (1<<27) ? "protected" : "unmapped", |
---|
363 | addr); |
---|
364 | #elif !defined(WINDOWS) |
---|
365 | if (info) { |
---|
366 | fprintf(dbgout, "received signal %d; faulting address: %p\n", |
---|
367 | info->si_signo, info->si_addr); |
---|
368 | describe_siginfo(info); |
---|
369 | } |
---|
370 | #endif |
---|
371 | } |
---|
372 | |
---|
373 | #ifdef PPC |
---|
374 | void |
---|
375 | describe_ppc_illegal(ExceptionInformation *xp) |
---|
376 | { |
---|
377 | pc where = xpPC(xp); |
---|
378 | opcode the_uuo = *where; |
---|
379 | Boolean described = false; |
---|
380 | |
---|
381 | if (IS_UUO(the_uuo)) { |
---|
382 | unsigned |
---|
383 | minor = UUO_MINOR(the_uuo), |
---|
384 | errnum = 0x3ff & (the_uuo >> 16); |
---|
385 | |
---|
386 | switch(minor) { |
---|
387 | case UUO_INTERR: |
---|
388 | switch (errnum) { |
---|
389 | case error_udf_call: |
---|
390 | fprintf(dbgout, "ERROR: undefined function call: %s\n", |
---|
391 | print_lisp_object(xpGPR(xp,fname))); |
---|
392 | described = true; |
---|
393 | break; |
---|
394 | |
---|
395 | default: |
---|
396 | fprintf(dbgout, "ERROR: lisp error %d\n", errnum); |
---|
397 | described = true; |
---|
398 | break; |
---|
399 | } |
---|
400 | break; |
---|
401 | |
---|
402 | default: |
---|
403 | break; |
---|
404 | } |
---|
405 | } |
---|
406 | if (!described) { |
---|
407 | fprintf(dbgout, "Illegal instruction (0x%08x) at 0x%lx\n", |
---|
408 | the_uuo, where); |
---|
409 | } |
---|
410 | } |
---|
411 | #endif |
---|
412 | |
---|
413 | #ifdef PPC |
---|
414 | void |
---|
415 | describe_ppc_trap(ExceptionInformation *xp) |
---|
416 | { |
---|
417 | pc where = xpPC(xp); |
---|
418 | opcode the_trap = *where, instr; |
---|
419 | int err_arg2, ra, rs; |
---|
420 | Boolean identified = false; |
---|
421 | |
---|
422 | if ((the_trap & OP_MASK) == OP(major_opcode_TRI)) { |
---|
423 | /* TWI/TDI. If the RA field is "nargs", that means that the |
---|
424 | instruction is either a number-of-args check or an |
---|
425 | event-poll. Otherwise, the trap is some sort of |
---|
426 | typecheck. */ |
---|
427 | |
---|
428 | if (RA_field(the_trap) == nargs) { |
---|
429 | switch (TO_field(the_trap)) { |
---|
430 | case TO_NE: |
---|
431 | if (xpGPR(xp, nargs) < D_field(the_trap)) { |
---|
432 | fprintf(dbgout, "Too few arguments (no opt/rest)\n"); |
---|
433 | } else { |
---|
434 | fprintf(dbgout, "Too many arguments (no opt/rest)\n"); |
---|
435 | } |
---|
436 | identified = true; |
---|
437 | break; |
---|
438 | |
---|
439 | case TO_GT: |
---|
440 | fprintf(dbgout, "Event poll !\n"); |
---|
441 | identified = true; |
---|
442 | break; |
---|
443 | |
---|
444 | case TO_HI: |
---|
445 | fprintf(dbgout, "Too many arguments (with opt)\n"); |
---|
446 | identified = true; |
---|
447 | break; |
---|
448 | |
---|
449 | case TO_LT: |
---|
450 | fprintf(dbgout, "Too few arguments (with opt/rest/key)\n"); |
---|
451 | identified = true; |
---|
452 | break; |
---|
453 | |
---|
454 | default: /* some weird trap, not ours. */ |
---|
455 | identified = false; |
---|
456 | break; |
---|
457 | } |
---|
458 | } else { |
---|
459 | /* A type or boundp trap of some sort. */ |
---|
460 | switch (TO_field(the_trap)) { |
---|
461 | case TO_EQ: |
---|
462 | /* Boundp traps are of the form: |
---|
463 | treqi rX,unbound |
---|
464 | where some preceding instruction is of the form: |
---|
465 | lwz/ld rX,symbol.value(rY). |
---|
466 | The error message should try to say that rY is unbound. */ |
---|
467 | |
---|
468 | if (D_field(the_trap) == unbound) { |
---|
469 | #ifdef PPC64 |
---|
470 | instr = scan_for_instr(LD_instruction(RA_field(the_trap), |
---|
471 | unmasked_register, |
---|
472 | offsetof(lispsymbol,vcell)-fulltag_misc), |
---|
473 | D_RT_IMM_MASK, |
---|
474 | where); |
---|
475 | #else |
---|
476 | instr = scan_for_instr(LWZ_instruction(RA_field(the_trap), |
---|
477 | unmasked_register, |
---|
478 | offsetof(lispsymbol,vcell)-fulltag_misc), |
---|
479 | D_RT_IMM_MASK, |
---|
480 | where); |
---|
481 | #endif |
---|
482 | if (instr) { |
---|
483 | ra = RA_field(instr); |
---|
484 | if (lisp_reg_p(ra)) { |
---|
485 | fprintf(dbgout, "Unbound variable: %s\n", |
---|
486 | print_lisp_object(xpGPR(xp,ra))); |
---|
487 | identified = true; |
---|
488 | } |
---|
489 | } |
---|
490 | } |
---|
491 | break; |
---|
492 | |
---|
493 | case TO_NE: |
---|
494 | /* A type check. If the type (the immediate field of the trap |
---|
495 | instruction) is a header type, an "lbz |
---|
496 | rX,misc_header_offset(rY)" should precede it, in which case |
---|
497 | we say that "rY is not of header type <type>." If the type |
---|
498 | is not a header type, then rX should have been set by a |
---|
499 | preceding "clrlwi rX,rY,29/30". In that case, scan |
---|
500 | backwards for an RLWINM instruction that set rX and report |
---|
501 | that rY isn't of the indicated type. */ |
---|
502 | err_arg2 = D_field(the_trap); |
---|
503 | if (nodeheader_tag_p(err_arg2) || |
---|
504 | immheader_tag_p(err_arg2)) { |
---|
505 | instr = scan_for_instr(LBZ_instruction(RA_field(the_trap), |
---|
506 | unmasked_register, |
---|
507 | misc_subtag_offset), |
---|
508 | D_RT_IMM_MASK, |
---|
509 | where); |
---|
510 | if (instr) { |
---|
511 | ra = RA_field(instr); |
---|
512 | if (lisp_reg_p(ra)) { |
---|
513 | fprintf(dbgout, "value 0x%lX is not of the expected header type 0x%02X\n", xpGPR(xp, ra), err_arg2); |
---|
514 | identified = true; |
---|
515 | } |
---|
516 | } |
---|
517 | } else { |
---|
518 | /* Not a header type, look for rlwinm whose RA field matches the_trap's */ |
---|
519 | instr = scan_for_instr((OP(major_opcode_RLWINM) | (the_trap & RA_MASK)), |
---|
520 | (OP_MASK | RA_MASK), |
---|
521 | where); |
---|
522 | if (instr) { |
---|
523 | rs = RS_field(instr); |
---|
524 | if (lisp_reg_p(rs)) { |
---|
525 | fprintf(dbgout, "value 0x%lX is not of the expected type 0x%02X\n", |
---|
526 | xpGPR(xp, rs), err_arg2); |
---|
527 | identified = true; |
---|
528 | } |
---|
529 | } |
---|
530 | } |
---|
531 | break; |
---|
532 | } |
---|
533 | } |
---|
534 | } else { |
---|
535 | /* a "TW <to>,ra,rb" instruction." |
---|
536 | twltu sp,rN is stack-overflow on SP. |
---|
537 | twgeu rX,rY is subscript out-of-bounds, which was preceded |
---|
538 | by an "lwz rM,misc_header_offset(rN)" instruction. |
---|
539 | rM may or may not be the same as rY, but no other header |
---|
540 | would have been loaded before the trap. */ |
---|
541 | switch (TO_field(the_trap)) { |
---|
542 | case TO_LO: |
---|
543 | if (RA_field(the_trap) == sp) { |
---|
544 | fprintf(dbgout, "Stack overflow! Run away! Run away!\n"); |
---|
545 | identified = true; |
---|
546 | } |
---|
547 | break; |
---|
548 | |
---|
549 | case (TO_HI|TO_EQ): |
---|
550 | instr = scan_for_instr(OP(major_opcode_LWZ) | (D_MASK & misc_header_offset), |
---|
551 | (OP_MASK | D_MASK), |
---|
552 | where); |
---|
553 | if (instr) { |
---|
554 | ra = RA_field(instr); |
---|
555 | if (lisp_reg_p(ra)) { |
---|
556 | fprintf(dbgout, "Bad index %d for vector %lX length %d\n", |
---|
557 | unbox_fixnum(xpGPR(xp, RA_field(the_trap))), |
---|
558 | xpGPR(xp, ra), |
---|
559 | unbox_fixnum(xpGPR(xp, RB_field(the_trap)))); |
---|
560 | identified = true; |
---|
561 | } |
---|
562 | } |
---|
563 | break; |
---|
564 | } |
---|
565 | } |
---|
566 | |
---|
567 | if (!identified) { |
---|
568 | fprintf(dbgout, "Unknown trap: 0x%08x\n", the_trap); |
---|
569 | } |
---|
570 | |
---|
571 | |
---|
572 | } |
---|
573 | #endif |
---|
574 | |
---|
575 | #ifdef ARM |
---|
576 | void |
---|
577 | describe_arm_uuo(ExceptionInformation *xp) |
---|
578 | { |
---|
579 | pc program_counter = xpPC(xp); |
---|
580 | opcode instruction = *program_counter; |
---|
581 | |
---|
582 | if (IS_UUO(instruction)) { |
---|
583 | unsigned format = UUO_FORMAT(instruction); |
---|
584 | |
---|
585 | switch(format) { |
---|
586 | case uuo_format_nullary: |
---|
587 | case uuo_format_nullary_error: |
---|
588 | switch UUOA_field(instruction) { |
---|
589 | case 0: |
---|
590 | fprintf(dbgout,"alloc_trap\n"); |
---|
591 | break; |
---|
592 | case 1: |
---|
593 | fprintf(dbgout,"wrong number of args (%d) to %s\n",xpGPR(xp,nargs)>>node_shift, |
---|
594 | print_lisp_object(xpGPR(xp,nfn))); |
---|
595 | break; |
---|
596 | case 2: |
---|
597 | fprintf(dbgout,"gc trap\n"); |
---|
598 | break; |
---|
599 | case 3: |
---|
600 | fprintf(dbgout,"debug trap\n"); |
---|
601 | break; |
---|
602 | case 4: |
---|
603 | fprintf(dbgout,"deferred interrupt\n"); |
---|
604 | break; |
---|
605 | case 5: |
---|
606 | fprintf(dbgout,"deferred suspend\n"); |
---|
607 | break; |
---|
608 | default: |
---|
609 | break; |
---|
610 | } |
---|
611 | break; |
---|
612 | |
---|
613 | case uuo_format_unary_error: |
---|
614 | switch (UUO_UNARY_field(instruction)) { |
---|
615 | case 0: |
---|
616 | case 1: |
---|
617 | fprintf(dbgout,"%s is unbound\n", print_lisp_object(xpGPR(xp,UUOA_field(instruction)))); |
---|
618 | break; |
---|
619 | |
---|
620 | default: |
---|
621 | break; |
---|
622 | } |
---|
623 | default: |
---|
624 | break; |
---|
625 | } |
---|
626 | } |
---|
627 | } |
---|
628 | #endif |
---|
629 | |
---|
630 | char * |
---|
631 | area_code_name(int code) |
---|
632 | { |
---|
633 | switch (code) { |
---|
634 | case AREA_VOID: return "void"; |
---|
635 | case AREA_CSTACK: return "cstack"; |
---|
636 | case AREA_VSTACK: return "vstack"; |
---|
637 | case AREA_TSTACK: return "tstack"; |
---|
638 | case AREA_READONLY: return "readonly"; |
---|
639 | case AREA_WATCHED: return "watched"; |
---|
640 | case AREA_STATIC_CONS: return "static cons"; |
---|
641 | case AREA_MANAGED_STATIC: return "managed static"; |
---|
642 | case AREA_STATIC: return "static"; |
---|
643 | case AREA_DYNAMIC: return "dynamic"; |
---|
644 | default: return "unknown"; |
---|
645 | } |
---|
646 | } |
---|
647 | |
---|
648 | debug_command_return |
---|
649 | debug_memory_areas(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
650 | { |
---|
651 | area *a, *header = all_areas; |
---|
652 | char label[100]; |
---|
653 | |
---|
654 | fprintf(dbgout, "Lisp memory areas:\n"); |
---|
655 | fprintf(dbgout, "%20s %20s %20s\n", "code", "low", "high"); |
---|
656 | for (a = header->succ; a != header; a = a->succ) { |
---|
657 | snprintf(label, sizeof(label), "%s (%d)", area_code_name(a->code), |
---|
658 | a->code >> fixnumshift); |
---|
659 | fprintf(dbgout, "%20s %20p %20p\n", label, a->low, a->high); |
---|
660 | } |
---|
661 | return debug_continue; |
---|
662 | } |
---|
663 | |
---|
664 | debug_command_return |
---|
665 | debug_lisp_registers(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
666 | { |
---|
667 | if (lisp_debugger_in_foreign_code == false) { |
---|
668 | #ifdef PPC |
---|
669 | TCR *xpcontext = (TCR *)ptr_from_lispobj(xpGPR(xp, rcontext)); |
---|
670 | |
---|
671 | fprintf(dbgout, "rcontext = 0x%lX ", xpcontext); |
---|
672 | if (!active_tcr_p(xpcontext)) { |
---|
673 | fprintf(dbgout, "(INVALID)\n"); |
---|
674 | } else { |
---|
675 | fprintf(dbgout, "\nnargs = %d\n", xpGPR(xp, nargs) >> fixnumshift); |
---|
676 | show_lisp_register(xp, "fn", fn); |
---|
677 | show_lisp_register(xp, "arg_z", arg_z); |
---|
678 | show_lisp_register(xp, "arg_y", arg_y); |
---|
679 | show_lisp_register(xp, "arg_x", arg_x); |
---|
680 | show_lisp_register(xp, "temp0", temp0); |
---|
681 | show_lisp_register(xp, "temp1/next_method_context", temp1); |
---|
682 | show_lisp_register(xp, "temp2/nfn", temp2); |
---|
683 | show_lisp_register(xp, "temp3/fname", temp3); |
---|
684 | /* show_lisp_register(xp, "new_fn", new_fn); */ |
---|
685 | show_lisp_register(xp, "save0", save0); |
---|
686 | show_lisp_register(xp, "save1", save1); |
---|
687 | show_lisp_register(xp, "save2", save2); |
---|
688 | show_lisp_register(xp, "save3", save3); |
---|
689 | show_lisp_register(xp, "save4", save4); |
---|
690 | show_lisp_register(xp, "save5", save5); |
---|
691 | show_lisp_register(xp, "save6", save6); |
---|
692 | show_lisp_register(xp, "save7", save7); |
---|
693 | } |
---|
694 | #endif |
---|
695 | #ifdef X8664 |
---|
696 | |
---|
697 | show_lisp_register(xp, "arg_z", Iarg_z); |
---|
698 | show_lisp_register(xp, "arg_y", Iarg_y); |
---|
699 | show_lisp_register(xp, "arg_x", Iarg_x); |
---|
700 | fprintf(dbgout,"------\n"); |
---|
701 | show_lisp_register(xp, "fn", Ifn); |
---|
702 | fprintf(dbgout,"------\n"); |
---|
703 | show_lisp_register(xp, "save0", Isave0); |
---|
704 | show_lisp_register(xp, "save1", Isave1); |
---|
705 | show_lisp_register(xp, "save2", Isave2); |
---|
706 | show_lisp_register(xp, "save3", Isave3); |
---|
707 | fprintf(dbgout,"------\n"); |
---|
708 | show_lisp_register(xp, "temp0", Itemp0); |
---|
709 | show_lisp_register(xp, "temp1", Itemp1); |
---|
710 | show_lisp_register(xp, "temp2", Itemp2); |
---|
711 | fprintf(dbgout,"------\n"); |
---|
712 | if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) { |
---|
713 | fprintf(dbgout,"%%rcx (nargs) = %ld (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs)&0xffff)); |
---|
714 | } |
---|
715 | #endif |
---|
716 | |
---|
717 | #ifdef X8632 |
---|
718 | show_lisp_register(xp, "arg_z", Iarg_z); |
---|
719 | show_lisp_register(xp, "arg_y", Iarg_y); |
---|
720 | fprintf(dbgout,"------\n"); |
---|
721 | show_lisp_register(xp, "fn", Ifn); |
---|
722 | fprintf(dbgout,"------\n"); |
---|
723 | show_lisp_register(xp, "temp0", Itemp0); |
---|
724 | show_lisp_register(xp, "temp1", Itemp1); |
---|
725 | fprintf(dbgout,"------\n"); |
---|
726 | if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) { |
---|
727 | fprintf(dbgout,"%%edx (nargs) = %d (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs))); |
---|
728 | } |
---|
729 | #endif |
---|
730 | #ifdef ARM |
---|
731 | TCR *xpcontext = (TCR *)ptr_from_lispobj(xpGPR(xp, rcontext)); |
---|
732 | |
---|
733 | fprintf(dbgout, "rcontext = 0x%lX ", xpcontext); |
---|
734 | if (!active_tcr_p(xpcontext)) { |
---|
735 | fprintf(dbgout, "(INVALID)\n"); |
---|
736 | } else { |
---|
737 | fprintf(dbgout, "\nnargs = %d\n", xpGPR(xp, nargs) >> fixnumshift); |
---|
738 | show_lisp_register(xp, "fn", Rfn); |
---|
739 | show_lisp_register(xp, "arg_z", arg_z); |
---|
740 | show_lisp_register(xp, "arg_y", arg_y); |
---|
741 | show_lisp_register(xp, "arg_x", arg_x); |
---|
742 | show_lisp_register(xp, "temp0", temp0); |
---|
743 | show_lisp_register(xp, "temp1/fname/next_method_context", temp1); |
---|
744 | show_lisp_register(xp, "temp2/nfn", temp2); |
---|
745 | } |
---|
746 | #endif |
---|
747 | } |
---|
748 | |
---|
749 | return debug_continue; |
---|
750 | } |
---|
751 | |
---|
752 | #ifndef X86 |
---|
753 | debug_command_return |
---|
754 | debug_advance_pc(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
755 | { |
---|
756 | adjust_exception_pc(xp,4); |
---|
757 | return debug_continue; |
---|
758 | } |
---|
759 | #endif |
---|
760 | |
---|
761 | debug_command_return |
---|
762 | debug_identify_exception(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
763 | { |
---|
764 | #ifndef X86 |
---|
765 | pc program_counter = xpPC(xp); |
---|
766 | opcode instruction = 0; |
---|
767 | #endif |
---|
768 | |
---|
769 | switch (arg) { |
---|
770 | #ifdef PPC |
---|
771 | case SIGILL: |
---|
772 | case SIGTRAP: |
---|
773 | instruction = *program_counter; |
---|
774 | if (major_opcode_p(instruction, major_opcode_TRI) || |
---|
775 | X_opcode_p(instruction,major_opcode_X31,minor_opcode_TR)) { |
---|
776 | describe_ppc_trap(xp); |
---|
777 | } else { |
---|
778 | describe_ppc_illegal(xp); |
---|
779 | } |
---|
780 | break; |
---|
781 | #endif |
---|
782 | |
---|
783 | #ifdef ARM |
---|
784 | case SIGILL: |
---|
785 | instruction = *program_counter; |
---|
786 | if (IS_UUO(instruction)) { |
---|
787 | describe_arm_uuo(xp); |
---|
788 | } |
---|
789 | break; |
---|
790 | #endif |
---|
791 | case SIGSEGV: |
---|
792 | case SIGBUS: |
---|
793 | describe_memfault(xp, info); |
---|
794 | break; |
---|
795 | default: |
---|
796 | break; |
---|
797 | } |
---|
798 | return debug_continue; |
---|
799 | } |
---|
800 | |
---|
801 | char * |
---|
802 | debug_get_string_value(char *prompt) |
---|
803 | { |
---|
804 | static char buf[128]; |
---|
805 | char *p, *res; |
---|
806 | |
---|
807 | do { |
---|
808 | fpurge(stdin); |
---|
809 | fprintf(dbgout, "\n %s :",prompt); |
---|
810 | buf[0] = 0; |
---|
811 | res = fgets(buf, sizeof(buf), stdin); |
---|
812 | } while (0); |
---|
813 | p = strchr(res, '\n'); |
---|
814 | if (p) { |
---|
815 | *p = 0; |
---|
816 | return buf; |
---|
817 | } |
---|
818 | return NULL; |
---|
819 | } |
---|
820 | |
---|
821 | natural |
---|
822 | debug_get_natural_value(char *prompt) |
---|
823 | { |
---|
824 | char s[32], *res, *endptr; |
---|
825 | natural val; |
---|
826 | |
---|
827 | do { |
---|
828 | fpurge(stdin); |
---|
829 | fprintf(dbgout, "\n %s :", prompt); |
---|
830 | s[0]=0; |
---|
831 | res = fgets(s, 24, stdin); |
---|
832 | val = strtoul(res,&endptr,0); |
---|
833 | } while (*endptr); |
---|
834 | return val; |
---|
835 | } |
---|
836 | |
---|
837 | unsigned |
---|
838 | debug_get_u5_value(char *prompt) |
---|
839 | { |
---|
840 | char s[32], *res; |
---|
841 | int n; |
---|
842 | unsigned val; |
---|
843 | |
---|
844 | do { |
---|
845 | fpurge(stdin); |
---|
846 | fprintf(dbgout, "\n %s :", prompt); |
---|
847 | res = fgets(s, 24, stdin); |
---|
848 | n = sscanf(res, "%i", &val); |
---|
849 | } while ((n != 1) || (val > 31)); |
---|
850 | return val; |
---|
851 | } |
---|
852 | |
---|
853 | debug_command_return |
---|
854 | debug_show_symbol(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
855 | { |
---|
856 | char *pname = debug_get_string_value("symbol name"); |
---|
857 | extern void *plsym(ExceptionInformation *,char*); |
---|
858 | |
---|
859 | if (pname != NULL) { |
---|
860 | plsym(xp, pname); |
---|
861 | } |
---|
862 | return debug_continue; |
---|
863 | } |
---|
864 | |
---|
865 | debug_command_return |
---|
866 | debug_show_lisp_version(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
867 | { |
---|
868 | extern void *plsym(ExceptionInformation *,char*); |
---|
869 | |
---|
870 | fprintf(dbgout, "Lisp kernel svn revision: %s\n", kernel_svn_revision); |
---|
871 | if (xp) |
---|
872 | plsym(xp, "*OPENMCL-VERSION*"); |
---|
873 | return debug_continue; |
---|
874 | } |
---|
875 | |
---|
876 | debug_command_return |
---|
877 | debug_thread_info(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
878 | { |
---|
879 | TCR * tcr = get_tcr(false); |
---|
880 | |
---|
881 | if (tcr) { |
---|
882 | area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area; |
---|
883 | |
---|
884 | fprintf(dbgout, "Current Thread Context Record (tcr) = 0x" LISP "\n", tcr); |
---|
885 | fprintf(dbgout, "Control (C) stack area: low = 0x" LISP ", high = 0x" LISP "\n", |
---|
886 | (cs_area->low), (cs_area->high)); |
---|
887 | fprintf(dbgout, "Value (lisp) stack area: low = 0x" LISP ", high = 0x" LISP "\n", |
---|
888 | (u64_t)(natural)(vs_area->low), (u64_t)(natural)vs_area->high); |
---|
889 | if (xp) { |
---|
890 | fprintf(dbgout, "Exception stack pointer = 0x" LISP "\n", |
---|
891 | #ifdef PPC |
---|
892 | (u64_t) (natural)(xpGPR(xp,1)) |
---|
893 | #endif |
---|
894 | #ifdef X86 |
---|
895 | (u64_t) (natural)(xpGPR(xp,Isp)) |
---|
896 | #endif |
---|
897 | #ifdef ARM |
---|
898 | (u64_t) (natural)(xpGPR(xp,Rsp)) |
---|
899 | #endif |
---|
900 | ); |
---|
901 | } |
---|
902 | } |
---|
903 | return debug_continue; |
---|
904 | } |
---|
905 | |
---|
906 | |
---|
907 | debug_command_return |
---|
908 | debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
909 | { |
---|
910 | char buf[32]; |
---|
911 | natural val; |
---|
912 | |
---|
913 | sprintf(buf, "value for GPR %d", arg); |
---|
914 | val = debug_get_natural_value(buf); |
---|
915 | xpGPR(xp,arg) = val; |
---|
916 | return debug_continue; |
---|
917 | } |
---|
918 | |
---|
919 | debug_command_return |
---|
920 | debug_show_registers(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
921 | { |
---|
922 | |
---|
923 | |
---|
924 | #ifdef PPC |
---|
925 | #ifdef PPC64 |
---|
926 | int a, b; |
---|
927 | for (a = 0, b = 16; a < 16; a++, b++) { |
---|
928 | fprintf(dbgout,"r%02d = 0x%016lX r%02d = 0x%016lX\n", |
---|
929 | a, xpGPR(xp, a), |
---|
930 | b, xpGPR(xp, b)); |
---|
931 | } |
---|
932 | |
---|
933 | fprintf(dbgout, "\n PC = 0x%016lX LR = 0x%016lX\n", |
---|
934 | xpPC(xp), xpLR(xp)); |
---|
935 | fprintf(dbgout, "CTR = 0x%016lX CCR = 0x%08X\n", |
---|
936 | xpCTR(xp), xpCCR(xp)); |
---|
937 | fprintf(dbgout, "XER = 0x%08X MSR = 0x%016lX\n", |
---|
938 | xpXER(xp), xpMSR(xp)); |
---|
939 | fprintf(dbgout,"DAR = 0x%016lX DSISR = 0x%08X\n", |
---|
940 | xpDAR(xp), xpDSISR(xp)); |
---|
941 | #else |
---|
942 | int a, b, c, d;; |
---|
943 | for (a = 0, b = 8, c = 16, d = 24; a < 8; a++, b++, c++, d++) { |
---|
944 | fprintf(dbgout,"r%02d = 0x%08X r%02d = 0x%08X r%02d = 0x%08X r%02d = 0x%08X\n", |
---|
945 | a, xpGPR(xp, a), |
---|
946 | b, xpGPR(xp, b), |
---|
947 | c, xpGPR(xp, c), |
---|
948 | d, xpGPR(xp, d)); |
---|
949 | } |
---|
950 | fprintf(dbgout, "\n PC = 0x%08X LR = 0x%08X CTR = 0x%08X CCR = 0x%08X\n", |
---|
951 | xpPC(xp), xpLR(xp), xpCTR(xp), xpCCR(xp)); |
---|
952 | fprintf(dbgout, "XER = 0x%08X MSR = 0x%08X DAR = 0x%08X DSISR = 0x%08X\n", |
---|
953 | xpXER(xp), xpMSR(xp), xpDAR(xp), xpDSISR(xp)); |
---|
954 | #endif |
---|
955 | #endif |
---|
956 | |
---|
957 | #ifdef X8664 |
---|
958 | fprintf(dbgout,"%%rax = 0x" ZLISP " %%r8 = 0x" ZLISP "\n", xpGPR(xp,REG_RAX),xpGPR(xp,REG_R8)); |
---|
959 | fprintf(dbgout,"%%rcx = 0x" ZLISP " %%r9 = 0x" ZLISP "\n", xpGPR(xp,REG_RCX),xpGPR(xp,REG_R9)); |
---|
960 | fprintf(dbgout,"%%rdx = 0x" ZLISP " %%r10 = 0x" ZLISP "\n", xpGPR(xp,REG_RDX),xpGPR(xp,REG_R10)); |
---|
961 | fprintf(dbgout,"%%rbx = 0x" ZLISP " %%r11 = 0x" ZLISP "\n", xpGPR(xp,REG_RBX),xpGPR(xp,REG_R11)); |
---|
962 | fprintf(dbgout,"%%rsp = 0x" ZLISP " %%r12 = 0x" ZLISP "\n", xpGPR(xp,REG_RSP),xpGPR(xp,REG_R12)); |
---|
963 | fprintf(dbgout,"%%rbp = 0x" ZLISP " %%r13 = 0x" ZLISP "\n", xpGPR(xp,REG_RBP),xpGPR(xp,REG_R13)); |
---|
964 | fprintf(dbgout,"%%rsi = 0x" ZLISP " %%r14 = 0x" ZLISP "\n", xpGPR(xp,REG_RSI),xpGPR(xp,REG_R14)); |
---|
965 | fprintf(dbgout,"%%rdi = 0x" ZLISP " %%r15 = 0x" ZLISP "\n", xpGPR(xp,REG_RDI),xpGPR(xp,REG_R15)); |
---|
966 | fprintf(dbgout,"%%rip = 0x" ZLISP " %%rflags = 0x%08lx\n", |
---|
967 | xpGPR(xp, Iip), eflags_register(xp)); |
---|
968 | #endif |
---|
969 | |
---|
970 | #ifdef X8632 |
---|
971 | unsigned short rcs,rds,res,rfs,rgs,rss; |
---|
972 | #ifdef DARWIN |
---|
973 | rcs = xp->uc_mcontext->__ss.__cs; |
---|
974 | rds = xp->uc_mcontext->__ss.__ds; |
---|
975 | res = xp->uc_mcontext->__ss.__es; |
---|
976 | rfs = xp->uc_mcontext->__ss.__fs; |
---|
977 | rgs = xp->uc_mcontext->__ss.__gs; |
---|
978 | rss = xp->uc_mcontext->__ss.__ss; |
---|
979 | #define DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
980 | #endif |
---|
981 | #ifdef LINUX |
---|
982 | rcs = xp->uc_mcontext.gregs[REG_CS]; |
---|
983 | rds = xp->uc_mcontext.gregs[REG_DS]; |
---|
984 | res = xp->uc_mcontext.gregs[REG_ES]; |
---|
985 | rfs = xp->uc_mcontext.gregs[REG_FS]; |
---|
986 | rgs = xp->uc_mcontext.gregs[REG_GS]; |
---|
987 | rss = xp->uc_mcontext.gregs[REG_SS]; |
---|
988 | #define DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
989 | #endif |
---|
990 | #ifdef FREEBSD |
---|
991 | rcs = xp->uc_mcontext.mc_cs; |
---|
992 | rds = xp->uc_mcontext.mc_ds; |
---|
993 | res = xp->uc_mcontext.mc_es; |
---|
994 | rfs = xp->uc_mcontext.mc_fs; |
---|
995 | rgs = xp->uc_mcontext.mc_gs; |
---|
996 | rss = xp->uc_mcontext.mc_ss; |
---|
997 | #define DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
998 | #endif |
---|
999 | #ifdef SOLARIS |
---|
1000 | rcs = xp->uc_mcontext.gregs[CS]; |
---|
1001 | rds = xp->uc_mcontext.gregs[DS]; |
---|
1002 | res = xp->uc_mcontext.gregs[ES]; |
---|
1003 | rfs = xp->uc_mcontext.gregs[FS]; |
---|
1004 | rgs = xp->uc_mcontext.gregs[GS]; |
---|
1005 | rss = xp->uc_mcontext.gregs[SS]; |
---|
1006 | #define DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
1007 | #endif |
---|
1008 | #ifdef WINDOWS |
---|
1009 | rcs = xp->SegCs; |
---|
1010 | rds = xp->SegDs; |
---|
1011 | res = xp->SegEs; |
---|
1012 | rfs = xp->SegFs; |
---|
1013 | rgs = xp->SegGs; |
---|
1014 | rss = xp->SegSs; |
---|
1015 | #define DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
1016 | #endif |
---|
1017 | |
---|
1018 | |
---|
1019 | |
---|
1020 | fprintf(dbgout, "%%eax = 0x" ZLISP "\n", xpGPR(xp, REG_EAX)); |
---|
1021 | fprintf(dbgout, "%%ecx = 0x" ZLISP "\n", xpGPR(xp, REG_ECX)); |
---|
1022 | fprintf(dbgout, "%%edx = 0x" ZLISP "\n", xpGPR(xp, REG_EDX)); |
---|
1023 | fprintf(dbgout, "%%ebx = 0x" ZLISP "\n", xpGPR(xp, REG_EBX)); |
---|
1024 | fprintf(dbgout, "%%esp = 0x" ZLISP "\n", xpGPR(xp, REG_ESP)); |
---|
1025 | fprintf(dbgout, "%%ebp = 0x" ZLISP "\n", xpGPR(xp, REG_EBP)); |
---|
1026 | fprintf(dbgout, "%%esi = 0x" ZLISP "\n", xpGPR(xp, REG_ESI)); |
---|
1027 | fprintf(dbgout, "%%edi = 0x" ZLISP "\n", xpGPR(xp, REG_EDI)); |
---|
1028 | fprintf(dbgout, "%%eip = 0x" ZLISP "\n", xpGPR(xp, REG_EIP)); |
---|
1029 | fprintf(dbgout, "%%eflags = 0x" ZLISP "\n", xpGPR(xp, REG_EFL)); |
---|
1030 | #ifdef DEBUG_SHOW_X86_SEGMENT_REGISTERS |
---|
1031 | fprintf(dbgout,"\n"); |
---|
1032 | fprintf(dbgout, "%%cs = 0x%04x\n", rcs); |
---|
1033 | fprintf(dbgout, "%%ds = 0x%04x\n", rds); |
---|
1034 | fprintf(dbgout, "%%ss = 0x%04x\n", rss); |
---|
1035 | fprintf(dbgout, "%%es = 0x%04x\n", res); |
---|
1036 | fprintf(dbgout, "%%fs = 0x%04x\n", rfs); |
---|
1037 | fprintf(dbgout, "%%gs = 0x%04x\n", rgs); |
---|
1038 | |
---|
1039 | #endif |
---|
1040 | |
---|
1041 | #endif |
---|
1042 | |
---|
1043 | #ifdef ARM |
---|
1044 | int a, b; |
---|
1045 | for (a = 0, b = 8; a < 8; a++, b++) { |
---|
1046 | fprintf(dbgout,"r%02d = 0x%08lX r%02d = 0x%08lX\n", |
---|
1047 | a, xpGPR(xp, a), |
---|
1048 | b, xpGPR(xp, b)); |
---|
1049 | } |
---|
1050 | #endif |
---|
1051 | |
---|
1052 | return debug_continue; |
---|
1053 | } |
---|
1054 | |
---|
1055 | debug_command_return |
---|
1056 | debug_show_fpu(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
1057 | { |
---|
1058 | double *dp; |
---|
1059 | int *np, i; |
---|
1060 | #ifdef PPC |
---|
1061 | dp = xpFPRvector(xp); |
---|
1062 | np = (int *) dp; |
---|
1063 | |
---|
1064 | for (i = 0; i < 32; i++, np+=2) { |
---|
1065 | fprintf(dbgout, "f%02d : 0x%08X%08X (%f)\n", i, np[0], np[1], *dp++); |
---|
1066 | } |
---|
1067 | fprintf(dbgout, "FPSCR = %08X\n", xpFPSCR(xp)); |
---|
1068 | #endif |
---|
1069 | #ifdef X8664 |
---|
1070 | #ifdef LINUX |
---|
1071 | struct _libc_xmmreg * xmmp = NULL; |
---|
1072 | #endif |
---|
1073 | #ifdef DARWIN |
---|
1074 | struct xmm { |
---|
1075 | char fpdata[16]; |
---|
1076 | }; |
---|
1077 | struct xmm *xmmp = (struct xmm *)(xpFPRvector(xp)); |
---|
1078 | #endif |
---|
1079 | #ifdef WINDOWS |
---|
1080 | struct xmm { |
---|
1081 | char fpdata[16]; |
---|
1082 | }; |
---|
1083 | struct xmm *xmmp; /* XXX: actually get them */ |
---|
1084 | #endif |
---|
1085 | #ifdef FREEBSD |
---|
1086 | struct xmmacc *xmmp = xpXMMregs(xp); |
---|
1087 | #endif |
---|
1088 | #ifdef SOLARIS |
---|
1089 | upad128_t *xmmp = xpXMMregs(xp); |
---|
1090 | #endif |
---|
1091 | float *sp; |
---|
1092 | |
---|
1093 | #ifdef LINUX |
---|
1094 | if (xp->uc_mcontext.fpregs) |
---|
1095 | xmmp = &(xp->uc_mcontext.fpregs->_xmm[0]); |
---|
1096 | else |
---|
1097 | /* no fp state, apparently */ |
---|
1098 | return debug_continue; |
---|
1099 | #endif |
---|
1100 | |
---|
1101 | for (i = 0; i < 16; i++, xmmp++) { |
---|
1102 | sp = (float *) xmmp; |
---|
1103 | dp = (double *) xmmp; |
---|
1104 | np = (int *) xmmp; |
---|
1105 | fprintf(dbgout, "f%02d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np, (double)(*sp), np[1], np[0], *dp); |
---|
1106 | } |
---|
1107 | fprintf(dbgout, "mxcsr = 0x%08x\n", |
---|
1108 | #ifdef LINUX |
---|
1109 | xp->uc_mcontext.fpregs->mxcsr |
---|
1110 | #endif |
---|
1111 | #ifdef DARWIN |
---|
1112 | UC_MCONTEXT(xp)->__fs.__fpu_mxcsr |
---|
1113 | #endif |
---|
1114 | #ifdef FREEBSD |
---|
1115 | (((struct savefpu *)(&(xp)->uc_mcontext.mc_fpstate))->sv_env.en_mxcsr) |
---|
1116 | #endif |
---|
1117 | #ifdef SOLARIS |
---|
1118 | xp->uc_mcontext.fpregs.fp_reg_set.fpchip_state.xstatus |
---|
1119 | #endif |
---|
1120 | #ifdef WINDOWS |
---|
1121 | *(xpMXCSRptr(xp)) |
---|
1122 | #endif |
---|
1123 | ); |
---|
1124 | #endif |
---|
1125 | #ifdef X8632 |
---|
1126 | #ifdef DARWIN |
---|
1127 | struct xmm { |
---|
1128 | char fpdata[8]; |
---|
1129 | }; |
---|
1130 | struct xmm *xmmp = (struct xmm *)(xpFPRvector(xp)); |
---|
1131 | |
---|
1132 | for (i = 0; i < 8; i++, xmmp++) { |
---|
1133 | float *sp = (float *)xmmp; |
---|
1134 | dp = (double *)xmmp; |
---|
1135 | np = (int *)xmmp; |
---|
1136 | fprintf(dbgout, "f%1d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np, |
---|
1137 | (double)(*sp), np[1], np[0], *dp); |
---|
1138 | } |
---|
1139 | fprintf(dbgout, "mxcsr = 0x%08x\n", UC_MCONTEXT(xp)->__fs.__fpu_mxcsr); |
---|
1140 | #endif |
---|
1141 | #endif |
---|
1142 | |
---|
1143 | return debug_continue; |
---|
1144 | } |
---|
1145 | |
---|
1146 | debug_command_return |
---|
1147 | debug_kill_process(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
1148 | return debug_kill; |
---|
1149 | } |
---|
1150 | |
---|
1151 | debug_command_return |
---|
1152 | debug_win(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
1153 | return debug_exit_success; |
---|
1154 | } |
---|
1155 | |
---|
1156 | debug_command_return |
---|
1157 | debug_lose(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
1158 | return debug_exit_fail; |
---|
1159 | } |
---|
1160 | |
---|
1161 | debug_command_return |
---|
1162 | debug_help(ExceptionInformation *xp, siginfo_t *info, int arg) { |
---|
1163 | debug_command_entry *entry; |
---|
1164 | |
---|
1165 | for (entry = debug_command_entries; entry->f; entry++) { |
---|
1166 | /* If we have an XP or don't need one, call the function */ |
---|
1167 | if (xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) { |
---|
1168 | fprintf(dbgout, "(%c) %s\n", entry->c, entry->help_text); |
---|
1169 | } |
---|
1170 | } |
---|
1171 | return debug_continue; |
---|
1172 | } |
---|
1173 | |
---|
1174 | |
---|
1175 | |
---|
1176 | |
---|
1177 | debug_command_return |
---|
1178 | debug_backtrace(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
1179 | { |
---|
1180 | extern LispObj current_stack_pointer(); |
---|
1181 | extern void plbt_sp(LispObj); |
---|
1182 | extern void plbt(ExceptionInformation *); |
---|
1183 | |
---|
1184 | if (xp) { |
---|
1185 | plbt(xp); |
---|
1186 | #ifndef X86 |
---|
1187 | } else { |
---|
1188 | plbt_sp(current_stack_pointer()); |
---|
1189 | #endif |
---|
1190 | } |
---|
1191 | return debug_continue; |
---|
1192 | } |
---|
1193 | |
---|
1194 | debug_command_return |
---|
1195 | debug_thread_reset(ExceptionInformation *xp, siginfo_t *info, int arg) |
---|
1196 | { |
---|
1197 | reset_lisp_process(xp); |
---|
1198 | return debug_exit_success; |
---|
1199 | } |
---|
1200 | |
---|
1201 | |
---|
1202 | debug_command_entry debug_command_entries[] = |
---|
1203 | { |
---|
1204 | {debug_set_gpr, |
---|
1205 | "Set specified GPR to new value", |
---|
1206 | DEBUG_COMMAND_FLAG_AUX_REGNO, |
---|
1207 | "GPR to set (0-31) ?", |
---|
1208 | 'G'}, |
---|
1209 | #ifndef X86 |
---|
1210 | {debug_advance_pc, |
---|
1211 | "Advance the program counter by one instruction (use with caution!)", |
---|
1212 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY, |
---|
1213 | NULL, |
---|
1214 | 'A'}, |
---|
1215 | {debug_identify_exception, |
---|
1216 | "Describe the current exception in greater detail", |
---|
1217 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY | |
---|
1218 | DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG, |
---|
1219 | NULL, |
---|
1220 | 'D'}, |
---|
1221 | #endif |
---|
1222 | {debug_show_registers, |
---|
1223 | "Show raw GPR/SPR register values", |
---|
1224 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
1225 | NULL, |
---|
1226 | 'R'}, |
---|
1227 | {debug_lisp_registers, |
---|
1228 | "Show Lisp values of tagged registers", |
---|
1229 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
1230 | NULL, |
---|
1231 | 'L'}, |
---|
1232 | {debug_show_fpu, |
---|
1233 | "Show FPU registers", |
---|
1234 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
1235 | NULL, |
---|
1236 | 'F'}, |
---|
1237 | {debug_show_symbol, |
---|
1238 | "Find and describe symbol matching specified name", |
---|
1239 | 0, |
---|
1240 | NULL, |
---|
1241 | 'S'}, |
---|
1242 | {debug_backtrace, |
---|
1243 | "Show backtrace", |
---|
1244 | 0, |
---|
1245 | NULL, |
---|
1246 | 'B'}, |
---|
1247 | {debug_thread_info, |
---|
1248 | "Show info about current thread", |
---|
1249 | 0, |
---|
1250 | NULL, |
---|
1251 | 'T'}, |
---|
1252 | {debug_memory_areas, |
---|
1253 | "Show memory areas", |
---|
1254 | 0, |
---|
1255 | NULL, |
---|
1256 | 'M'}, |
---|
1257 | {debug_win, |
---|
1258 | "Exit from this debugger, asserting that any exception was handled", |
---|
1259 | 0, |
---|
1260 | NULL, |
---|
1261 | 'X'}, |
---|
1262 | #ifdef DARWIN |
---|
1263 | {debug_lose, |
---|
1264 | "Propagate the exception to another handler (debugger or OS)", |
---|
1265 | DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY, |
---|
1266 | NULL, |
---|
1267 | 'P'}, |
---|
1268 | #endif |
---|
1269 | #if 0 |
---|
1270 | {debug_thread_reset, |
---|
1271 | "Reset current thread (as if in response to stack overflow)", |
---|
1272 | DEBUG_COMMAND_FLAG_REQUIRE_XP, |
---|
1273 | NULL, |
---|
1274 | 'T'}, |
---|
1275 | #endif |
---|
1276 | {debug_kill_process, |
---|
1277 | "Kill Clozure CL process", |
---|
1278 | 0, |
---|
1279 | NULL, |
---|
1280 | 'K'}, |
---|
1281 | {debug_show_lisp_version, |
---|
1282 | "Show Subversion revision information", |
---|
1283 | 0, |
---|
1284 | NULL, |
---|
1285 | 'V'}, |
---|
1286 | {debug_help, |
---|
1287 | "Show this help", |
---|
1288 | 0, |
---|
1289 | NULL, |
---|
1290 | '?'}, |
---|
1291 | /* end-of-table */ |
---|
1292 | {NULL, |
---|
1293 | NULL, |
---|
1294 | 0, |
---|
1295 | NULL, |
---|
1296 | 0} |
---|
1297 | }; |
---|
1298 | |
---|
1299 | debug_command_return |
---|
1300 | apply_debug_command(ExceptionInformation *xp, int c, siginfo_t *info, int why) |
---|
1301 | { |
---|
1302 | if (c == EOF) { |
---|
1303 | return debug_kill; |
---|
1304 | } else { |
---|
1305 | debug_command_entry *entry; |
---|
1306 | debug_command f; |
---|
1307 | c = toupper(c); |
---|
1308 | |
---|
1309 | for (entry = debug_command_entries; (f = entry->f) != NULL; entry++) { |
---|
1310 | if (toupper(entry->c) == c) { |
---|
1311 | /* If we have an XP or don't need one, call the function */ |
---|
1312 | if ((xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) && |
---|
1313 | ((why > debug_entry_exception) || |
---|
1314 | !(entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY))) { |
---|
1315 | int arg = 0; |
---|
1316 | if ((entry->flags & DEBUG_COMMAND_REG_FLAGS) |
---|
1317 | == DEBUG_COMMAND_FLAG_AUX_REGNO) { |
---|
1318 | arg = debug_get_u5_value("register number"); |
---|
1319 | } |
---|
1320 | if (entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG) { |
---|
1321 | arg = why; |
---|
1322 | } |
---|
1323 | return (f)(xp, info, arg); |
---|
1324 | } |
---|
1325 | break; |
---|
1326 | } |
---|
1327 | } |
---|
1328 | return debug_continue; |
---|
1329 | } |
---|
1330 | } |
---|
1331 | |
---|
1332 | void |
---|
1333 | debug_identify_function(ExceptionInformation *xp, siginfo_t *info) |
---|
1334 | { |
---|
1335 | #ifdef PPC |
---|
1336 | if (xp) { |
---|
1337 | if (active_tcr_p((TCR *)(ptr_from_lispobj(xpGPR(xp, rcontext))))) { |
---|
1338 | LispObj f = xpGPR(xp, fn), codev; |
---|
1339 | pc where = xpPC(xp); |
---|
1340 | |
---|
1341 | if (!(codev = register_codevector_contains_pc(f, where))) { |
---|
1342 | f = xpGPR(xp, nfn); |
---|
1343 | codev = register_codevector_contains_pc(f, where); |
---|
1344 | } |
---|
1345 | if (codev) { |
---|
1346 | fprintf(dbgout, " While executing: %s\n", print_lisp_object(f)); |
---|
1347 | } |
---|
1348 | } else { |
---|
1349 | int disp; |
---|
1350 | char *foreign_name; |
---|
1351 | natural where = (natural)xpPC(xp); |
---|
1352 | |
---|
1353 | fprintf(dbgout, " In foreign code at address 0x" ZLISP "\n", where); |
---|
1354 | foreign_name = foreign_name_and_offset(where, &disp); |
---|
1355 | if (foreign_name) { |
---|
1356 | fprintf(dbgout, " [%s + %d]\n", foreign_name, disp); |
---|
1357 | } |
---|
1358 | } |
---|
1359 | } |
---|
1360 | #endif |
---|
1361 | } |
---|
1362 | |
---|
1363 | #ifndef WINDOWS |
---|
1364 | extern pid_t main_thread_pid; |
---|
1365 | #endif |
---|
1366 | |
---|
1367 | |
---|
1368 | OSStatus |
---|
1369 | lisp_Debugger(ExceptionInformation *xp, |
---|
1370 | siginfo_t *info, |
---|
1371 | int why, |
---|
1372 | Boolean in_foreign_code, |
---|
1373 | char *message, |
---|
1374 | ...) |
---|
1375 | { |
---|
1376 | va_list args; |
---|
1377 | debug_command_return state = debug_continue; |
---|
1378 | |
---|
1379 | |
---|
1380 | if (stdin_is_dev_null()) { |
---|
1381 | return -1; |
---|
1382 | } |
---|
1383 | |
---|
1384 | va_start(args,message); |
---|
1385 | vfprintf(dbgout, message, args); |
---|
1386 | fprintf(dbgout, "\n"); |
---|
1387 | va_end(args); |
---|
1388 | |
---|
1389 | if (threads_initialized) { |
---|
1390 | suspend_other_threads(false); |
---|
1391 | } |
---|
1392 | |
---|
1393 | lisp_debugger_in_foreign_code = in_foreign_code; |
---|
1394 | if (in_foreign_code) { |
---|
1395 | char *foreign_name; |
---|
1396 | int disp; |
---|
1397 | fprintf(dbgout, "Exception occurred while executing foreign code\n"); |
---|
1398 | foreign_name = foreign_name_and_offset((natural)xpPC(xp), &disp); |
---|
1399 | if (foreign_name) { |
---|
1400 | fprintf(dbgout, " at %s + %d\n", foreign_name, disp); |
---|
1401 | } |
---|
1402 | } |
---|
1403 | |
---|
1404 | if (xp) { |
---|
1405 | if (why > debug_entry_exception) { |
---|
1406 | debug_identify_exception(xp, info, why); |
---|
1407 | } |
---|
1408 | debug_identify_function(xp, info); |
---|
1409 | } |
---|
1410 | if (lisp_global(BATCH_FLAG)) { |
---|
1411 | #ifdef WINDOWS |
---|
1412 | fprintf(dbgout, "Current Process Id %d\n", (int)GetCurrentProcessId()); |
---|
1413 | #else |
---|
1414 | fprintf(dbgout, "Main thread pid %d\n", main_thread_pid); |
---|
1415 | #endif |
---|
1416 | debug_thread_info(xp, info, 0); |
---|
1417 | if (xp) { |
---|
1418 | debug_show_registers(xp, info, 0); |
---|
1419 | debug_lisp_registers(xp, info, 0); |
---|
1420 | debug_show_fpu(xp, info, 0); |
---|
1421 | } |
---|
1422 | debug_memory_areas(xp, info, 0); |
---|
1423 | debug_show_lisp_version(xp, info, 0); |
---|
1424 | debug_backtrace(xp, info, 0); |
---|
1425 | abort(); |
---|
1426 | } |
---|
1427 | |
---|
1428 | fprintf(dbgout, "? for help\n"); |
---|
1429 | while (state == debug_continue) { |
---|
1430 | #ifdef WINDOWS |
---|
1431 | fprintf(dbgout, "[%d] Clozure CL kernel debugger: ", (int)GetCurrentProcessId()); |
---|
1432 | #else |
---|
1433 | fprintf(dbgout, "[%d] Clozure CL kernel debugger: ", main_thread_pid); |
---|
1434 | #endif |
---|
1435 | fflush(dbgout); /* dbgout should be unbuffered, so this shouldn't be necessary. But it can't hurt ... */ |
---|
1436 | state = apply_debug_command(xp, readc(), info, why); |
---|
1437 | } |
---|
1438 | switch (state) { |
---|
1439 | case debug_exit_success: |
---|
1440 | if (threads_initialized) { |
---|
1441 | resume_other_threads(false); |
---|
1442 | } |
---|
1443 | return 0; |
---|
1444 | case debug_exit_fail: |
---|
1445 | if (threads_initialized) { |
---|
1446 | resume_other_threads(false); |
---|
1447 | } |
---|
1448 | return -1; |
---|
1449 | case debug_kill: |
---|
1450 | terminate_lisp(); |
---|
1451 | default: |
---|
1452 | return 0; |
---|
1453 | } |
---|
1454 | } |
---|
1455 | |
---|
1456 | void |
---|
1457 | Bug(ExceptionInformation *xp, const char *format, ...) |
---|
1458 | { |
---|
1459 | va_list args; |
---|
1460 | char s[512]; |
---|
1461 | |
---|
1462 | va_start(args, format); |
---|
1463 | vsnprintf(s, sizeof(s),format, args); |
---|
1464 | va_end(args); |
---|
1465 | lisp_Debugger(xp, NULL, debug_entry_bug, false, s); |
---|
1466 | |
---|
1467 | } |
---|
1468 | |
---|
1469 | void |
---|
1470 | FBug(ExceptionInformation *xp, const char *format, ...) |
---|
1471 | { |
---|
1472 | va_list args; |
---|
1473 | char s[512]; |
---|
1474 | |
---|
1475 | va_start(args, format); |
---|
1476 | vsnprintf(s, sizeof(s),format, args); |
---|
1477 | va_end(args); |
---|
1478 | lisp_Debugger(xp, NULL, debug_entry_bug, true, s); |
---|
1479 | } |
---|
1480 | |
---|
1481 | void |
---|
1482 | lisp_bug(char *string) |
---|
1483 | { |
---|
1484 | Bug(NULL, "Bug in Clozure CL system code:\n%s", string); |
---|
1485 | } |
---|
1486 | |
---|