[COMMITTED 03/30] ada: Add support for symbolic backtraces with DLLs on Windows

["Marc Poulhiès" <poulhies@adacore.com>]

From: Eric Botcazou <ebotcazou@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