source: release/1.9/source/lisp-kernel/plbt.c @ 16083

Last change on this file since 16083 was 15473, checked in by gb, 7 years ago

Ensure that darwin_sigreturn() is prototyped on platforms where it's
used.

Remove some remaining Mach-isms (notably the paging info stuff used
by GC-VERBOSE; just use getrusage()).

Make sure that the right headers are included in threads.h, to support
the remaining Mach-ism (use of Mach semaphores. Apple still doesn't
implement POSIX semaphores, though the functions have been prototyped
for several years now.)

This builds without warnings or errors on 10.8.1 with Xcode 4.4's
toolchain. It -may- address the problems described in ticket:1019.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.8 KB
Line 
1/*
2   Copyright (C) 2009 Clozure Associates
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of Clozure CL. 
5
6   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with Clozure CL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with Clozure CL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   Clozure CL is referenced in the preamble as the "LIBRARY."
13
14   The LLGPL is also available online at
15   http://opensource.franz.com/preamble.html
16*/
17
18#include "lispdcmd.h"
19#ifdef LINUX
20#define __USE_GNU 1
21#endif
22
23#ifndef WINDOWS
24#include <dlfcn.h>
25#endif
26
27
28extern Boolean lisp_frame_p(lisp_frame *);
29
30void
31print_lisp_frame(lisp_frame *frame)
32{
33  LispObj fun = frame->savefn, pc = frame->savelr;
34  int delta = 0;
35  Dl_info info;
36  char *spname;
37
38  if ((fun == 0) || (fun == fulltag_misc)) {
39    spname = "unknown ?";
40#ifndef STATIC
41    if (dladdr((void *)ptr_from_lispobj(pc), &info)) {
42      spname = (char *)(info.dli_sname);
43#ifdef DARWIN
44      if (spname[-1] != '_') {
45        --spname;
46      }
47#endif
48    }
49#endif
50#ifdef PPC64
51    Dprintf("(#x%016lX) #x%016lX : (subprimitive %s)", frame, pc, spname);
52#else
53    Dprintf("(#x%08X) #x%08X : (subprimitive %s)", frame, pc, spname);
54#endif
55  } else {
56    if ((fulltag_of(fun) != fulltag_misc) ||
57        (header_subtag(header_of(fun)) != subtag_function)) {
58#ifdef PPC64
59      Dprintf("(#x%016lX) #x%016lX : (not a function!)", frame, pc);
60#else
61      Dprintf("(#x%08X) #x%08X : (not a function!)", frame, pc);
62#endif
63    } else {
64      LispObj code_vector = deref(fun, 1);
65     
66      if ((pc >= (code_vector+misc_data_offset)) &&
67          (pc < ((code_vector+misc_data_offset)+(header_element_count(header_of(code_vector))<<2)))) {
68        delta = (pc - (code_vector+misc_data_offset));
69      }
70#ifdef PPC64
71      Dprintf("(#x%016lX) #x%016lX : %s + %d", frame, pc, print_lisp_object(fun), delta);
72#else
73      Dprintf("(#x%08X) #x%08X : %s + %d", frame, pc, print_lisp_object(fun), delta);
74#endif
75    }
76  }
77}
78
79
80void
81print_foreign_frame(void *frame)
82{
83#ifdef LINUX
84  natural pc = (natural) (((eabi_c_frame *)frame)->savelr);
85#endif
86#ifdef DARWIN
87  natural pc = (natural) (((c_frame *)frame)->savelr);
88#endif
89  Dl_info foreign_info;
90
91#ifndef STATIC
92  if (dladdr((void *)pc, &foreign_info)) {
93    Dprintf(
94#ifdef PPC64
95"(#x%016lx) #x%016lX : %s + %d"
96#else
97"(#x%08x) #x%08X : %s + %d"
98#endif
99, frame, pc, foreign_info.dli_sname,
100            pc-((long)foreign_info.dli_saddr));
101  } else {
102#endif
103    Dprintf(
104#ifdef PPC64
105"(#x%016X) #x%016X : foreign code (%s)"
106#else
107"(#x%08X) #x%08X : foreign code (%s)"
108#endif
109, frame, pc, "unknown");
110#ifndef STATIC
111  }
112#endif
113}
114
115
116/* Walk frames from "start" to "end".
117   Say whatever can be said about foreign frames and lisp frames.
118*/
119
120void
121walk_stack_frames(lisp_frame *start, lisp_frame *end) 
122{
123  lisp_frame *next;
124  Dprintf("\n");
125  while (start < end) {
126
127    if (lisp_frame_p(start)) {
128      print_lisp_frame(start);
129    } else {
130#ifdef DARWIN
131      print_foreign_frame((c_frame *)start);
132#else
133      print_foreign_frame((eabi_c_frame *)start);
134#endif
135    }
136   
137    next = start->backlink;
138    if (next == 0) {
139      next = end;
140    }
141    if (next < start) {
142      fprintf(dbgout, "Bad frame! (%x < %x)\n", next, start);
143      break;
144    }
145    start = next;
146  }
147}
148
149char *
150interrupt_level_description(TCR *tcr)
151{
152  signed_natural level = (signed_natural) TCR_INTERRUPT_LEVEL(tcr);
153  if (level < 0) {
154    if (tcr->interrupt_pending) {
155      return "disabled(pending)";
156    } else {
157      return "disabled";
158    }
159  } else {
160    return "enabled";
161  }
162}
163
164void
165walk_other_areas()
166{
167  TCR *start = (TCR *)get_tcr(true), *tcr = start->next;
168  area *a;
169  char *ilevel = interrupt_level_description(tcr);
170
171  while (tcr != start) {
172    a = tcr->cs_area;
173    Dprintf("\n\n TCR = 0x%lx, cstack area #x%lx,  native thread ID = 0x%lx, interrupts %s", tcr, a,  tcr->native_thread_id, ilevel);
174    walk_stack_frames((lisp_frame *) (a->active), (lisp_frame *) (a->high));
175    tcr = tcr->next;
176  }
177}
178
179void
180plbt_sp(LispObj currentSP)
181{
182  area *cs_area;
183 
184{
185    TCR *tcr = (TCR *)get_tcr(true);
186    char *ilevel = interrupt_level_description(tcr);
187    cs_area = tcr->cs_area;
188    if ((((LispObj) ptr_to_lispobj(cs_area->low)) > currentSP) ||
189        (((LispObj) ptr_to_lispobj(cs_area->high)) < currentSP)) {
190      Dprintf("\nStack pointer [#x%lX] in unknown area.", currentSP);
191    } else {
192      fprintf(dbgout, "current thread: tcr = 0x%lx, native thread ID = 0x%lx, interrupts %s\n", tcr, tcr->native_thread_id, ilevel);
193      walk_stack_frames((lisp_frame *) ptr_from_lispobj(currentSP), (lisp_frame *) (cs_area->high));
194      walk_other_areas();
195    }
196  } 
197}
198
199 
200void
201plbt(ExceptionInformation *xp)
202{
203  plbt_sp(xpGPR(xp, sp));
204}
205   
Note: See TracBrowser for help on using the repository browser.