482 lines
15 KiB
Ada
482 lines
15 KiB
Ada
|
------------------------------------------------------------------------------
|
||
|
-- --
|
||
|
-- GNAT COMPILER COMPONENTS --
|
||
|
-- --
|
||
|
-- V X A D D R 2 L I N E --
|
||
|
-- --
|
||
|
-- B o d y --
|
||
|
-- --
|
||
|
-- 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 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 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. --
|
||
|
-- --
|
||
|
------------------------------------------------------------------------------
|
||
|
|
||
|
-- 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 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.Directory_Operations; use GNAT.Directory_Operations;
|
||
|
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,
|
||
|
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 : 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
|
||
|
-- 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 Unsigned_32;
|
||
|
-- Computes the static offset of the reference symbol by calling nm
|
||
|
|
||
|
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 : Unsigned_32) 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 Unsigned_32 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 : Unsigned_32;
|
||
|
|
||
|
begin
|
||
|
Match (Reference, Match_String, Matches);
|
||
|
Value := Unsigned_32'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 Unsigned_32 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 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 : Unsigned_32) return String_Access is
|
||
|
Result : String (1 .. 20);
|
||
|
Start_Pos : Natural;
|
||
|
|
||
|
begin
|
||
|
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;
|
||
|
|
||
|
-----------
|
||
|
-- 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 : Unsigned_32;
|
||
|
|
||
|
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);
|
||
|
|
||
|
if not Success then
|
||
|
Error ("Couldn't spawn " & Addr2line_Cmd.all);
|
||
|
end if;
|
||
|
|
||
|
exception
|
||
|
when others =>
|
||
|
|
||
|
-- Mask all exceptions
|
||
|
|
||
|
return;
|
||
|
end VxAddr2Line;
|