source: branches/working-0711/ccl/lisp-kernel/xlbt.c @ 9995

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

When trying to print lisp backtrace, if provided frame pointer is
out of range, use tcr.save_rbp instead.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1/*
2   Copyright (C) 2005 Clozure Associates
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 "lispdcmd.h"
18#include <stdio.h>
19
20
21
22void
23print_lisp_frame(lisp_frame *frame)
24{
25  LispObj pc = frame->tra, fun=0;
26  int delta = 0;
27
28  if (pc == lisp_global(RET1VALN)) {
29    pc = frame->xtra;
30  }
31  if (tag_of(pc) == tag_tra) {
32    if ((*((unsigned short *)pc) == RECOVER_FN_FROM_RIP_WORD0) &&
33        (*((unsigned char *)(pc+2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
34      int sdisp = (*(int *) (pc+3));
35      fun = RECOVER_FN_FROM_RIP_LENGTH+pc+sdisp;
36    }
37    if (fulltag_of(fun) == fulltag_function) {
38      delta = pc - fun;
39      Dprintf("(#x%016lX) #x%016lX : %s + %d", frame, pc, print_lisp_object(fun), delta);
40      return;
41    }
42  }
43  if (pc == 0) {
44    fun = ((xcf *)frame)->nominal_function;
45    Dprintf("(#x%016lX) #x%016lX : %s + ??", frame, pc, print_lisp_object(fun));
46    return;
47  }
48}
49
50Boolean
51lisp_frame_p(lisp_frame *f)
52{
53  LispObj ra;
54
55  if (f) {
56    ra = f->tra;
57    if (ra == lisp_global(RET1VALN)) {
58      ra = f->xtra;
59    }
60
61    if (tag_of(ra) == tag_tra) {
62      return true;
63    } else if ((ra == lisp_global(LEXPR_RETURN)) ||
64               (ra == lisp_global(LEXPR_RETURN1V))) {
65      return true;
66    } else if (ra == 0) {
67      return true;
68    }
69  }
70  return false;
71}
72
73void
74walk_stack_frames(lisp_frame *start, lisp_frame *end) 
75{
76  lisp_frame *next;
77  Dprintf("\n");
78  while (start < end) {
79
80    if (lisp_frame_p(start)) {
81      print_lisp_frame(start);
82    } else {
83      if (start->backlink) {
84        fprintf(stderr, "Bogus  frame %lx\n", start);
85      }
86      return;
87    }
88   
89    next = start->backlink;
90    if (next == 0) {
91      next = end;
92    }
93    if (next < start) {
94      fprintf(stderr, "Bad frame! (%x < %x)\n", next, start);
95      break;
96    }
97    start = next;
98  }
99}
100
101char *
102interrupt_level_description(TCR *tcr)
103{
104  signed_natural level = (signed_natural) TCR_INTERRUPT_LEVEL(tcr);
105  if (level < 0) {
106    if (tcr->interrupt_pending) {
107      return "disabled(pending)";
108    } else {
109      return "disabled";
110    }
111  } else {
112    return "enabled";
113  }
114}
115
116void
117plbt_sp(LispObj currentRBP)
118{
119  area *vs_area, *cs_area;
120 
121{
122    TCR *tcr = (TCR *)get_tcr(true);
123    char *ilevel = interrupt_level_description(tcr);
124    vs_area = tcr->vs_area;
125    cs_area = tcr->cs_area;
126    if ((((LispObj) ptr_to_lispobj(vs_area->low)) > currentRBP) ||
127        (((LispObj) ptr_to_lispobj(vs_area->high)) < currentRBP)) {
128      currentRBP = (LispObj) (tcr->save_rbp);
129    }
130    if ((((LispObj) ptr_to_lispobj(vs_area->low)) > currentRBP) ||
131        (((LispObj) ptr_to_lispobj(vs_area->high)) < currentRBP)) {
132      Dprintf("\nFramepointer [#x%lX] in unknown area.", currentRBP);
133    } else {
134      fprintf(stderr, "current thread: tcr = 0x%lx, native thread ID = 0x%lx, interrupts %s\n", tcr, tcr->native_thread_id, ilevel);
135      walk_stack_frames((lisp_frame *) ptr_from_lispobj(currentRBP), (lisp_frame *) (vs_area->high));
136      /*      walk_other_areas();*/
137    }
138  } 
139}
140
141
142void
143plbt(ExceptionInformation *xp)
144{
145  plbt_sp(xpGPR(xp,Irbp));
146}
Note: See TracBrowser for help on using the repository browser.