source: branches/ia32/lisp-kernel/lisp-debug.c @ 9145

Last change on this file since 9145 was 9145, checked in by rme, 12 years ago

Include lispdcmd.h for print_lisp_object prototype.

bit_for_regnum: new function

show_lisp_register: consult node_regs_mask when printing values of lisp regs

debug_lisp_registers, debug_show_registers, debug_show_fpu: additions for
32-bit x86

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