aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.2.1/gcc/ada/vxaddr2line.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.2.1/gcc/ada/vxaddr2line.adb')
-rw-r--r--gcc-4.2.1/gcc/ada/vxaddr2line.adb468
1 files changed, 468 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/vxaddr2line.adb b/gcc-4.2.1/gcc/ada/vxaddr2line.adb
new file mode 100644
index 000000000..ba87c9938
--- /dev/null
+++ b/gcc-4.2.1/gcc/ada/vxaddr2line.adb
@@ -0,0 +1,468 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- V X A D D R 2 L I N E --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2005, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This program is meant to be used with vxworks to compute symbolic
+-- backtraces on the host from non-symbolic backtraces obtained on the target.
+
+-- The basic idea is to automate the computation of the necessary address
+-- adjustments prior to calling addr2line when the application has only been
+-- partially linked on the host.
+
+-- Variants for various targets are supported, and the command line should
+-- be like :
+
+-- <target>-addr2line [-a <target_arch>] <exe_file> <ref_address>
+-- <backtrace addresses>
+
+-- Where:
+-- <target_arch> :
+-- selects the target architecture. In the absence of this parameter the
+-- default variant is chosen based on the Detect_Arch result. Generally,
+-- this parameter will only be used if vxaddr2line is recompiled manually.
+-- Otherwise, the command name will always be of the form
+-- <target>-vxaddr2line where there is no ambiguity on the target's
+-- architecture.
+
+-- <exe_file> :
+-- The name of the partially linked binary file for the application.
+
+-- <ref_address> :
+-- Runtime address (on the target) of a reference symbol you choose,
+-- which name shall match the value of the Ref_Symbol variable declared
+-- below. A symbol with a small offset from the beginning of the text
+-- segment is better, so "adainit" is a good choice.
+
+-- <backtrace addresses> :
+-- The call chain addresses you obtained at run time on the target and
+-- for which you want a symbolic association.
+
+-- TO ADD A NEW ARCHITECTURE add an appropriate value to Architecture type
+-- (in a format <host>_<target>), and then an appropriate value to Config_List
+-- array
+
+with Text_IO; use Text_IO;
+with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Expect; use GNAT.Expect;
+with GNAT.Regpat; use GNAT.Regpat;
+
+procedure VxAddr2Line is
+
+ Ref_Symbol : constant String := "adainit";
+ -- This is the name of the reference symbol which runtime address shall
+ -- be provided as the <ref_address> argument.
+
+ -- All supported architectures
+ type Architecture is
+ (SOLARIS_I586,
+ WINDOWS_POWERPC,
+ WINDOWS_I586,
+ WINDOWS_M68K,
+ SOLARIS_POWERPC,
+ DEC_ALPHA);
+
+ type Arch_Record is record
+ Addr2line_Binary : String_Access;
+ -- Name of the addr2line utility to use
+
+ Nm_Binary : String_Access;
+ -- Name of the host nm utility, which will be used to find out the
+ -- offset of the reference symbol in the text segment of the partially
+ -- linked executable.
+
+ Addr_Digits_To_Skip : Integer;
+ -- When addresses such as 0xfffffc0001dfed50 are provided, for instance
+ -- on ALPHA, indicate the number of leading digits that can be ignored,
+ -- which will avoid computational overflows. Typically only useful when
+ -- 64bit addresses are provided.
+
+ Bt_Offset_From_Call : Integer;
+ -- Offset from a backtrace address to the address of the corresponding
+ -- call instruction. This should always be 0, except on platforms where
+ -- the backtrace addresses actually correspond to return and not call
+ -- points. In such cases, a negative value is most likely.
+ end record;
+
+ -- Configuration for each of the architectures
+ Arch_List : array (Architecture'Range) of Arch_Record :=
+ (WINDOWS_POWERPC =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4),
+ WINDOWS_M68K =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -4),
+ WINDOWS_I586 =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -2),
+ SOLARIS_POWERPC =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => 0),
+ SOLARIS_I586 =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 0,
+ Bt_Offset_From_Call => -2),
+ DEC_ALPHA =>
+ (Addr2line_Binary => null,
+ Nm_Binary => null,
+ Addr_Digits_To_Skip => 8,
+ Bt_Offset_From_Call => 0)
+ );
+
+ -- Current architecture
+ Cur_Arch : Architecture;
+
+ -- State of architecture detection
+ Detect_Success : Boolean := False;
+
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Error (Msg : String);
+ pragma No_Return (Error);
+ -- Prints the message and then terminates the program
+
+ procedure Usage;
+ -- Displays the short help message and then terminates the program
+
+ function Get_Reference_Offset return Integer;
+ -- Computes the static offset of the reference symbol by calling nm
+
+ function Get_Value_From_Hex_Arg (Arg : Natural) return Integer;
+ -- Threats the argument number Arg as a C-style hexadecimal literal
+ -- and returns its integer value
+
+ function Hex_Image (Value : Integer) return String_Access;
+ -- Returns access to a string that contains hexadecimal image of Value
+
+ -- Separate functions that provide build-time customization:
+
+ procedure Detect_Arch;
+ -- Saves in Cur_Arch the current architecture, based on the name of
+ -- vxaddr2line instance and properties of the host. Detect_Success is False
+ -- if detection fails
+
+ -----------------
+ -- Detect_Arch --
+ -----------------
+
+ procedure Detect_Arch is
+ Name : constant String := Base_Name (Command_Name);
+ Proc : constant String :=
+ Name (Name'First .. Index (Name, "-") - 1);
+ Target : constant String :=
+ Name (Name'First .. Index (Name, "vxaddr2line") - 1);
+
+ begin
+ Detect_Success := False;
+
+ if Proc = "" then
+ return;
+ end if;
+
+ if Proc = "alpha" then
+ Cur_Arch := DEC_ALPHA;
+ else
+ -- Let's detect the host.
+ -- ??? A naive implementation that can't distinguish between Unixes
+ if Directory_Separator = '/' then
+ Cur_Arch := Architecture'Value ("solaris_" & Proc);
+ else
+ Cur_Arch := Architecture'Value ("windows_" & Proc);
+ end if;
+ end if;
+
+ if Arch_List (Cur_Arch).Addr2line_Binary = null then
+ Arch_List (Cur_Arch).Addr2line_Binary := new String'
+ (Target & "addr2line");
+ end if;
+ if Arch_List (Cur_Arch).Nm_Binary = null then
+ Arch_List (Cur_Arch).Nm_Binary := new String'
+ (Target & "nm");
+ end if;
+
+ Detect_Success := True;
+
+ exception
+ when others =>
+ return;
+ end Detect_Arch;
+
+ -----------
+ -- Error --
+ -----------
+
+ procedure Error (Msg : String) is
+ begin
+ Put_Line (Msg);
+ OS_Exit (1);
+ raise Program_Error;
+ end Error;
+
+ --------------------------
+ -- Get_Reference_Offset --
+ --------------------------
+
+ function Get_Reference_Offset return Integer is
+ Nm_Cmd : constant String_Access :=
+ Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all);
+
+ Nm_Args : constant Argument_List :=
+ (new String'("-P"),
+ new String'(Argument (1)));
+
+ Forever : aliased String := "^@@@@";
+ Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)";
+
+ Pd : Process_Descriptor;
+ Result : Expect_Match;
+
+ begin
+ -- If Nm is not found, abort
+
+ if Nm_Cmd = null then
+ Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all);
+ end if;
+
+ Non_Blocking_Spawn
+ (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True);
+
+ -- Expect a string containing the reference symbol
+
+ Expect (Pd, Result,
+ Regexp_Array'(1 => Reference'Unchecked_Access),
+ Timeout => -1);
+
+ -- If we are here, the pattern was matched successfully
+
+ declare
+ Match_String : constant String := Expect_Out_Match (Pd);
+ Matches : Match_Array (0 .. 1);
+ Value : Integer;
+
+ begin
+ Match (Reference, Match_String, Matches);
+ Value := Integer'Value
+ ("16#"
+ & Match_String (Matches (1).First .. Matches (1).Last) & "#");
+
+ -- Expect a string that will never be emitted, so that the
+ -- process can be correctly terminated (with Process_Died)
+
+ Expect (Pd, Result,
+ Regexp_Array'(1 => Forever'Unchecked_Access),
+ Timeout => -1);
+
+ exception
+ when Process_Died =>
+ return Value;
+ end;
+
+ -- We cannot get here
+
+ raise Program_Error;
+
+ exception
+ when Invalid_Process =>
+ Error ("Could not spawn a process " & Nm_Cmd.all);
+
+ when others =>
+
+ -- The process died without matching the reference symbol or the
+ -- format wasn't recognized.
+
+ Error ("Unexpected output from " & Nm_Cmd.all);
+ end Get_Reference_Offset;
+
+ ----------------------------
+ -- Get_Value_From_Hex_Arg --
+ ----------------------------
+
+ function Get_Value_From_Hex_Arg (Arg : Natural) return Integer is
+ Cur_Arg : constant String := Argument (Arg);
+ Offset : Natural;
+
+ begin
+ -- Skip "0x" prefix if present
+
+ if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then
+ Offset := 3;
+ else
+ Offset := 1;
+ end if;
+
+ -- Add architecture-specific offset
+
+ Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip;
+
+ -- Convert to value
+
+ return Integer'Value ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#");
+ end Get_Value_From_Hex_Arg;
+
+ ---------------
+ -- Hex_Image --
+ ---------------
+
+ function Hex_Image (Value : Integer) return String_Access is
+ Result : String (1 .. 20);
+ Start_Pos : Natural;
+
+ begin
+ Put (Result, Value, 16);
+ Start_Pos := Index (Result, "16#") + 3;
+ return new String'(Result (Start_Pos .. Result'Last - 1));
+ end Hex_Image;
+
+ -----------
+ -- Usage --
+ -----------
+
+ procedure Usage is
+ begin
+ Put_Line ("Usage : " & Base_Name (Command_Name)
+ & " <executable> <"
+ & Ref_Symbol & " offset on target> <addr1> ...");
+
+ OS_Exit (1);
+ end Usage;
+
+ Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Integer;
+
+ Addr2line_Cmd : String_Access;
+
+ Addr2line_Args : Argument_List (1 .. 501);
+ -- We expect that there won't be more than 500 backtrace frames
+
+ Addr2line_Args_Count : Natural;
+
+ Success : Boolean;
+
+-- Start of processing for VxAddr2Line
+
+begin
+
+ Detect_Arch;
+
+ -- There should be at least two arguments
+
+ if Argument_Count < 2 then
+ Usage;
+ end if;
+
+ -- ??? HARD LIMIT! There should be at most 501 arguments
+
+ if Argument_Count > 501 then
+ Error ("Too many backtrace frames");
+ end if;
+
+ -- Do we have a valid architecture?
+
+ if not Detect_Success then
+ Put_Line ("Couldn't detect the architecture");
+ return;
+ end if;
+
+ Addr2line_Cmd :=
+ Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all);
+
+ -- If Addr2line is not found, abort
+
+ if Addr2line_Cmd = null then
+ Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
+ end if;
+
+ -- The first argument specifies the image file. Check if it exists
+
+ if not Is_Regular_File (Argument (1)) then
+ Error ("Couldn't find the executable " & Argument (1));
+ end if;
+
+ -- The second argument specifies the reference symbol runtime address.
+ -- Let's parse and store it
+
+ Ref_Runtime_Address := Get_Value_From_Hex_Arg (2);
+
+ -- Run nm command to get the reference symbol static offset
+
+ Ref_Static_Offset := Get_Reference_Offset;
+
+ -- Build addr2line parameters. First, the standard part
+
+ Addr2line_Args (1) := new String'("--exe=" & Argument (1));
+ Addr2line_Args_Count := 1;
+
+ -- Now, append to this the adjusted backtraces in arguments 4 and further
+
+ for J in 3 .. Argument_Count loop
+
+ -- Basically, for each address in the runtime backtrace ...
+
+ -- o We compute its offset relatively to the runtime address of the
+ -- reference symbol,
+
+ -- and then ...
+
+ -- o We add this offset to the static one for the reference symbol in
+ -- the executable to find the executable offset corresponding to the
+ -- backtrace address.
+
+ Bt_Address := Get_Value_From_Hex_Arg (J);
+
+ Bt_Address :=
+ Bt_Address - Ref_Runtime_Address
+ + Ref_Static_Offset
+ + Arch_List (Cur_Arch).Bt_Offset_From_Call;
+
+ Addr2line_Args_Count := Addr2line_Args_Count + 1;
+ Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address);
+ end loop;
+
+ -- Run the resulting command
+
+ Spawn (Addr2line_Cmd.all,
+ Addr2line_Args (1 .. Addr2line_Args_Count), Success);
+
+exception
+ when others =>
+
+ -- Mask all exceptions
+
+ return;
+end VxAddr2Line;