annotate gcc/ada/vxaddr2line.adb @ 143:76e1cf5455ef

add cbc_gc test
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 19:24:05 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- V X A D D R 2 L I N E --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 2002-2018, AdaCore --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
kono
parents:
diff changeset
17 -- for more details. You should have received a copy of the GNU General --
kono
parents:
diff changeset
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
kono
parents:
diff changeset
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
kono
parents:
diff changeset
20 -- --
kono
parents:
diff changeset
21 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
23 -- --
kono
parents:
diff changeset
24 ------------------------------------------------------------------------------
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 -- This program is meant to be used with vxworks to compute symbolic
kono
parents:
diff changeset
27 -- backtraces on the host from non-symbolic backtraces obtained on the target.
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29 -- The basic idea is to automate the computation of the necessary address
kono
parents:
diff changeset
30 -- adjustments prior to calling addr2line when the application has only been
kono
parents:
diff changeset
31 -- partially linked on the host.
kono
parents:
diff changeset
32
kono
parents:
diff changeset
33 -- Variants for various targets are supported, and the command line should
kono
parents:
diff changeset
34 -- be like :
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 -- <target>-addr2line [-a <target_arch>] <exe_file> <ref_address>
kono
parents:
diff changeset
37 -- <backtrace addresses>
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 -- Where:
kono
parents:
diff changeset
40 -- <target_arch> :
kono
parents:
diff changeset
41 -- selects the target architecture. In the absence of this parameter the
kono
parents:
diff changeset
42 -- default variant is chosen based on the Detect_Arch result. Generally,
kono
parents:
diff changeset
43 -- this parameter will only be used if vxaddr2line is recompiled manually.
kono
parents:
diff changeset
44 -- Otherwise, the command name will always be of the form:
kono
parents:
diff changeset
45 -- <target>-vxaddr2line
kono
parents:
diff changeset
46 -- where there is no ambiguity on the target's architecture.
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 -- <exe_file> :
kono
parents:
diff changeset
49 -- The name of the partially linked binary file for the application.
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 -- <ref_address> :
kono
parents:
diff changeset
52 -- Runtime address (on the target) of a reference symbol you choose. This
kono
parents:
diff changeset
53 -- name must match the value of the Ref_Symbol variable declared below.
kono
parents:
diff changeset
54 -- A symbol with a small offset from the beginning of the text segment is
kono
parents:
diff changeset
55 -- better, so "adainit" is a good choice.
kono
parents:
diff changeset
56
kono
parents:
diff changeset
57 -- <backtrace addresses> :
kono
parents:
diff changeset
58 -- The call chain addresses you obtained at run time on the target and
kono
parents:
diff changeset
59 -- for which you want a symbolic association.
kono
parents:
diff changeset
60
kono
parents:
diff changeset
61 -- TO ADD A NEW ARCHITECTURE add an appropriate value to Architecture type
kono
parents:
diff changeset
62 -- (in a format <host>_<target>), and then an appropriate value to Config_List
kono
parents:
diff changeset
63 -- array
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 with Ada.Text_IO; use Ada.Text_IO;
kono
parents:
diff changeset
66 with Ada.Command_Line; use Ada.Command_Line;
kono
parents:
diff changeset
67 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
kono
parents:
diff changeset
68 with Interfaces; use Interfaces;
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 with GNAT.OS_Lib; use GNAT.OS_Lib;
kono
parents:
diff changeset
71 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
kono
parents:
diff changeset
72 with GNAT.Expect; use GNAT.Expect;
kono
parents:
diff changeset
73 with GNAT.Regpat; use GNAT.Regpat;
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 procedure VxAddr2Line is
kono
parents:
diff changeset
76
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
77 package Unsigned_64_IO is new Modular_IO (Unsigned_64);
111
kono
parents:
diff changeset
78 -- Instantiate Modular_IO to have Put
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 Ref_Symbol : constant String := "adainit";
kono
parents:
diff changeset
81 -- This is the name of the reference symbol whose runtime address must
kono
parents:
diff changeset
82 -- be provided as the <ref_address> argument.
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 -- All supported architectures
kono
parents:
diff changeset
85 type Architecture is
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
86 (LINUX_AARCH64,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
87 LINUX_ARM,
111
kono
parents:
diff changeset
88 LINUX_E500V2,
kono
parents:
diff changeset
89 LINUX_I586,
kono
parents:
diff changeset
90 LINUX_POWERPC,
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
91 LINUX_POWERPC64,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
92 LINUX_X86_64,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
93 WINDOWS_AARCH64,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
94 WINDOWS_ARM,
111
kono
parents:
diff changeset
95 WINDOWS_E500V2,
kono
parents:
diff changeset
96 WINDOWS_I586,
kono
parents:
diff changeset
97 WINDOWS_POWERPC,
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
98 WINDOWS_POWERPC64,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
99 WINDOWS_X86_64);
111
kono
parents:
diff changeset
100
kono
parents:
diff changeset
101 type Arch_Record is record
kono
parents:
diff changeset
102 Addr2line_Binary : String_Access;
kono
parents:
diff changeset
103 -- Name of the addr2line utility to use
kono
parents:
diff changeset
104
kono
parents:
diff changeset
105 Nm_Binary : String_Access;
kono
parents:
diff changeset
106 -- Name of the host nm utility, which will be used to find out the
kono
parents:
diff changeset
107 -- offset of the reference symbol in the text segment of the partially
kono
parents:
diff changeset
108 -- linked executable.
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 Addr_Digits_To_Skip : Integer;
kono
parents:
diff changeset
111 -- When addresses such as 0xfffffc0001dfed50 are provided, for instance
kono
parents:
diff changeset
112 -- on ALPHA, indicate the number of leading digits that can be ignored,
kono
parents:
diff changeset
113 -- which will avoid computational overflows. Typically only useful when
kono
parents:
diff changeset
114 -- 64bit addresses are provided.
kono
parents:
diff changeset
115
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
116 Bt_Offset_From_Call : Unsigned_64;
111
kono
parents:
diff changeset
117 -- Offset from a backtrace address to the address of the corresponding
kono
parents:
diff changeset
118 -- call instruction. This should always be 0, except on platforms where
kono
parents:
diff changeset
119 -- the backtrace addresses actually correspond to return and not call
kono
parents:
diff changeset
120 -- points. In such cases, a negative value is most likely.
kono
parents:
diff changeset
121 end record;
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 -- Configuration for each of the architectures
kono
parents:
diff changeset
124 Arch_List : array (Architecture'Range) of Arch_Record :=
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
125 (LINUX_AARCH64 =>
111
kono
parents:
diff changeset
126 (Addr2line_Binary => null,
kono
parents:
diff changeset
127 Nm_Binary => null,
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
128 Addr_Digits_To_Skip => 0,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
129 Bt_Offset_From_Call => -2),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
130 LINUX_ARM =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
131 (Addr2line_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
132 Nm_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
133 Addr_Digits_To_Skip => 0,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
134 Bt_Offset_From_Call => -2),
111
kono
parents:
diff changeset
135 LINUX_E500V2 =>
kono
parents:
diff changeset
136 (Addr2line_Binary => null,
kono
parents:
diff changeset
137 Nm_Binary => null,
kono
parents:
diff changeset
138 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
139 Bt_Offset_From_Call => -4),
kono
parents:
diff changeset
140 LINUX_I586 =>
kono
parents:
diff changeset
141 (Addr2line_Binary => null,
kono
parents:
diff changeset
142 Nm_Binary => null,
kono
parents:
diff changeset
143 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
144 Bt_Offset_From_Call => -2),
kono
parents:
diff changeset
145 LINUX_POWERPC =>
kono
parents:
diff changeset
146 (Addr2line_Binary => null,
kono
parents:
diff changeset
147 Nm_Binary => null,
kono
parents:
diff changeset
148 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
149 Bt_Offset_From_Call => -4),
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
150 LINUX_POWERPC64 =>
111
kono
parents:
diff changeset
151 (Addr2line_Binary => null,
kono
parents:
diff changeset
152 Nm_Binary => null,
kono
parents:
diff changeset
153 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
154 Bt_Offset_From_Call => -4),
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
155 LINUX_X86_64 =>
111
kono
parents:
diff changeset
156 (Addr2line_Binary => null,
kono
parents:
diff changeset
157 Nm_Binary => null,
kono
parents:
diff changeset
158 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
159 Bt_Offset_From_Call => -2),
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
160 WINDOWS_AARCH64 =>
111
kono
parents:
diff changeset
161 (Addr2line_Binary => null,
kono
parents:
diff changeset
162 Nm_Binary => null,
kono
parents:
diff changeset
163 Addr_Digits_To_Skip => 0,
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
164 Bt_Offset_From_Call => -2),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
165 WINDOWS_ARM =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
166 (Addr2line_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
167 Nm_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
168 Addr_Digits_To_Skip => 0,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
169 Bt_Offset_From_Call => -2),
111
kono
parents:
diff changeset
170 WINDOWS_E500V2 =>
kono
parents:
diff changeset
171 (Addr2line_Binary => null,
kono
parents:
diff changeset
172 Nm_Binary => null,
kono
parents:
diff changeset
173 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
174 Bt_Offset_From_Call => -4),
kono
parents:
diff changeset
175 WINDOWS_I586 =>
kono
parents:
diff changeset
176 (Addr2line_Binary => null,
kono
parents:
diff changeset
177 Nm_Binary => null,
kono
parents:
diff changeset
178 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
179 Bt_Offset_From_Call => -2),
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
180 WINDOWS_POWERPC =>
111
kono
parents:
diff changeset
181 (Addr2line_Binary => null,
kono
parents:
diff changeset
182 Nm_Binary => null,
kono
parents:
diff changeset
183 Addr_Digits_To_Skip => 0,
kono
parents:
diff changeset
184 Bt_Offset_From_Call => -4),
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
185 WINDOWS_POWERPC64 =>
111
kono
parents:
diff changeset
186 (Addr2line_Binary => null,
kono
parents:
diff changeset
187 Nm_Binary => null,
kono
parents:
diff changeset
188 Addr_Digits_To_Skip => 0,
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
189 Bt_Offset_From_Call => -4),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
190 WINDOWS_X86_64 =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
191 (Addr2line_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
192 Nm_Binary => null,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
193 Addr_Digits_To_Skip => 0,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
194 Bt_Offset_From_Call => -2)
111
kono
parents:
diff changeset
195 );
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 -- Current architecture
kono
parents:
diff changeset
198 Cur_Arch : Architecture;
kono
parents:
diff changeset
199
kono
parents:
diff changeset
200 -- State of architecture detection
kono
parents:
diff changeset
201 Detect_Success : Boolean := False;
kono
parents:
diff changeset
202
kono
parents:
diff changeset
203 -----------------------
kono
parents:
diff changeset
204 -- Local subprograms --
kono
parents:
diff changeset
205 -----------------------
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 procedure Error (Msg : String);
kono
parents:
diff changeset
208 pragma No_Return (Error);
kono
parents:
diff changeset
209 -- Prints the message and then terminates the program
kono
parents:
diff changeset
210
kono
parents:
diff changeset
211 procedure Usage;
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
212 pragma No_Return (Usage);
111
kono
parents:
diff changeset
213 -- Displays the short help message and then terminates the program
kono
parents:
diff changeset
214
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
215 function Get_Reference_Offset return Unsigned_64;
111
kono
parents:
diff changeset
216 -- Computes the static offset of the reference symbol by calling nm
kono
parents:
diff changeset
217
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
218 function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64;
111
kono
parents:
diff changeset
219 -- Threats the argument number Arg as a C-style hexadecimal literal
kono
parents:
diff changeset
220 -- and returns its integer value
kono
parents:
diff changeset
221
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
222 function Hex_Image (Value : Unsigned_64) return String_Access;
111
kono
parents:
diff changeset
223 -- Returns access to a string that contains hexadecimal image of Value
kono
parents:
diff changeset
224
kono
parents:
diff changeset
225 -- Separate functions that provide build-time customization:
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 procedure Detect_Arch;
kono
parents:
diff changeset
228 -- Saves in Cur_Arch the current architecture, based on the name of
kono
parents:
diff changeset
229 -- vxaddr2line instance and properties of the host. Detect_Success is False
kono
parents:
diff changeset
230 -- if detection fails
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 -----------------
kono
parents:
diff changeset
233 -- Detect_Arch --
kono
parents:
diff changeset
234 -----------------
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 procedure Detect_Arch is
kono
parents:
diff changeset
237 Name : constant String := Base_Name (Command_Name);
kono
parents:
diff changeset
238 Proc : constant String :=
kono
parents:
diff changeset
239 Name (Name'First .. Index (Name, "-") - 1);
kono
parents:
diff changeset
240 Target : constant String :=
kono
parents:
diff changeset
241 Name (Name'First .. Index (Name, "vxaddr2line") - 1);
kono
parents:
diff changeset
242
kono
parents:
diff changeset
243 begin
kono
parents:
diff changeset
244 Detect_Success := False;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 if Proc = "" then
kono
parents:
diff changeset
247 return;
kono
parents:
diff changeset
248 end if;
kono
parents:
diff changeset
249
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
250 -- Let's detect a Linux or Windows host.
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
251 if Directory_Separator = '/' then
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
252 Cur_Arch := Architecture'Value ("linux_" & Proc);
111
kono
parents:
diff changeset
253 else
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
254 Cur_Arch := Architecture'Value ("windows_" & Proc);
111
kono
parents:
diff changeset
255 end if;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 if Arch_List (Cur_Arch).Addr2line_Binary = null then
kono
parents:
diff changeset
258 Arch_List (Cur_Arch).Addr2line_Binary := new String'
kono
parents:
diff changeset
259 (Target & "addr2line");
kono
parents:
diff changeset
260 end if;
kono
parents:
diff changeset
261 if Arch_List (Cur_Arch).Nm_Binary = null then
kono
parents:
diff changeset
262 Arch_List (Cur_Arch).Nm_Binary := new String'
kono
parents:
diff changeset
263 (Target & "nm");
kono
parents:
diff changeset
264 end if;
kono
parents:
diff changeset
265
kono
parents:
diff changeset
266 Detect_Success := True;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 exception
kono
parents:
diff changeset
269 when others =>
kono
parents:
diff changeset
270 return;
kono
parents:
diff changeset
271 end Detect_Arch;
kono
parents:
diff changeset
272
kono
parents:
diff changeset
273 -----------
kono
parents:
diff changeset
274 -- Error --
kono
parents:
diff changeset
275 -----------
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 procedure Error (Msg : String) is
kono
parents:
diff changeset
278 begin
kono
parents:
diff changeset
279 Put_Line (Msg);
kono
parents:
diff changeset
280 OS_Exit (1);
kono
parents:
diff changeset
281 raise Program_Error;
kono
parents:
diff changeset
282 end Error;
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 --------------------------
kono
parents:
diff changeset
285 -- Get_Reference_Offset --
kono
parents:
diff changeset
286 --------------------------
kono
parents:
diff changeset
287
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
288 function Get_Reference_Offset return Unsigned_64 is
111
kono
parents:
diff changeset
289 Nm_Cmd : constant String_Access :=
kono
parents:
diff changeset
290 Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);
kono
parents:
diff changeset
291
kono
parents:
diff changeset
292 Nm_Args : constant Argument_List :=
kono
parents:
diff changeset
293 (new String'("-P"),
kono
parents:
diff changeset
294 new String'(Argument (1)));
kono
parents:
diff changeset
295
kono
parents:
diff changeset
296 Forever : aliased String := "^@@@@";
kono
parents:
diff changeset
297 Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)";
kono
parents:
diff changeset
298
kono
parents:
diff changeset
299 Pd : Process_Descriptor;
kono
parents:
diff changeset
300 Result : Expect_Match;
kono
parents:
diff changeset
301
kono
parents:
diff changeset
302 begin
kono
parents:
diff changeset
303 -- If Nm is not found, abort
kono
parents:
diff changeset
304
kono
parents:
diff changeset
305 if Nm_Cmd = null then
kono
parents:
diff changeset
306 Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all);
kono
parents:
diff changeset
307 end if;
kono
parents:
diff changeset
308
kono
parents:
diff changeset
309 Non_Blocking_Spawn
kono
parents:
diff changeset
310 (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True);
kono
parents:
diff changeset
311
kono
parents:
diff changeset
312 -- Expect a string containing the reference symbol
kono
parents:
diff changeset
313
kono
parents:
diff changeset
314 Expect (Pd, Result,
kono
parents:
diff changeset
315 Regexp_Array'(1 => Reference'Unchecked_Access),
kono
parents:
diff changeset
316 Timeout => -1);
kono
parents:
diff changeset
317
kono
parents:
diff changeset
318 -- If we are here, the pattern was matched successfully
kono
parents:
diff changeset
319
kono
parents:
diff changeset
320 declare
kono
parents:
diff changeset
321 Match_String : constant String := Expect_Out_Match (Pd);
kono
parents:
diff changeset
322 Matches : Match_Array (0 .. 1);
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
323 Value : Unsigned_64 := 0;
111
kono
parents:
diff changeset
324
kono
parents:
diff changeset
325 begin
kono
parents:
diff changeset
326 Match (Reference, Match_String, Matches);
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
327 Value := Unsigned_64'Value
111
kono
parents:
diff changeset
328 ("16#"
kono
parents:
diff changeset
329 & Match_String (Matches (1).First .. Matches (1).Last) & "#");
kono
parents:
diff changeset
330
kono
parents:
diff changeset
331 -- Expect a string that will never be emitted, so that the
kono
parents:
diff changeset
332 -- process can be correctly terminated (with Process_Died)
kono
parents:
diff changeset
333
kono
parents:
diff changeset
334 Expect (Pd, Result,
kono
parents:
diff changeset
335 Regexp_Array'(1 => Forever'Unchecked_Access),
kono
parents:
diff changeset
336 Timeout => -1);
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 exception
kono
parents:
diff changeset
339 when Process_Died =>
kono
parents:
diff changeset
340 return Value;
kono
parents:
diff changeset
341 end;
kono
parents:
diff changeset
342
kono
parents:
diff changeset
343 -- We cannot get here
kono
parents:
diff changeset
344
kono
parents:
diff changeset
345 raise Program_Error;
kono
parents:
diff changeset
346
kono
parents:
diff changeset
347 exception
kono
parents:
diff changeset
348 when Invalid_Process =>
kono
parents:
diff changeset
349 Error ("Could not spawn a process " & Nm_Cmd.all);
kono
parents:
diff changeset
350
kono
parents:
diff changeset
351 when others =>
kono
parents:
diff changeset
352
kono
parents:
diff changeset
353 -- The process died without matching the reference symbol or the
kono
parents:
diff changeset
354 -- format wasn't recognized.
kono
parents:
diff changeset
355
kono
parents:
diff changeset
356 Error ("Unexpected output from " & Nm_Cmd.all);
kono
parents:
diff changeset
357 end Get_Reference_Offset;
kono
parents:
diff changeset
358
kono
parents:
diff changeset
359 ----------------------------
kono
parents:
diff changeset
360 -- Get_Value_From_Hex_Arg --
kono
parents:
diff changeset
361 ----------------------------
kono
parents:
diff changeset
362
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
363 function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64 is
111
kono
parents:
diff changeset
364 Cur_Arg : constant String := Argument (Arg);
kono
parents:
diff changeset
365 Offset : Natural;
kono
parents:
diff changeset
366
kono
parents:
diff changeset
367 begin
kono
parents:
diff changeset
368 -- Skip "0x" prefix if present
kono
parents:
diff changeset
369
kono
parents:
diff changeset
370 if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then
kono
parents:
diff changeset
371 Offset := 3;
kono
parents:
diff changeset
372 else
kono
parents:
diff changeset
373 Offset := 1;
kono
parents:
diff changeset
374 end if;
kono
parents:
diff changeset
375
kono
parents:
diff changeset
376 -- Add architecture-specific offset
kono
parents:
diff changeset
377
kono
parents:
diff changeset
378 Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip;
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 -- Convert to value
kono
parents:
diff changeset
381
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
382 return Unsigned_64'Value
111
kono
parents:
diff changeset
383 ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");
kono
parents:
diff changeset
384
kono
parents:
diff changeset
385 exception
kono
parents:
diff changeset
386 when Constraint_Error =>
kono
parents:
diff changeset
387
kono
parents:
diff changeset
388 Error ("Can't parse backtrace address '" & Cur_Arg & "'");
kono
parents:
diff changeset
389 raise;
kono
parents:
diff changeset
390 end Get_Value_From_Hex_Arg;
kono
parents:
diff changeset
391
kono
parents:
diff changeset
392 ---------------
kono
parents:
diff changeset
393 -- Hex_Image --
kono
parents:
diff changeset
394 ---------------
kono
parents:
diff changeset
395
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
396 function Hex_Image (Value : Unsigned_64) return String_Access is
111
kono
parents:
diff changeset
397 Result : String (1 .. 20);
kono
parents:
diff changeset
398 Start_Pos : Natural;
kono
parents:
diff changeset
399
kono
parents:
diff changeset
400 begin
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
401 Unsigned_64_IO.Put (Result, Value, 16);
111
kono
parents:
diff changeset
402 Start_Pos := Index (Result, "16#") + 3;
kono
parents:
diff changeset
403 return new String'(Result (Start_Pos .. Result'Last - 1));
kono
parents:
diff changeset
404 end Hex_Image;
kono
parents:
diff changeset
405
kono
parents:
diff changeset
406 -----------
kono
parents:
diff changeset
407 -- Usage --
kono
parents:
diff changeset
408 -----------
kono
parents:
diff changeset
409
kono
parents:
diff changeset
410 procedure Usage is
kono
parents:
diff changeset
411 begin
kono
parents:
diff changeset
412 Put_Line ("Usage : " & Base_Name (Command_Name)
kono
parents:
diff changeset
413 & " <executable> <"
kono
parents:
diff changeset
414 & Ref_Symbol & " offset on target> <addr1> ...");
kono
parents:
diff changeset
415
kono
parents:
diff changeset
416 OS_Exit (1);
kono
parents:
diff changeset
417 end Usage;
kono
parents:
diff changeset
418
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
419 Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_64;
111
kono
parents:
diff changeset
420
kono
parents:
diff changeset
421 Addr2line_Cmd : String_Access;
kono
parents:
diff changeset
422
kono
parents:
diff changeset
423 Addr2line_Args : Argument_List (1 .. 501);
kono
parents:
diff changeset
424 -- We expect that there won't be more than 500 backtrace frames
kono
parents:
diff changeset
425
kono
parents:
diff changeset
426 Addr2line_Args_Count : Natural;
kono
parents:
diff changeset
427
kono
parents:
diff changeset
428 Success : Boolean;
kono
parents:
diff changeset
429
kono
parents:
diff changeset
430 -- Start of processing for VxAddr2Line
kono
parents:
diff changeset
431
kono
parents:
diff changeset
432 begin
kono
parents:
diff changeset
433
kono
parents:
diff changeset
434 Detect_Arch;
kono
parents:
diff changeset
435
kono
parents:
diff changeset
436 -- There should be at least two arguments
kono
parents:
diff changeset
437
kono
parents:
diff changeset
438 if Argument_Count < 2 then
kono
parents:
diff changeset
439 Usage;
kono
parents:
diff changeset
440 end if;
kono
parents:
diff changeset
441
kono
parents:
diff changeset
442 -- Enforce HARD LIMIT There should be at most 501 arguments. Why 501???
kono
parents:
diff changeset
443
kono
parents:
diff changeset
444 if Argument_Count > 501 then
kono
parents:
diff changeset
445 Error ("Too many backtrace frames");
kono
parents:
diff changeset
446 end if;
kono
parents:
diff changeset
447
kono
parents:
diff changeset
448 -- Do we have a valid architecture?
kono
parents:
diff changeset
449
kono
parents:
diff changeset
450 if not Detect_Success then
kono
parents:
diff changeset
451 Put_Line ("Couldn't detect the architecture");
kono
parents:
diff changeset
452 return;
kono
parents:
diff changeset
453 end if;
kono
parents:
diff changeset
454
kono
parents:
diff changeset
455 Addr2line_Cmd :=
kono
parents:
diff changeset
456 Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all);
kono
parents:
diff changeset
457
kono
parents:
diff changeset
458 -- If Addr2line is not found, abort
kono
parents:
diff changeset
459
kono
parents:
diff changeset
460 if Addr2line_Cmd = null then
kono
parents:
diff changeset
461 Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
kono
parents:
diff changeset
462 end if;
kono
parents:
diff changeset
463
kono
parents:
diff changeset
464 -- The first argument specifies the image file. Check if it exists
kono
parents:
diff changeset
465
kono
parents:
diff changeset
466 if not Is_Regular_File (Argument (1)) then
kono
parents:
diff changeset
467 Error ("Couldn't find the executable " & Argument (1));
kono
parents:
diff changeset
468 end if;
kono
parents:
diff changeset
469
kono
parents:
diff changeset
470 -- The second argument specifies the reference symbol runtime address.
kono
parents:
diff changeset
471 -- Let's parse and store it
kono
parents:
diff changeset
472
kono
parents:
diff changeset
473 Ref_Runtime_Address := Get_Value_From_Hex_Arg (2);
kono
parents:
diff changeset
474
kono
parents:
diff changeset
475 -- Run nm command to get the reference symbol static offset
kono
parents:
diff changeset
476
kono
parents:
diff changeset
477 Ref_Static_Offset := Get_Reference_Offset;
kono
parents:
diff changeset
478
kono
parents:
diff changeset
479 -- Build addr2line parameters. First, the standard part
kono
parents:
diff changeset
480
kono
parents:
diff changeset
481 Addr2line_Args (1) := new String'("--exe=" & Argument (1));
kono
parents:
diff changeset
482 Addr2line_Args_Count := 1;
kono
parents:
diff changeset
483
kono
parents:
diff changeset
484 -- Now, append to this the adjusted backtraces in arguments 4 and further
kono
parents:
diff changeset
485
kono
parents:
diff changeset
486 for J in 3 .. Argument_Count loop
kono
parents:
diff changeset
487
kono
parents:
diff changeset
488 -- Basically, for each address in the runtime backtrace ...
kono
parents:
diff changeset
489
kono
parents:
diff changeset
490 -- o We compute its offset relatively to the runtime address of the
kono
parents:
diff changeset
491 -- reference symbol,
kono
parents:
diff changeset
492
kono
parents:
diff changeset
493 -- and then ...
kono
parents:
diff changeset
494
kono
parents:
diff changeset
495 -- o We add this offset to the static one for the reference symbol in
kono
parents:
diff changeset
496 -- the executable to find the executable offset corresponding to the
kono
parents:
diff changeset
497 -- backtrace address.
kono
parents:
diff changeset
498
kono
parents:
diff changeset
499 Bt_Address := Get_Value_From_Hex_Arg (J);
kono
parents:
diff changeset
500
kono
parents:
diff changeset
501 Bt_Address :=
kono
parents:
diff changeset
502 Bt_Address - Ref_Runtime_Address
kono
parents:
diff changeset
503 + Ref_Static_Offset
kono
parents:
diff changeset
504 + Arch_List (Cur_Arch).Bt_Offset_From_Call;
kono
parents:
diff changeset
505
kono
parents:
diff changeset
506 Addr2line_Args_Count := Addr2line_Args_Count + 1;
kono
parents:
diff changeset
507 Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address);
kono
parents:
diff changeset
508 end loop;
kono
parents:
diff changeset
509
kono
parents:
diff changeset
510 -- Run the resulting command
kono
parents:
diff changeset
511
kono
parents:
diff changeset
512 Spawn (Addr2line_Cmd.all,
kono
parents:
diff changeset
513 Addr2line_Args (1 .. Addr2line_Args_Count), Success);
kono
parents:
diff changeset
514
kono
parents:
diff changeset
515 if not Success then
kono
parents:
diff changeset
516 Error ("Couldn't spawn " & Addr2line_Cmd.all);
kono
parents:
diff changeset
517 end if;
kono
parents:
diff changeset
518
kono
parents:
diff changeset
519 exception
kono
parents:
diff changeset
520 when others =>
kono
parents:
diff changeset
521
kono
parents:
diff changeset
522 -- Mask all exceptions
kono
parents:
diff changeset
523
kono
parents:
diff changeset
524 return;
kono
parents:
diff changeset
525 end VxAddr2Line;