[Ada] Display executable load address before traceback

[Arnaud Charlet]

This is useful for post-mortem traceback analysis on PIE platforms.
No new test, as this is platform specific.

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* adaint.c, adaint.h (__gnat_get_executable_load_address):
	New function.
	* a-exexda.adb (Append_Info_Basic_Exception_Traceback): Add
	executable load address (Basic_Exception_Tback_Maxlength): Adjust.

-------------- next part --------------
Index: a-exexda.adb
===================================================================
--- a-exexda.adb	(revision 203521)
+++ a-exexda.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -206,6 +206,11 @@
    pragma Export
      (Ada, Exception_Message_Length, "__gnat_exception_msg_len");
 
+   function Get_Executable_Load_Address return System.Address;
+   pragma Import (C, Get_Executable_Load_Address,
+                  "__gnat_get_executable_load_address");
+   --  Get the load address of the executable, or Null_Address if not known
+
    -------------------------
    -- Append_Info_Address --
    -------------------------
@@ -377,17 +382,29 @@
    --  As for Basic_Exception_Information:
 
    BETB_Header : constant String := "Call stack traceback locations:";
+   LDAD_Header : constant String := "Load address: ";
 
    procedure Append_Info_Basic_Exception_Traceback
      (X    : Exception_Occurrence;
       Info : in out String;
       Ptr  : in out Natural)
    is
+      Load_Address : Address;
    begin
       if X.Num_Tracebacks = 0 then
          return;
       end if;
 
+      --  The executable load address line
+
+      Load_Address := Get_Executable_Load_Address;
+      if Load_Address /= Null_Address then
+         Append_Info_String (LDAD_Header, Info, Ptr);
+         Append_Info_Address (Load_Address, Info, Ptr);
+         Append_Info_NL (Info, Ptr);
+      end if;
+
+      --  The traceback lines
       Append_Info_String (BETB_Header, Info, Ptr);
       Append_Info_NL (Info, Ptr);
 
@@ -407,11 +424,12 @@
    function Basic_Exception_Tback_Maxlength
      (X : Exception_Occurrence) return Natural
    is
-      Space_Per_Traceback : constant := 2 + 16 + 1;
+      Space_Per_Address : constant := 2 + 16 + 1;
       --  Space for "0x" + HHHHHHHHHHHHHHHH + " "
    begin
-      return BETB_Header'Length + 1 +
-               X.Num_Tracebacks * Space_Per_Traceback + 1;
+      return LDAD_Header'Length + Space_Per_Address +
+               BETB_Header'Length + 1 +
+               X.Num_Tracebacks * Space_Per_Address + 1;
    end Basic_Exception_Tback_Maxlength;
 
    ---------------------------------------
Index: adaint.c
===================================================================
--- adaint.c	(revision 203521)
+++ adaint.c	(working copy)
@@ -3830,8 +3830,8 @@
 extern void __main (void);
 
 void __main (void) {}
-#endif
-#endif
+#endif /* RTSS */
+#endif /* RTX */
 
 #if defined (__ANDROID__)
 
@@ -3889,7 +3889,7 @@
   CPU_SET_S (cpu - 1, count, set);
 }
 
-#else
+#else /* !CPU_ALLOC */
 
 /* Static cpu sets */
 
@@ -3919,8 +3919,59 @@
      CPU by a 0, so we need to adjust. */
   CPU_SET (cpu - 1, set);
 }
+#endif /* !CPU_ALLOC */
+#endif /* linux */
+
+/* Return the load address of the executable, or 0 if not known.  In the
+   specific case of error, (void *)-1 can be returned. Beware: this unit may
+   be in a shared library.  As low-level units are needed, we allow #include
+   here.  */
+
+#if defined (__APPLE__)
+#include <mach-o/dyld.h>
+#elif defined (__linux__)
+#include <link.h>
+#elif defined (__AIX__)
+#include <sys/ldr.h>
 #endif
+
+const void *
+__gnat_get_executable_load_address (void)
+{
+#if defined (__APPLE__)
+  return _dyld_get_image_header (0);
+
+#elif defined (__linux__)
+  struct link_map *map = _r_debug.r_map;
+
+  return (const void *)map->l_addr;
+
+#elif defined (__AIX__)
+  /* Unfortunately, AIX wants to return the info for all loaded objects,
+     so we need to increase the buffer if too small.  */
+  size_t blen = 4096;
+  int status;
+
+  while (1)
+    {
+      char buf[blen];
+
+      status = loadquery (L_GETINFO, buf, blen);
+      if (status == 0)
+        {
+          struct ldinfo *info = (struct ld_info *)buf;
+          return info->ldinfo_textorg;
+        }
+      blen = blen * 2;
+
+      /* Avoid stack overflow.  */
+      if (blen > 40 * 1024)
+        return (const void *)-1;
+    }
+#else
+  return NULL;
 #endif
+}
 
 #ifdef __cplusplus
 }
Index: adaint.h
===================================================================
--- adaint.h	(revision 203521)
+++ adaint.h	(working copy)
@@ -287,6 +287,8 @@
 extern int    __gnat_binder_supports_auto_init     (void);
 extern int    __gnat_sals_init_using_constructors  (void);
 
+extern const void * __gnat_get_executable_load_address  (void);
+
 #ifdef __cplusplus
 }
 #endif