[multiple changes]

2013-10-14  Vincent Celier  <celier@adacore.com>

	* projects.texi: Add documentation for new attributes of package
	Clean: Artifacts_In_Object_Dir and Artifacts_In_Exec_Dir.

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.

From-SVN: r203530

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce4507636471b719414ac0a002b34ade23cb44da..99ad22f5ba674318353bf3e6d64ed466dffc7e8c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2013-10-14  Vincent Celier  <celier@adacore.com>
+
+       * projects.texi: Add documentation for new attributes of package
+       Clean: Artifacts_In_Object_Dir and Artifacts_In_Exec_Dir.
+
+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.
+
 2013-10-14  Vincent Celier  <celier@adacore.com>
 
        * prj-attr.adb: New attributes in package Clean:

diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb
index 85b519a5e1e30e8776728260737c6dbd08413fb1..815afac8dbffe18b95d68813c325a9ce292b97f0 100644 (file)
--- a/gcc/ada/a-exexda.adb
+++ b/gcc/ada/a-exexda.adb
@@ -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 @@ package body Exception_Data is
    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 @@ package body Exception_Data is
    --  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 @@ package body Exception_Data is
    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;
 
    ---------------------------------------

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index f76edb739954e4558f1d82ee239048bef58b3498..5b261af22a7aebea2e55eb0bb8a7e31a348ea6e3 100644 (file)
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -3830,8 +3830,8 @@ void GetTimeAsFileTime(LPFILETIME pTime)
 extern void __main (void);
 
 void __main (void) {}
-#endif
-#endif
+#endif /* RTSS */
+#endif /* RTX */
 
 #if defined (__ANDROID__)
 
@@ -3889,7 +3889,7 @@ void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
   CPU_SET_S (cpu - 1, count, set);
 }
 
-#else
+#else /* !CPU_ALLOC */
 
 /* Static cpu sets */
 
@@ -3919,8 +3919,59 @@ void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
      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
 }

diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 78af57c9dae9b9a82b3aa7477723d2d10bbe9a46..554d848f736d23519f3db855e5e1aa7f76ce9db7 100644 (file)
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -287,6 +287,8 @@ extern int    get_gcc_version                      (void);
 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

diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index 7072e0e6ada51adc07909649cdf0ecad7bb65f83..c027904f1533d5796d2a65da3a33beae31e7f322 100644 (file)
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -4292,6 +4292,16 @@ Index is a language names. Value is the list of extensions for file names
 derived from source file names that need to be cleaned in the object
 directory of the project.
 
+@item @b{Artifacts_In_Object_Dir}: single
+
+Value is a list of file names expressed as regular expressions that are to be
+deleted by gprclean in the object directory of the project.
+
+@item @b{Artifacts_In_Exec_Dir}: single
+
+Value is list of file names expressed as regular expressions that are to be
+deleted by gprclean in the exec directory of the main project.
+
 @end itemize
 
 @node Package Compiler Attributes