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

Last change on this file since 10565 was 10565, checked in by gb, 12 years ago

Merge changes from branches/win64.

As well as the expected low-level exception/suspend/interrupt stuff,
these changes also include changes to [f]printf format strings. Note
that on win64, a 'long' is 32-bits wide, which complicates matters:

  • an address (viewed as an integer) or a natural-sized integer isn't

(portably) a long, and so can't be printed with %l.

  • an address (viewed as an integer) or a natural-sized integer isn't

(portably) a long long, and so can't be printed with %ll.

  • an address (viewed as an integer) or a natural-sized integer can be

portably printed with '%p', but implementations differ as to whether
or not '%p' prepends a gratuitous '0x' to the hex address. (Linux
does, other current platforms seem not to.)

The approach that seems to work is to cast arguments to natural, then
to u64_t, then use %ll. That approach probably isn't taken consistently
(yet), so some debugging information printed by the kernel may be
incorrect.

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