[multiple changes]
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. From-SVN: r194842
This commit is contained in:
parent
86a2db336a
commit
329ea7ece2
@ -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
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -67,13 +67,14 @@
|
||||
|
||||
-- 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.
|
||||
-- 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.
|
||||
|
||||
-- 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.
|
||||
-- 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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
x
Reference in New Issue
Block a user