gcc/ada/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-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
  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_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    pragma No_Return (Usage);
 213    --  Displays the short help message and then terminates the program
 214
 215    function Get_Reference_Offset return Unsigned_64;
 216    --  Computes the static offset of the reference symbol by calling nm
 217
 218    function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64;
 219    --  Threats the argument number Arg as a C-style hexadecimal literal
 220    --  and returns its integer value
 221
 222    function Hex_Image (Value : Unsigned_64) return String_Access;
 223    --  Returns access to a string that contains hexadecimal image of Value
 224
 225    --  Separate functions that provide build-time customization:
 226
 227    procedure Detect_Arch;
 228    --  Saves in Cur_Arch the current architecture, based on the name of
 229    --  vxaddr2line instance and properties of the host. Detect_Success is False
 230    --  if detection fails
 231
 232    -----------------
 233    -- Detect_Arch --
 234    -----------------
 235
 236    procedure Detect_Arch is
 237       Name   : constant String := Base_Name (Command_Name);
 238       Proc   : constant String :=
 239                  Name (Name'First .. Index (Name, "-") - 1);
 240       Target : constant String :=
 241                  Name (Name'First .. Index (Name, "vxaddr2line") - 1);
 242
 243    begin
 244       Detect_Success := False;
 245
 246       if Proc = "" then
 247          return;
 248       end if;
 249
 250       --  Let's detect a Linux or Windows host.
 251       if Directory_Separator = '/' then
 252          Cur_Arch := Architecture'Value ("linux_" & Proc);
 253       else
 254          Cur_Arch := Architecture'Value ("windows_" & Proc);
 255       end if;
 256
 257       if Arch_List (Cur_Arch).Addr2line_Binary = null then
 258          Arch_List (Cur_Arch).Addr2line_Binary := new String'
 259            (Target & "addr2line");
 260       end if;
 261       if Arch_List (Cur_Arch).Nm_Binary = null then
 262          Arch_List (Cur_Arch).Nm_Binary := new String'
 263            (Target & "nm");
 264       end if;
 265
 266       Detect_Success := True;
 267
 268    exception
 269       when others =>
 270          return;
 271    end Detect_Arch;
 272
 273    -----------
 274    -- Error --
 275    -----------
 276
 277    procedure Error (Msg : String) is
 278    begin
 279       Put_Line (Msg);
 280       OS_Exit (1);
 281       raise Program_Error;
 282    end Error;
 283
 284    --------------------------
 285    -- Get_Reference_Offset --
 286    --------------------------
 287
 288    function Get_Reference_Offset return Unsigned_64 is
 289       Nm_Cmd  : constant String_Access :=
 290                   Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);
 291
 292       Nm_Args : constant Argument_List :=
 293                   (new String'("-P"),
 294                    new String'(Argument (1)));
 295
 296       Forever   : aliased String := "^@@@@";
 297       Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)";
 298
 299       Pd     : Process_Descriptor;
 300       Result : Expect_Match;
 301
 302    begin
 303       --  If Nm is not found, abort
 304
 305       if Nm_Cmd = null then
 306          Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all);
 307       end if;
 308
 309       Non_Blocking_Spawn
 310         (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True);
 311
 312       --  Expect a string containing the reference symbol
 313
 314       Expect (Pd, Result,
 315               Regexp_Array'(1 => Reference'Unchecked_Access),
 316               Timeout => -1);
 317
 318       --  If we are here, the pattern was matched successfully
 319
 320       declare
 321          Match_String : constant String := Expect_Out_Match (Pd);
 322          Matches      : Match_Array (0 .. 1);
 323          Value        : Unsigned_64 := 0;
 324
 325       begin
 326          Match (Reference, Match_String, Matches);
 327          Value := Unsigned_64'Value
 328            ("16#"
 329             & Match_String (Matches (1).First .. Matches (1).Last) & "#");
 330
 331          --  Expect a string that will never be emitted, so that the
 332          --  process can be correctly terminated (with Process_Died)
 333
 334          Expect (Pd, Result,
 335                  Regexp_Array'(1 => Forever'Unchecked_Access),
 336                  Timeout => -1);
 337
 338       exception
 339          when Process_Died =>
 340             return Value;
 341       end;
 342
 343       --  We cannot get here
 344
 345       raise Program_Error;
 346
 347    exception
 348       when Invalid_Process =>
 349          Error ("Could not spawn a process " & Nm_Cmd.all);
 350
 351       when others    =>
 352
 353          --  The process died without matching the reference symbol or the
 354          --  format wasn't recognized.
 355
 356          Error ("Unexpected output from " & Nm_Cmd.all);
 357    end Get_Reference_Offset;
 358
 359    ----------------------------
 360    -- Get_Value_From_Hex_Arg --
 361    ----------------------------
 362
 363    function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64 is
 364       Cur_Arg : constant String := Argument (Arg);
 365       Offset  : Natural;
 366
 367    begin
 368       --  Skip "0x" prefix if present
 369
 370       if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then
 371          Offset := 3;
 372       else
 373          Offset := 1;
 374       end if;
 375
 376       --  Add architecture-specific offset
 377
 378       Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip;
 379
 380       --  Convert to value
 381
 382       return Unsigned_64'Value
 383         ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");
 384
 385    exception
 386       when Constraint_Error =>
 387
 388          Error ("Can't parse backtrace address '" & Cur_Arg & "'");
 389          raise;
 390    end Get_Value_From_Hex_Arg;
 391
 392    ---------------
 393    -- Hex_Image --
 394    ---------------
 395
 396    function Hex_Image (Value : Unsigned_64) return String_Access is
 397       Result    : String (1 .. 20);
 398       Start_Pos : Natural;
 399
 400    begin
 401       Unsigned_64_IO.Put (Result, Value, 16);
 402       Start_Pos := Index (Result, "16#") + 3;
 403       return new String'(Result (Start_Pos .. Result'Last - 1));
 404    end Hex_Image;
 405
 406    -----------
 407    -- Usage --
 408    -----------
 409
 410    procedure Usage is
 411    begin
 412       Put_Line ("Usage : " & Base_Name (Command_Name)
 413                 & " <executable> <"
 414                 & Ref_Symbol & " offset on target> <addr1> ...");
 415
 416       OS_Exit (1);
 417    end Usage;
 418
 419    Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_64;
 420
 421    Addr2line_Cmd : String_Access;
 422
 423    Addr2line_Args : Argument_List (1 .. 501);
 424    --  We expect that there won't be more than 500 backtrace frames
 425
 426    Addr2line_Args_Count : Natural;
 427
 428    Success : Boolean;
 429
 430 --  Start of processing for VxAddr2Line
 431
 432 begin
 433
 434    Detect_Arch;
 435
 436    --  There should be at least two arguments
 437
 438    if Argument_Count < 2 then
 439       Usage;
 440    end if;
 441
 442    --  Enforce HARD LIMIT There should be at most 501 arguments. Why 501???
 443
 444    if Argument_Count > 501 then
 445       Error ("Too many backtrace frames");
 446    end if;
 447
 448    --  Do we have a valid architecture?
 449
 450    if not Detect_Success then
 451       Put_Line ("Couldn't detect the architecture");
 452       return;
 453    end if;
 454
 455    Addr2line_Cmd :=
 456      Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all);
 457
 458    --  If Addr2line is not found, abort
 459
 460    if Addr2line_Cmd = null then
 461       Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
 462    end if;
 463
 464    --  The first argument specifies the image file. Check if it exists
 465
 466    if not Is_Regular_File (Argument (1)) then
 467       Error ("Couldn't find the executable " & Argument (1));
 468    end if;
 469
 470    --  The second argument specifies the reference symbol runtime address.
 471    --  Let's parse and store it
 472
 473    Ref_Runtime_Address := Get_Value_From_Hex_Arg (2);
 474
 475    --  Run nm command to get the reference symbol static offset
 476
 477    Ref_Static_Offset := Get_Reference_Offset;
 478
 479    --  Build addr2line parameters. First, the standard part
 480
 481    Addr2line_Args (1) := new String'("--exe=" & Argument (1));
 482    Addr2line_Args_Count := 1;
 483
 484    --  Now, append to this the adjusted backtraces in arguments 4 and further
 485
 486    for J in 3 .. Argument_Count loop
 487
 488       --  Basically, for each address in the runtime backtrace ...
 489
 490       --  o We compute its offset relatively to the runtime address of the
 491       --    reference symbol,
 492
 493       --  and then ...
 494
 495       --  o We add this offset to the static one for the reference symbol in
 496       --    the executable to find the executable offset corresponding to the
 497       --    backtrace address.
 498
 499       Bt_Address := Get_Value_From_Hex_Arg (J);
 500
 501       Bt_Address :=
 502         Bt_Address - Ref_Runtime_Address
 503                    + Ref_Static_Offset
 504                    + Arch_List (Cur_Arch).Bt_Offset_From_Call;
 505
 506       Addr2line_Args_Count := Addr2line_Args_Count + 1;
 507       Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address);
 508    end loop;
 509
 510    --  Run the resulting command
 511
 512    Spawn (Addr2line_Cmd.all,
 513           Addr2line_Args (1 .. Addr2line_Args_Count), Success);
 514
 515    if not Success then
 516       Error ("Couldn't spawn " & Addr2line_Cmd.all);
 517    end if;
 518
 519 exception
 520    when others =>
 521
 522       --  Mask all exceptions
 523
 524       return;
 525 end VxAddr2Line;