Commit 2551782d by Arnaud Charlet

[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
parent f0709ca6
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> 2010-10-12 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb (Process_PPCs): Handle inherited postconditions. * sem_ch6.adb (Process_PPCs): Handle inherited postconditions.
......
...@@ -2384,6 +2384,10 @@ __gnat_number_of_cpus (void) ...@@ -2384,6 +2384,10 @@ __gnat_number_of_cpus (void)
if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1) if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
cores = (int) psd.psd_proc_cnt; cores = (int) psd.psd_proc_cnt;
#elif defined (_WIN32)
SYSTEM_INFO sysinfo;
GetSystemInfo (&sysinfo);
cores = (int) sysinfo.dwNumberOfProcessors;
#endif #endif
return cores; return cores;
......
...@@ -4844,7 +4844,11 @@ package body Exp_Util is ...@@ -4844,7 +4844,11 @@ package body Exp_Util is
-- expression (and hence we would generate a never-ending loop in the -- expression (and hence we would generate a never-ending loop in the
-- front end). -- front end).
if Is_Class_Wide_Type (Exp_Type) -- 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 and then Nkind (Parent (Exp)) = N_Object_Renaming_Declaration
then then
return; return;
......
...@@ -176,8 +176,11 @@ procedure Gnat1drv is ...@@ -176,8 +176,11 @@ procedure Gnat1drv is
-- Enable some restrictions systematically to simplify the generated -- Enable some restrictions systematically to simplify the generated
-- code (and ease analysis). Note that restriction checks are also -- 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_Task_Hierarchy) := True;
Restrict.Restrictions.Set (No_Abort_Statements) := True; Restrict.Restrictions.Set (No_Abort_Statements) := True;
Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True; Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
......
...@@ -432,6 +432,9 @@ package body Make is ...@@ -432,6 +432,9 @@ package body Make is
-- with the switches -c, -b and -l. These flags are reset to True for -- with the switches -c, -b and -l. These flags are reset to True for
-- each invocation of procedure Gnatmake. -- 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"; Shared_String : aliased String := "-shared";
Force_Elab_Flags_String : aliased String := "-F"; Force_Elab_Flags_String : aliased String := "-F";
...@@ -654,6 +657,9 @@ package body Make is ...@@ -654,6 +657,9 @@ package body Make is
Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake"); Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
-- Default compiler, binder, linker programs -- Default compiler, binder, linker programs
Globalizer : constant String := "codepeer_globalizer";
-- CodePeer globalizer executable name
Saved_Gcc : String_Access := null; Saved_Gcc : String_Access := null;
Saved_Gnatbind : String_Access := null; Saved_Gnatbind : String_Access := null;
Saved_Gnatlink : String_Access := null; Saved_Gnatlink : String_Access := null;
...@@ -668,6 +674,10 @@ package body Make is ...@@ -668,6 +674,10 @@ package body Make is
-- Path for compiler, binder, linker programs, defaulted now for gnatdist. -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
-- Changed later if overridden on command line. -- 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"); Comp_Flag : constant String_Access := new String'("-c");
Output_Flag : constant String_Access := new String'("-o"); Output_Flag : constant String_Access := new String'("-o");
Ada_Flag_1 : constant String_Access := new String'("-x"); Ada_Flag_1 : constant String_Access := new String'("-x");
...@@ -1007,6 +1017,10 @@ package body Make is ...@@ -1007,6 +1017,10 @@ package body Make is
-- during a compilation are also transitively included in the W section -- during a compilation are also transitively included in the W section
-- of the originally compiled file. -- 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); procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref);
-- Performs default and package initialization. Therefore, -- Performs default and package initialization. Therefore,
-- Compile_Sources can be called by an external unit. -- Compile_Sources can be called by an external unit.
...@@ -2885,6 +2899,13 @@ package body Make is ...@@ -2885,6 +2899,13 @@ package body Make is
Do_Bind_Step := False; Do_Bind_Step := False;
Do_Link_Step := False; Do_Link_Step := False;
Syntax_Only := 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 if;
end loop; end loop;
...@@ -4111,6 +4132,53 @@ package body Make is ...@@ -4111,6 +4132,53 @@ package body Make is
Obsoleted.Set (F2, True); Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted; 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 -- -- Gnatmake --
-------------- --------------
...@@ -6387,6 +6455,23 @@ package body Make is ...@@ -6387,6 +6455,23 @@ package body Make is
Delete_All_Marks; Delete_All_Marks;
end loop Multiple_Main_Loop; 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 if Failed_Links.Last > 0 then
for Index in 1 .. Successful_Links.Last loop for Index in 1 .. Successful_Links.Last loop
Write_Str ("Linking of """); Write_Str ("Linking of """);
......
...@@ -4594,6 +4594,12 @@ package body Sem_Prag is ...@@ -4594,6 +4594,12 @@ package body Sem_Prag is
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings -- Start of processing for Process_Restrictions_Or_Restriction_Warnings
begin begin
-- Ignore all Restrictions pragma in CodePeer mode
if CodePeer_Mode then
return;
end if;
Check_Ada_83_Warning; Check_Ada_83_Warning;
Check_At_Least_N_Arguments (1); Check_At_Least_N_Arguments (1);
Check_Valid_Configuration_Pragma; Check_Valid_Configuration_Pragma;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment