From: Steve Baird Date: Thu, 20 Feb 2020 00:27:47 +0000 (-0800) Subject: [Ada] Implement AI12-0291 (Jorvik profile) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a998e58bf019c7174a7480fc4d46ec9fcbc4cd92;p=gcc.git [Ada] Implement AI12-0291 (Jorvik profile) 2020-06-08 Steve Baird gcc/ada/ * libgnat/s-rident.ads: Add Jorvik to the Profile_Name enumeration type. Add an element for Jorvik to the array aggregate that is the initial value of the constant Profile_Info. * targparm.adb (Get_Target_Parameters): Handle "pragma Profile (Jorvik);" similarly to "pragma Profile (Ravenscar);". * snames.ads-tmpl: Declare Name_Jorvik Name_Id. Unlike Ravenscar, Jorvik is not a pragma name and has no corresponding element in the Pragma_Id enumeration type; this means that its declaration must not occur between those of First_Pragma_Name and Last_Pragma_Name. * sem_prag.adb (Analyze_Pragma): Add call to Set_Ravenscar_Profile for Jorvik, similar to the existing calls for Ravenscar and the GNAT Ravenscar variants. --- diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads index 73a0450b458..b7969fb96b4 100644 --- a/gcc/ada/libgnat/s-rident.ads +++ b/gcc/ada/libgnat/s-rident.ads @@ -381,6 +381,7 @@ package System.Rident is Restricted_Tasking, Restricted, Ravenscar, + Jorvik, GNAT_Extended_Ravenscar, GNAT_Ravenscar_EDF); -- Names of recognized profiles. No_Profile is used to indicate that a @@ -545,6 +546,67 @@ package System.Rident is Max_Task_Entries => 0, others => 0)), + Jorvik => + + -- Restrictions for Jorvik profile .. + + -- Note: the table entries here only represent the + -- required restriction profile for Jorvik. The + -- full Jorvik profile also requires: + + -- pragma Dispatching_Policy (FIFO_Within_Priorities); + -- pragma Locking_Policy (Ceiling_Locking); + -- pragma Detect_Blocking; + + -- The differences between Ravenscar and Jorvik are + -- as follows: + -- 1) Ravenscar includes restriction Simple_Barriers; + -- Jorvik includes Pure_Barriers instead. + -- 2) The following 6 restrictions are included in + -- Ravenscar but not in Jorvik: + -- No_Implicit_Heap_Allocations + -- No_Relative_Delay + -- Max_Entry_Queue_Length => 1 + -- Max_Protected_Entries => 1 + -- No_Dependence => Ada.Calendar + -- No_Dependence => Ada.Synchronous_Barriers + -- + -- The last of those 7 (i.e., No_Dep => Ada.Synch_Bars) + -- is not reflected here (see sem_prag.adb). + + (Set => + (No_Abort_Statements => True, + No_Asynchronous_Control => True, + No_Dynamic_Attachment => True, + No_Dynamic_Priorities => 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_Select_Alternatives => True, + Max_Task_Entries => True, + + -- plus these additional restrictions: + + No_Local_Timing_Events => True, + No_Select_Statements => True, + No_Specific_Termination_Handlers => True, + No_Task_Termination => True, + Pure_Barriers => True, + others => False), + + -- Value settings for Ravenscar (same as Restricted) + + Value => + (Max_Asynchronous_Select_Nesting => 0, + Max_Select_Alternatives => 0, + Max_Task_Entries => 0, + others => 0)), + GNAT_Extended_Ravenscar => -- Restrictions for GNAT_Extended_Ravenscar = diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 55325f8c8a5..269cbbbe528 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -4330,9 +4330,9 @@ 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_Ravenscar, - -- GNAT_Ravenscar_EDF, or Ravenscar. N is the corresponding pragma node, - -- which is used for error messages on any constructs violating the - -- profile. + -- GNAT_Ravenscar_EDF, Jorvik, or Ravenscar. N is the corresponding + -- pragma node, which is used for error messages on any constructs + -- violating the profile. --------------------- -- Ada_2005_Pragma -- @@ -11162,7 +11162,7 @@ package body Sem_Prag is -- Set required policies -- pragma Task_Dispatching_Policy (FIFO_Within_Priorities) - -- (For Ravenscar and GNAT_Extended_Ravenscar profiles) + -- (For Ravenscar, Jorvik, and GNAT_Extended_Ravenscar profiles) -- pragma Task_Dispatching_Policy (EDF_Across_Priorities) -- (For GNAT_Ravenscar_EDF profile) -- pragma Locking_Policy (Ceiling_Locking) @@ -11283,6 +11283,10 @@ package body Sem_Prag is -- No_Dependence => Ada.Execution_Time.Group_Budget -- No_Dependence => Ada.Execution_Time.Timers + -- ??? Eventually when AI12-0073 is implemented, we'll register a + -- No_Dependence restriction on Ada.Synchronous_Barriers + -- for Ravenscar but not for Jorvik. + if Ada_Version >= Ada_2005 then Pref_Id := Make_Identifier (Loc, Name_Find ("ada")); Sel_Id := Make_Identifier (Loc, Name_Find ("execution_time")); @@ -21314,6 +21318,9 @@ package body Sem_Prag is if Chars (Argx) = Name_Ravenscar then Set_Ravenscar_Profile (Ravenscar, N); + elsif Chars (Argx) = Name_Jorvik then + Set_Ravenscar_Profile (Jorvik, N); + elsif Chars (Argx) = Name_Gnat_Extended_Ravenscar then Set_Ravenscar_Profile (GNAT_Extended_Ravenscar, N); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index e5494ae73ab..b88f861a2d5 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -782,6 +782,7 @@ package Snames is Name_Info : constant Name_Id := N + $; Name_Internal : constant Name_Id := N + $; Name_Ivdep : constant Name_Id := N + $; + Name_Jorvik : constant Name_Id := N + $; Name_Link_Name : constant Name_Id := N + $; Name_Low_Order_First : constant Name_Id := N + $; Name_Lowercase : constant Name_Id := N + $; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index c1ec8e71249..9e1571091bf 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -334,6 +334,14 @@ package body Targparm is Opt.Locking_Policy := 'C'; goto Line_Loop_Continue; + -- Test for pragma Profile (Jorvik); + + elsif Looking_At_Skip ("pragma Profile (Jorvik);") then + Set_Profile_Restrictions (Jorvik); + Opt.Task_Dispatching_Policy := 'F'; + Opt.Locking_Policy := 'C'; + goto Line_Loop_Continue; + -- Test for pragma Profile (GNAT_Extended_Ravenscar); elsif Looking_At_Skip