File : s-traceb-xi-armeabi.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 ARM EABI targets, using
33 -- unwind tables.
34
35 with Ada.Unchecked_Conversion;
36
37 package body System.Traceback is
38
39 use System.Traceback_Entries;
40
41 type Unwind_Reason_Code is
42 (URC_OK,
43 URC_FOREIGN_EXCEPTION_CAUGHT,
44 URC_END_OF_STACK,
45 URC_HANDLER_FOUND,
46 URC_INSTALL_CONTEXT,
47 URC_CONTINUE_UNWIND,
48 URC_FAILURE);
49 pragma Convention (C, Unwind_Reason_Code);
50 -- The _Unwind_Reason_Code enum defined by ARM EHABI document
51
52 pragma Unreferenced (URC_FOREIGN_EXCEPTION_CAUGHT,
53 URC_END_OF_STACK,
54 URC_HANDLER_FOUND,
55 URC_INSTALL_CONTEXT,
56 URC_CONTINUE_UNWIND);
57
58 type Unwind_Context_Type is null record;
59 type Unwind_Context_Acc is access Unwind_Context_Type;
60 pragma Convention (C, Unwind_Context_Acc);
61 -- Access to the opaque _Unwind_Context type
62
63 type Unwind_Trace_Fn is access
64 function (UC : Unwind_Context_Acc; Data : System.Address)
65 return Unwind_Reason_Code;
66 pragma Convention (C, Unwind_Trace_Fn);
67 -- The _Unwind_Trace_Fn function (used for the callback)
68
69 function Unwind_Backtrace
70 (Func : Unwind_Trace_Fn;
71 Data : System.Address) return Unwind_Reason_Code;
72 pragma Import (C, Unwind_Backtrace, "_Unwind_Backtrace");
73 -- The _Unwind_Backtrace function that calls Func with Data for each frame
74
75 function Unwind_VRS_Get
76 (UC : Unwind_Context_Acc;
77 Reg_Class : Integer;
78 Reg_Num : Integer;
79 Data_Rep : Integer;
80 Addr : System.Address) return Integer;
81 pragma Import (C, Unwind_VRS_Get, "_Unwind_VRS_Get");
82 -- The _Unwind_VRS_Get function to extract a register from the unwind
83 -- context UC.
84
85 UVRSR_OK : constant Integer := 0;
86 -- Success return status for Unwind_VRS_Get
87
88 UVRSC_CORE : constant Integer := 0;
89 -- Core register class for Unwind_VRS_Get
90
91 UVRSD_UINT32 : constant Integer := 0;
92 -- Unsigned int 32 data representation for Unwind_VRS_Get
93
94 type Tracebacks_Array_Ptr is access Tracebacks_Array (Positive);
95
96 type Callback_Params_Type is record
97 Tracebacks : Tracebacks_Array_Ptr;
98 Max_Len : Natural;
99 Len : Natural;
100 Exclude_Min : System.Address;
101 Exclude_Max : System.Address;
102 Skip_Frames : Natural;
103 end record;
104 -- This record contains the parameters for Call_Chain to be passed to
105 -- the callback. We could have used a nested subprogram, but as we are
106 -- interfacing with C (in bare board context), we prefer to use an
107 -- explicit mechanism.
108
109 type Callback_Params_Acc is access all Callback_Params_Type;
110
111 function Backtrace_Callback
112 (UC : Unwind_Context_Acc;
113 Data : System.Address) return Unwind_Reason_Code;
114 pragma Convention (C, Backtrace_Callback);
115 -- The callback for _Unwind_Backtrace, which is called for each frame
116
117 ------------------------
118 -- Backtrace_Callback --
119 ------------------------
120
121 function Backtrace_Callback
122 (UC : Unwind_Context_Acc;
123 Data : System.Address) return Unwind_Reason_Code
124 is
125 function To_Callback_Params is new Ada.Unchecked_Conversion
126 (System.Address, Callback_Params_Acc);
127 Params : constant Callback_Params_Acc := To_Callback_Params (Data);
128 -- The parameters of Call_Chain
129
130 PC : System.Address;
131
132 begin
133 -- Exclude Skip_Frames frames from the traceback.
134
135 if Params.Skip_Frames > 0 then
136 Params.Skip_Frames := Params.Skip_Frames - 1;
137 return URC_OK;
138 end if;
139
140 -- If the backtrace is full, simply discard new entries
141
142 if Params.Len >= Params.Max_Len then
143 return URC_OK;
144 end if;
145
146 -- Extract the PC (register 15)
147
148 if Unwind_VRS_Get (UC, UVRSC_CORE, 15, UVRSD_UINT32, PC'Address) /=
149 UVRSR_OK
150 then
151 return URC_FAILURE;
152 end if;
153
154 -- Discard exluded values
155
156 if PC in Params.Exclude_Min .. Params.Exclude_Max then
157 return URC_OK;
158 end if;
159
160 -- Append an entry
161
162 Params.Len := Params.Len + 1;
163 Params.Tracebacks (Params.Len) := PC;
164
165 return URC_OK;
166 end Backtrace_Callback;
167
168 ----------------
169 -- Call_Chain --
170 ----------------
171
172 procedure Call_Chain
173 (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
174 Max_Len : Natural;
175 Len : out Natural;
176 Exclude_Min : System.Address := System.Null_Address;
177 Exclude_Max : System.Address := System.Null_Address;
178 Skip_Frames : Natural := 1)
179 is
180 function To_Tracebacks_Array_Ptr is new Ada.Unchecked_Conversion
181 (System.Address, Tracebacks_Array_Ptr);
182
183 Params : aliased Callback_Params_Type;
184
185 Res : Unwind_Reason_Code;
186 pragma Unreferenced (Res);
187
188 begin
189 -- Copy parameters; add 1 to Skip_Frames to ignore the caller of
190 -- Call_Chain.
191
192 Params := (Tracebacks => To_Tracebacks_Array_Ptr (Traceback'Address),
193 Len => 0,
194 Max_Len => Max_Len,
195 Exclude_Min => Exclude_Min,
196 Exclude_Max => Exclude_Max,
197 Skip_Frames => Skip_Frames + 1);
198
199 -- Call the unwinder
200
201 Res := Unwind_Backtrace (Backtrace_Callback'Access, Params'Address);
202
203 -- Copy the result
204
205 Len := Params.Len;
206 end Call_Chain;
207
208 end System.Traceback;