X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fvxaddr2line.adb;h=028de5e5fbf49cf69705a28a3b4229fefeadb850;hb=4c97a37dc04bd1838ea3d099bebf2900e10322dd;hp=ad53b1024adeec13388ec9742eb0474d872e2131;hpb=f27cea3abf8ded22456f5f46a812cc3915969815;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb index ad53b1024ad..028de5e5fbf 100644 --- a/gcc/ada/vxaddr2line.adb +++ b/gcc/ada/vxaddr2line.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2005 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2011, 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- -- +-- 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 COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- +-- 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. -- @@ -63,34 +62,42 @@ -- (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 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.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; +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, + (DEC_ALPHA, + LINUX_E500V2, + LINUX_I586, + LINUX_POWERPC, + WINDOWS_E500V2, WINDOWS_I586, WINDOWS_M68K, - SOLARIS_POWERPC, - DEC_ALPHA); + WINDOWS_POWERPC, + SOLARIS_E500V2, + SOLARIS_I586, + SOLARIS_POWERPC); type Arch_Record is record Addr2line_Binary : String_Access; - -- Name of the addr2line utility to use. + -- 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 @@ -103,7 +110,7 @@ procedure VxAddr2Line is -- which will avoid computational overflows. Typically only useful when -- 64bit addresses are provided. - Bt_Offset_From_Call : Integer; + 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 @@ -112,17 +119,32 @@ procedure VxAddr2Line is -- Configuration for each of the architectures Arch_List : array (Architecture'Range) of Arch_Record := - (WINDOWS_POWERPC => + (DEC_ALPHA => + (Addr2line_Binary => null, + Nm_Binary => null, + Addr_Digits_To_Skip => 8, + Bt_Offset_From_Call => 0), + LINUX_E500V2 => (Addr2line_Binary => null, Nm_Binary => null, Addr_Digits_To_Skip => 0, Bt_Offset_From_Call => -4), - WINDOWS_M68K => + LINUX_I586 => + (Addr2line_Binary => null, + Nm_Binary => null, + Addr_Digits_To_Skip => 0, + Bt_Offset_From_Call => -2), + LINUX_POWERPC => (Addr2line_Binary => null, Nm_Binary => null, Addr_Digits_To_Skip => 0, Bt_Offset_From_Call => -4), - WINDOWS_I586 => + SOLARIS_E500V2 => + (Addr2line_Binary => null, + Nm_Binary => null, + Addr_Digits_To_Skip => 0, + Bt_Offset_From_Call => -4), + SOLARIS_I586 => (Addr2line_Binary => null, Nm_Binary => null, Addr_Digits_To_Skip => 0, @@ -131,17 +153,27 @@ procedure VxAddr2Line is (Addr2line_Binary => null, Nm_Binary => null, Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => 0), - SOLARIS_I586 => + Bt_Offset_From_Call => -4), + WINDOWS_E500V2 => + (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), - DEC_ALPHA => + WINDOWS_M68K => (Addr2line_Binary => null, Nm_Binary => null, - Addr_Digits_To_Skip => 8, - Bt_Offset_From_Call => 0) + Addr_Digits_To_Skip => 0, + Bt_Offset_From_Call => -4), + WINDOWS_POWERPC => + (Addr2line_Binary => null, + Nm_Binary => null, + Addr_Digits_To_Skip => 0, + Bt_Offset_From_Call => -4) ); -- Current architecture @@ -161,14 +193,14 @@ procedure VxAddr2Line is procedure Usage; -- Displays the short help message and then terminates the program - function Get_Reference_Offset return Integer; + 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 Integer; + 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 : Integer) return String_Access; + 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: @@ -239,7 +271,7 @@ procedure VxAddr2Line is -- Get_Reference_Offset -- -------------------------- - function Get_Reference_Offset return Integer is + function Get_Reference_Offset return Unsigned_32 is Nm_Cmd : constant String_Access := Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all); @@ -274,11 +306,11 @@ procedure VxAddr2Line is declare Match_String : constant String := Expect_Out_Match (Pd); Matches : Match_Array (0 .. 1); - Value : Integer; + Value : Unsigned_32; begin Match (Reference, Match_String, Matches); - Value := Integer'Value + Value := Unsigned_32'Value ("16#" & Match_String (Matches (1).First .. Matches (1).Last) & "#"); @@ -294,7 +326,7 @@ procedure VxAddr2Line is return Value; end; - -- We can not get here + -- We cannot get here raise Program_Error; @@ -314,7 +346,7 @@ procedure VxAddr2Line is -- Get_Value_From_Hex_Arg -- ---------------------------- - function Get_Value_From_Hex_Arg (Arg : Natural) return Integer is + function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_32 is Cur_Arg : constant String := Argument (Arg); Offset : Natural; @@ -333,19 +365,26 @@ procedure VxAddr2Line is -- Convert to value - return Integer'Value ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#"); + 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 : Integer) return String_Access is + function Hex_Image (Value : Unsigned_32) return String_Access is Result : String (1 .. 20); Start_Pos : Natural; begin - Put (Result, Value, 16); + 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; @@ -363,7 +402,7 @@ procedure VxAddr2Line is OS_Exit (1); end Usage; - Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Integer; + Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_32; Addr2line_Cmd : String_Access; @@ -408,7 +447,7 @@ begin Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all); end if; - -- The first argument specifies the image file. Check if it exists. + -- 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)); @@ -459,6 +498,10 @@ begin 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 =>