[multiple changes]

2009-07-22  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): If Implicit_Packing is enabled, and the
	component size is an exact number of bytes, an array type can have a
	size clause that forces packing even though the array type itself is
	not bit-packed.

2009-07-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): For a constant declaration,
	if there is a previous entity with the same name in the scope, ignore
	it if it is the renaming declaration for a generic package introduced
	in instances.

2009-07-22  Nicolas Roche  <roche@adacore.com>

	* seh_init.c: use RtlAddFunctionTable to register our SEH exception
	handler on x86_64 windows.

2009-07-22  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Initialize/Normalize_Scalars create
	false positives in CodePeer, so ignore this pragma in this mode.

From-SVN: r149931

5 files changed, 157 insertions, 10 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2f3fdb9..5bce84d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2009-07-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Entity): If Implicit_Packing is enabled, and the
+	component size is an exact number of bytes, an array type can have a
+	size clause that forces packing even though the array type itself is
+	not bit-packed.
+
+2009-07-22  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb (Analyze_Object_Declaration): For a constant declaration,
+	if there is a previous entity with the same name in the scope, ignore
+	it if it is the renaming declaration for a generic package introduced
+	in instances.
+
+2009-07-22  Nicolas Roche  <roche@adacore.com>
+
+	* seh_init.c: use RtlAddFunctionTable to register our SEH exception
+	handler on x86_64 windows.
+
+2009-07-22  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Initialize/Normalize_Scalars create
+	false positives in CodePeer, so ignore this pragma in this mode.
+
 2009-07-22  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_util.adb, sem_ch10.adb: Minor reformatting
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index da49f9e..036e927 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3030,7 +3030,10 @@ package body Freeze is
                         --  was a pragma Pack (resulting in the component size
                         --  being the same as the RM_Size). Furthermore, the
                         --  component type size must be an odd size (not a
-                        --  multiple of storage unit)
+                        --  multiple of storage unit). If the component RM size
+                        --  is an exact number of storage units that is a power
+                        --  of two, the array is not packed and has a standard
+                        --  representation.
 
                         begin
                            if RM_Size (E) = Len * Rsiz
@@ -3054,6 +3057,19 @@ package body Freeze is
                                    ("\use explicit pragma Pack "
                                     & "or use pragma Implicit_Packing", SZ);
                               end if;
+
+                           elsif RM_Size (E) = Len * Rsiz
+                             and then Implicit_Packing
+                             and then
+                               (Rsiz / System_Storage_Unit = 1
+                                 or else Rsiz / System_Storage_Unit = 2
+                                 or else Rsiz / System_Storage_Unit = 4)
+                           then
+
+                              --  Not a packed array, but indicate the desired
+                              --  component size, for the back-end.
+
+                              Set_Component_Size (Btyp, Rsiz);
                            end if;
                         end;
                      end if;
diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c
index dc353d0..9edd882 100644
--- a/gcc/ada/seh_init.c
+++ b/gcc/ada/seh_init.c
@@ -59,7 +59,7 @@ extern struct Exception_Data _abort_signal;
 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
 
 
-#if defined (_WIN32) && !defined (_WIN64)
+#if defined (_WIN32)
 
 #include <windows.h>
 #include <excpt.h>
@@ -179,17 +179,100 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
       msg = "unhandled signal";
     }
 
+#if ! defined (_WIN64)
   /* This call is important as it avoids locking the second time we catch a
      signal. Note that this routine is documented as internal to Windows and
      should not be used.  */
 
   _global_unwind2 (EstablisherFrame);
   /* Call equivalent to RtlUnwind (EstablisherFrame, NULL, NULL, 0); */
+#endif
 
   Raise_From_Signal_Handler (exception, msg);
   return 0; /* This is never reached, avoid compiler warning  */
 }
 
