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