File : s-tracon-ppc-lynx178.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S Y S T E M . T R A C E B A C K _ C O N T R O L --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 2012-2013, Free Software Foundation, Inc. --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 3, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- --
23 -- You should have received a copy of the GNU General Public License and --
24 -- a copy of the GCC Runtime Library Exception along with this program; --
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
26 -- <http://www.gnu.org/licenses/>. --
27 -- --
28 -- GNAT was originally developed by the GNAT team at New York University. --
29 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
30 -- --
31 ------------------------------------------------------------------------------
32
33 -- This is the System.Traceback_Control implementation for PPC/LynxOS-178.
34
35 with System.Address_To_Access_Conversions;
36
37 package body System.Traceback_Control is
38
39 package Addr is new System.Address_To_Access_Conversions (System.Address);
40
41 ---------------------------
42 -- Is_Topframe_Retaddr --
43 ---------------------------
44
45 function Is_Topframe_Retaddr (Retaddr : System.Address) return Boolean is
46
47 -- LynxOS-178 marks call-chain entry points with a return address
48 -- pointing to the first instruction of that entry point.
49
50 -- Subprogram'Address yields the address of a descriptor, the first
51 -- field of which contains the actual subprogram code-start address,
52 -- so we'll have to dereference.
53
54 procedure Process_Entry;
55 pragma Import (C, Process_Entry, "__start");
56
57 procedure Thread_Entry;
58 pragma Import (C, Thread_Entry, "__runnit");
59
60 begin
61
62 return Retaddr = Addr.To_Pointer (Process_Entry'Address).all
63 or else Retaddr = Addr.To_Pointer (Thread_Entry'Address).all
64
65 -- ??? We also have to stop the backtrace prematuraly upon hitting
66 -- a return address designating an unexpected region of the address
67 -- space, probably originating from a bogus backchain pointer or one
68 -- retrieved while trying to walk past a signal handler.
69
70 or else (Retaddr and 16#E0000000#) /= 0;
71 end Is_Topframe_Retaddr;
72
73 -----------------------------
74 -- Return_Address_Offset --
75 -----------------------------
76
77 function Return_Address_Offset return System.Address is
78 Return_Address_Slot_Offset : constant := 8;
79 -- Lynx178 obeys the AIX/XCOFF ABI where the return address slot is
80 -- located 4 bytes past the 4bytes back-link chain in a frame:
81
82 begin
83 return Return_Address_Slot_Offset;
84 end Return_Address_Offset;
85
86 end System.Traceback_Control;