source: branches/working-0711/ccl/lisp-kernel/lisp-debug.c @ 9962

Last change on this file since 9962 was 9962, checked in by gb, 11 years ago

More WINDOWS nonsense.
Use dladdr() to report foreign addresses symbolically in some cases.
Ignore EIO errors.
Remove some unused variables.
Use %% when printing x8664 register names via fprintf.
Set a global if we were entered via exception in foreign code, keep
show_lisp_registers() from doing anything in that case. (Would
be even better to disable the menu option.)

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