------------------------------------------------------------------------------ -- -- -- 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 : -- -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 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 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) & " <" & Ref_Symbol & " offset on target> ..."); 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;