From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/vxaddr2line.adb | 481 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 481 insertions(+) create mode 100644 gcc/ada/vxaddr2line.adb (limited to 'gcc/ada/vxaddr2line.adb') diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb new file mode 100644 index 000000000..f1bb48a74 --- /dev/null +++ b/gcc/ada/vxaddr2line.adb @@ -0,0 +1,481 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- V X A D D R 2 L I N E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2009, 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 3, 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 COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- 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 : + +-- -addr2line [-a ] +-- + +-- Where: +-- : +-- 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 +-- -vxaddr2line where there is no ambiguity on the target's +-- architecture. + +-- : +-- The name of the partially linked binary file for the application. + +-- : +-- 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. + +-- : +-- 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 _), and then an appropriate value to Config_List +-- array + +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Command_Line; use Ada.Command_Line; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; +with Interfaces; use Interfaces; + +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 + + package Unsigned_32_IO is new Modular_IO (Unsigned_32); + -- Instantiate Modular_IO to have Put + + Ref_Symbol : constant String := "adainit"; + -- This is the name of the reference symbol which runtime address shall + -- be provided as the 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 : Unsigned_32; + -- 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 Unsigned_32; + -- Computes the static offset of the reference symbol by calling nm + + function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32; + -- Threats the argument number Arg as a C-style hexadecimal literal + -- and returns its integer value + + function Hex_Image (Value : Unsigned_32) 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 Unsigned_32 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 : Unsigned_32; + + begin + Match (Reference, Match_String, Matches); + Value := Unsigned_32'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 Unsigned_32 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 Unsigned_32'Value + ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#"); + + exception + when Constraint_Error => + + Error ("Can't parse backtrace address '" & Cur_Arg & "'"); + raise; + end Get_Value_From_Hex_Arg; + + --------------- + -- Hex_Image -- + --------------- + + function Hex_Image (Value : Unsigned_32) return String_Access is + Result : String (1 .. 20); + Start_Pos : Natural; + + begin + Unsigned_32_IO.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) + & " <" + & Ref_Symbol & " offset on target> ..."); + + OS_Exit (1); + end Usage; + + Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_32; + + 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); + + if not Success then + Error ("Couldn't spawn " & Addr2line_Cmd.all); + end if; + +exception + when others => + + -- Mask all exceptions + + return; +end VxAddr2Line; -- cgit v1.2.3