+#if defined (_WIN64)
+/*  On x86_64 windows exception mechanism is no more based on a chained list
+    of handlers addresses on the stack. Instead unwinding information is used
+    to retrieve the exception handler (similar to ZCX GCC mechanism). So in
+    order to register an exception handler we need to put in the final
+    executable some unwinding information. This information might be present
+    statically in the image file inside the .pdata section or registered
+    through RtlAddFunctionTable API. Currently the GCC toolchain does not
+    generate the .pdata information for each function. As we don't need to
+    handle SEH exceptions except for signal handling we are registering a
+    "fake" unwinding data that associate a SEH exception handler to the
+    complete .text section. As we never return from the handler, the system
+    does not try to do the final unwinding using the pdata information. The
+    unwinding is handled by the runtime using either the GNAT SJLJ mechanism
+    or the ZCX GCC mechanism.
+
+    The current implementation is using the RtlAddFunctionTable. Here is for
+    information purposes the equivalent using a static .pdata section:
+
+         .section .rdata,"dr"
+         .align 4
+      Lunwind_info:
+         .byte 9,0,0,0
+         .rva ___gnat_SEH_error_handler
+         .section .pdata,"dr"
+         .align 4
+         .long 0
+         .rva etext
+         .rva Lunwind_info
+
+    Solutions based on SetUnhandledExceptionFilter have been discarded as this
+    function is mostly disabled on last Windows versions.
+    Using AddVectoredExceptionHandler should also be discarded as it overrides
+    all SEH exception handlers that might be present in the program itself and
+    the loaded DLL (for example it results in unexpected behaviors in the
+    Win32 subsystem.  */
+
+typedef struct _UNWIND_INFO {
+  BYTE VersionAndFlags;
+  BYTE PrologSize;
+  BYTE CountOfUnwindCodes;
+  BYTE FrameRegisterAndOffset;
+  ULONG AddressOfExceptionHandler;
+} UNWIND_INFO,*PUNWIND_INFO;
+
+static RUNTIME_FUNCTION Table[1];
+static UNWIND_INFO unwind_info[1];
+
+#define UNW_VERSION 0x01
+#define UNW_FLAG_EHANDLER 0x08
+
+void __gnat_install_SEH_handler (void *eh ATTRIBUTE_UNUSED)
+{
+  /* Get the end of the text section.  */
+  extern char etext[] asm("etext");
+  /* Get the base of the module.  */
+  extern char _ImageBase[];
+
+  /* Current version is always 1 and we are registering an
+     exception handler.  */
+  unwind_info[0].VersionAndFlags = UNW_FLAG_EHANDLER | UNW_VERSION;
+
+  /* We don't use the unwinding info so fill the structure with 0 values.  */
+  unwind_info[0].PrologSize = 0;
+  unwind_info[0].CountOfUnwindCodes = 0;
+  unwind_info[0].FrameRegisterAndOffset = 0;
+
+  /* Add the exception handler.  */
+  unwind_info[0].AddressOfExceptionHandler =
+    (DWORD)((char *)__gnat_SEH_error_handler - _ImageBase);
+
+  /* Set its scope to the entire program.  */
+  Table[0].BeginAddress = 0;
+  Table[0].EndAddress = (DWORD)(etext - _ImageBase);
+  Table[0].UnwindData = (DWORD)((char *)unwind_info - _ImageBase);
+
+  /* Register the unwind information.  */
+  RtlAddFunctionTable (Table, 1, (DWORD64)_ImageBase);
+}
+
+#else /* defined (_WIN64) */
 /*  Install the Win32 SEH exception handler. Note that the caller must have
     allocated 8 bytes on the stack and pass the pointer to this stack
     space. This is needed as the SEH exception handler must be on the stack of
@@ -220,8 +303,9 @@ __gnat_install_SEH_handler (void *ER)
 
   asm volatile ("mov %0,%%fs:(0)": : "r" (ER));
 }
+#endif
 
-#else /* defined (_WIN32) && !defined (_WIN64) */
+#else /* defined (_WIN32) */
 /* For all non Windows targets we provide a dummy SEH install handler.  */
 void __gnat_install_SEH_handler (void *eh ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 4efc727..9fe88de 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2330,11 +2330,11 @@ package body Sem_Ch3 is
       if Constant_Present (N) then
          Prev_Entity := Current_Entity_In_Scope (Id);
 
-         --  If the homograph is an implicit subprogram, it is overridden by
-         --  the current declaration.
-
          if Present (Prev_Entity)
            and then
+               --  If the homograph is an implicit subprogram, it is overridden
+               --  by the current declaration.
+
              ((Is_Overloadable (Prev_Entity)
                  and then Is_Inherited_Operation (Prev_Entity))
 
@@ -2346,7 +2346,19 @@ package body Sem_Ch3 is
                or else
                 (Is_Discriminal (Id)
                    and then Ekind (Discriminal_Link (Id)) =
-                              E_Entry_Index_Parameter))
+                              E_Entry_Index_Parameter)
+
+               --  The current object is the renaming for a generic declared
+               --  within the instance.
+
+               or else
+                (Ekind (Prev_Entity) = E_Package
+                   and then
+                 Nkind (Parent (Prev_Entity)) = N_Package_Renaming_Declaration
+                   and then
+                 not Comes_From_Source (Prev_Entity)
+                   and then
+                 Is_Generic_Instance (Renamed_Entity (Prev_Entity))))
          then
             Prev_Entity := Empty;
          end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 45dc5f9..c76e5bc 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7949,7 +7949,12 @@ package body Sem_Prag is
             Check_Valid_Configuration_Pragma;
             Check_Restriction (No_Initialize_Scalars, N);
 
-            if not Restriction_Active (No_Initialize_Scalars) then
+            --  Initialize_Scalars creates false positives in CodePeer,
+            --  so ignore this pragma in this mode.
+
+            if not Restriction_Active (No_Initialize_Scalars)
+              and then not CodePeer_Mode
+            then
                Init_Or_Norm_Scalars := True;
                Initialize_Scalars := True;
             end if;
@@ -9154,8 +9159,14 @@ package body Sem_Prag is
             Check_Ada_83_Warning;
             Check_Arg_Count (0);
             Check_Valid_Configuration_Pragma;
-            Normalize_Scalars := True;
-            Init_Or_Norm_Scalars := True;
+
+            --  Normalize_Scalars creates false positives in CodePeer,
+            --  so ignore this pragma in this mode.
+
+            if not CodePeer_Mode then
+               Normalize_Scalars := True;
+               Init_Or_Norm_Scalars := True;
+            end if;
 
          -----------------
          -- Obsolescent --