[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:
Arnaud Charlet 2013-01-03 11:09:24 +01:00
parent 86a2db336a
commit 329ea7ece2
9 changed files with 102 additions and 68 deletions

View 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

View 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

View 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);

View 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;

View 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);

View 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

View File

@ -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

View 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

View 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;