From 1f70c47f8a074151222103aa69b16375584d24a0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 15:05:10 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Hristian Kirtchev * sem_util.adb (Is_Post_State): A reference to a generic in out parameter is considered a change in the post-state of a subprogram. 2017-04-25 Ed Schonberg * sem_ch12.adb (Load_Parent_Of_Generic); When retrieving the declaration of a subprogram instance within its wrapper package, skip over null statements that may result from the rewriting of ignored pragmas. 2017-04-25 Ed Schonberg * exp_attr.adb (Expand_Attribute_Reference, case 'Read): If the type is an unchecked_union, replace the attribute with a Raise_Program_Error (rather than inserting such before the attribute reference) to handle properly the case where we are processing a component of a larger record, and we need to prevent further expansion for the unchecked union. (Expand_Attribute_Reference, case 'Write): If the type is an unchecked_union, check whether enclosing scope is a Write subprogram. Replace attribute with a Raise_Program_Error if the discriminants of the unchecked_union type have not default values because such a use is erroneous.. 2017-04-25 Tristan Gingold * exp_ch9.adb (Expand_N_Task_Type_Declaration): Add relative_deadline to task record on edf profile. (Make_Initialize_Protection): Pass deadline_floor value on edf profile. (Make_Task_Create_Call): Pass relative_deadline value. * par-prag.adb (Prag): Handle Pragma_Deadline_Floor. * s-rident.ads (Profile_Name): Add GNAT_Ravenscar_EDF. (Profile_Info): Add info for GNAT_Ravenscar_EDF. * sem_prag.adb (Set_Ravenscar_Profile): Handle GNAT_Ravenscar_EDF (set scheduling policy). (Analyze_Pragma): Handle GNAT_Ravenscar_EDF profile and Deadline_Floor pragma. (Sig_Flags): Add choice for Pragma_Deadline_Floor. * snames.ads-tmpl (Name_Deadline_Floor, Name_Gnat_Ravenscar_EDF): New names. (Pragma_Deadline_Floor): New pragma. * targparm.adb (Get_Target_Parameters): Recognize GNAT_Ravenscar_EDF profile. From-SVN: r247221 --- gcc/ada/ChangeLog | 47 ++++++++++++++++++++++++++++++++ gcc/ada/exp_attr.adb | 32 +++++++++++++++------- gcc/ada/exp_ch9.adb | 72 ++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/par-prag.adb | 3 ++- gcc/ada/s-rident.ads | 60 ++++++++++++++++++++++++++++++++++++++--- gcc/ada/sem_ch12.adb | 18 +++++++------ gcc/ada/sem_prag.adb | 70 ++++++++++++++++++++++++++++++++++++++++++----- gcc/ada/sem_util.adb | 15 ++++++++--- gcc/ada/snames.ads-tmpl | 5 +++- gcc/ada/targparm.adb | 15 +++++++++-- 10 files changed, 291 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6a5b6fa..27c0af0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,50 @@ +2017-04-25 Hristian Kirtchev + + * sem_util.adb (Is_Post_State): A reference to a + generic in out parameter is considered a change in the post-state + of a subprogram. + +2017-04-25 Ed Schonberg + + * sem_ch12.adb (Load_Parent_Of_Generic); When retrieving the + declaration of a subprogram instance within its wrapper package, + skip over null statements that may result from the rewriting of + ignored pragmas. + +2017-04-25 Ed Schonberg + + * exp_attr.adb (Expand_Attribute_Reference, case 'Read): + If the type is an unchecked_union, replace the attribute with + a Raise_Program_Error (rather than inserting such before the + attribute reference) to handle properly the case where we are + processing a component of a larger record, and we need to prevent + further expansion for the unchecked union. + (Expand_Attribute_Reference, case 'Write): If the type is + an unchecked_union, check whether enclosing scope is a Write + subprogram. Replace attribute with a Raise_Program_Error if the + discriminants of the unchecked_union type have not default values + because such a use is erroneous.. + +2017-04-25 Tristan Gingold + + * exp_ch9.adb (Expand_N_Task_Type_Declaration): + Add relative_deadline to task record on edf profile. + (Make_Initialize_Protection): Pass deadline_floor value on edf profile. + (Make_Task_Create_Call): Pass relative_deadline value. + * par-prag.adb (Prag): Handle Pragma_Deadline_Floor. + * s-rident.ads (Profile_Name): Add GNAT_Ravenscar_EDF. + (Profile_Info): Add info for GNAT_Ravenscar_EDF. + * sem_prag.adb (Set_Ravenscar_Profile): Handle + GNAT_Ravenscar_EDF (set scheduling policy). + (Analyze_Pragma): Handle GNAT_Ravenscar_EDF profile and Deadline_Floor + pragma. + (Sig_Flags): Add choice for Pragma_Deadline_Floor. + * snames.ads-tmpl (Name_Deadline_Floor, Name_Gnat_Ravenscar_EDF): + New names. + (Pragma_Deadline_Floor): New pragma. + * targparm.adb (Get_Target_Parameters): Recognize + GNAT_Ravenscar_EDF profile. + 2017-04-25 Arnaud Charlet * gnatvsn.ads (Library_Version): Bump to 8. Update comment. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ac252cd..ec16bee 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -5515,12 +5515,17 @@ package body Exp_Attr is -- Ada 2005 (AI-216): Program_Error is raised when executing -- the default implementation of the Read attribute of an - -- Unchecked_Union type. + -- Unchecked_Union type. We replace the attribute with a + -- raise statement (rather than inserting it before) to handle + -- properly the case of an unchecked union that is a record + -- component. if Is_Unchecked_Union (Base_Type (U_Type)) then - Insert_Action (N, + Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Unchecked_Union_Restriction)); + Set_Etype (N, B_Type); + return; end if; if Has_Discriminants (U_Type) @@ -7215,14 +7220,21 @@ package body Exp_Attr is -- Unchecked_Union type. However, if the 'Write reference is -- within the generated Output stream procedure, Write outputs -- the components, and the default values of the discriminant - -- are streamed by the Output procedure itself. + -- are streamed by the Output procedure itself. If there are + -- no default values this is also erroneous. - if Is_Unchecked_Union (Base_Type (U_Type)) - and not Is_TSS (Current_Scope, TSS_Stream_Output) - then - Insert_Action (N, - Make_Raise_Program_Error (Loc, - Reason => PE_Unchecked_Union_Restriction)); + if Is_Unchecked_Union (Base_Type (U_Type)) then + if (not Is_TSS (Current_Scope, TSS_Stream_Output) + and not Is_TSS (Current_Scope, TSS_Stream_Write)) + or else No (Discriminant_Default_Value + (First_Discriminant (U_Type))) + then + Rewrite (N, + Make_Raise_Program_Error (Loc, + Reason => PE_Unchecked_Union_Restriction)); + Set_Etype (N, U_Type); + return; + end if; end if; if Has_Discriminants (U_Type) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index b38aed3..89f9e71 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -12026,9 +12026,11 @@ package body Exp_Ch9 is -- Add the _Relative_Deadline component if a Relative_Deadline pragma is -- present. If we are using a restricted run time this component will - -- not be added (deadlines are not allowed by the Ravenscar profile). + -- not be added (deadlines are not allowed by the Ravenscar profile), + -- unless the task dispatching policy is EDF (for GNAT_Ravenscar_EDF + -- profile). - if not Restricted_Profile + if (not Restricted_Profile or else Task_Dispatching_Policy = 'E') and then Present (Taskdef) and then Has_Relative_Deadline_Pragma (Taskdef) then @@ -13822,6 +13824,46 @@ package body Exp_Ch9 is New_Occurrence_Of (RTE (RE_Unspecified_Priority), Loc)); end if; + -- Deadline_Floor parameter for GNAT_Ravenscar_EDF runtimes + + if Restricted_Profile and Task_Dispatching_Policy = 'E' then + Deadline_Floor : declare + Item : constant Node_Id := + Get_Rep_Item + (Ptyp, Name_Deadline_Floor, Check_Parents => False); + + Deadline : Node_Id; + + begin + if Present (Item) then + + -- Pragma Deadline_Floor + + if Nkind (Item) = N_Pragma then + Deadline := + Expression + (First (Pragma_Argument_Associations (Item))); + + -- Attribute definition clause Deadline_Floor + + else + pragma Assert + (Nkind (Item) = N_Attribute_Definition_Clause); + + Deadline := Expression (Item); + end if; + + Append_To (Args, Deadline); + + -- Unusual case: default deadline + + else + Append_To (Args, + New_Occurrence_Of (RTE (RE_Time_Span_Zero), Loc)); + end if; + end Deadline_Floor; + end if; + -- Test for Compiler_Info parameter. This parameter allows entry body -- procedures and barrier functions to be called from the runtime. It -- is a pointer to the record generated by the compiler to represent @@ -14127,15 +14169,18 @@ package body Exp_Ch9 is -- Priority parameter. Set to Unspecified_Priority unless there is a -- Priority rep item, in which case we take the value from the rep item. + -- Not used on Ravenscar_EDF profile. - if Has_Rep_Item (Ttyp, Name_Priority, Check_Parents => False) then - Append_To (Args, - Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => Make_Identifier (Loc, Name_uPriority))); - else - Append_To (Args, - New_Occurrence_Of (RTE (RE_Unspecified_Priority), Loc)); + if not (Restricted_Profile and then Task_Dispatching_Policy = 'E') then + if Has_Rep_Item (Ttyp, Name_Priority, Check_Parents => False) then + Append_To (Args, + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_uInit), + Selector_Name => Make_Identifier (Loc, Name_uPriority))); + else + Append_To (Args, + New_Occurrence_Of (RTE (RE_Unspecified_Priority), Loc)); + end if; end if; -- Optional Stack parameter @@ -14231,7 +14276,7 @@ package body Exp_Ch9 is New_Occurrence_Of (RTE (RE_Unspecified_CPU), Loc)); end if; - if not Restricted_Profile then + if not Restricted_Profile or else Task_Dispatching_Policy = 'E' then -- Deadline parameter. If no Relative_Deadline pragma is present, -- then the deadline is Time_Span_Zero. If a pragma is present, then @@ -14255,6 +14300,9 @@ package body Exp_Ch9 is Append_To (Args, New_Occurrence_Of (RTE (RE_Time_Span_Zero), Loc)); end if; + end if; + + if not Restricted_Profile then -- Dispatching_Domain parameter. If no Dispatching_Domain rep item is -- present, then the dispatching domain is null. If a rep item is diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index e3a1b3f..6296f7b 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1334,6 +1334,7 @@ begin | Pragma_Component_Alignment | Pragma_Controlled | Pragma_Convention + | Pragma_Deadline_Floor | Pragma_Debug_Policy | Pragma_Depends | Pragma_Detect_Blocking diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 3228bac..f3bd771 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -381,7 +381,8 @@ package System.Rident is Restricted_Tasking, Restricted, Ravenscar, - GNAT_Extended_Ravenscar); + GNAT_Extended_Ravenscar, + GNAT_Ravenscar_EDF); -- Names of recognized profiles. No_Profile is used to indicate that a -- restriction came from pragma Restrictions[_Warning], as opposed to -- pragma Profile[_Warning]. Restricted_Tasking is a non-user profile that @@ -390,7 +391,7 @@ package System.Rident is -- that also restrict protected types. subtype Profile_Name_Actual is Profile_Name - range No_Implementation_Extensions .. GNAT_Extended_Ravenscar; + range No_Implementation_Extensions .. Profile_Name'Last; -- Actual used profile names type Profile_Data is record @@ -583,6 +584,59 @@ package System.Rident is (Max_Asynchronous_Select_Nesting => 0, Max_Select_Alternatives => 0, Max_Task_Entries => 0, + others => 0)), + + -- GNAT_Ravenscar_EDF Profile + + -- Note: the table entries here only represent the + -- required restriction profile for GNAT_Ravenscar_EDF. + -- The full GNAT_Ravenscar_EDF profile also requires: + + -- pragma Dispatching_Policy (EDF_Across_Priorities); + -- pragma Locking_Policy (Ceiling_Locking); + -- pragma Detect_Blocking; + + GNAT_Ravenscar_EDF => + + -- Restrictions for Ravenscar = Restricted profile .. + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => True, + No_Entry_Queue => True, + No_Local_Protected_Objects => True, + No_Protected_Type_Allocators => True, + No_Requeue_Statements => True, + No_Task_Allocators => True, + No_Task_Attributes_Package => True, + No_Task_Hierarchy => True, + No_Terminate_Alternatives => True, + Max_Asynchronous_Select_Nesting => True, + Max_Protected_Entries => True, + Max_Select_Alternatives => True, + Max_Task_Entries => True, + + -- plus these additional restrictions: + + No_Calendar => True, + No_Implicit_Heap_Allocations => True, + No_Local_Timing_Events => True, + No_Relative_Delay => True, + No_Select_Statements => True, + No_Specific_Termination_Handlers => True, + No_Task_Termination => True, + Simple_Barriers => True, + others => False), + + -- Value settings for Ravenscar (same as Restricted) + + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Protected_Entries => 1, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, others => 0))); end System.Rident; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3a450eb..2f2262d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -13217,8 +13217,8 @@ package body Sem_Ch12 is -- package, in which case the usual generic rule applies. declare - Exp_Status : Boolean := True; - Scop : Entity_Id; + Exp_Status : Boolean := True; + Scop : Entity_Id; begin -- Loop through scopes looking for generic package @@ -13292,8 +13292,7 @@ package body Sem_Ch12 is -- Package instance - if - Nkind (Node (Decl)) = N_Package_Instantiation + if Nkind (Node (Decl)) = N_Package_Instantiation then Instantiate_Package_Body (Info, Body_Optional => True); @@ -13308,8 +13307,9 @@ package body Sem_Ch12 is -- these result in the corresponding pragmas, -- inserted after the subprogram declaration. -- They must be skipped as well when retrieving - -- the desired spec. A direct link would be - -- more robust ??? + -- the desired spec. Some of them may have been + -- rewritten as null statements. + -- A direct link would be more robust ??? declare Decl : Node_Id := @@ -13317,7 +13317,9 @@ package body Sem_Ch12 is (Specification (Info.Act_Decl)))); begin while Nkind_In (Decl, - N_Subprogram_Renaming_Declaration, N_Pragma) + N_Null_Statement, + N_Pragma, + N_Subprogram_Renaming_Declaration) loop Decl := Prev (Decl); end loop; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 03da247..6d570d0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -3998,9 +3998,10 @@ package body Sem_Prag is procedure Set_Ravenscar_Profile (Profile : Profile_Name; N : Node_Id); -- Activate the set of configuration pragmas and restrictions that make - -- up the Profile. Profile must be either GNAT_Extended_Ravencar or - -- Ravenscar. N is the corresponding pragma node, which is used for - -- error messages on any constructs violating the profile. + -- up the Profile. Profile must be either GNAT_Extended_Ravencar, + -- GNAT_Ravenscar_EDF or Ravenscar. N is the corresponding pragma node, + -- which is used for error messages on any constructs violating the + -- profile. ---------------------------------- -- Acquire_Warning_Match_String -- @@ -10322,6 +10323,9 @@ package body Sem_Prag is -- Set required policies -- pragma Task_Dispatching_Policy (FIFO_Within_Priorities) + -- (For Ravenscar and GNAT_Extended_Ravenscar profiles) + -- pragma Task_Dispatching_Policy (EDF_Across_Priorities) + -- (For GNAT_Ravenscar_EDF profile) -- pragma Locking_Policy (Ceiling_Locking) -- Set Detect_Blocking mode @@ -10364,13 +10368,24 @@ package body Sem_Prag is Pref_Id : Node_Id; Sel_Id : Node_Id; + Profile_Dispatching_Policy : Character; + -- Start of processing for Set_Ravenscar_Profile begin + -- pragma Task_Dispatching_Policy (EDF_Across_Priorities) + + if Profile = GNAT_Ravenscar_EDF then + Profile_Dispatching_Policy := 'E'; + -- pragma Task_Dispatching_Policy (FIFO_Within_Priorities) + else + Profile_Dispatching_Policy := 'F'; + end if; + if Task_Dispatching_Policy /= ' ' - and then Task_Dispatching_Policy /= 'F' + and then Task_Dispatching_Policy /= Profile_Dispatching_Policy then Error_Msg_Sloc := Task_Dispatching_Policy_Sloc; Set_Error_Msg_To_Profile_Name; @@ -10381,7 +10396,7 @@ package body Sem_Prag is -- name. else - Task_Dispatching_Policy := 'F'; + Task_Dispatching_Policy := Profile_Dispatching_Policy; if Task_Dispatching_Policy_Sloc /= System_Location then Task_Dispatching_Policy_Sloc := Loc; @@ -13818,6 +13833,45 @@ package body Sem_Prag is Record_Rep_Item (Ent, N); end CPU; + -------------------- + -- Deadline_Floor -- + -------------------- + + -- pragma Deadline_Floor (time_span_EXPRESSION); + + when Pragma_Deadline_Floor => Deadline_Floor : declare + P : constant Node_Id := Parent (N); + Arg : Node_Id; + Ent : Entity_Id; + + begin + GNAT_Pragma; + Check_No_Identifiers; + Check_Arg_Count (1); + + Arg := Get_Pragma_Arg (Arg1); + + -- The expression must be analyzed in the special manner described + -- in "Handling of Default and Per-Object Expressions" in sem.ads. + + Preanalyze_Spec_Expression (Arg, RTE (RE_Time_Span)); + + -- Only protected types allowed + + if Nkind (P) /= N_Protected_Definition then + Pragma_Misplaced; + + else + Ent := Defining_Identifier (Parent (P)); + + -- Check duplicate pragma before we chain the pragma in the Rep + -- Item chain of Ent. + + Check_Duplicate_Pragma (Ent); + Record_Rep_Item (Ent, N); + end if; + end Deadline_Floor; + ----------- -- Debug -- ----------- @@ -19928,6 +19982,9 @@ package body Sem_Prag is elsif Chars (Argx) = Name_Gnat_Extended_Ravenscar then Set_Ravenscar_Profile (GNAT_Extended_Ravenscar, N); + elsif Chars (Argx) = Name_Gnat_Ravenscar_EDF then + Set_Ravenscar_Profile (GNAT_Ravenscar_EDF, N); + elsif Chars (Argx) = Name_Restricted then Set_Profile_Restrictions (Restricted, @@ -29110,6 +29167,7 @@ package body Sem_Prag is Pragma_Controlled => 0, Pragma_Convention => 0, Pragma_Convention_Identifier => 0, + Pragma_Deadline_Floor => -1, Pragma_Debug => -1, Pragma_Debug_Policy => 0, Pragma_Detect_Blocking => 0, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 42e1601..d33a4f9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3311,11 +3311,20 @@ package body Sem_Util is elsif Nkind_In (N, N_Expanded_Name, N_Identifier) then Ent := Entity (N); - -- The entity may be modifiable through an implicit - -- dereference. + -- Treat an undecorated reference as OK if No (Ent) - or else Ekind (Ent) in Assignable_Kind + + -- A reference to an assignable entity is considered a + -- change in the post-state of a subprogram. + + or else Ekind_In (Ent, E_Generic_In_Out_Parameter, + E_In_Out_Parameter, + E_Out_Parameter, + E_Variable) + + -- The reference may be modified through a dereference + or else (Is_Access_Type (Etype (Ent)) and then Nkind (Parent (N)) = N_Selected_Component) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fe58505..2d49322 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -513,6 +513,7 @@ package Snames is -- correctly recognize and process CPU. CPU is a standard Ada 2012 -- pragma. + Name_Deadline_Floor : constant Name_Id := N + $; -- GNAT Name_Debug : constant Name_Id := N + $; -- GNAT Name_Default_Initial_Condition : constant Name_Id := N + $; -- GNAT Name_Depends : constant Name_Id := N + $; -- GNAT @@ -748,6 +749,7 @@ package Snames is Name_General : constant Name_Id := N + $; Name_Gnat : constant Name_Id := N + $; Name_Gnat_Extended_Ravenscar : constant Name_Id := N + $; + Name_Gnat_Ravenscar_EDF : constant Name_Id := N + $; Name_Gnatprove : constant Name_Id := N + $; Name_GPL : constant Name_Id := N + $; Name_High_Order_First : constant Name_Id := N + $; @@ -1871,6 +1873,7 @@ package Snames is Pragma_CPP_Constructor, Pragma_CPP_Virtual, Pragma_CPP_Vtable, + Pragma_Deadline_Floor, Pragma_Debug, Pragma_Default_Initial_Condition, Pragma_Depends, diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 70bd061..cb12a28 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -304,7 +304,18 @@ package body Targparm is Set_Profile_Restrictions (GNAT_Extended_Ravenscar); Opt.Task_Dispatching_Policy := 'F'; Opt.Locking_Policy := 'C'; - P := P + 27; + P := P + 41; + goto Line_Loop_Continue; + + -- Test for pragma Profile (GNAT_Ravenscar_EDF); + + elsif System_Text (P .. P + 35) = + "pragma Profile (GNAT_Ravenscar_EDF);" + then + Set_Profile_Restrictions (GNAT_Ravenscar_EDF); + Opt.Task_Dispatching_Policy := 'E'; + Opt.Locking_Policy := 'C'; + P := P + 36; goto Line_Loop_Continue; -- Test for pragma Profile (Restricted); -- 2.7.4