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

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

Iregnames for ia32-Linux.

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