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

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