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