source: trunk/source/lisp-kernel/xlbt.c @ 14484

Last change on this file since 14484 was 14484, checked in by rme, 10 years ago

When in batch mode, reset the signal action for SIGSEGV and SIGBUS
to the default before trying to print a backtrace in the lisp kernel
debugger. The idea is to avoid looping on "unhandled exception 11"
or whatever when trying to print out a trashed call stack.

Also print version information before the backtrace, so that we see
it if printing the backtrace fails.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.5 KB
Line 
1/*
2   Copyright (C) 2005-2009 Clozure Associates
3   This file is part of Clozure CL. 
4
5   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with Clozure CL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with Clozure CL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   Clozure CL 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 "lispdcmd.h"
18#include <stdio.h>
19#include <signal.h>
20
21
22
23void
24print_lisp_frame(lisp_frame *frame)
25{
26  LispObj pc = frame->tra, fun=0;
27  int delta = 0;
28
29  if (pc == lisp_global(RET1VALN)) {
30    pc = frame->xtra;
31  }
32#ifdef X8632
33  if (fulltag_of(pc) == fulltag_tra) {
34    if (*((unsigned char *)pc) == RECOVER_FN_OPCODE) {
35      natural n = *((natural *)(pc + 1));
36      fun = (LispObj)n;
37    }
38    if (fun && header_subtag(header_of(fun)) == subtag_function) {
39      delta = pc - fun;
40      Dprintf("(#x%08X) #x%08X : %s + %d", frame, pc, print_lisp_object(fun), delta);
41      return;
42    }
43  }
44  if (pc == 0) {
45    fun = ((xcf *)frame)->nominal_function;
46    Dprintf("(#x%08X) #x%08X : %s + ??", frame, pc, print_lisp_object(fun));
47    return;
48  }
49#else
50  if (tag_of(pc) == tag_tra) {
51    if ((*((unsigned short *)pc) == RECOVER_FN_FROM_RIP_WORD0) &&
52        (*((unsigned char *)(pc+2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
53      int sdisp = (*(int *) (pc+3));
54      fun = RECOVER_FN_FROM_RIP_LENGTH+pc+sdisp;
55    }
56    if (fulltag_of(fun) == fulltag_function) {
57      delta = pc - fun;
58      Dprintf("(#x%016lX) #x%016lX : %s + %d", frame, pc, print_lisp_object(fun), delta);
59      return;
60    }
61  }
62  if (pc == 0) {
63    fun = ((xcf *)frame)->nominal_function;
64    Dprintf("(#x%016lX) #x%016lX : %s + ??", frame, pc, print_lisp_object(fun));
65    return;
66  }
67#endif
68}
69
70Boolean
71lisp_frame_p(lisp_frame *f)
72{
73  LispObj ra;
74
75  if (f) {
76    ra = f->tra;
77    if (ra == lisp_global(RET1VALN)) {
78      ra = f->xtra;
79    }
80
81#ifdef X8632
82    if (fulltag_of(ra) == fulltag_tra) {
83#else
84    if (tag_of(ra) == tag_tra) {
85#endif
86      return true;
87    } else if ((ra == lisp_global(LEXPR_RETURN)) ||
88               (ra == lisp_global(LEXPR_RETURN1V))) {
89      return true;
90    } else if (ra == 0) {
91      return true;
92    }
93  }
94  return false;
95}
96
97void
98walk_stack_frames(lisp_frame *start, lisp_frame *end) 
99{
100  lisp_frame *next;
101  Dprintf("\n");
102  while (start < end) {
103
104    if (lisp_frame_p(start)) {
105      print_lisp_frame(start);
106    } else {
107      if (start->backlink) {
108        fprintf(dbgout, "Bogus frame %lx\n", start);
109      }
110      return;
111    }
112   
113    next = start->backlink;
114    if (next == 0) {
115      next = end;
116    }
117    if (next < start) {
118      fprintf(dbgout, "Bad frame! (%x < %x)\n", next, start);
119      break;
120    }
121    start = next;
122  }
123}
124
125char *
126interrupt_level_description(TCR *tcr)
127{
128  signed_natural level = (signed_natural) TCR_INTERRUPT_LEVEL(tcr);
129  if (level < 0) {
130    if (tcr->interrupt_pending) {
131      return "disabled(pending)";
132    } else {
133      return "disabled";
134    }
135  } else {
136    return "enabled";
137  }
138}
139
140void
141plbt_sp(LispObj current_fp)
142{
143  area *vs_area, *cs_area;
144  TCR *tcr = (TCR *)get_tcr(true);
145  char *ilevel = interrupt_level_description(tcr);
146
147  vs_area = tcr->vs_area;
148  cs_area = tcr->cs_area;
149  if ((((LispObj) ptr_to_lispobj(vs_area->low)) > current_fp) ||
150      (((LispObj) ptr_to_lispobj(vs_area->high)) < current_fp)) {
151    current_fp = (LispObj) (tcr->save_fp);
152  }
153  if ((((LispObj) ptr_to_lispobj(vs_area->low)) > current_fp) ||
154      (((LispObj) ptr_to_lispobj(vs_area->high)) < current_fp)) {
155    Dprintf("\nFrame pointer [#x" LISP "] in unknown area.", current_fp);
156  } else {
157    fprintf(dbgout, "current thread: tcr = 0x" LISP ", native thread ID = 0x" LISP ", interrupts %s\n", tcr, tcr->native_thread_id, ilevel);
158
159#ifndef WINDOWS
160    if (lisp_global(BATCH_FLAG)) {
161      /*
162       * In batch mode, we will be exiting.  Reset some signal actions
163       * to the default to avoid a loop of "Unhandled exception 11" or
164       * whatever if we try to print some call stack that is totally
165       * screwed up.  (Instead, we'll just die horribly and get it
166       * over with.)
167       */
168      signal(SIGBUS, SIG_DFL);
169      signal(SIGSEGV, SIG_DFL);
170    }
171#endif
172
173    walk_stack_frames((lisp_frame *) ptr_from_lispobj(current_fp), (lisp_frame *) (vs_area->high));
174    /*      walk_other_areas();*/
175  }
176}
177
178
179void
180plbt(ExceptionInformation *xp)
181{
182  plbt_sp(xpGPR(xp, Ifp));
183}
Note: See TracBrowser for help on using the repository browser.