-- --
-- 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. --
-- (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 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 <ref_address> 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
-- 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
-- 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,
(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
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:
-- 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);
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) & "#");
return Value;
end;
- -- We can not get here
+ -- We cannot get here
raise Program_Error;
-- 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;
-- 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;
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;
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));
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 =>
OSDN Git Service
