diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/gnatbind.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/restrict.adb | 51 | ||||
| -rw-r--r-- | gcc/ada/restrict.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 156 | ||||
| -rw-r--r-- | gcc/ada/tbuild.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/tbuild.ads | 5 |
7 files changed, 176 insertions, 139 deletions
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 4372152..be087af 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -238,8 +238,8 @@ procedure Gnatbind is ------------------------------ function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is - CR : Restrictions_Info renames Cumulative_Restrictions; - + CR : Restrictions_Info renames Cumulative_Restrictions; + Result : Boolean; begin case R is @@ -247,11 +247,19 @@ procedure Gnatbind is when All_Boolean_Restrictions => - -- The condition for listing a boolean restriction as an - -- additional restriction that could be set is that it is - -- not violated by any unit, and not already set. + -- Print it if not violated by any unit, and not already set... + + Result := not CR.Violated (R) and then not CR.Set (R); + + -- ...except that for No_Tasks_Unassigned_To_CPU, we don't want + -- to print it if it would violate the restriction post + -- compilation. - return CR.Violated (R) = False and then CR.Set (R) = False; + if R = No_Tasks_Unassigned_To_CPU + and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU + then + Result := False; + end if; -- Parameter restriction @@ -261,18 +269,18 @@ procedure Gnatbind is -- unknown, the restriction can definitely not be listed. if CR.Violated (R) and then CR.Unknown (R) then - return False; + Result := False; -- We can list the restriction if it is not set elsif not CR.Set (R) then - return True; + Result := True; -- We can list the restriction if is set to a greater value -- than the maximum value known for the violation. else - return CR.Value (R) > CR.Count (R); + Result := CR.Value (R) > CR.Count (R); end if; -- No other values for R possible @@ -280,6 +288,8 @@ procedure Gnatbind is when others => raise Program_Error; end case; + + return Result; end Restriction_Could_Be_Set; -- Start of processing for List_Applicable_Restrictions @@ -881,6 +891,17 @@ begin -- mode where we want to be more flexible. if not CodePeer_Mode then + -- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU": + -- If the restriction No_Tasks_Unassigned_To_CPU applies, then + -- check that the main subprogram has a CPU assigned. + + if Cumulative_Restrictions.Set (No_Tasks_Unassigned_To_CPU) + and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU + then + Error_Msg ("No_Tasks_Unassigned_To_CPU restriction requires CPU" & + " aspect to be specified for main procedure"); + end if; + Check_Duplicated_Subunits; Check_Versions; Check_Consistency; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 08788d1..5ba2931 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -1354,8 +1354,6 @@ package body Restrict is -- Set_Restriction -- --------------------- - -- Case of Boolean restriction - procedure Set_Restriction (R : All_Boolean_Restrictions; N : Node_Id) @@ -1395,8 +1393,6 @@ package body Restrict is end if; end Set_Restriction; - -- Case of parameter restriction - procedure Set_Restriction (R : All_Parameter_Restrictions; N : Node_Id; @@ -1446,6 +1442,29 @@ package body Restrict is Restriction_Profile_Name (R) := No_Profile; end Set_Restriction; + procedure Set_Restriction + (R : All_Restrictions; + N : Node_Id; + Warn : Boolean; + V : Integer := Integer'First) + is + Set : Boolean := True; + begin + if Warn and then Restriction_Active (R) then + Set := False; + end if; + + if Set then + if R in All_Boolean_Restrictions then + Set_Restriction (R, N); + else + Set_Restriction (R, N, V); + end if; + + Restriction_Warnings (R) := Warn; + end if; + end Set_Restriction; + ----------------------------------- -- Set_Restriction_No_Dependence -- ----------------------------------- @@ -1485,7 +1504,7 @@ package body Restrict is procedure Set_Restriction_No_Use_Of_Entity (Entity : Node_Id; - Warning : Boolean; + Warn : Boolean; Profile : Profile_Name := No_Profile) is Nam : Node_Id; @@ -1501,7 +1520,7 @@ package body Restrict is -- Error has precedence over warning - if not Warning then + if not Warn then No_Use_Of_Entity.Table (J).Warn := False; end if; @@ -1511,7 +1530,7 @@ package body Restrict is -- Entry is not currently in table - No_Use_Of_Entity.Append ((Entity, Warning, Profile)); + No_Use_Of_Entity.Append ((Entity, Warn, Profile)); -- Now we need to find the direct name and set Boolean2 flag @@ -1532,15 +1551,15 @@ package body Restrict is ------------------------------------------------ procedure Set_Restriction_No_Specification_Of_Aspect - (N : Node_Id; - Warning : Boolean) + (N : Node_Id; + Warn : Boolean) is A_Id : constant Aspect_Id_Exclude_No_Aspect := Get_Aspect_Id (Chars (N)); begin No_Specification_Of_Aspect_Set := True; No_Specification_Of_Aspects (A_Id) := Sloc (N); - No_Specification_Of_Aspect_Warning (A_Id) := Warning; + No_Specification_Of_Aspect_Warning (A_Id) := Warn; end Set_Restriction_No_Specification_Of_Aspect; procedure Set_Restriction_No_Specification_Of_Aspect (A_Id : Aspect_Id) is @@ -1555,15 +1574,15 @@ package body Restrict is ----------------------------------------- procedure Set_Restriction_No_Use_Of_Attribute - (N : Node_Id; - Warning : Boolean) + (N : Node_Id; + Warn : Boolean) is A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); begin No_Use_Of_Attribute_Set := True; No_Use_Of_Attribute (A_Id) := Sloc (N); - No_Use_Of_Attribute_Warning (A_Id) := Warning; + No_Use_Of_Attribute_Warning (A_Id) := Warn; end Set_Restriction_No_Use_Of_Attribute; procedure Set_Restriction_No_Use_Of_Attribute (A_Id : Attribute_Id) is @@ -1578,15 +1597,15 @@ package body Restrict is -------------------------------------- procedure Set_Restriction_No_Use_Of_Pragma - (N : Node_Id; - Warning : Boolean) + (N : Node_Id; + Warn : Boolean) is A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N)); begin No_Use_Of_Pragma_Set := True; No_Use_Of_Pragma (A_Id) := Sloc (N); - No_Use_Of_Pragma_Warning (A_Id) := Warning; + No_Use_Of_Pragma_Warning (A_Id) := Warn; end Set_Restriction_No_Use_Of_Pragma; procedure Set_Restriction_No_Use_Of_Pragma (A_Id : Pragma_Id) is diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index a638401..7a84d37 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -452,6 +452,20 @@ package Restrict is -- Similar to the above, except that this is used for the case of a -- parameter restriction, and the corresponding value V is given. + procedure Set_Restriction + (R : All_Restrictions; + N : Node_Id; + Warn : Boolean; + V : Integer := Integer'First); + -- Same as above two, except also takes care of setting the + -- Restriction_Warnings flag. V is ignored for Boolean + -- restrictions. + -- + -- If this is the first time we've seen this restriction, the warning flag + -- is set to Warn. If this is a second or subsequent time, Warn = False + -- wins; that is, errors always trump warnings. In that case, the warning + -- flag can be set to False, but never to True. + procedure Set_Restriction_No_Dependence (Unit : Node_Id; Warn : Boolean; @@ -463,8 +477,8 @@ package Restrict is -- No_Dependence restriction comes from a Profile pragma. procedure Set_Restriction_No_Specification_Of_Aspect - (N : Node_Id; - Warning : Boolean); + (N : Node_Id; + Warn : Boolean); -- N is the node id for an identifier from a pragma Restrictions for the -- No_Specification_Of_Aspect pragma. An error message will be issued if -- the identifier is not a valid aspect name. Warning is set True for the @@ -475,8 +489,8 @@ package Restrict is -- Version used by Get_Target_Parameters (via Tbuild) procedure Set_Restriction_No_Use_Of_Attribute - (N : Node_Id; - Warning : Boolean); + (N : Node_Id; + Warn : Boolean); -- N is the node id for the identifier in a pragma Restrictions for -- No_Use_Of_Attribute. Caller has verified that this is a valid attribute -- designator. @@ -486,7 +500,7 @@ package Restrict is procedure Set_Restriction_No_Use_Of_Entity (Entity : Node_Id; - Warning : Boolean; + Warn : Boolean; Profile : Profile_Name := No_Profile); -- Sets given No_Use_Of_Entity restriction in table if not there already. -- Warn is True if from Restriction_Warnings, or for Restrictions if the @@ -497,8 +511,8 @@ package Restrict is -- the entity (to optimize table searches). procedure Set_Restriction_No_Use_Of_Pragma - (N : Node_Id; - Warning : Boolean); + (N : Node_Id; + Warn : Boolean); -- N is the node id for the identifier in a pragma Restrictions for -- No_Use_Of_Pragma. Caller has verified that this is a valid pragma id. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9008b60..5ed468e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6464,7 +6464,24 @@ package body Sem_Ch13 is Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range)); Pop_Type (U_Ent); - if not Is_OK_Static_Expression (Expr) then + -- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU": + -- If the expression is static, and its value is + -- System.Multiprocessors.Not_A_Specific_CPU (i.e. zero) then + -- that's a violation of No_Tasks_Unassigned_To_CPU. It might + -- seem better to refer to Not_A_Specific_CPU here, but that + -- involves a lot of horsing around with Rtsfind, and this + -- value is not going to change, so it's better to hardwire + -- Uint_0. + -- + -- AI12-0055-1, "All properties of a usage profile are defined + -- by pragmas": If the expression is nonstatic, that's a + -- violation of No_Dynamic_CPU_Assignment. + + if Is_OK_Static_Expression (Expr) then + if Expr_Value (Expr) = Uint_0 then + Check_Restriction (No_Tasks_Unassigned_To_CPU, Expr); + end if; + else Check_Restriction (No_Dynamic_CPU_Assignment, Expr); end if; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 91c3d6d..eb8f2a0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10542,23 +10542,28 @@ package body Sem_Prag is Set_Global_No_Tasking; end if; - -- If this is a warning, then set the warning unless we already - -- have a real restriction active (we never want a warning to - -- override a real restriction). - - if Warn then - if not Restriction_Active (R_Id) then - Set_Restriction (R_Id, N); - Restriction_Warnings (R_Id) := True; - end if; + Set_Restriction (R_Id, N, Warn); - -- If real restriction case, then set it and make sure that the - -- restriction warning flag is off, since a real restriction - -- always overrides a warning. + if R_Id = No_Dynamic_CPU_Assignment + or else R_Id = No_Tasks_Unassigned_To_CPU + then + -- These imply No_Dependence => + -- "System.Multiprocessors.Dispatching_Domains". + -- This is not strictly what the AI says, but it eliminates + -- the need for run-time checks, which are undesirable in + -- this context. - else - Set_Restriction (R_Id, N); - Restriction_Warnings (R_Id) := False; + Set_Restriction_No_Dependence + (Sel_Comp + (Sel_Comp ("system", "multiprocessors", Loc), + "dispatching_domains"), + Warn); + end if; + + if R_Id = No_Tasks_Unassigned_To_CPU then + -- Likewise, imply No_Dynamic_CPU_Assignment + + Set_Restriction (No_Dynamic_CPU_Assignment, N, Warn); end if; -- Check for obsolescent restrictions in Ada 2005 mode @@ -10702,26 +10707,7 @@ package body Sem_Prag is ("pragma ignored, value too large??", Arg); end if; - -- Warning case. If the real restriction is active, then we - -- ignore the request, since warning never overrides a real - -- restriction. Otherwise we set the proper warning. Note that - -- this circuit sets the warning again if it is already set, - -- which is what we want, since the constant may have changed. - - if Warn then - if not Restriction_Active (R_Id) then - Set_Restriction - (R_Id, N, Integer (UI_To_Int (Val))); - Restriction_Warnings (R_Id) := True; - end if; - - -- Real restriction case, set restriction and make sure warning - -- flag is off since real restriction always overrides warning. - - else - Set_Restriction (R_Id, N, Integer (UI_To_Int (Val))); - Restriction_Warnings (R_Id) := False; - end if; + Set_Restriction (R_Id, N, Warn, Integer (UI_To_Int (Val))); end if; Next (Arg); @@ -11313,13 +11299,6 @@ package body Sem_Prag is Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); end Set_Error_Msg_To_Profile_Name; - -- Local variables - - Nod : Node_Id; - Pref : Node_Id; - Pref_Id : Node_Id; - Sel_Id : Node_Id; - Profile_Dispatching_Policy : Character; -- Start of processing for Set_Ravenscar_Profile @@ -11391,46 +11370,30 @@ package body Sem_Prag is -- No_Dependence => Ada.Calendar -- No_Dependence => Ada.Task_Attributes -- are already set by previous call to Set_Profile_Restrictions. + -- Really??? -- Set the following restrictions which were added to Ada 2005: -- No_Dependence => Ada.Execution_Time.Group_Budget -- No_Dependence => Ada.Execution_Time.Timers if Ada_Version >= Ada_2005 then - Pref_Id := Make_Identifier (Loc, Name_Find ("ada")); - Sel_Id := Make_Identifier (Loc, Name_Find ("execution_time")); - - Pref := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref_Id, - Selector_Name => Sel_Id); - - Sel_Id := Make_Identifier (Loc, Name_Find ("group_budgets")); - - Nod := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref, - Selector_Name => Sel_Id); - - Set_Restriction_No_Dependence - (Unit => Nod, - Warn => Treat_Restrictions_As_Warnings, - Profile => Ravenscar); - - Sel_Id := Make_Identifier (Loc, Name_Find ("timers")); - - Nod := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref, - Selector_Name => Sel_Id); - - Set_Restriction_No_Dependence - (Unit => Nod, - Warn => Treat_Restrictions_As_Warnings, - Profile => Ravenscar); + declare + Execution_Time : constant Node_Id := + Sel_Comp ("ada", "execution_time", Loc); + Group_Budgets : constant Node_Id := + Sel_Comp (Execution_Time, "group_budgets"); + Timers : constant Node_Id := + Sel_Comp (Execution_Time, "timers"); + begin + Set_Restriction_No_Dependence + (Unit => Group_Budgets, + Warn => Treat_Restrictions_As_Warnings, + Profile => Ravenscar); + Set_Restriction_No_Dependence + (Unit => Timers, + Warn => Treat_Restrictions_As_Warnings, + Profile => Ravenscar); + end; end if; -- Set the following restriction which was added to Ada 2012 (see @@ -11438,25 +11401,10 @@ package body Sem_Prag is -- No_Dependence => System.Multiprocessors.Dispatching_Domains if Ada_Version >= Ada_2012 then - Pref_Id := Make_Identifier (Loc, Name_Find ("system")); - Sel_Id := Make_Identifier (Loc, Name_Find ("multiprocessors")); - - Pref := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref_Id, - Selector_Name => Sel_Id); - - Sel_Id := Make_Identifier (Loc, Name_Find ("dispatching_domains")); - - Nod := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref, - Selector_Name => Sel_Id); - Set_Restriction_No_Dependence - (Unit => Nod, + (Sel_Comp + (Sel_Comp ("system", "multiprocessors", Loc), + "dispatching_domains"), Warn => Treat_Restrictions_As_Warnings, Profile => Ravenscar); @@ -11468,18 +11416,8 @@ package body Sem_Prag is -- in Ada2012 (AI05-0174). if Profile /= Jorvik then - Pref_Id := Make_Identifier (Loc, Name_Find ("ada")); - Sel_Id := Make_Identifier (Loc, Name_Find - ("synchronous_barriers")); - - Nod := - Make_Selected_Component - (Sloc => Loc, - Prefix => Pref_Id, - Selector_Name => Sel_Id); - Set_Restriction_No_Dependence - (Unit => Nod, + (Sel_Comp ("ada", "synchronous_barriers", Loc), Warn => Treat_Restrictions_As_Warnings, Profile => Ravenscar); end if; @@ -14916,7 +14854,13 @@ package body Sem_Prag is Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range)); - if not Is_OK_Static_Expression (Arg) then + -- See comment in Sem_Ch13 about the following restrictions + + if Is_OK_Static_Expression (Arg) then + if Expr_Value (Arg) = Uint_0 then + Check_Restriction (No_Tasks_Unassigned_To_CPU, N); + end if; + else Check_Restriction (No_Dynamic_CPU_Assignment, N); end if; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 212d315..4feb3a2 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -797,6 +797,23 @@ package body Tbuild is return Result; end OK_Convert_To; + -------------- + -- Sel_Comp -- + -------------- + + function Sel_Comp (Pre : Node_Id; Sel : String) return Node_Id is + begin + return Make_Selected_Component + (Sloc => Sloc (Pre), + Prefix => Pre, + Selector_Name => Make_Identifier (Sloc (Pre), Name_Find (Sel))); + end Sel_Comp; + + function Sel_Comp (Pre, Sel : String; Loc : Source_Ptr) return Node_Id is + begin + return Sel_Comp (Make_Identifier (Loc, Name_Find (Pre)), Sel); + end Sel_Comp; + ------------- -- Set_NOD -- ------------- diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index 3256804..70bf653 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -335,6 +335,11 @@ package Tbuild is -- fixed-point small is called typ_SMALL where typ is the name of the -- fixed-point type (as passed in Related_Id), and Suffix is "SMALL". + function Sel_Comp (Pre, Sel : String; Loc : Source_Ptr) return Node_Id; + function Sel_Comp (Pre : Node_Id; Sel : String) return Node_Id; + -- Create a selected component of the form Pre.Sel; that is, Pre is the + -- prefix, and Sel is the selector name. + function OK_Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id; -- Like Convert_To, except that a conversion node is always generated, and -- the Conversion_OK flag is set on this conversion node. |