source: trunk/source/lisp-kernel/lisp-debug.c @ 10100

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

Additions for Darwin/x8632.

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