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-2018, 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
65with Ada.Text_IO;       use Ada.Text_IO;
66with Ada.Command_Line;  use Ada.Command_Line;
67with Ada.Strings.Fixed; use Ada.Strings.Fixed;
68with Interfaces;        use Interfaces;
69
70with GNAT.OS_Lib;               use GNAT.OS_Lib;
71with GNAT.Directory_Operations; use GNAT.Directory_Operations;
72with GNAT.Expect;               use GNAT.Expect;
73with GNAT.Regpat;               use GNAT.Regpat;
74
75procedure VxAddr2Line is
76
77   package Unsigned_64_IO is new Modular_IO (Unsigned_64);
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     (LINUX_AARCH64,
87      LINUX_ARM,
88      LINUX_E500V2,
89      LINUX_I586,
90      LINUX_POWERPC,
91      LINUX_POWERPC64,
92      LINUX_X86_64,
93      WINDOWS_AARCH64,
94      WINDOWS_ARM,
95      WINDOWS_E500V2,
96      WINDOWS_I586,
97      WINDOWS_POWERPC,
98      WINDOWS_POWERPC64,
99      WINDOWS_X86_64);
100
101   type Arch_Record is record
102      Addr2line_Binary : String_Access;
103      --  Name of the addr2line utility to use
104
105      Nm_Binary : String_Access;
106      --  Name of the host nm utility, which will be used to find out the
107      --  offset of the reference symbol in the text segment of the partially
108      --  linked executable.
109
110      Addr_Digits_To_Skip : Integer;
111      --  When addresses such as 0xfffffc0001dfed50 are provided, for instance
112      --  on ALPHA, indicate the number of leading digits that can be ignored,
113      --  which will avoid computational overflows. Typically only useful when
114      --  64bit addresses are provided.
115
116      Bt_Offset_From_Call : Unsigned_64;
117      --  Offset from a backtrace address to the address of the corresponding
118      --  call instruction. This should always be 0, except on platforms where
119      --  the backtrace addresses actually correspond to return and not call
120      --  points. In such cases, a negative value is most likely.
121   end record;
122
123   --  Configuration for each of the architectures
124   Arch_List : array (Architecture'Range) of Arch_Record :=
125     (LINUX_AARCH64 =>
126        (Addr2line_Binary    => null,
127         Nm_Binary           => null,
128         Addr_Digits_To_Skip => 0,
129         Bt_Offset_From_Call => -2),
130      LINUX_ARM =>
131        (Addr2line_Binary    => null,
132         Nm_Binary           => null,
133         Addr_Digits_To_Skip => 0,
134         Bt_Offset_From_Call => -2),
135      LINUX_E500V2 =>
136        (Addr2line_Binary    => null,
137         Nm_Binary           => null,
138         Addr_Digits_To_Skip => 0,
139         Bt_Offset_From_Call => -4),
140      LINUX_I586 =>
141        (Addr2line_Binary    => null,
142         Nm_Binary           => null,
143         Addr_Digits_To_Skip => 0,
144         Bt_Offset_From_Call => -2),
145      LINUX_POWERPC =>
146        (Addr2line_Binary    => null,
147         Nm_Binary           => null,
148         Addr_Digits_To_Skip => 0,
149         Bt_Offset_From_Call => -4),
150      LINUX_POWERPC64 =>
151        (Addr2line_Binary    => null,
152         Nm_Binary           => null,
153         Addr_Digits_To_Skip => 0,
154         Bt_Offset_From_Call => -4),
155      LINUX_X86_64 =>
156        (Addr2line_Binary    => null,
157         Nm_Binary           => null,
158         Addr_Digits_To_Skip => 0,
159         Bt_Offset_From_Call => -2),
160      WINDOWS_AARCH64 =>
161        (Addr2line_Binary    => null,
162         Nm_Binary           => null,
163         Addr_Digits_To_Skip => 0,
164         Bt_Offset_From_Call => -2),
165      WINDOWS_ARM =>
166        (Addr2line_Binary    => null,
167         Nm_Binary           => null,
168         Addr_Digits_To_Skip => 0,
169         Bt_Offset_From_Call => -2),
170      WINDOWS_E500V2 =>
171        (Addr2line_Binary    => null,
172         Nm_Binary           => null,
173         Addr_Digits_To_Skip => 0,
174         Bt_Offset_From_Call => -4),
175      WINDOWS_I586 =>
176        (Addr2line_Binary    => null,
177         Nm_Binary           => null,
178         Addr_Digits_To_Skip => 0,
179         Bt_Offset_From_Call => -2),
180      WINDOWS_POWERPC =>
181        (Addr2line_Binary    => null,
182         Nm_Binary           => null,
183         Addr_Digits_To_Skip => 0,
184         Bt_Offset_From_Call => -4),
185      WINDOWS_POWERPC64 =>
186        (Addr2line_Binary    => null,
187         Nm_Binary           => null,
188         Addr_Digits_To_Skip => 0,
189         Bt_Offset_From_Call => -4),
190      WINDOWS_X86_64 =>
191        (Addr2line_Binary    => null,
192         Nm_Binary           => null,
193         Addr_Digits_To_Skip => 0,
194         Bt_Offset_From_Call => -2)
195     );
196
197   --  Current architecture
198   Cur_Arch : Architecture;
199
200   --  State of architecture detection
201   Detect_Success : Boolean := False;
202
203   -----------------------
204   -- Local subprograms --
205   -----------------------
206
207   procedure Error (Msg : String);
208   pragma No_Return (Error);
209   --  Prints the message and then terminates the program
210
211   procedure Usage;
212   --  Displays the short help message and then terminates the program
213
214   function Get_Reference_Offset return Unsigned_64;
215   --  Computes the static offset of the reference symbol by calling nm
216
217   function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64;
218   --  Threats the argument number Arg as a C-style hexadecimal literal
219   --  and returns its integer value
220
221   function Hex_Image (Value : Unsigned_64) return String_Access;
222   --  Returns access to a string that contains hexadecimal image of Value
223
224   --  Separate functions that provide build-time customization:
225
226   procedure Detect_Arch;
227   --  Saves in Cur_Arch the current architecture, based on the name of
228   --  vxaddr2line instance and properties of the host. Detect_Success is False
229   --  if detection fails
230
231   -----------------
232   -- Detect_Arch --
233   -----------------
234
235   procedure Detect_Arch is
236      Name   : constant String := Base_Name (Command_Name);
237      Proc   : constant String :=
238                 Name (Name'First .. Index (Name, "-") - 1);
239      Target : constant String :=
240                 Name (Name'First .. Index (Name, "vxaddr2line") - 1);
241
242   begin
243      Detect_Success := False;
244
245      if Proc = "" then
246         return;
247      end if;
248
249      --  Let's detect a Linux or Windows host.
250      if Directory_Separator = '/' then
251         Cur_Arch := Architecture'Value ("linux_" & Proc);
252      else
253         Cur_Arch := Architecture'Value ("windows_" & Proc);
254      end if;
255
256      if Arch_List (Cur_Arch).Addr2line_Binary = null then
257         Arch_List (Cur_Arch).Addr2line_Binary := new String'
258           (Target & "addr2line");
259      end if;
260      if Arch_List (Cur_Arch).Nm_Binary = null then
261         Arch_List (Cur_Arch).Nm_Binary := new String'
262           (Target & "nm");
263      end if;
264
265      Detect_Success := True;
266
267   exception
268      when others =>
269         return;
270   end Detect_Arch;
271
272   -----------
273   -- Error --
274   -----------
275
276   procedure Error (Msg : String) is
277   begin
278      Put_Line (Msg);
279      OS_Exit (1);
280      raise Program_Error;
281   end Error;
282
283   --------------------------
284   -- Get_Reference_Offset --
285   --------------------------
286
287   function Get_Reference_Offset return Unsigned_64 is
288      Nm_Cmd  : constant String_Access :=
289                  Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);
290
291      Nm_Args : constant Argument_List :=
292                  (new String'("-P"),
293                   new String'(Argument (1)));
294
295      Forever   : aliased String := "^@@@@";
296      Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)";
297
298      Pd     : Process_Descriptor;
299      Result : Expect_Match;
300
301   begin
302      --  If Nm is not found, abort
303
304      if Nm_Cmd = null then
305         Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all);
306      end if;
307
308      Non_Blocking_Spawn
309        (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True);
310
311      --  Expect a string containing the reference symbol
312
313      Expect (Pd, Result,
314              Regexp_Array'(1 => Reference'Unchecked_Access),
315              Timeout => -1);
316
317      --  If we are here, the pattern was matched successfully
318
319      declare
320         Match_String : constant String := Expect_Out_Match (Pd);
321         Matches      : Match_Array (0 .. 1);
322         Value        : Unsigned_64;
323
324      begin
325         Match (Reference, Match_String, Matches);
326         Value := Unsigned_64'Value
327           ("16#"
328            & Match_String (Matches (1).First .. Matches (1).Last) & "#");
329
330         --  Expect a string that will never be emitted, so that the
331         --  process can be correctly terminated (with Process_Died)
332
333         Expect (Pd, Result,
334                 Regexp_Array'(1 => Forever'Unchecked_Access),
335                 Timeout => -1);
336
337      exception
338         when Process_Died =>
339            return Value;
340      end;
341
342      --  We cannot get here
343
344      raise Program_Error;
345
346   exception
347      when Invalid_Process =>
348         Error ("Could not spawn a process " & Nm_Cmd.all);
349
350      when others    =>
351
352         --  The process died without matching the reference symbol or the
353         --  format wasn't recognized.
354
355         Error ("Unexpected output from " & Nm_Cmd.all);
356   end Get_Reference_Offset;
357
358   ----------------------------
359   -- Get_Value_From_Hex_Arg --
360   ----------------------------
361
362   function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64 is
363      Cur_Arg : constant String := Argument (Arg);
364      Offset  : Natural;
365
366   begin
367      --  Skip "0x" prefix if present
368
369      if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then
370         Offset := 3;
371      else
372         Offset := 1;
373      end if;
374
375      --  Add architecture-specific offset
376
377      Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip;
378
379      --  Convert to value
380
381      return Unsigned_64'Value
382        ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");
383
384   exception
385      when Constraint_Error =>
386
387         Error ("Can't parse backtrace address '" & Cur_Arg & "'");
388         raise;
389   end Get_Value_From_Hex_Arg;
390
391   ---------------
392   -- Hex_Image --
393   ---------------
394
395   function Hex_Image (Value : Unsigned_64) return String_Access is
396      Result    : String (1 .. 20);
397      Start_Pos : Natural;
398
399   begin
400      Unsigned_64_IO.Put (Result, Value, 16);
401      Start_Pos := Index (Result, "16#") + 3;
402      return new String'(Result (Start_Pos .. Result'Last - 1));
403   end Hex_Image;
404
405   -----------
406   -- Usage --
407   -----------
408
409   procedure Usage is
410   begin
411      Put_Line ("Usage : " & Base_Name (Command_Name)
412                & " <executable> <"
413                & Ref_Symbol & " offset on target> <addr1> ...");
414
415      OS_Exit (1);
416   end Usage;
417
418   Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_64;
419
420   Addr2line_Cmd : String_Access;
421
422   Addr2line_Args : Argument_List (1 .. 501);
423   --  We expect that there won't be more than 500 backtrace frames
424
425   Addr2line_Args_Count : Natural;
426
427   Success : Boolean;
428
429--  Start of processing for VxAddr2Line
430
431begin
432
433   Detect_Arch;
434
435   --  There should be at least two arguments
436
437   if Argument_Count < 2 then
438      Usage;
439   end if;
440
441   --  Enforce HARD LIMIT There should be at most 501 arguments. Why 501???
442
443   if Argument_Count > 501 then
444      Error ("Too many backtrace frames");
445   end if;
446
447   --  Do we have a valid architecture?
448
449   if not Detect_Success then
450      Put_Line ("Couldn't detect the architecture");
451      return;
452   end if;
453
454   Addr2line_Cmd :=
455     Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all);
456
457   --  If Addr2line is not found, abort
458
459   if Addr2line_Cmd = null then
460      Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
461   end if;
462
463   --  The first argument specifies the image file. Check if it exists
464
465   if not Is_Regular_File (Argument (1)) then
466      Error ("Couldn't find the executable " & Argument (1));
467   end if;
468
469   --  The second argument specifies the reference symbol runtime address.
470   --  Let's parse and store it
471
472   Ref_Runtime_Address := Get_Value_From_Hex_Arg (2);
473
474   --  Run nm command to get the reference symbol static offset
475
476   Ref_Static_Offset := Get_Reference_Offset;
477
478   --  Build addr2line parameters. First, the standard part
479
480   Addr2line_Args (1) := new String'("--exe=" & Argument (1));
481   Addr2line_Args_Count := 1;
482
483   --  Now, append to this the adjusted backtraces in arguments 4 and further
484
485   for J in 3 .. Argument_Count loop
486
487      --  Basically, for each address in the runtime backtrace ...
488
489      --  o We compute its offset relatively to the runtime address of the
490      --    reference symbol,
491
492      --  and then ...
493
494      --  o We add this offset to the static one for the reference symbol in
495      --    the executable to find the executable offset corresponding to the
496      --    backtrace address.
497
498      Bt_Address := Get_Value_From_Hex_Arg (J);
499
500      Bt_Address :=
501        Bt_Address - Ref_Runtime_Address
502                   + Ref_Static_Offset
503                   + Arch_List (Cur_Arch).Bt_Offset_From_Call;
504
505      Addr2line_Args_Count := Addr2line_Args_Count + 1;
506      Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address);
507   end loop;
508
509   --  Run the resulting command
510
511   Spawn (Addr2line_Cmd.all,
512          Addr2line_Args (1 .. Addr2line_Args_Count), Success);
513
514   if not Success then
515      Error ("Couldn't spawn " & Addr2line_Cmd.all);
516   end if;
517
518exception
519   when others =>
520
521      --  Mask all exceptions
522
523      return;
524end VxAddr2Line;
525