source: branches/ia32/lisp-kernel/lisp-debug.c @ 8372

Last change on this file since 8372 was 8372, checked in by rme, 13 years ago

Merged changes 7685:8261 from branches/1.1/ccl.

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