From 15d8a51dee9e80190ac43afc9b553976776e17a9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 15:50:50 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Robert Dewar * exp_ch5.adb, exp_ch7.adb, exp_util.adb, bindgen.adb, sem_prag.adb, s-tassta.adb, exp_ch4.adb, exp_disp.adb, s-stausa.adb: Minor reformatting. 2011-08-04 Arnaud Charlet * make.adb (Linking_Phase): Set source search path before calling gnatlink in CodePeer mode. From-SVN: r177388 --- gcc/ada/ChangeLog | 11 +++++++ gcc/ada/bindgen.adb | 21 +++++++----- gcc/ada/exp_ch4.adb | 3 +- gcc/ada/exp_ch5.adb | 1 - gcc/ada/exp_ch7.adb | 4 +-- gcc/ada/exp_disp.adb | 4 +-- gcc/ada/exp_util.adb | 12 +++---- gcc/ada/make.adb | 5 ++- gcc/ada/s-stausa.adb | 78 +++++++++++++++++++++++++------------------- gcc/ada/s-tassta.adb | 13 +++++--- gcc/ada/sem_prag.adb | 32 +++++++++++------- 11 files changed, 110 insertions(+), 74 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9e1dd4078a0..5089441c14e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-08-04 Robert Dewar + + * exp_ch5.adb, exp_ch7.adb, exp_util.adb, bindgen.adb, sem_prag.adb, + s-tassta.adb, exp_ch4.adb, exp_disp.adb, s-stausa.adb: Minor + reformatting. + +2011-08-04 Arnaud Charlet + + * make.adb (Linking_Phase): Set source search path before calling + gnatlink in CodePeer mode. + 2011-08-04 Javier Miranda * exp_ch7.adb (Expand_N_Package_Body, Expand_N_Package_Declaration): diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 47e1d1b7f8f..8c89a5095a8 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ +------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- @@ -467,8 +467,8 @@ package body Bindgen is end if; -- Pragma Import C cannot be used on virtual machine targets, therefore - -- call the runtime finalization routine directly. - -- Similarly in CodePeer mode, where imported functions are ignored. + -- call the runtime finalization routine directly. Similarly in CodePeer + -- mode, where imported functions are ignored. else WBI (" System.Standard_Library.Adafinal;"); @@ -1406,6 +1406,7 @@ package body Bindgen is procedure Gen_Elab_Calls_Ada is Check_Elab_Flag : Boolean; + begin for E in Elab_Order.First .. Elab_Order.Last loop declare @@ -1478,9 +1479,9 @@ package body Bindgen is elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then Check_Elab_Flag := not CodePeer_Mode - and then (Force_Checking_Of_Elaboration_Flags - or Interface_Library_Unit - or not Bind_Main_Program); + and then (Force_Checking_Of_Elaboration_Flags + or Interface_Library_Unit + or not Bind_Main_Program); if Check_Elab_Flag then Set_String (" if E"); @@ -2179,6 +2180,7 @@ package body Bindgen is Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2); -- Strip trailing "%b" + begin if ALIs.Table (ALIs.First).Main_Program = Proc then WBI (" procedure " & CodePeer_Wrapper_Name & " is "); @@ -2277,6 +2279,7 @@ package body Bindgen is if ALIs.Table (ALIs.First).Main_Program = Func then WBI (" Result : Integer;"); end if; + else -- To call the main program, we declare it using a pragma Import -- Ada with the right link name. @@ -2330,7 +2333,7 @@ package body Bindgen is -- with a pragma Volatile in order to tell the compiler to preserve -- this variable at any level of optimization. - if Bind_Main_Program and then not CodePeer_Mode then + if Bind_Main_Program and not CodePeer_Mode then WBI (" Ensure_Reference : aliased System.Address := " & "Ada_Main_Program_Name'Address;"); @@ -3312,8 +3315,8 @@ package body Bindgen is Gen_Adainit_Ada; if Bind_Main_Program and then VM_Target = No_VM then - -- For CodePeer, declare a wrapper for the - -- user-defined main program. + + -- For CodePeer, declare a wrapper for the user-defined main program if CodePeer_Mode then Gen_CodePeer_Wrapper; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d2852e3dd80..0a9ddb1c336 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -659,8 +659,7 @@ package body Exp_Ch4 is Attribute_Name => Name_Tag); if Tagged_Type_Expansion then - New_Node := - Build_Get_Access_Level (Loc, New_Node); + New_Node := Build_Get_Access_Level (Loc, New_Node); elsif VM_Target /= No_VM then New_Node := diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 3c08b512d3b..6bf52463244 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2462,7 +2462,6 @@ package body Exp_Ch5 is and then Nkind (Alt) = N_Case_Statement_Alternative loop Process_Statements_For_Controlled_Objects (Alt); - Next (Alt); end loop; end; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index c31682caec7..aef06214b2f 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3936,8 +3936,8 @@ package body Exp_Ch7 is if Tagged_Type_Expansion and then (Is_Compilation_Unit (Id) - or else (Is_Generic_Instance (Id) - and then Is_Library_Level_Entity (Id))) + or else (Is_Generic_Instance (Id) + and then Is_Library_Level_Entity (Id))) then Build_Static_Dispatch_Tables (N); end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index a9ae2c55172..a577a2512ac 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6649,7 +6649,7 @@ package body Exp_Disp is Name => New_Reference_To (RTE (RE_Check_TSD), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (TSD, Loc), + Prefix => New_Reference_To (TSD, Loc), Attribute_Name => Name_Unrestricted_Access)))); end if; @@ -6661,7 +6661,7 @@ package body Exp_Disp is Name => New_Reference_To (RTE (RE_Register_TSD), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (TSD, Loc), + Prefix => New_Reference_To (TSD, Loc), Attribute_Name => Name_Unrestricted_Access)))); -- Populate the two auxiliary tables used for dispatching asynchronous, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c8d41cb0e7c..fbf7fe92038 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5468,7 +5468,6 @@ package body Exp_Util is function Are_Wrapped (L : List_Id) return Boolean is Stmt : constant Node_Id := First (L); - begin return Present (Stmt) @@ -5494,15 +5493,14 @@ package body Exp_Util is begin case Nkind (N) is - when N_Elsif_Part | - N_If_Statement | - N_Conditional_Entry_Call | - N_Selective_Accept => + when N_Elsif_Part | + N_If_Statement | + N_Conditional_Entry_Call | + N_Selective_Accept => -- Check the "then statements" for elsif parts and if statements - if Nkind_In (N, N_Elsif_Part, - N_If_Statement) + if Nkind_In (N, N_Elsif_Part, N_If_Statement) and then not Is_Empty_List (Then_Statements (N)) and then not Are_Wrapped (Then_Statements (N)) and then Requires_Cleanup_Actions diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index cc62e7f897b..ec5cfb0f610 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4357,16 +4357,16 @@ package body Make is end if; end; end if; - end if; -- Put the object directories in ADA_OBJECTS_PATH + -- Ditto for source directories in ADA_INCLUDE_PATH in CodePeer mode Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, Including_Libraries => False, - Include_Path => False); + Include_Path => CodePeer_Mode); -- Check for attributes Linker'Linker_Options in projects other than -- the main project @@ -4581,7 +4581,6 @@ package body Make is new String'("-F=" & Get_Name_String (Mapping_Path)); end if; end if; - end if; begin diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index 76cac90454f..6ccc386c7f4 100644 --- a/gcc/ada/s-stausa.adb +++ b/gcc/ada/s-stausa.adb @@ -129,8 +129,8 @@ package body System.Stack_Usage is Result_Array := new Result_Array_Type (1 .. Buffer_Size); Result_Array.all := (others => - (Task_Name => (others => ASCII.NUL), - Value => 0, + (Task_Name => (others => ASCII.NUL), + Value => 0, Stack_Size => 0)); -- Set the Is_Enabled flag to true, so that the task wrapper knows that @@ -176,6 +176,7 @@ package body System.Stack_Usage is ---------------- procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is + -- Change the local variables and parameters of this function with -- super-extra care. The more the stack frame size of this function is -- big, the more an "instrumentation threshold at writing" error is @@ -188,21 +189,23 @@ package body System.Stack_Usage is -- allocated byte on the stack. begin if Parameters.Stack_Grows_Down then - if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) - > To_Stack_Address (Current_Stack_Level'Address) - Guard + if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) > + To_Stack_Address (Current_Stack_Level'Address) - Guard then -- No room for a pattern + Analyzer.Pattern_Size := 0; return; end if; - Analyzer.Pattern_Limit := Analyzer.Stack_Base - - Stack_Address (Analyzer.Pattern_Size); + Analyzer.Pattern_Limit := + Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size); if Analyzer.Stack_Base > - To_Stack_Address (Current_Stack_Level'Address) - Guard + To_Stack_Address (Current_Stack_Level'Address) - Guard then -- Reduce pattern size to prevent local frame overwrite + Analyzer.Pattern_Size := Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard - Analyzer.Pattern_Limit); @@ -211,35 +214,39 @@ package body System.Stack_Usage is Analyzer.Pattern_Overlay_Address := To_Address (Analyzer.Pattern_Limit); else - if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) - < To_Stack_Address (Current_Stack_Level'Address) + Guard + if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) < + To_Stack_Address (Current_Stack_Level'Address) + Guard then -- No room for a pattern + Analyzer.Pattern_Size := 0; return; end if; - Analyzer.Pattern_Limit := Analyzer.Stack_Base - + Stack_Address (Analyzer.Pattern_Size); + Analyzer.Pattern_Limit := + Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size); if Analyzer.Stack_Base < To_Stack_Address (Current_Stack_Level'Address) + Guard then -- Reduce pattern size to prevent local frame overwrite - Analyzer.Pattern_Size := Integer - (Analyzer.Pattern_Limit - - (To_Stack_Address (Current_Stack_Level'Address) + Guard)); + + Analyzer.Pattern_Size := + Integer + (Analyzer.Pattern_Limit - + (To_Stack_Address (Current_Stack_Level'Address) + Guard)); end if; Analyzer.Pattern_Overlay_Address := - To_Address (Analyzer.Pattern_Limit - - Stack_Address (Analyzer.Pattern_Size)); + To_Address (Analyzer.Pattern_Limit - + Stack_Address (Analyzer.Pattern_Size)); end if; -- Declare and fill the pattern buffer + declare Pattern : aliased Stack_Slots - (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern); + (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern); for Pattern'Address use Analyzer.Pattern_Overlay_Address; begin @@ -247,6 +254,7 @@ package body System.Stack_Usage is for J in reverse Pattern'Range loop Pattern (J) := Analyzer.Pattern; end loop; + else for J in Pattern'Range loop Pattern (J) := Analyzer.Pattern; @@ -284,7 +292,7 @@ package body System.Stack_Usage is else Analyzer.Task_Name := Task_Name (Task_Name'First .. - Task_Name'First + Task_Name_Length - 1); + Task_Name'First + Task_Name_Length - 1); end if; Next_Id := Next_Id + 1; @@ -322,6 +330,7 @@ package body System.Stack_Usage is begin -- Value if the pattern was not modified + if Parameters.Stack_Grows_Down then Analyzer.Topmost_Touched_Mark := Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size); @@ -341,8 +350,8 @@ package body System.Stack_Usage is if System.Parameters.Stack_Grows_Down then for J in Stack'Range loop if Stack (J) /= Analyzer.Pattern then - Analyzer.Topmost_Touched_Mark - := To_Stack_Address (Stack (J)'Address); + Analyzer.Topmost_Touched_Mark := + To_Stack_Address (Stack (J)'Address); exit; end if; end loop; @@ -350,8 +359,8 @@ package body System.Stack_Usage is else for J in reverse Stack'Range loop if Stack (J) /= Analyzer.Pattern then - Analyzer.Topmost_Touched_Mark - := To_Stack_Address (Stack (J)'Address); + Analyzer.Topmost_Touched_Mark := + To_Stack_Address (Stack (J)'Address); exit; end if; end loop; @@ -407,8 +416,9 @@ package body System.Stack_Usage is Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0; Task_Name_Blanks : constant - String (1 .. Task_Name_Length - Task_Name_Str'Length) := - (others => ' '); + String + (1 .. Task_Name_Length - Task_Name_Str'Length) := + (others => ' '); begin Set_Output (Standard_Error); @@ -444,12 +454,14 @@ package body System.Stack_Usage is declare Stack_Size_Blanks : constant - String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) := - (others => ' '); + String (1 .. Max_Stack_Size_Len - + Stack_Size_Str'Length) := + (others => ' '); Stack_Usage_Blanks : constant - String (1 .. Max_Actual_Use_Len - Actual_Size_Str'Length) := - (others => ' '); + String (1 .. Max_Actual_Use_Len - + Actual_Size_Str'Length) := + (others => ' '); begin if Stack_Size_Str'Length > Max_Stack_Size_Len then @@ -491,14 +503,14 @@ package body System.Stack_Usage is ------------------- procedure Report_Result (Analyzer : Stack_Analyzer) is - Result : Task_Result := (Task_Name => Analyzer.Task_Name, - Stack_Size => Analyzer.Stack_Size, - Value => 0); + Result : Task_Result := (Task_Name => Analyzer.Task_Name, + Stack_Size => Analyzer.Stack_Size, + Value => 0); begin if Analyzer.Pattern_Size = 0 then + -- If we have that result, it means that we didn't do any computation - -- at all. In other words, we used at least everything (and possibly - -- more). + -- at all (i.e. we used at least everything (and possibly more). Result.Value := Analyzer.Stack_Size; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 9a5b67d5284..8795ce7727d 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -1115,7 +1115,7 @@ package body System.Tasking.Stages is if System.Stack_Usage.Is_Enabled then declare - Guard_Page_Size : constant := 12 * 1024; + Guard_Page_Size : constant := 12 * 1024; -- Part of the stack used as a guard page. This is an OS dependent -- value, so we need to use the maximum. This value is only used -- when the stack address is known, that is currently Windows. @@ -1125,9 +1125,9 @@ package body System.Tasking.Stages is -- smaller values resulted in segmentation faults from dynamic -- stack analysis. - Big_Overflow_Guard : constant := 16 * 1024; - Small_Stack_Limit : constant := 64 * 1024; - -- ??? These three values are experimental, and seems to work on + Big_Overflow_Guard : constant := 16 * 1024; + Small_Stack_Limit : constant := 64 * 1024; + -- ??? These three values are experimental, and seem to work on -- most platforms. They still need to be analyzed further. They -- also need documentation, what are they??? @@ -1137,22 +1137,27 @@ package body System.Tasking.Stages is Stack_Base : Address; -- Address of the base of the stack + begin Stack_Base := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base; if Stack_Base = Null_Address then + -- On many platforms, we don't know the real stack base -- address. Estimate it using an address in the frame. + Stack_Base := Bottom_Of_Stack'Address; -- Also reduce the size of the stack to take into account the -- secondary stack array declared in this frame. This is for -- sure very conservative. + if not Parameters.Sec_Stack_Dynamic then Pattern_Size := Pattern_Size - Natural (Secondary_Stack_Size); end if; -- Adjustments for inner frames + Pattern_Size := Pattern_Size - (if Pattern_Size < Small_Stack_Limit then Small_Overflow_Guard diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d04a7efc413..a0b56a98c98 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -426,7 +426,9 @@ package body Sem_Prag is -- Checks that the given argument has an identifier, and if so, requires -- it to match one of the given identifier names. If there is no -- identifier, or a non-matching identifier, then an error message is - -- given and Pragma_Exit is raised. + -- given and Pragma_Exit is raised. ??? why is this needed, why isnt + -- Check_Arg_Is_One_Of good enough. At the very least explain this + -- odd apparent redundancy procedure Check_In_Main_Program; -- Common checks for pragmas that appear within a main program @@ -6843,9 +6845,9 @@ package body Sem_Prag is -- Check -- ----------- - -- pragma Check ([Name =>] Identifier, - -- [Check =>] Boolean_Expression - -- [,[Message =>] String_Expression]); + -- pragma Check ([Name =>] IDENTIFIER, + -- [Check =>] Boolean_EXPRESSION + -- [,[Message =>] String_EXPRESSION]); when Pragma_Check => Check : declare Expr : Node_Id; @@ -11527,8 +11529,8 @@ package body Sem_Prag is -- Postcondition -- ------------------- - -- pragma Postcondition ([Check =>] Boolean_Expression - -- [,[Message =>] String_Expression]); + -- pragma Postcondition ([Check =>] Boolean_EXPRESSION + -- [,[Message =>] String_EXPRESSION]); when Pragma_Postcondition => Postcondition : declare In_Body : Boolean; @@ -11550,8 +11552,8 @@ package body Sem_Prag is -- Precondition -- ------------------ - -- pragma Precondition ([Check =>] Boolean_Expression - -- [,[Message =>] String_Expression]); + -- pragma Precondition ([Check =>] Boolean_EXPRESSION + -- [,[Message =>] String_EXPRESSION]); when Pragma_Precondition => Precondition : declare In_Body : Boolean; @@ -13262,10 +13264,14 @@ package body Sem_Prag is -- Test_Case -- --------------- - -- pragma Test_Case ([Name =>] String_Expression + -- pragma Test_Case ([Name =>] String_EXPRESSION -- ,[Mode =>] (Normal | Robustness) - -- [, Requires => Boolean_Expression] - -- [, Ensures => Boolean_Expression]); + -- [, Requires => Boolean_EXPRESSION] + -- [, Ensures => Boolean_EXPRESSION]); + + -- ??? Why is Name not static_string_EXPRESSION??? Seems very + -- weird to require it to be a string literal, and if we DO want + -- that restriction the grammar should make this clear. when Pragma_Test_Case => Test_Case : declare @@ -13280,10 +13286,14 @@ package body Sem_Prag is Check_Arg_Is_String_Literal (Arg1); Check_Optional_Identifier (Arg2, Name_Mode); Check_Arg_Is_One_Of (Arg2, Name_Normal, Name_Robustness); + if Arg_Count = 4 then Check_Identifier (Arg3, Name_Requires); Check_Identifier (Arg4, Name_Ensures); else + -- ??? why not Check_Arg_Is_One_Of, very odd!!! At the very + -- least needs an explanation! + Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures); end if; -- 2.30.2