| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
