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

Last change on this file since 11089 was 11089, checked in by gz, 13 years ago

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

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