ada: Add support for symbolic backtraces with DLLs on Windows

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.

diff --git a/gcc/ada/libgnat/s-tsmona__linux.adb b/gcc/ada/libgnat/s-tsmona__linux.adb
index 417b57f454543d6f1e635f94deece64814bdd581..4545399017a7ce64b6dcbe57b6d7bebc5dc683c8 100644 (file)
--- 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 3100db08bbd15164487bc995a2a774caab6c622d..61264da7dfe5c8489a70d3af81bc02d8695dbf03 100644 (file)
--- 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 6e8e246d903a0d865eeb0d422da296fe0ce82bf0..963cb57b7f001b47374a5d342c6e2ea8dae3a94b 100644 (file)
--- 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;