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

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

Use %llx when printing x8664 registers.

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