]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2013-01-03 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 3 Jan 2013 10:09:24 +0000 (10:09 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 3 Jan 2013 10:09:24 +0000 (10:09 +0000)
* exp_intr.adb: Minor reformatting.

2013-01-03  Robert Dewar  <dewar@adacore.com>

* einfo.adb: Minor reformatting.

2013-01-03  Pascal Obry  <obry@adacore.com>

* adaint.c, adaint.h (__gnat_get_module_name): Removed.
(__gnat_is_module_name_supported): Removed.
* s-win32.ads: Add some needed definitions.
* g-trasym.ads: Update comments.

2013-01-03  Robert Dewar  <dewar@adacore.com>

* layout.adb (Set_Composite_Alignment): Fix problems of
interactions with Optimize_Alignment set to Space.

2013-01-03  Thomas Quinot  <quinot@adacore.com>

* exp_disp.adb: Minor reformatting.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194842 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/adaint.c
gcc/ada/adaint.h
gcc/ada/einfo.adb
gcc/ada/exp_disp.adb
gcc/ada/exp_intr.adb
gcc/ada/g-trasym.ads
gcc/ada/layout.adb
gcc/ada/s-win32.ads

index 5416e12e7e296e58e64db139e117c6f7e7bfd2ca..5ecac2e8dd1dd0c63b27125cfd90ae1da0f0f9ce 100644 (file)
@@ -1,3 +1,27 @@
+2013-01-03  Robert Dewar  <dewar@adacore.com>
+
+       * exp_intr.adb: Minor reformatting.
+
+2013-01-03  Robert Dewar  <dewar@adacore.com>
+
+       * einfo.adb: Minor reformatting.
+
+2013-01-03  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c, adaint.h (__gnat_get_module_name): Removed.
+       (__gnat_is_module_name_supported): Removed.
+       * s-win32.ads: Add some needed definitions.
+       * g-trasym.ads: Update comments.
+
+2013-01-03  Robert Dewar  <dewar@adacore.com>
+
+       * layout.adb (Set_Composite_Alignment): Fix problems of
+       interactions with Optimize_Alignment set to Space.
+
+2013-01-03  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_disp.adb: Minor reformatting.
+
 2013-01-02  Richard Biener  <rguenther@suse.de>
 
        PR bootstrap/55784
index d95b6615b772e6e73900e5c0529ec5a67fe06019..4b8ce5341effe674babb315ccfde9b4ad681c25d 100644 (file)
@@ -2960,54 +2960,6 @@ __gnat_locate_exec_on_path (char *exec_name)
 #endif
 }
 
