* 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
+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
#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
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);
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;
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);
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
-- 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
-- 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
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;
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;