1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- 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 -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2012-2018, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is the GNU/Linux specific version of this package 33with Interfaces.C; use Interfaces.C; 34 35separate (System.Traceback.Symbolic) 36 37package body Module_Name is 38 39 pragma Linker_Options ("-ldl"); 40 41 function Is_Shared_Lib (Base : Address) return Boolean; 42 -- Returns True if a shared library 43 44 -- The principle is: 45 46 -- 1. We get information about the module containing the address. 47 48 -- 2. We check that the full pathname is pointing to a shared library. 49 50 -- 3. for shared libraries, we return the non relocated address (so 51 -- the absolute address in the shared library). 52 53 -- 4. we also return the full pathname of the module containing this 54 -- address. 55 56 ------------------- 57 -- Is_Shared_Lib -- 58 ------------------- 59 60 function Is_Shared_Lib (Base : Address) return Boolean is 61 EI_NIDENT : constant := 16; 62 type u16 is mod 2 ** 16; 63 64 -- Just declare the needed header information, we just need to read the 65 -- type encoded in the second field. 66 67 type Elf32_Ehdr is record 68 e_ident : char_array (1 .. EI_NIDENT); 69 e_type : u16; 70 end record; 71 72 ET_DYN : constant := 3; -- A shared lib if e_type = ET_DYN 73 74 Header : Elf32_Ehdr; 75 pragma Import (Ada, Header); 76 -- Suppress initialization in Normalized_Scalars mode 77 for Header'Address use Base; 78 79 begin 80 return Header.e_type = ET_DYN; 81 exception 82 when others => 83 return False; 84 end Is_Shared_Lib; 85 86 --------------------------------- 87 -- Build_Cache_For_All_Modules -- 88 --------------------------------- 89 90 procedure Build_Cache_For_All_Modules is 91 type link_map; 92 type link_map_acc is access all link_map; 93 pragma Convention (C, link_map_acc); 94 95 type link_map is record 96 l_addr : Address; 97 -- Base address of the shared object 98 99 l_name : Address; 100 -- Null-terminated absolute file name 101 102 l_ld : Address; 103 -- Dynamic section 104 105 l_next, l_prev : link_map_acc; 106 -- Chain 107 end record; 108 pragma Convention (C, link_map); 109 110 type r_debug_type is record 111 r_version : Integer; 112 r_map : link_map_acc; 113 end record; 114 pragma Convention (C, r_debug_type); 115 116 r_debug : r_debug_type; 117 pragma Import (C, r_debug, "_r_debug"); 118 119 lm : link_map_acc; 120 begin 121 lm := r_debug.r_map; 122 while lm /= null loop 123 if Big_String_Conv.To_Pointer (lm.l_name) (1) /= ASCII.NUL then 124 -- Discard non-file (like the executable itself or the gate). 125 Add_Module_To_Cache (Value (lm.l_name)); 126 end if; 127 lm := lm.l_next; 128 end loop; 129 end Build_Cache_For_All_Modules; 130 131 --------- 132 -- Get -- 133 --------- 134 135 function Get (Addr : System.Address; 136 Load_Addr : access System.Address) 137 return String 138 is 139 140 -- Dl_info record for Linux, used to get sym reloc offset 141 142 type Dl_info is record 143 dli_fname : System.Address; 144 dli_fbase : System.Address; 145 dli_sname : System.Address; 146 dli_saddr : System.Address; 147 end record; 148 149 function dladdr 150 (addr : System.Address; 151 info : not null access Dl_info) return int; 152 pragma Import (C, dladdr, "dladdr"); 153 -- This is a Linux extension and not POSIX 154 155 info : aliased Dl_info; 156 157 begin 158 Load_Addr.all := System.Null_Address; 159 160 if dladdr (Addr, info'Access) /= 0 then 161 162 -- If we have a shared library we need to adjust the address to 163 -- be relative to the base address of the library. 164 165 if Is_Shared_Lib (info.dli_fbase) then 166 Load_Addr.all := info.dli_fbase; 167 end if; 168 169 return Value (info.dli_fname); 170 171 -- Not found, fallback to executable name 172 173 else 174 return ""; 175 end if; 176 177 exception 178 when others => 179 return ""; 180 end Get; 181 182 ------------------ 183 -- Is_Supported -- 184 ------------------ 185 186 function Is_Supported return Boolean is 187 begin 188 return True; 189 end Is_Supported; 190 191end Module_Name; 192