1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
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 --
9 -- Copyright (C) 2012-2024, AdaCore --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the GNU/Linux specific version of this package
34 with Interfaces
.C
; use Interfaces
.C
;
36 separate (System
.Traceback
.Symbolic
)
38 package body Module_Name
is
40 pragma Linker_Options
("-ldl");
42 function Is_Shared_Lib
(Base
: Address
) return Boolean;
43 -- Returns True if a shared library
49 function Is_Shared_Lib
(Base
: Address
) return Boolean is
50 EI_NIDENT
: constant := 16;
51 type u16
is mod 2 ** 16;
53 -- Just declare the needed header information, we just need to read the
54 -- type encoded in the second field.
56 type Elf32_Ehdr
is record
57 e_ident
: char_array
(1 .. EI_NIDENT
);
61 ET_DYN
: constant := 3; -- A shared lib if e_type = ET_DYN
64 pragma Import
(Ada
, Header
);
65 -- Suppress initialization in Normalized_Scalars mode
66 for Header
'Address use Base
;
69 return Header
.e_type
= ET_DYN
;
75 ---------------------------------
76 -- Build_Cache_For_All_Modules --
77 ---------------------------------
79 procedure Build_Cache_For_All_Modules
is
81 type link_map_acc
is access all link_map
;
82 pragma Convention
(C
, link_map_acc
);
84 type link_map
is record
85 l_addr
: aliased Address
;
86 -- Base address of the shared object
88 l_name
: aliased Address
;
89 -- Null-terminated absolute file name
91 l_ld
: aliased Address
;
94 l_next
, l_prev
: aliased link_map_acc
;
97 pragma Convention
(C
, link_map
);
99 type r_debug_state
is (RT_CONSISTENT
, RT_ADD
, RT_DELETE
);
100 pragma Convention
(C
, r_debug_state
);
101 pragma Unreferenced
(RT_CONSISTENT
, RT_ADD
, RT_DELETE
);
103 type r_debug_type
is record
104 r_version
: aliased int
;
105 r_map
: aliased link_map_acc
;
106 r_brk
: aliased Address
;
107 r_state
: aliased r_debug_state
;
108 r_ldbase
: aliased Address
;
110 pragma Convention
(C
, r_debug_type
);
112 r_debug
: r_debug_type
;
113 pragma Import
(C
, r_debug
, "_r_debug");
118 while lm
/= null loop
119 if Big_String_Conv
.To_Pointer
(lm
.l_name
) (1) /= ASCII
.NUL
then
120 -- Discard non-file (like the executable itself or the gate).
121 Add_Module_To_Cache
(Value
(lm
.l_name
), lm
.l_addr
);
125 end Build_Cache_For_All_Modules
;
133 -- 1. We get information about the module containing the address.
135 -- 2. We check whether the module is a shared library.
137 -- 3. For shared libraries, we return the non-relocated address (so
138 -- the absolute address in the shared library).
140 -- 4. We also return the full pathname of the module containing this
144 (Addr
: System
.Address
;
145 Load_Addr
: access System
.Address
) return String
147 -- Dl_info record for Linux, used to get sym reloc offset
149 type Dl_info
is record
150 dli_fname
: System
.Address
;
151 dli_fbase
: System
.Address
;
152 dli_sname
: System
.Address
;
153 dli_saddr
: System
.Address
;
157 (addr
: System
.Address
;
158 info
: not null access Dl_info
) return int
;
159 pragma Import
(C
, dladdr
, "dladdr");
160 -- This is a Linux extension and not POSIX
162 info
: aliased Dl_info
;
165 Load_Addr
.all := System
.Null_Address
;
167 if dladdr
(Addr
, info
'Access) /= 0 then
169 -- If we have a shared library we need to adjust the address to
170 -- be relative to the base address of the library.
172 if Is_Shared_Lib
(info
.dli_fbase
) then
173 Load_Addr
.all := info
.dli_fbase
;
176 return Value
(info
.dli_fname
);
178 -- Not found, fallback to executable name
193 function Is_Supported
return Boolean is