-/* __gnat_get_module_name returns the module name (executable or shared
-   library) in which the code at addr is. This is used to properly
-   report the symbolic tracebacks.  If the module cannot be located
-   it returns the empty string. The returned value must not be freed.
-
-   If this routine is fully implemented the value for
-   __gnat_is_module_name_supported should be set to 1.  */
-
-char *__gnat_get_module_name (void *addr ATTRIBUTE_UNUSED)
-{
-  extern char **gnat_argv;
-
-#ifdef _WIN32
-  static char lpFilename[MAX_PATH];
-  HMODULE hModule;
-
-  lpFilename[0] = '\0';
-
-  /* Get the module handle in which the code running at the specified
-     address is contained.  */
-
-  if (GetModuleHandleEx
-      (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, addr, &hModule) == FALSE)
-    return __gnat_locate_exec_on_path (gnat_argv[0]);
-
-  /* Get the corresponding module full path name.  We really want the
-     standard ASCII version of this routine as the name is passed to
-     the BFD library.  */
-
-  if (GetModuleFileNameA (hModule, lpFilename, MAX_PATH) == 0)
-    return __gnat_locate_exec_on_path (gnat_argv[0]);
-
-  return lpFilename;
-
-#else
-  /* On all other platforms we just return the full path name of the
-     main executable.  */
-
-  return __gnat_locate_exec_on_path (gnat_argv[0]);
-#endif
-}
-
-#ifdef _WIN32
-int __gnat_is_module_name_supported = 1;
-#else
-int __gnat_is_module_name_supported = 0;
-#endif
-
 #ifdef VMS
 
 /* These functions are used to translate to and from VMS and Unix syntax
index 217ce6c48e14472b51cbd4aff11f1f7e11839b16..7956e27a709f705d0dd6d0e8d709b9af48226c1c 100644 (file)
@@ -186,7 +186,6 @@ extern int    __gnat_portable_wait                 (int *);
 extern char  *__gnat_locate_exec                   (char *, char *);
 extern char  *__gnat_locate_exec_on_path          (char *);
 extern char  *__gnat_locate_regular_file           (char *, char *);
-extern char  *__gnat_get_module_name               (void *);
 extern void   __gnat_maybe_glob_args               (int *, char ***);
 extern void   __gnat_os_exit                      (int);
 extern char  *__gnat_get_libraries_from_registry   (void);
index 34f61b9f25ee82f56e4513460c8ba1ffa4ddc38d..89cd7826313716037e731ba24fb69938811ee494 100644 (file)
@@ -5910,14 +5910,12 @@ package body Einfo is
    begin
       pragma Assert
         (Is_Record_Type (Id)
-         or else Is_Incomplete_Or_Private_Type (Id)
-         or else Has_Discriminants (Id));
+          or else Is_Incomplete_Or_Private_Type (Id)
+          or else Has_Discriminants (Id));
 
       Comp_Id := First_Entity (Id);
       while Present (Comp_Id) loop
-         exit when Ekind (Comp_Id) = E_Component
-                     or else
-                   Ekind (Comp_Id) = E_Discriminant;
+         exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
          Comp_Id := Next_Entity (Comp_Id);
       end loop;
 
index c0872ade55fa7e4453e8301b9b273db2a447b67b..5b8ae1720ae020e987f99ed956531a1d906a372c 100644 (file)
@@ -8107,7 +8107,7 @@ package body Exp_Disp is
          procedure Handle_Inherited_Private_Subprograms (Typ : Entity_Id);
          --  Called if Typ is declared in a nested package or a public child
          --  package to handle inherited primitives that were inherited by Typ
-         --  in  the visible part, but whose declaration was deferred because
+         --  in the visible part, but whose declaration was deferred because
          --  the parent operation was private and not visible at that point.
 
          procedure Set_Fixed_Prim (Pos : Nat);
index b2c24c83101d42b8d8a1272662530949e460ab14..f86cbe5e24868d262560bedb0bda7eaa7d2f4a0d 100644 (file)
@@ -287,7 +287,8 @@ package body Exp_Intr is
          Set_Controlling_Argument (Cnstr_Call,
            New_Occurrence_Of (Defining_Identifier (Iface_Tag), Loc));
       else
-         Set_Controlling_Argument (Cnstr_Call, Relocate_Node (Tag_Arg));
+         Set_Controlling_Argument (Cnstr_Call,
+           Relocate_Node (Tag_Arg));
       end if;
 
       --  Rewrite and analyze the call to the instance as a class-wide
index 7b4e0035c7c95391c2d719c8280026edd2631bd1..62bb632c8158b99fd86c1c623d29b6faa60ed456 100644 (file)
 
 --  In order to retrieve symbolic information, functions in this package will
 --  read on disk all the debug information of the executable file (found via
---  Argument (0), and looked in the PATH if needed), and load them in memory,
---  causing a significant cpu and memory overhead.
-
---  On all platforms except VMS, this package is not intended to be used
---  within a shared library, symbolic tracebacks are only supported for the
---  main executable and not for shared libraries. You should consider using
---  gdb to obtain symbolic traceback in such cases.
+--  Argument (0), and looked in the PATH if needed) or shared libraries using
+--  OS facilities, and load them in memory, causing a significant cpu and
+--  memory overhead.
+
+--  Symbolic traceback from shared libraries is only supported for VMS, Windows
+--  and GNU/Linux. On other targets symbolic tracebacks are only supported for
+--  the main executable. You should consider using gdb to obtain symbolic
+--  traceback in such cases.
 
 --  On VMS, there is no restriction on using this facility with shared
 --  libraries. However, the OS should be at least v7.3-1 and OS patch
index 3ac620ca4ca40794ef260582f730012d23231114..55fe37812cec1d9f38f197e0c44c1c44d0bef32e 100644 (file)
@@ -2873,22 +2873,63 @@ package body Layout is
       --  Alignment is not known, see if we can set it, taking into account
       --  the setting of the Optimize_Alignment mode.
 
-      --  If Optimize_Alignment is set to Space, then packed records always
-      --  have an alignment of 1. But don't do anything for atomic records
-      --  since we may need higher alignment for indivisible access.
+      --  If Optimize_Alignment is set to Space, then we try to give packed
+      --  records an aligmment of 1, unless there is some reason we can't.
 
       if Optimize_Alignment_Space (E)
         and then Is_Record_Type (E)
         and then Is_Packed (E)
-        and then not Is_Atomic (E)
       then
+         --  No effect for record with atomic components
+
+         if Is_Atomic (E) then
+            Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
+            Error_Msg_N ("\pragma ignored for atomic record??", E);
+            return;
+         end if;
+
+         --  No effect if independent components
+
+         if Has_Independent_Components (E) then
+            Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
+            Error_Msg_N
+              ("\pragma ignored for record with independent components??", E);
+            return;
+         end if;
+
+         --  No effect if any component is atomic or is a by reference type
+
+         declare
+            Ent : Entity_Id;
+         begin
+            Ent := First_Component_Or_Discriminant (E);
+            while Present (Ent) loop
+               if Is_By_Reference_Type (Etype (Ent))
+                 or else Is_Atomic (Etype (Ent))
+                 or else Is_Atomic (Ent)
+               then
+                  Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
+                  Error_Msg_N
+                    ("\pragma is ignored if atomic components present??", E);
+                  return;
+               else
+                  Next_Component_Or_Discriminant (Ent);
+               end if;
+            end loop;
+         end;
+
+         --  Optimize_Alignment has no effect on variable length record
+
          if not Size_Known_At_Compile_Time (E) then
             Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
             Error_Msg_N ("\pragma is ignored for variable length record??", E);
-         else
-            Align := 1;
+            return;
          end if;
 
+         --  All tests passed, we can set alignment to 1
+
+         Align := 1;
+
       --  Not a record, or not packed
 
       else
index ec07b820d45da35db3cbc3438e928255ea746163..4c92ea5ede7422135a3dda04065a6e4a5039f944 100644 (file)
@@ -154,6 +154,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#;
+
    type OVERLAPPED is record
       Internal     : DWORD;
       InternalHigh : DWORD;
@@ -318,4 +320,20 @@ package System.Win32 is
    pragma Import
      (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
 
+   ------------
+   -- Module --
+   ------------
+
+   function GetModuleHandleEx
+     (dwFlags      : DWORD;
+      lpModuleName : Address;
+      phModule     : access HANDLE) return BOOL;
+   pragma Import (Stdcall, GetModuleHandleEx, "GetModuleHandleExA");
+
+   function GetModuleFileName
+     (hModule    : HANDLE;
+      lpFilename : Address;
+      nSize      : DWORD) return DWORD;
+   pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
+
 end System.Win32;