+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
-- 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
("\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;
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>
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
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)
{
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))
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;
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;
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 --