[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:
parent
f0709ca650
commit
2551782dc3
@ -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.
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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 """);
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user