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

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

Change Iregnames for x8632-Solaris (ESP vs UESP).

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