From 2551782dc3fdb3baa1e97310223fc8e3c51cf6c9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 Oct 2010 12:49:00 +0200 Subject: [multiple changes] 2010-10-12 Pascal Obry * adaint.c (__gnat_number_of_cpus): Add implementation for Windows. 2010-10-12 Arnaud Charlet * 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 * exp_util.adb (Remove_Side_Effects): Disable previous change, can cause side effects to be duplicated. From-SVN: r165359 --- gcc/ada/ChangeLog | 19 +++++++++++ gcc/ada/adaint.c | 4 +++ gcc/ada/exp_util.adb | 8 +++-- gcc/ada/gnat1drv.adb | 5 ++- gcc/ada/make.adb | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/sem_prag.adb | 6 ++++ 6 files changed, 127 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bc7f0b4..670c155 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2010-10-12 Pascal Obry + + * adaint.c (__gnat_number_of_cpus): Add implementation for Windows. + +2010-10-12 Arnaud Charlet + + * 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 + + * exp_util.adb (Remove_Side_Effects): Disable previous change, + can cause side effects to be duplicated. + 2010-10-12 Robert Dewar * sem_ch6.adb (Process_PPCs): Handle inherited postconditions. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 51e2bb7..982ae11 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a0c641b..a3e09a6 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 5e95182..813765b 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 9aa812a..4f09513 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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 """); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 91a6e8f..82f797e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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; -- cgit v1.1