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