[multiple changes]

2010-10-12  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_number_of_cpus): Add implementation for Windows.

2010-10-12  Arnaud Charlet  <charlet@adacore.com>

	* make.adb (Globalize): New procedure.
	(Compile): Set Do_Codepeer_Globalize_Step when -gnatC is used.
	(Gnatmake): Call Globalize when needed.
	(Process_Restrictions_Or_Restriction_Warnings): Ignore Restrictions
	pragmas in CodePeer mode.
	(Adjust_Global_Switches): Set No_Initialize_Scalars in CodePeer mode,
	to generate simpler and consistent code.

2010-10-12  Bob Duff  <duff@adacore.com>

	* exp_util.adb (Remove_Side_Effects): Disable previous change,
	can cause side effects to be duplicated.

From-SVN: r165359
This commit is contained in:
Arnaud Charlet 2010-10-12 12:49:00 +02:00
parent f0709ca650
commit 2551782dc3
6 changed files with 127 additions and 6 deletions

View File

@ -1,3 +1,22 @@
2010-10-12 Pascal Obry <obry@adacore.com>
* adaint.c (__gnat_number_of_cpus): Add implementation for Windows.
2010-10-12 Arnaud Charlet <charlet@adacore.com>
* make.adb (Globalize): New procedure.
(Compile): Set Do_Codepeer_Globalize_Step when -gnatC is used.
(Gnatmake): Call Globalize when needed.
(Process_Restrictions_Or_Restriction_Warnings): Ignore Restrictions
pragmas in CodePeer mode.
(Adjust_Global_Switches): Set No_Initialize_Scalars in CodePeer mode,
to generate simpler and consistent code.
2010-10-12 Bob Duff <duff@adacore.com>
* exp_util.adb (Remove_Side_Effects): Disable previous change,
can cause side effects to be duplicated.
2010-10-12 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb (Process_PPCs): Handle inherited postconditions.

View File

@ -2384,6 +2384,10 @@ __gnat_number_of_cpus (void)
if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
cores = (int) psd.psd_proc_cnt;
#elif defined (_WIN32)
SYSTEM_INFO sysinfo;
GetSystemInfo (&sysinfo);
cores = (int) sysinfo.dwNumberOfProcessors;
#endif
return cores;

View File

@ -4844,8 +4844,12 @@ package body Exp_Util is
-- expression (and hence we would generate a never-ending loop in the
-- front end).
if Is_Class_Wide_Type (Exp_Type)
and then Nkind (Parent (Exp)) = N_Object_Renaming_Declaration
-- For now, disable this test. class-wide renamings can have side
-- effects, and this test causes such side effects to be duplicated.
-- To be sorted out later ???
if False and then Is_Class_Wide_Type (Exp_Type)
and then Nkind (Parent (Exp)) = N_Object_Renaming_Declaration
then
return;
end if;

View File

@ -176,8 +176,11 @@ procedure Gnat1drv is
-- Enable some restrictions systematically to simplify the generated
-- code (and ease analysis). Note that restriction checks are also
-- disabled in CodePeer mode, see Restrict.Check_Restriction
-- disabled in CodePeer mode, see Restrict.Check_Restriction, and
-- user specified Restrictions pragmas are ignored, see
-- Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
Restrict.Restrictions.Set (No_Task_Hierarchy) := True;
Restrict.Restrictions.Set (No_Abort_Statements) := True;
Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;

View File

@ -432,6 +432,9 @@ package body Make is
-- with the switches -c, -b and -l. These flags are reset to True for
-- each invocation of procedure Gnatmake.
Do_Codepeer_Globalize_Step : Boolean := False;
-- Flag to indicate whether the CodePeer globalizer should be called
Shared_String : aliased String := "-shared";
Force_Elab_Flags_String : aliased String := "-F";
@ -654,20 +657,27 @@ package body Make is
Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
-- Default compiler, binder, linker programs
Globalizer : constant String := "codepeer_globalizer";
-- CodePeer globalizer executable name
Saved_Gcc : String_Access := null;
Saved_Gnatbind : String_Access := null;
Saved_Gnatlink : String_Access := null;
-- Given by the command line. Will be used, if non null
Gcc_Path : String_Access :=
GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
Gnatbind_Path : String_Access :=
GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
Gnatlink_Path : String_Access :=
GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
-- Path for compiler, binder, linker programs, defaulted now for gnatdist.
-- Changed later if overridden on command line.
Globalizer_Path : constant String_Access :=
GNAT.OS_Lib.Locate_Exec_On_Path (Globalizer);
-- Path for CodePeer globalizer
Comp_Flag : constant String_Access := new String'("-c");
Output_Flag : constant String_Access := new String'("-o");
Ada_Flag_1 : constant String_Access := new String'("-x");
@ -1007,6 +1017,10 @@ package body Make is
-- during a compilation are also transitively included in the W section
-- of the originally compiled file.
procedure Globalize (Success : out Boolean);
-- Call the CodePeer globalizer on all the project's object directories,
-- or on the current directory if no projects.
procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref);
-- Performs default and package initialization. Therefore,
-- Compile_Sources can be called by an external unit.
@ -2885,6 +2899,13 @@ package body Make is
Do_Bind_Step := False;
Do_Link_Step := False;
Syntax_Only := False;
elsif Args (J).all = "-gnatC"
or else Args (J).all = "-gnatcC"
then
-- If we compile with -gnatC, enable CodePeer globalize step
Do_Codepeer_Globalize_Step := True;
end if;
end loop;
@ -4111,6 +4132,53 @@ package body Make is
Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted;
---------------
-- Globalize --
---------------
procedure Globalize (Success : out Boolean) is
Quiet_Str : aliased String := "-quiet";
Globalizer_Args : constant Argument_List :=
(1 => Quiet_Str'Unchecked_Access);
Previous_Dir : String_Access;
procedure Globalize_Dir (Dir : String);
-- Call CodePeer globalizer on Dir
-------------------
-- Globalize_Dir --
-------------------
procedure Globalize_Dir (Dir : String) is
Result : Boolean;
begin
if Previous_Dir = null or else Dir /= Previous_Dir.all then
Free (Previous_Dir);
Previous_Dir := new String'(Dir);
Change_Dir (Dir);
GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Result);
Success := Success and Result;
end if;
end Globalize_Dir;
procedure Globalize_Dirs is new
Prj.Env.For_All_Object_Dirs (Globalize_Dir);
begin
Success := True;
Display (Globalizer, Globalizer_Args);
if Globalizer_Path = null then
Make_Failed ("error, unable to locate " & Globalizer);
end if;
if Main_Project = No_Project then
GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
else
Globalize_Dirs (Main_Project);
end if;
end Globalize;
--------------
-- Gnatmake --
--------------
@ -6387,6 +6455,23 @@ package body Make is
Delete_All_Marks;
end loop Multiple_Main_Loop;
if Do_Codepeer_Globalize_Step then
declare
Success : Boolean := False;
begin
Globalize (Success);
if not Success then
Set_Standard_Error;
Write_Str ("*** globalize failed.");
if Commands_To_Stdout then
Set_Standard_Output;
end if;
end if;
end;
end if;
if Failed_Links.Last > 0 then
for Index in 1 .. Successful_Links.Last loop
Write_Str ("Linking of """);

View File

@ -4594,6 +4594,12 @@ package body Sem_Prag is
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
begin
-- Ignore all Restrictions pragma in CodePeer mode
if CodePeer_Mode then
return;
end if;
Check_Ada_83_Warning;
Check_At_Least_N_Arguments (1);
Check_Valid_Configuration_Pragma;