source: branches/win64/lisp-kernel/lisp-debug.c @ 8802

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

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