From: Eric Botcazou <ebotca...@adacore.com>
This puts Windows on par with Linux as far as backtraces are concerned.
gcc/ada/
* libgnat/s-tsmona__linux.adb (Get): Move down descriptive comment.
* libgnat/s-tsmona__mingw.adb: Add with clause and use clause for
System.Storage_Elements.
(Get): Pass GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT in the call
to GetModuleHandleEx and remove the subsequent call to FreeLibrary.
Upon success, set Load_Addr to the base address of the module.
* libgnat/s-win32.ads (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS): Use
shorter literal.
(GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT): New constant.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/s-tsmona__linux.adb | 34 ++++++++++++++---------------
gcc/ada/libgnat/s-tsmona__mingw.adb | 20 ++++++++---------
gcc/ada/libgnat/s-win32.ads | 3 ++-
3 files changed, 29 insertions(+), 28 deletions(-)
diff --git a/gcc/ada/libgnat/s-tsmona__linux.adb
b/gcc/ada/libgnat/s-tsmona__linux.adb
index 417b57f4545..4545399017a 100644
--- a/gcc/ada/libgnat/s-tsmona__linux.adb
+++ b/gcc/ada/libgnat/s-tsmona__linux.adb
@@ -30,7 +30,8 @@
------------------------------------------------------------------------------
-- This is the GNU/Linux specific version of this package
-with Interfaces.C; use Interfaces.C;
+
+with Interfaces.C; use Interfaces.C;
separate (System.Traceback.Symbolic)
@@ -41,18 +42,6 @@ package body Module_Name is
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 --
-------------------
@@ -139,11 +128,22 @@ package body Module_Name is
-- Get --
---------
- function Get (Addr : System.Address;
- Load_Addr : access System.Address)
- return String
- is
+ -- The principle is:
+
+ -- 1. We get information about the module containing the address.
+
+ -- 2. We check whether the module is 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.
+
+ 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
diff --git a/gcc/ada/libgnat/s-tsmona__mingw.adb
b/gcc/ada/libgnat/s-tsmona__mingw.adb
index 3100db08bbd..61264da7dfe 100644
--- a/gcc/ada/libgnat/s-tsmona__mingw.adb
+++ b/gcc/ada/libgnat/s-tsmona__mingw.adb
@@ -31,7 +31,8 @@
-- This is the Windows specific version of this package
-with System.Win32; use System.Win32;
+with System.Storage_Elements; use System.Storage_Elements;
+with System.Win32; use System.Win32;
separate (System.Traceback.Symbolic)
@@ -50,27 +51,26 @@ package body Module_Name is
-- Get --
---------
- function Get (Addr : System.Address;
- Load_Addr : access System.Address)
- return String
+ function Get
+ (Addr : System.Address;
+ Load_Addr : access System.Address) return String
is
Res : DWORD;
hModule : aliased HANDLE;
- Path : String (1 .. 1_024);
+ Path : String (1 .. 1024);
begin
Load_Addr.all := System.Null_Address;
if GetModuleHandleEx
- (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
+ (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS +
+ GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT,
Addr,
hModule'Access) = Win32.TRUE
then
- Res := GetModuleFileName (hModule, Path'Address, Path'Length);
+ Load_Addr.all := To_Address (Integer_Address (hModule));
- if FreeLibrary (hModule) = Win32.FALSE then
- null;
- end if;
+ Res := GetModuleFileName (hModule, Path'Address, Path'Length);
if Res > 0 then
return Path (1 .. Positive (Res));
diff --git a/gcc/ada/libgnat/s-win32.ads b/gcc/ada/libgnat/s-win32.ads
index 6e8e246d903..963cb57b7f0 100644
--- a/gcc/ada/libgnat/s-win32.ads
+++ b/gcc/ada/libgnat/s-win32.ads
@@ -157,7 +157,8 @@ package System.Win32 is
FILE_ATTRIBUTE_VALID_FLAGS : constant := 16#00007fb7#;
FILE_ATTRIBUTE_VALID_SET_FLAGS : constant := 16#000031a7#;
- GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS : constant := 16#00000004#;
+ GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS : constant := 16#04#;
+ GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT : constant := 16#02#;
type OVERLAPPED is record
Internal : access ULONG;
--
2.45.1
