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