192 lines
6.4 KiB
Ada
192 lines
6.4 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT RUN-TIME COMPONENTS --
|
|
-- --
|
|
-- G N A T . T R A C E B A C K . S Y M B O L I C . M O D U L E _ N A M E --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2012-2020, 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. --
|
|
-- --
|
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
|
-- version 3.1, as published by the Free Software Foundation. --
|
|
-- --
|
|
-- You should have received a copy of the GNU General Public License and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This is the GNU/Linux specific version of this package
|
|
with Interfaces.C; use Interfaces.C;
|
|
|
|
separate (System.Traceback.Symbolic)
|
|
|
|
package body Module_Name is
|
|
|
|
pragma Linker_Options ("-ldl");
|
|
|
|
function Is_Shared_Lib (Base : Address) return Boolean;
|
|
-- Returns True if a shared library
|
|
|
|
-- The principle is:
|
|
|
|
-- 1. We get information about the module containing the address.
|
|
|
|
-- 2. We check that the full pathname is pointing to a shared library.
|
|
|
|
-- 3. for shared libraries, we return the non relocated address (so
|
|
-- the absolute address in the shared library).
|
|
|
|
-- 4. we also return the full pathname of the module containing this
|
|
-- address.
|
|
|
|
-------------------
|
|
-- Is_Shared_Lib --
|
|
-------------------
|
|
|
|
function Is_Shared_Lib (Base : Address) return Boolean is
|
|
EI_NIDENT : constant := 16;
|
|
type u16 is mod 2 ** 16;
|
|
|
|
-- Just declare the needed header information, we just need to read the
|
|
-- type encoded in the second field.
|
|
|
|
type Elf32_Ehdr is record
|
|
e_ident : char_array (1 .. EI_NIDENT);
|
|
e_type : u16;
|
|
end record;
|
|
|
|
ET_DYN : constant := 3; -- A shared lib if e_type = ET_DYN
|
|
|
|
Header : Elf32_Ehdr;
|
|
pragma Import (Ada, Header);
|
|
-- Suppress initialization in Normalized_Scalars mode
|
|
for Header'Address use Base;
|
|
|
|
begin
|
|
return Header.e_type = ET_DYN;
|
|
exception
|
|
when others =>
|
|
return False;
|
|
end Is_Shared_Lib;
|
|
|
|
---------------------------------
|
|
-- Build_Cache_For_All_Modules --
|
|
---------------------------------
|
|
|
|
procedure Build_Cache_For_All_Modules is
|
|
type link_map;
|
|
type link_map_acc is access all link_map;
|
|
pragma Convention (C, link_map_acc);
|
|
|
|
type link_map is record
|
|
l_addr : Address;
|
|
-- Base address of the shared object
|
|
|
|
l_name : Address;
|
|
-- Null-terminated absolute file name
|
|
|
|
l_ld : Address;
|
|
-- Dynamic section
|
|
|
|
l_next, l_prev : link_map_acc;
|
|
-- Chain
|
|
end record;
|
|
pragma Convention (C, link_map);
|
|
|
|
type r_debug_type is record
|
|
r_version : Integer;
|
|
r_map : link_map_acc;
|
|
end record;
|
|
pragma Convention (C, r_debug_type);
|
|
|
|
r_debug : r_debug_type;
|
|
pragma Import (C, r_debug, "_r_debug");
|
|
|
|
lm : link_map_acc;
|
|
begin
|
|
lm := r_debug.r_map;
|
|
while lm /= null loop
|
|
if Big_String_Conv.To_Pointer (lm.l_name) (1) /= ASCII.NUL then
|
|
-- Discard non-file (like the executable itself or the gate).
|
|
Add_Module_To_Cache (Value (lm.l_name), lm.l_addr);
|
|
end if;
|
|
lm := lm.l_next;
|
|
end loop;
|
|
end Build_Cache_For_All_Modules;
|
|
|
|
---------
|
|
-- Get --
|
|
---------
|
|
|
|
function Get (Addr : System.Address;
|
|
Load_Addr : access System.Address)
|
|
return String
|
|
is
|
|
|
|
-- Dl_info record for Linux, used to get sym reloc offset
|
|
|
|
type Dl_info is record
|
|
dli_fname : System.Address;
|
|
dli_fbase : System.Address;
|
|
dli_sname : System.Address;
|
|
dli_saddr : System.Address;
|
|
end record;
|
|
|
|
function dladdr
|
|
(addr : System.Address;
|
|
info : not null access Dl_info) return int;
|
|
pragma Import (C, dladdr, "dladdr");
|
|
-- This is a Linux extension and not POSIX
|
|
|
|
info : aliased Dl_info;
|
|
|
|
begin
|
|
Load_Addr.all := System.Null_Address;
|
|
|
|
if dladdr (Addr, info'Access) /= 0 then
|
|
|
|
-- If we have a shared library we need to adjust the address to
|
|
-- be relative to the base address of the library.
|
|
|
|
if Is_Shared_Lib (info.dli_fbase) then
|
|
Load_Addr.all := info.dli_fbase;
|
|
end if;
|
|
|
|
return Value (info.dli_fname);
|
|
|
|
-- Not found, fallback to executable name
|
|
|
|
else
|
|
return "";
|
|
end if;
|
|
|
|
exception
|
|
when others =>
|
|
return "";
|
|
end Get;
|
|
|
|
------------------
|
|
-- Is_Supported --
|
|
------------------
|
|
|
|
function Is_Supported return Boolean is
|
|
begin
|
|
return True;
|
|
end Is_Supported;
|
|
|
|
end Module_Name;
|