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

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

lisp_Debugger() takes an extra Boolean "in foreign context" arg, rather
than trying to set a bit in the exception code (which might be negative.)

Add a (T)hread info command to kernel debugger.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 22.8 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
505debug_command_return
506debug_thread_info(ExceptionInformation *xp, siginfo_t *info, int arg)
507{
508  TCR * tcr = get_tcr(false);
509 
510  if (tcr) {
511    area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area;
512
513    fprintf(stderr, "Current Thread Context Record (tcr) = 0x%lx\n", tcr);
514    fprintf(stderr, "Control (C) stack area:  low = 0x%lx, high = 0x%lx\n",
515            cs_area->low, cs_area->high);
516    fprintf(stderr, "Value (lisp) stack area: low = 0x%lx, high = 0x%lx\n",
517            vs_area->low, vs_area->high);
518    if (xp) {
519      fprintf(stderr, "Exception stack pointer = 0x%lx\n",
520#ifdef PPC
521              xpGPR(xp,1)
522#endif
523#ifdef X86
524              xpGPR(xp,Isp)
525#endif
526              );
527    }
528  }
529  return debug_continue;
530}
531     
532
533debug_command_return
534debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg)
535{
536  char buf[32];
537  natural val;
538
539  sprintf(buf, "value for GPR %d", arg);
540  val = debug_get_natural_value(buf);
541  set_xpGPR(xp, arg, val);
542  return debug_continue;
543}
544
545
546debug_command_return
547debug_show_registers(ExceptionInformation *xp, siginfo_t *info, int arg)
548{
549  int a, b, c, d, i;
550
551#ifdef PPC
552#ifdef PPC64
553  for (a = 0, b = 16; a < 16; a++, b++) {
554    fprintf(stderr,"r%02d = 0x%016lX    r%02d = 0x%016lX\n",
555            a, xpGPR(xp, a),
556            b, xpGPR(xp, b));
557  }
558 
559  fprintf(stderr, "\n PC = 0x%016lX     LR = 0x%016lX\n",
560          xpPC(xp), xpLR(xp));
561  fprintf(stderr, "CTR = 0x%016lX    CCR = 0x%08X\n",
562          xpCTR(xp), xpCCR(xp));
563  fprintf(stderr, "XER = 0x%08X            MSR = 0x%016lX\n",
564          xpXER(xp), xpMSR(xp));
565  fprintf(stderr,"DAR = 0x%016lX  DSISR = 0x%08X\n",
566          xpDAR(xp), xpDSISR(xp));
567#else
568  for (a = 0, b = 8, c = 16, d = 24; a < 8; a++, b++, c++, d++) {
569    fprintf(stderr,"r%02d = 0x%08X  r%02d = 0x%08X  r%02d = 0x%08X  r%02d = 0x%08X\n",
570            a, xpGPR(xp, a),
571            b, xpGPR(xp, b),
572            c, xpGPR(xp, c),
573            d, xpGPR(xp, d));
574  }
575  fprintf(stderr, "\n PC = 0x%08X   LR = 0x%08X  CTR = 0x%08X  CCR = 0x%08X\n",
576          xpPC(xp), xpLR(xp), xpCTR(xp), xpCCR(xp));
577  fprintf(stderr, "XER = 0x%08X  MSR = 0x%08X  DAR = 0x%08X  DSISR = 0x%08X\n",
578          xpXER(xp), xpMSR(xp), xpDAR(xp), xpDSISR(xp));
579#endif
580#endif
581
582#ifdef X8664
583  fprintf(stderr,"%rax = 0x%016lX      %r8  = 0x%016lX\n", xpGPR(xp,REG_RAX),xpGPR(xp,REG_R8));
584  fprintf(stderr,"%rcx = 0x%016lX      %r9  = 0x%016lX\n", xpGPR(xp,REG_RCX),xpGPR(xp,REG_R9));
585  fprintf(stderr,"%rdx = 0x%016lX      %r10 = 0x%016lX\n", xpGPR(xp,REG_RDX),xpGPR(xp,REG_R10));
586  fprintf(stderr,"%rbx = 0x%016lX      %r11 = 0x%016lX\n", xpGPR(xp,REG_RBX),xpGPR(xp,REG_R11));
587  fprintf(stderr,"%rsp = 0x%016lX      %r12 = 0x%016lX\n", xpGPR(xp,REG_RSP),xpGPR(xp,REG_R12));
588  fprintf(stderr,"%rbp = 0x%016lX      %r13 = 0x%016lX\n", xpGPR(xp,REG_RBP),xpGPR(xp,REG_R13));
589  fprintf(stderr,"%rsi = 0x%016lX      %r14 = 0x%016lX\n", xpGPR(xp,REG_RSI),xpGPR(xp,REG_R14));
590  fprintf(stderr,"%rdi = 0x%016lX      %r15 = 0x%016lX\n", xpGPR(xp,REG_RDI),xpGPR(xp,REG_R15));
591  fprintf(stderr,"%rip = 0x%016lX   %rflags = 0x%016lX\n",
592          xpGPR(xp, Iip), xpGPR(xp, Iflags));
593#endif
594  return debug_continue;
595}
596
597debug_command_return
598debug_show_fpu(ExceptionInformation *xp, siginfo_t *info, int arg)
599{
600  double *dp;
601  int *np, i;
602#ifdef PPC
603  dp = xpFPRvector(xp);
604  np = (int *) dp;
605 
606  for (i = 0; i < 32; i++) {
607    fprintf(stderr, "f%02d : 0x%08X%08X (%f)\n", i,  *np++, *np++, *dp++);
608  }
609  fprintf(stderr, "FPSCR = %08X\n", xpFPSCR(xp));
610#endif
611#ifdef X8664
612#ifdef LINUX
613  struct _libc_xmmreg * xmmp = &(xp->uc_mcontext.fpregs->_xmm[0]);
614#endif
615#ifdef DARWIN
616  struct xmm {
617    char fpdata[16];
618  };
619  struct xmm *xmmp = (struct xmm *)(xpFPRvector(xp));
620#endif
621#ifdef FREEBSD
622  struct xmmacc *xmmp = xpXMMregs(xp);
623#endif
624  float *sp;
625
626
627  for (i = 0; i < 16; i++, xmmp++) {
628    sp = (float *) xmmp;
629    dp = (double *) xmmp;
630    np = (int *) xmmp;
631    fprintf(stderr, "f%02d: 0x%08x (%e), 0x%08x%08x (%e)\n", i, *np, (double)(*sp), np[1], np[0], *dp);
632  }
633  fprintf(stderr, "mxcsr = 0x%08x\n",
634#ifdef LINUX
635          xp->uc_mcontext.fpregs->mxcsr
636#endif
637#ifdef DARWIN
638          UC_MCONTEXT(xp)->__fs.__fpu_mxcsr
639#endif
640#ifdef FREEBSD
641          (((struct savefpu *)(&(xp)->uc_mcontext.mc_fpstate))->sv_env.en_mxcsr)
642#endif
643          );
644#endif 
645  return debug_continue;
646}
647
648debug_command_return
649debug_kill_process(ExceptionInformation *xp, siginfo_t *info, int arg) {
650  return debug_kill;
651}
652
653debug_command_return
654debug_win(ExceptionInformation *xp, siginfo_t *info, int arg) {
655  return debug_exit_success;
656}
657
658debug_command_return
659debug_lose(ExceptionInformation *xp, siginfo_t *info, int arg) {
660  return debug_exit_fail;
661}
662
663debug_command_return
664debug_help(ExceptionInformation *xp, siginfo_t *info, int arg) {
665  debug_command_entry *entry;
666
667  for (entry = debug_command_entries; entry->f; entry++) {
668    /* If we have an XP or don't need one, call the function */
669    if (xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) {
670      fprintf(stderr, "(%c)  %s\n", entry->c, entry->help_text);
671    }
672  }
673  return debug_continue;
674}
675             
676
677 
678
679debug_command_return
680debug_backtrace(ExceptionInformation *xp, siginfo_t *info, int arg)
681{
682  extern LispObj current_stack_pointer();
683  extern void plbt_sp(LispObj);
684  extern void plbt(ExceptionInformation *);
685
686  if (xp) {
687    plbt(xp);
688  } else {
689    plbt_sp(current_stack_pointer());
690  }
691  return debug_continue;
692}
693
694debug_command_return
695debug_thread_reset(ExceptionInformation *xp, siginfo_t *info, int arg)
696{
697  reset_lisp_process(xp);
698  return debug_exit_success;
699}
700
701
702debug_command_entry debug_command_entries[] = 
703{
704  {debug_set_gpr,
705   "Set specified GPR to new value",
706   DEBUG_COMMAND_FLAG_AUX_REGNO,
707   "GPR to set (0-31) ?",
708   'G'},
709#ifdef PPC
710  {debug_advance_pc,
711   "Advance the program counter by one instruction (use with caution!)",
712   DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY,
713   NULL,
714   'A'},
715  {debug_identify_exception,
716   "Describe the current exception in greater detail",
717   DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY |
718   DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG,
719   NULL,
720   'D'},
721#endif
722  {debug_show_registers, 
723   "Show raw GPR/SPR register values", 
724   DEBUG_COMMAND_FLAG_REQUIRE_XP,
725   NULL,
726   'R'},
727  {debug_lisp_registers,
728   "Show Lisp values of tagged registers",
729   DEBUG_COMMAND_FLAG_REQUIRE_XP,
730   NULL,
731   'L'},
732  {debug_show_fpu,
733   "Show FPU registers",
734   DEBUG_COMMAND_FLAG_REQUIRE_XP,
735   NULL,
736   'F'},
737  {debug_show_symbol,
738   "Find and describe symbol matching specified name",
739   0,
740   NULL,
741   'S'},
742  {debug_backtrace,
743   "Show backtrace",
744   0,
745   NULL,
746   'B'},
747  {debug_thread_info,
748   "Show info about current thread",
749   0,
750   NULL,
751   'T'},
752  {debug_win,
753   "Exit from this debugger, asserting that any exception was handled",
754   0,
755   NULL,
756   'X'},
757#ifdef DARWIN
758  {debug_lose,
759   "Propagate the exception to another handler (debugger or OS)",
760   DEBUG_COMMAND_FLAG_REQUIRE_XP | DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY,
761   NULL,
762   'P'},
763#endif
764#if 0
765  {debug_thread_reset,
766   "Reset current thread (as if in response to stack overflow)",
767   DEBUG_COMMAND_FLAG_REQUIRE_XP,
768   NULL,
769   'T'},
770#endif
771  {debug_kill_process,
772   "Kill OpenMCL process",
773   0,
774   NULL,
775   'K'},
776  {debug_help,
777   "Show this help",
778   0,
779   NULL,
780   '?'},
781  /* end-of-table */
782  {NULL,
783   NULL,
784   0,
785   NULL,
786   0}
787};
788
789debug_command_return
790apply_debug_command(ExceptionInformation *xp, int c, siginfo_t *info, int why) 
791{
792  if (c == EOF) {
793    return debug_kill;
794  } else {
795    debug_command_entry *entry;
796    debug_command f;
797    c = toupper(c);
798
799    for (entry = debug_command_entries; f = entry->f; entry++) {
800      if (toupper(entry->c) == c) {
801        /* If we have an XP or don't need one, call the function */
802        if ((xp || !(entry->flags & DEBUG_COMMAND_FLAG_REQUIRE_XP)) &&
803            ((why > debug_entry_exception) || 
804             !(entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_ENTRY_ONLY))) {
805          int arg = 0;
806          if ((entry->flags & DEBUG_COMMAND_REG_FLAGS)
807              == DEBUG_COMMAND_FLAG_AUX_REGNO) {
808            arg = debug_get_u5_value("register number");
809          }
810          if (entry->flags & DEBUG_COMMAND_FLAG_EXCEPTION_REASON_ARG) {
811            arg = why;
812          }
813          return (f)(xp, info, arg);
814        }
815        break;
816      }
817    }
818    return debug_continue;
819  }
820}
821
822debug_identify_function(ExceptionInformation *xp, siginfo_t *info) 
823{
824#ifdef PPC
825  if (xp) {
826    if (active_tcr_p((TCR *)(ptr_from_lispobj(xpGPR(xp, rcontext))))) {
827      LispObj f = xpGPR(xp, fn), codev;
828      pc where = xpPC(xp);
829     
830      if (!(codev = register_codevector_contains_pc(f, where))) {
831        f = xpGPR(xp, nfn);
832        codev =  register_codevector_contains_pc(f, where);
833      }
834      if (codev) {
835        fprintf(stderr, " While executing: %s\n", print_lisp_object(f));
836      }
837    } else {
838      fprintf(stderr, " In foreign code at address 0x%08lx\n", xpPC(xp));
839    }
840  }
841#endif
842}
843
844extern pid_t main_thread_pid;
845
846OSStatus
847lisp_Debugger(ExceptionInformation *xp, 
848              siginfo_t *info, 
849              int why, 
850              Boolean in_foreign_code,
851              char *message, 
852              ...)
853{
854  va_list args;
855  debug_command_return state = debug_continue;
856
857  if (threads_initialized) {
858    suspend_other_threads(false);
859  }
860
861  va_start(args,message);
862  vfprintf(stderr, message, args);
863  fprintf(stderr, "\n");
864  va_end(args);
865  if (in_foreign_code) {
866    fprintf(stderr, "Exception occurred while executing foreign code\n");
867  }
868
869  if (lisp_global(BATCH_FLAG)) {
870    abort();
871  }
872  if (xp) {
873    if (why > debug_entry_exception) {
874      debug_identify_exception(xp, info, why);
875    }
876    debug_identify_function(xp, info);
877  }
878  fprintf(stderr, "? for help\n");
879  while (state == debug_continue) {
880    fprintf(stderr, "[%d] OpenMCL kernel debugger: ", main_thread_pid);
881    state = apply_debug_command(xp, readc(), info, why);
882  }
883  switch (state) {
884  case debug_exit_success:
885    if (threads_initialized) {
886      resume_other_threads(false);
887    }
888    return 0;
889  case debug_exit_fail:
890    if (threads_initialized) {
891      resume_other_threads(false);
892    }
893    return -1;
894  case debug_kill:
895    terminate_lisp();
896  }
897}
898
899void
900Bug(ExceptionInformation *xp, const char *format, ...)
901{
902  va_list args;
903  char s[512];
904 
905  va_start(args, format);
906  vsnprintf(s, sizeof(s),format, args);
907  va_end(args);
908  lisp_Debugger(xp, NULL, debug_entry_bug, false, s);
909
910}
911
912void
913FBug(ExceptionInformation *xp, const char *format, ...)
914{
915  va_list args;
916  char s[512];
917 
918  va_start(args, format);
919  vsnprintf(s, sizeof(s),format, args);
920  va_end(args);
921  lisp_Debugger(xp, NULL, debug_entry_bug, true, s);
922
923}
924
925void
926lisp_bug(char *string)
927{
928  Bug(NULL, "Bug in OpenMCL system code:\n%s", string);
929}
930
Note: See TracBrowser for help on using the repository browser.