-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2005 Ada Core Technologies, Inc. --
+-- 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 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.
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
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
