source: trunk/ccl/lisp-kernel/lisp-debug.c @ 7282

Last change on this file since 7282 was 7282, checked in by gb, 13 years ago

Don't use sigaltstack on any x86-64 platform: even if it works, it makes
it harder to deal with exceptions in foreign code (we've often gotten
segfaults from running out of space on the alt stack, the mechanism
isn't reentrant, etc.)

Try to report cases where the kernel debugger is entered due to an
exception in foreign code. Todo: make it less tempting to use (L)
in that case, maybe try to make backtrace find saved_rbp from tcr on x86-64,
etc.

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