Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/s-trasym__dwarf.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- S Y S T E M . T R A C E B A C K . S Y M B O L I C -- 5 -- S Y S T E M . T R A C E B A C K . S Y M B O L I C --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1999-2017, AdaCore -- 9 -- Copyright (C) 1999-2018, AdaCore --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
121 121
122 function Value (Item : System.Address) return String; 122 function Value (Item : System.Address) return String;
123 -- Return the String contained in Item, up until the first NUL character 123 -- Return the String contained in Item, up until the first NUL character
124 124
125 pragma Warnings (Off, "*Add_Module_To_Cache*"); 125 pragma Warnings (Off, "*Add_Module_To_Cache*");
126 procedure Add_Module_To_Cache (Module_Name : String); 126 procedure Add_Module_To_Cache (Module_Name : String;
127 Load_Address : System.Address);
127 -- To be called by Build_Cache_For_All_Modules to add a new module to the 128 -- To be called by Build_Cache_For_All_Modules to add a new module to the
128 -- list. May not be referenced. 129 -- list. May not be referenced.
129 130
130 package Module_Name is 131 package Module_Name is
131 132
132 procedure Build_Cache_For_All_Modules; 133 procedure Build_Cache_For_All_Modules;
133 -- Create the cache for all current modules 134 -- Create the cache for all current modules
134 135
135 function Get (Addr : access System.Address) return String; 136 function Get (Addr : System.Address;
136 -- Returns the module name for the given address, Addr may be updated 137 Load_Addr : access System.Address) return String;
137 -- to be set relative to a shared library. This depends on the platform. 138 -- Returns the module name for the given address Addr, or an empty
138 -- Returns an empty string for the main executable. 139 -- string for the main executable. Load_Addr is set to the shared
140 -- library load address if this information is available, or to
141 -- System.Null_Address otherwise.
139 142
140 function Is_Supported return Boolean; 143 function Is_Supported return Boolean;
141 pragma Inline (Is_Supported); 144 pragma Inline (Is_Supported);
142 -- Returns True if Module_Name is supported, so if the traceback is 145 -- Returns True if Module_Name is supported, so if the traceback is
143 -- supported for shared libraries. 146 -- supported for shared libraries.
146 149
147 package body Module_Name is separate; 150 package body Module_Name is separate;
148 151
149 function Executable_Name return String; 152 function Executable_Name return String;
150 -- Returns the executable name as reported by argv[0]. If gnat_argv not 153 -- Returns the executable name as reported by argv[0]. If gnat_argv not
151 -- initialized or if argv[0] executable not found in path, function returns 154 -- initialized, return an empty string. If the argv[0] executable is not
152 -- an empty string. 155 -- found in the PATH, return it unresolved.
153 156
154 function Get_Executable_Load_Address return System.Address; 157 function Get_Executable_Load_Address return System.Address;
155 pragma Import 158 pragma Import
156 (C, 159 (C,
157 Get_Executable_Load_Address, 160 Get_Executable_Load_Address,
213 216
214 ------------------------- 217 -------------------------
215 -- Add_Module_To_Cache -- 218 -- Add_Module_To_Cache --
216 ------------------------- 219 -------------------------
217 220
218 procedure Add_Module_To_Cache (Module_Name : String) is 221 procedure Add_Module_To_Cache (Module_Name : String;
222 Load_Address : System.Address)
223 is
219 Module : Module_Cache_Acc; 224 Module : Module_Cache_Acc;
220 Success : Boolean; 225 Success : Boolean;
221 begin 226 begin
222 Module := new Module_Cache; 227 Module := new Module_Cache;
223 Init_Module (Module.all, Success, Module_Name); 228 Init_Module (Module.all, Success, Module_Name, Load_Address);
224 if not Success then 229 if not Success then
225 Free (Module); 230 Free (Module);
226 return; 231 return;
227 end if; 232 end if;
228 Module.Chain := Cache_Chain; 233 Module.Chain := Cache_Chain;
256 -- Lt -- 261 -- Lt --
257 -------- 262 --------
258 263
259 function Lt (Left, Right : Module_Cache_Acc) return Boolean is 264 function Lt (Left, Right : Module_Cache_Acc) return Boolean is
260 begin 265 begin
261 return Low (Left.C) < Low (Right.C); 266 return Low_Address (Left.C) < Low_Address (Right.C);
262 end Lt; 267 end Lt;
263 268
264 ----------------------------- 269 -----------------------------
265 -- Module_Cache_Array_Sort -- 270 -- Module_Cache_Array_Sort --
266 ----------------------------- 271 -----------------------------
282 return; 287 return;
283 end if; 288 end if;
284 289
285 -- Add all modules 290 -- Add all modules
286 Init_Exec_Module; 291 Init_Exec_Module;
292
293 if Exec_Module_State = Failed then
294 raise Program_Error with
295 "cannot enable cache, executable state initialization failed.";
296 end if;
297
287 Cache_Chain := Exec_Module'Access; 298 Cache_Chain := Exec_Module'Access;
288 299
289 if Include_Modules then 300 if Include_Modules then
290 Module_Name.Build_Cache_For_All_Modules; 301 Module_Name.Build_Cache_For_All_Modules;
291 end if; 302 end if;
340 begin 351 begin
341 if Gnat_Argv = Null_Address then 352 if Gnat_Argv = Null_Address then
342 return ""; 353 return "";
343 end if; 354 end if;
344 355
356 -- See if we can resolve argv[0] to a full path (to a file that we will
357 -- be able to open). If the resolution fails, we were probably spawned
358 -- by an imprecise exec call, typically passing a mere file name as
359 -- argv[0] for a program in the current directory with '.' not on PATH.
360 -- Best we can do is fallback to argv[0] unchanged in this case. If we
361 -- fail opening that downstream, we'll just bail out.
362
345 declare 363 declare
346 Addr : constant System.Address := 364 Argv0 : constant System.Address
347 locate_exec_on_path (Conv.To_Pointer (Gnat_Argv) (0)); 365 := Conv.To_Pointer (Gnat_Argv) (0);
348 Result : constant String := Value (Addr); 366
367 Resolved_Argv0 : constant System.Address
368 := locate_exec_on_path (Argv0);
369
370 Exe_Argv : constant System.Address
371 := (if Resolved_Argv0 /= System.Null_Address
372 then Resolved_Argv0
373 else Argv0);
374
375 Result : constant String := Value (Exe_Argv);
349 376
350 begin 377 begin
351 -- The buffer returned by locate_exec_on_path was allocated using 378 -- The buffer returned by locate_exec_on_path was allocated using
352 -- malloc, so we should use free to release the memory. 379 -- malloc and we should release this memory.
353 380
354 if Addr /= Null_Address then 381 if Resolved_Argv0 /= Null_Address then
355 System.CRTL.free (Addr); 382 System.CRTL.free (Resolved_Argv0);
356 end if; 383 end if;
357 384
358 return Result; 385 return Result;
359 end; 386 end;
360 end Executable_Name; 387 end Executable_Name;
462 begin 489 begin
463 Lo := Modules_Cache'First; 490 Lo := Modules_Cache'First;
464 Hi := Modules_Cache'Last; 491 Hi := Modules_Cache'Last;
465 while Lo <= Hi loop 492 while Lo <= Hi loop
466 Mid := (Lo + Hi) / 2; 493 Mid := (Lo + Hi) / 2;
467 if Addr < Low (Modules_Cache (Mid).C) then 494 if Addr < Low_Address (Modules_Cache (Mid).C) then
468 Hi := Mid - 1; 495 Hi := Mid - 1;
469 elsif Is_Inside (Modules_Cache (Mid).C, Addr) then 496 elsif Is_Inside (Modules_Cache (Mid).C, Addr) then
470 Multi_Module_Symbolic_Traceback 497 Multi_Module_Symbolic_Traceback
471 (Traceback, 498 (Traceback,
472 Modules_Cache (Mid).all, 499 Modules_Cache (Mid).all,
497 return; 524 return;
498 end if; 525 end if;
499 526
500 -- Otherwise, try a shared library 527 -- Otherwise, try a shared library
501 declare 528 declare
502 Addr : aliased System.Address := Traceback (F); 529 Load_Addr : aliased System.Address;
503 M_Name : constant String := Module_Name.Get (Addr'Access); 530 M_Name : constant String :=
531 Module_Name.Get (Addr => Traceback (F),
532 Load_Addr => Load_Addr'Access);
504 Module : Module_Cache; 533 Module : Module_Cache;
505 Success : Boolean; 534 Success : Boolean;
506 begin 535 begin
507 Init_Module (Module, Success, M_Name, System.Null_Address); 536 Init_Module (Module, Success, M_Name, Load_Addr);
508 if Success then 537 if Success then
509 Multi_Module_Symbolic_Traceback 538 Multi_Module_Symbolic_Traceback
510 (Traceback, 539 (Traceback,
511 Module, 540 Module,
512 Suppress_Hex, 541 Suppress_Hex,