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

Last change on this file since 7017 was 7017, checked in by rme, 13 years ago

Changes for x8632.

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