File : s-traceb-zfp-ppc.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S Y S T E M . T R A C E B A C K --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is the bare board version of this package for PPC targets
33
34 with Ada.Unchecked_Conversion;
35
36 with System.Machine_Code; use System.Machine_Code;
37
38 package body System.Traceback is
39
40 type Address_Ptr is access all System.Address;
41 function To_Pointer is new
42 Ada.Unchecked_Conversion (System.Address, Address_Ptr);
43
44 procedure Call_Chain
45 (Frame_Pointer : System.Address;
46 Traceback : in out System.Traceback_Entries.Tracebacks_Array;
47 Len : out Natural;
48 Exclude_Min : System.Address := System.Null_Address;
49 Exclude_Max : System.Address := System.Null_Address;
50 Skip_Frames : Natural := 0)
51 is
52 Return_Address_Offset : constant System.Address := 4;
53 pragma Assert (Return_Address_Offset mod System.Address'Alignment = 0);
54 -- Offset in bytes where return address of current frame stored,
55 -- relative to current frame. This value is required to be a multiple
56 -- of the ppc instruction size (4).
57
58 PC_Adjust : constant := 4;
59 -- Size of call instruction to subtract from return address to get the
60 -- PC for the calling frame.
61
62 Frame : System.Address := Frame_Pointer;
63 -- Frame being processed
64
65 Index : Natural := Traceback'First;
66 -- Index of next item to store in Traceback
67
68 begin
69 Len := 0;
70
71 -- Set to correct frame location, with correct return address
72
73 -- Exclude Skip_Frames frames from the traceback. The PPC ABI has
74 -- (System.Null_Address) as the back pointer address of the shallowest
75 -- frame in the stack.
76
77 for J in 1 .. Skip_Frames loop
78 if Frame = System.Null_Address
79 or else Frame mod System.Address'Alignment /= 0
80 or else To_Pointer (Frame).all = System.Null_Address
81 then
82 -- Something is wrong. Skip_Frames is greater than the number of
83 -- frames on the current stack. Do not return a trace.
84
85 return;
86 end if;
87
88 Frame := To_Pointer (Frame).all;
89 end loop;
90
91 pragma Assert (Frame /= System.Null_Address);
92
93 while Frame mod System.Address'Alignment = 0
94 and then To_Pointer (Frame).all /= System.Null_Address
95 and then Len < Traceback'Length
96 loop
97 declare
98 PC : constant System.Address :=
99 To_Pointer (Frame + Return_Address_Offset).all - PC_Adjust;
100
101 begin
102 if PC not in Exclude_Min .. Exclude_Max then
103
104 -- Skip specified routines, if any (e.g. Ada.Exceptions)
105
106 Traceback (Index) := PC;
107 Len := Len + 1;
108 Index := Index + 1;
109 end if;
110
111 Frame := To_Pointer (Frame).all;
112 end;
113
114 pragma Assert (Frame /= System.Null_Address);
115 end loop;
116 end Call_Chain;
117
118 procedure Call_Chain
119 (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
120 Max_Len : Natural;
121 Len : out Natural;
122 Exclude_Min : System.Address := System.Null_Address;
123 Exclude_Max : System.Address := System.Null_Address;
124 Skip_Frames : Natural := 1)
125 is
126 procedure Forced_Callee;
127 -- Force save of return address of Call_Chain on PPC
128
129 -------------------
130 -- Forced_Callee --
131 -------------------
132
133 -- The PPC ABI has an unusual characteristic: the return address saved
134 -- by a subprogram is located in its caller's frame, and the save
135 -- operation only occurs if the function performs a call.
136
137 -- To make Call_Chain able to consistently retrieve its own return
138 -- address, we define Forced_Callee and call it. This routine should
139 -- never be inlined.
140
141 procedure Forced_Callee is
142 Dummy : aliased Integer := 0;
143 pragma Volatile (Dummy);
144 pragma Warnings (Off, Dummy);
145 -- Force allocation of a frame. Dummy must be both volatile and
146 -- referenced (achieved by declaring it aliased). Suppress warning
147 -- that it could be declared a constant, and that pragma Volatile
148 -- has no effect (it forces creation of the frame).
149 begin
150 null;
151 end Forced_Callee;
152
153 Frame_Pointer : System.Address;
154
155 begin
156 Forced_Callee;
157
158 -- Move contents of r1 (sp) to "Frame_Pointer"
159
160 Asm ("mr %0, 1",
161 Outputs => Address'Asm_Output ("=r", Frame_Pointer),
162 Volatile => True);
163 Call_Chain
164 (Frame_Pointer,
165 Traceback (Traceback'First .. Traceback'First + Max_Len - 1),
166 Len, Exclude_Min, Exclude_Max, Skip_Frames);
167 end Call_Chain;
168
169 ------------------
170 -- C_Call_Chain --
171 ------------------
172
173 function C_Call_Chain
174 (Frame_Pointer : System.Address;
175 Traceback : System.Address;
176 Traceback_Len : Integer) return Integer
177 is
178 subtype Tracebacks is System.Traceback_Entries.Tracebacks_Array
179 (1 .. Traceback_Len);
180 type Ptr is access all Tracebacks;
181 function To_Ptr is new Ada.Unchecked_Conversion (System.Address, Ptr);
182
183 Len : Integer;
184
185 begin
186 Call_Chain (Frame_Pointer, To_Ptr (Traceback).all, Len);
187 return Len;
188 end C_Call_Chain;
189
190 end System.Traceback;