From eae66578ceb7a6d07dd58f18ee8bba5c31de468d Mon Sep 17 00:00:00 2001 From: Patrick Bernardi Date: Fri, 6 Jan 2017 12:06:41 +0000 Subject: [PATCH] aspects.adb, [...]: Reverted previous change for now. 2017-01-06 Patrick Bernardi * aspects.adb, aspects.ads, exp_ch3.adb, exp_ch9.adb, par-prag.adb, sem_ch13.adb, sem_prag.adb, sem_prag.ads, snames.adb-tmpl, snames.ads-tmpl, s-secsta.adb, s-secsta.ads, s-tarest.adb, s-tarest.ads, s-taskin.adb, s-taskin.ads, s-tassta.adb, s-tassta.ads: Reverted previous change for now. From-SVN: r244148 --- gcc/ada/ChangeLog | 8 +++ gcc/ada/aspects.adb | 1 - gcc/ada/aspects.ads | 5 -- gcc/ada/exp_ch3.adb | 19 +++--- gcc/ada/exp_ch9.adb | 65 +++----------------- gcc/ada/par-prag.adb | 1 - gcc/ada/s-secsta.adb | 11 +--- gcc/ada/s-secsta.ads | 4 -- gcc/ada/s-tarest.adb | 130 ++++++++++++++++------------------------ gcc/ada/s-tarest.ads | 46 +++++++------- gcc/ada/s-taskin.adb | 51 ++++++++-------- gcc/ada/s-taskin.ads | 32 ++++------ gcc/ada/s-tassta.adb | 61 +++++++------------ gcc/ada/s-tassta.ads | 30 +++++----- gcc/ada/sem_ch13.adb | 47 +-------------- gcc/ada/sem_prag.adb | 46 +------------- gcc/ada/sem_prag.ads | 1 - gcc/ada/snames.adb-tmpl | 5 -- gcc/ada/snames.ads-tmpl | 17 ++---- 19 files changed, 174 insertions(+), 406 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ad4f3ca647f..a8d4a00a1b6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2017-01-06 Patrick Bernardi + + * aspects.adb, aspects.ads, exp_ch3.adb, exp_ch9.adb, par-prag.adb, + sem_ch13.adb, sem_prag.adb, sem_prag.ads, snames.adb-tmpl, + snames.ads-tmpl, s-secsta.adb, s-secsta.ads, s-tarest.adb, + s-tarest.ads, s-taskin.adb, s-taskin.ads, s-tassta.adb, s-tassta.ads: + Reverted previous change for now. + 2017-01-06 Ed Schonberg * exp_ch3.adb (Build_Initialization_Call): Apply predicate diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 49eddf42851..0da6b812c97 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -599,7 +599,6 @@ package body Aspects is Aspect_Read => Aspect_Read, Aspect_Relative_Deadline => Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order, - Aspect_Secondary_Stack_Size => Aspect_Secondary_Stack_Size, Aspect_Shared => Aspect_Atomic, Aspect_Shared_Passive => Aspect_Shared_Passive, Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 586d35fea32..5de6539b0a5 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -135,7 +135,6 @@ package Aspects is Aspect_Refined_State, -- GNAT Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order, -- GNAT - Aspect_Secondary_Stack_Size, -- GNAT Aspect_Simple_Storage_Pool, -- GNAT Aspect_Size, Aspect_Small, @@ -256,7 +255,6 @@ package Aspects is Aspect_Pure_Function => True, Aspect_Remote_Access_Type => True, Aspect_Scalar_Storage_Order => True, - Aspect_Secondary_Stack_Size => True, Aspect_Shared => True, Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, @@ -376,7 +374,6 @@ package Aspects is Aspect_Refined_State => Expression, Aspect_Relative_Deadline => Expression, Aspect_Scalar_Storage_Order => Expression, - Aspect_Secondary_Stack_Size => Expression, Aspect_Simple_Storage_Pool => Name, Aspect_Size => Expression, Aspect_Small => Expression, @@ -497,7 +494,6 @@ package Aspects is Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, Aspect_Remote_Types => Name_Remote_Types, Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order, - Aspect_Secondary_Stack_Size => Name_Secondary_Stack_Size, Aspect_Shared => Name_Shared, Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, @@ -696,7 +692,6 @@ package Aspects is Aspect_Remote_Access_Type => Always_Delay, Aspect_Remote_Call_Interface => Always_Delay, Aspect_Remote_Types => Always_Delay, - Aspect_Secondary_Stack_Size => Always_Delay, Aspect_Shared => Always_Delay, Aspect_Shared_Passive => Always_Delay, Aspect_Simple_Storage_Pool => Always_Delay, diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index e617c0540f8..cd349dbdd8c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1485,7 +1485,7 @@ package body Exp_Ch3 is -- The constraints come from the discriminant default exps, -- they must be reevaluated, so we use New_Copy_Tree but we -- ensure the proper Sloc (for any embedded calls). - -- In addtion, if a predicate check is needed on the value + -- In addition, if a predicate check is needed on the value -- of the discriminant, insert it ahead of the call. Arg := New_Copy_Tree (Arg, New_Sloc => Loc); @@ -1495,7 +1495,7 @@ package body Exp_Ch3 is and then not Predicates_Ignored (Etype (Discr)) then Prepend_To (Res, - Make_Predicate_Check (Etype (Discr), Arg)); + Make_Predicate_Check (Etype (Discr), Arg)); end if; end if; end if; @@ -1741,7 +1741,7 @@ package body Exp_Ch3 is end if; -- If a component type has a predicate, add check to the component - -- assignment. Discriminants are hnndled at the point of the call, + -- assignment. Discriminants are handled at the point of the call, -- which provides for a better error message. if Comes_From_Source (Exp) @@ -2730,17 +2730,15 @@ package body Exp_Ch3 is Actions := Build_Assignment (Id, Expression (Decl)); end if; - -- CPU, Dispatching_Domain, Priority and - -- Secondary_Stack_Size components are filled with the - -- corresponding rep item expression of the concurrent - -- type (if any). + -- CPU, Dispatching_Domain, Priority and Size components are + -- filled with the corresponding rep item expression of the + -- concurrent type (if any). elsif Ekind (Scope (Id)) = E_Record_Type and then Present (Corresponding_Concurrent_Type (Scope (Id))) and then Nam_In (Chars (Id), Name_uCPU, Name_uDispatching_Domain, - Name_uPriority, - Name_uSecondary_Stack_Size) + Name_uPriority) then declare Exp : Node_Id; @@ -2756,9 +2754,6 @@ package body Exp_Ch3 is elsif Chars (Id) = Name_uPriority then Nam := Name_Priority; - - elsif Chars (Id) = Name_uSecondary_Stack_Size then - Nam := Name_Secondary_Stack_Size; end if; -- Get the Rep Item (aspect specification, attribute diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 91f8d37435c..7eb38b5e4d1 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11553,15 +11553,14 @@ package body Exp_Ch9 is -- values of this task. The general form of this type declaration is -- type taskV (discriminants) is record - -- _Task_Id : Task_Id; - -- entry_family : array (bounds) of Void; - -- _Priority : Integer := priority_expression; - -- _Size : Size_Type := size_expression; - -- _Secondary_Stack_Size : Size_Type := size_expression; - -- _Task_Info : Task_Info_Type := task_info_expression; - -- _CPU : Integer := cpu_range_expression; - -- _Relative_Deadline : Time_Span := time_span_expression; - -- _Domain : Dispatching_Domain := dd_expression; + -- _Task_Id : Task_Id; + -- entry_family : array (bounds) of Void; + -- _Priority : Integer := priority_expression; + -- _Size : Size_Type := size_expression; + -- _Task_Info : Task_Info_Type := task_info_expression; + -- _CPU : Integer := cpu_range_expression; + -- _Relative_Deadline : Time_Span := time_span_expression; + -- _Domain : Dispatching_Domain := dd_expression; -- end record; -- The discriminants are present only if the corresponding task type has @@ -11585,13 +11584,6 @@ package body Exp_Ch9 is -- in the pragma, and is used to override the task stack size otherwise -- associated with the task type. - -- The _Secondary_Stack_Size field is present only the task entity has a - -- Secondary_Stack_Size rep item. It will be filled at the freeze point, - -- when the record init proc is built, to capture the expression of the - -- rep item (see Build_Record_Init_Proc in Exp_Ch3). Note that it cannot - -- be filled here since aspect evaluations are delayed till the freeze - -- point. - -- The _Priority field is present only if the task entity has a Priority or -- Interrupt_Priority rep item (pragma, aspect specification or attribute -- definition clause). It will be filled at the freeze point, when the @@ -11931,24 +11923,6 @@ package body Exp_Ch9 is Get_Rep_Pragma (TaskId, Name_Storage_Size)))))))); end if; - -- Add the _Secondary_Stack_Size component if a - -- Secondary_Stack_Size rep item is present. - - if Has_Rep_Item (TaskId, Name_Secondary_Stack_Size, - Check_Parents => False) - then - Append_To (Cdecls, - Make_Component_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uSecondary_Stack_Size), - - Component_Definition => - Make_Component_Definition (Loc, - Aliased_Present => False, - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Size_Type), Loc)))); - end if; - -- Add the _Task_Info component if a Task_Info pragma is present if Has_Rep_Pragma (TaskId, Name_Task_Info, Check_Parents => False) then @@ -14140,29 +14114,6 @@ package body Exp_Ch9 is New_Occurrence_Of (Storage_Size_Variable (Ttyp), Loc)); end if; - -- Secondary_Stack_Size parameter. Set Default_Secondary_Stack_Size - -- unless there is a Secondary_Stack_Size rep item, in which case we - -- take the value from the rep item. If the restriction - -- No_Secondary_Stack is active then a size of 0 is passed regardless - -- to prevent the allocation of the unused stack. - - if Restriction_Active (No_Secondary_Stack) then - Append_To (Args, Make_Integer_Literal (Loc, 0)); - - elsif Has_Rep_Item (Ttyp, Name_Secondary_Stack_Size, - Check_Parents => False) - then - Append_To (Args, - Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => - Make_Identifier (Loc, Name_uSecondary_Stack_Size))); - - else - Append_To (Args, - New_Occurrence_Of (RTE (RE_Unspecified_Size), Loc)); - end if; - -- Task_Info parameter. Set to Unspecified_Task_Info unless there is a -- Task_Info pragma, in which case we take the value from the pragma. diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 865343695d6..ff939f6848d 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1452,7 +1452,6 @@ begin Pragma_Ravenscar | Pragma_Rename_Pragma | Pragma_Reviewable | - Pragma_Secondary_Stack_Size | Pragma_Share_Generic | Pragma_Shared | Pragma_Shared_Passive | diff --git a/gcc/ada/s-secsta.adb b/gcc/ada/s-secsta.adb index 6f8a0e832d6..30e03debf46 100644 --- a/gcc/ada/s-secsta.adb +++ b/gcc/ada/s-secsta.adb @@ -170,15 +170,6 @@ package body System.Secondary_Stack is Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr); -- Convert from address stored in task data structures - ---------------------------------- - -- Minumum_Secondary_Stack_Size -- - ---------------------------------- - - function Minimum_Secondary_Stack_Size return Natural is - begin - return Dummy_Fixed_Stack.Mem'Position; - end Minimum_Secondary_Stack_Size; - -------------- -- Allocate -- -------------- @@ -441,7 +432,7 @@ package body System.Secondary_Stack is Fixed_Stack.Top := 0; Fixed_Stack.Max := 0; - if Size <= Dummy_Fixed_Stack.Mem'Position then + if Size < Dummy_Fixed_Stack.Mem'Position then Fixed_Stack.Last := 0; else Fixed_Stack.Last := diff --git a/gcc/ada/s-secsta.ads b/gcc/ada/s-secsta.ads index c5a0eadf29f..c95171a61df 100644 --- a/gcc/ada/s-secsta.ads +++ b/gcc/ada/s-secsta.ads @@ -42,10 +42,6 @@ package System.Secondary_Stack is -- which causes the binder to generate an appropriate assignment in the -- binder generated file. - function Minimum_Secondary_Stack_Size return Natural; - -- The minimum size of the secondary stack so that the internal - -- requirements of the stack are met. - procedure SS_Init (Stk : in out Address; Size : Natural := Default_Secondary_Stack_Size); diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 67ad33909b1..a117da3732a 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -116,17 +116,16 @@ package body System.Tasking.Restricted.Stages is -- This should only be called by the Task_Wrapper procedure. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Storage_Elements.Storage_Offset; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Code shared between Create_Restricted_Task (the concurrent version) and -- Create_Restricted_Task_Sequential. See comment of the former in the -- specification of this package. @@ -206,31 +205,11 @@ package body System.Tasking.Restricted.Stages is -- -- DO NOT delete ID. As noted, it is needed on some targets. - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. The function - -- will return the ATCB field Secondary_Stack_Size if it is not set to - -- Unspecified_Size, otherwise a percentage of the stack is reserved - -- using the System.Parameters.Sec_Stack_Percentage property. + use type SSE.Storage_Offset; - function Secondary_Stack_Size return Storage_Elements.Storage_Offset is - use System.Storage_Elements; - use System.Parameters; - begin - if Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then - if Sec_Stack_Percentage = Dynamic then - return Default_Secondary_Stack_Size; - else - return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size - * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); - end if; - else - return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) + - Storage_Offset (Minimum_Secondary_Stack_Size); - end if; - end Secondary_Stack_Size; - - Secondary_Stack : aliased Storage_Elements.Storage_Array - (1 .. Secondary_Stack_Size); + Secondary_Stack : aliased SSE.Storage_Array + (1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * + SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100); for Secondary_Stack'Alignment use Standard'Maximum_Alignment; -- This is the secondary stack data. Note that it is critical that this -- have maximum alignment, since any kind of data can be allocated here. @@ -526,17 +505,16 @@ package body System.Tasking.Restricted.Stages is ---------------------------- procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; @@ -595,8 +573,7 @@ package body System.Tasking.Restricted.Stages is Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Base_CPU, null, Task_Info, Size, Secondary_Stack_Size, - Created_Task, Success); + Base_CPU, null, Task_Info, Size, Created_Task, Success); -- If we do our job right then there should never be any failures, which -- was probably said about the Titanic; so just to be safe, let's retain @@ -633,18 +610,17 @@ package body System.Tasking.Restricted.Stages is end Create_Restricted_Task; procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Types; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id) is begin if Partition_Elaboration_Policy = 'S' then @@ -655,15 +631,13 @@ package body System.Tasking.Restricted.Stages is -- sequential, activation must be deferred. Create_Restricted_Task_Sequential - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, - Task_Image, Created_Task); + (Priority, Stack_Address, Size, Task_Info, CPU, State, + Discriminants, Elaborated, Task_Image, Created_Task); else Create_Restricted_Task - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, - Task_Image, Created_Task); + (Priority, Stack_Address, Size, Task_Info, CPU, State, + Discriminants, Elaborated, Task_Image, Created_Task); -- Append this task to the activation chain @@ -677,20 +651,18 @@ package body System.Tasking.Restricted.Stages is --------------------------------------- procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) is + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is begin - Create_Restricted_Task (Priority, Stack_Address, Size, - Secondary_Stack_Size, Task_Info, + Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 6a53289144f..37b91a76388 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -128,18 +128,17 @@ package System.Tasking.Restricted.Stages is -- by the binder generated code, before calling elaboration code. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the partition -- elaboration policy is not specified (or is concurrent). @@ -154,8 +153,6 @@ package System.Tasking.Restricted.Stages is -- -- Size is the stack size of the task to create -- - -- Secondary_Stack_Size is the secondary stack size of the task to create - -- -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. -- @@ -185,17 +182,16 @@ package System.Tasking.Restricted.Stages is -- This procedure can raise Storage_Error if the task creation fails procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the sequential partition -- elaboration policy is used. diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index bddbe115b83..153fe79b2fa 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -86,19 +86,18 @@ package body System.Tasking is --------------------- procedure Initialize_ATCB - (Self_ID : Task_Id; - Task_Entry_Point : Task_Procedure_Access; - Task_Arg : System.Address; - Parent : Task_Id; - Elaborated : Access_Boolean; - Base_Priority : System.Any_Priority; - Base_CPU : System.Multiprocessors.CPU_Range; - Domain : Dispatching_Domain_Access; - Task_Info : System.Task_Info.Task_Info_Type; - Stack_Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - T : Task_Id; - Success : out Boolean) + (Self_ID : Task_Id; + Task_Entry_Point : Task_Procedure_Access; + Task_Arg : System.Address; + Parent : Task_Id; + Elaborated : Access_Boolean; + Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; + Domain : Dispatching_Domain_Access; + Task_Info : System.Task_Info.Task_Info_Type; + Stack_Size : System.Parameters.Size_Type; + T : Task_Id; + Success : out Boolean) is begin T.Common.State := Unactivated; @@ -147,7 +146,6 @@ package body System.Tasking is T.Common.Specific_Handler := null; T.Common.Debug_Events := (others => False); T.Common.Task_Image_Len := 0; - T.Common.Secondary_Stack_Size := Secondary_Stack_Size; if T.Common.Parent = null then @@ -234,19 +232,18 @@ package body System.Tasking is T := STPO.New_ATCB (0); Initialize_ATCB - (Self_ID => null, - Task_Entry_Point => null, - Task_Arg => Null_Address, - Parent => Null_Task, - Elaborated => null, - Base_Priority => Base_Priority, - Base_CPU => Base_CPU, - Domain => System_Domain, - Task_Info => Task_Info.Unspecified_Task_Info, - Stack_Size => 0, - Secondary_Stack_Size => Parameters.Unspecified_Size, - T => T, - Success => Success); + (Self_ID => null, + Task_Entry_Point => null, + Task_Arg => Null_Address, + Parent => Null_Task, + Elaborated => null, + Base_Priority => Base_Priority, + Base_CPU => Base_CPU, + Domain => System_Domain, + Task_Info => Task_Info.Unspecified_Task_Info, + Stack_Size => 0, + T => T, + Success => Success); pragma Assert (Success); STPO.Initialize (T); diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index a0b5879048a..c1fe020f5b8 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -702,13 +702,6 @@ package System.Tasking is -- need to do different things depending on the situation. -- -- Protection: Self.L - - Secondary_Stack_Size : System.Parameters.Size_Type; - -- Secondary_Stack_Size is the size of the secondary stack for the - -- task. Defined here since it is the responsibility of the task to - -- creates its own secondary stack. - -- - -- Protected: Only accessed by Self end record; --------------------------------------- @@ -1163,19 +1156,18 @@ package System.Tasking is -- System.Tasking.Initialization being present, as was done before. procedure Initialize_ATCB - (Self_ID : Task_Id; - Task_Entry_Point : Task_Procedure_Access; - Task_Arg : System.Address; - Parent : Task_Id; - Elaborated : Access_Boolean; - Base_Priority : System.Any_Priority; - Base_CPU : System.Multiprocessors.CPU_Range; - Domain : Dispatching_Domain_Access; - Task_Info : System.Task_Info.Task_Info_Type; - Stack_Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - T : Task_Id; - Success : out Boolean); + (Self_ID : Task_Id; + Task_Entry_Point : Task_Procedure_Access; + Task_Arg : System.Address; + Parent : Task_Id; + Elaborated : Access_Boolean; + Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; + Domain : Dispatching_Domain_Access; + Task_Info : System.Task_Info.Task_Info_Type; + Stack_Size : System.Parameters.Size_Type; + T : Task_Id; + Success : out Boolean); -- Initialize fields of the TCB for task T, and link into global TCB -- structures. Call this only with abort deferred and holding RTS_Lock. -- Self_ID is the calling task (normally the activator of T). Success is diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index edf4911da69..7566629ebe0 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -472,21 +472,20 @@ package body System.Tasking.Stages is -- called to create a new task. procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Storage_Elements.Storage_Offset; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - Relative_Deadline : Ada.Real_Time.Time_Span; - Domain : Dispatching_Domain_Access; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id) + (Priority : Integer; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + Relative_Deadline : Ada.Real_Time.Time_Span; + Domain : Dispatching_Domain_Access; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -612,8 +611,7 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Base_CPU, Domain, Task_Info, Size, - Secondary_Stack_Size, T, Success); + Base_Priority, Base_CPU, Domain, Task_Info, Size, T, Success); if not Success then Free (T); @@ -1039,31 +1037,12 @@ package body System.Tasking.Stages is Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; -- Whether to use above alternate signal stack for stack overflows - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. The function - -- will return the ATCB field Secondary_Stack_Size if it is not set to - -- Unspecified_Size, otherwise a percentage of the stack is reserved - -- using the System.Parameters.Sec_Stack_Percentage property. + Secondary_Stack_Size : + constant SSE.Storage_Offset := + Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * + SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100; - function Secondary_Stack_Size return Storage_Elements.Storage_Offset is - use System.Storage_Elements; - use System.Parameters; - begin - if Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then - if Sec_Stack_Percentage = Dynamic then - return Default_Secondary_Stack_Size; - else - return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size - * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); - end if; - else - return Self_ID.Common.Secondary_Stack_Size + - Storage_Offset (SST.Minimum_Secondary_Stack_Size); - end if; - end Secondary_Stack_Size; - - Secondary_Stack : aliased Storage_Elements.Storage_Array - (1 .. Secondary_Stack_Size); + Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size); for Secondary_Stack'Alignment use Standard'Maximum_Alignment; -- Actual area allocated for secondary stack. Note that it is critical -- that this have maximum alignment, since any kind of data can be diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index 347b306801b..b25f4bfb8b0 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -167,28 +167,26 @@ package System.Tasking.Stages is -- now in order to wake up the activator (the environment task). procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Storage_Elements.Storage_Offset; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - Relative_Deadline : Ada.Real_Time.Time_Span; - Domain : Dispatching_Domain_Access; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id); + (Priority : Integer; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + Relative_Deadline : Ada.Real_Time.Time_Span; + Domain : Dispatching_Domain_Access; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- -- Priority is the task's priority (assumed to be in range of type -- System.Any_Priority) -- Size is the stack size of the task to create - -- Secondary_Stack_Size is the secondary stack size of the task to create -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. -- CPU is the task affinity. Passed as an Integer because the undefined diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c240918e080..1685ff3d336 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2065,7 +2065,6 @@ package body Sem_Ch13 is Aspect_Scalar_Storage_Order | Aspect_Size | Aspect_Small | - Aspect_Secondary_Stack_Size | Aspect_Simple_Storage_Pool | Aspect_Storage_Pool | Aspect_Stream_Size | @@ -2429,7 +2428,7 @@ package body Sem_Ch13 is end if; end; - -- Handling for these aspects in subprograms is complete + -- Handling for these Aspects in subprograms is complete goto Continue; @@ -5697,47 +5696,6 @@ package body Sem_Ch13 is end if; end Scalar_Storage_Order; - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - when Attribute_Secondary_Stack_Size => Secondary_Stack_Size : - begin - -- Secondary_Stack_Size attribute definition clause not allowed - -- except from aspect specification. - - if From_Aspect_Specification (N) then - if not Is_Task_Type (U_Ent) then - Error_Msg_N ("Secondary Stack Size can only be " & - "defined for task", Nam); - - elsif Duplicate_Clause then - null; - - else - Check_Restriction (No_Secondary_Stack, Expr); - - -- The expression must be analyzed in the special manner - -- described in "Handling of Default and Per-Object - -- Expressions" in sem.ads. - - -- The visibility to the discriminants must be restored - - Push_Scope_And_Install_Discriminants (U_Ent); - Preanalyze_Spec_Expression (Expr, Any_Integer); - Uninstall_Discriminants_And_Pop_Scope (U_Ent); - - if not Is_OK_Static_Expression (Expr) then - Check_Restriction (Static_Storage_Size, Expr); - end if; - end if; - - else - Error_Msg_N - ("attribute& cannot be set with definition clause", N); - end if; - end Secondary_Stack_Size; - ---------- -- Size -- ---------- @@ -9191,9 +9149,6 @@ package body Sem_Ch13 is when Aspect_Relative_Deadline => T := RTE (RE_Time_Span); - when Aspect_Secondary_Stack_Size => - T := Standard_Integer; - when Aspect_Small => T := Universal_Real; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4738c60a869..f9ffb207ead 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19046,6 +19046,7 @@ package body Sem_Prag is when Pragma_Rename_Pragma => Rename_Pragma : declare New_Name : constant Node_Id := Get_Pragma_Arg (Arg1); Old_Name : constant Node_Id := Get_Pragma_Arg (Arg2); + begin GNAT_Pragma; Check_Valid_Configuration_Pragma; @@ -20602,50 +20603,6 @@ package body Sem_Prag is rv; - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - -- pragma Secondary_Stack_Size (EXPRESSION); - - when Pragma_Secondary_Stack_Size => Secondary_Stack_Size : declare - P : constant Node_Id := Parent (N); - Arg : Node_Id; - Ent : Entity_Id; - - begin - GNAT_Pragma; - Check_No_Identifiers; - Check_Arg_Count (1); - - if Nkind (P) = N_Task_Definition then - Arg := Get_Pragma_Arg (Arg1); - Ent := Defining_Identifier (Parent (P)); - - -- The expression must be analyzed in the special - -- manner described in "Handling of Default Expressions" - -- in sem.ads. - - Preanalyze_Spec_Expression (Arg, Any_Integer); - - -- The pragma cannot appear if the No_Secondary_Stack - -- restriction is in effect. - - Check_Restriction (No_Secondary_Stack, Arg); - - -- Anything else is incorrect - - else - Pragma_Misplaced; - end if; - - -- 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 Secondary_Stack_Size; - -------------------------- -- Short_Circuit_And_Or -- -------------------------- @@ -28862,7 +28819,6 @@ package body Sem_Prag is Pragma_Restriction_Warnings => 0, Pragma_Restrictions => 0, Pragma_Reviewable => -1, - Pragma_Secondary_Stack_Size => -1, Pragma_Short_Circuit_And_Or => 0, Pragma_Share_Generic => 0, Pragma_Shared => 0, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 5bbeb8a1c73..b229a6c8fe7 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -100,7 +100,6 @@ package Sem_Prag is Pragma_Remote_Access_Type => True, Pragma_Remote_Call_Interface => True, Pragma_Remote_Types => True, - Pragma_Secondary_Stack_Size => True, Pragma_Shared => True, Pragma_Shared_Passive => True, Pragma_Simple_Storage_Pool_Type => True, diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index 886a13c7d14..fe239983110 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -134,8 +134,6 @@ package body Snames is return Attribute_Dispatching_Domain; elsif N = Name_Interrupt_Priority then return Attribute_Interrupt_Priority; - elsif N = Name_Secondary_Stack_Size then - return Attribute_Secondary_Stack_Size; else return Attribute_Id'Val (N - First_Attribute_Name); end if; @@ -231,8 +229,6 @@ package body Snames is return Pragma_Lock_Free; when Name_Priority => return Pragma_Priority; - when Name_Secondary_Stack_Size => - return Pragma_Secondary_Stack_Size; when Name_Storage_Size => return Pragma_Storage_Size; when Name_Storage_Unit => @@ -460,7 +456,6 @@ package body Snames is or else N = Name_Interrupt_Priority or else N = Name_Lock_Free or else N = Name_Priority - or else N = Name_Secondary_Stack_Size or else N = Name_Storage_Size or else N = Name_Storage_Unit; end Is_Pragma_Name; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 9ed79ff3d94..a45b895d09f 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -175,7 +175,6 @@ package Snames is Name_uRelative_Deadline : constant Name_Id := N + $; Name_uResult : constant Name_Id := N + $; Name_uSecondary_Stack : constant Name_Id := N + $; - Name_uSecondary_Stack_Size : constant Name_Id := N + $; Name_uService : constant Name_Id := N + $; Name_uSize : constant Name_Id := N + $; Name_uStack : constant Name_Id := N + $; @@ -805,6 +804,7 @@ package Snames is Name_Robustness : constant Name_Id := N + $; Name_Runtime : constant Name_Id := N + $; Name_SB : constant Name_Id := N + $; + Name_Secondary_Stack_Size : constant Name_Id := N + $; Name_Section : constant Name_Id := N + $; Name_Semaphore : constant Name_Id := N + $; Name_Simple_Barriers : constant Name_Id := N + $; @@ -1052,9 +1052,8 @@ package Snames is -- Names of internal attributes. They are not real attributes but special -- names used internally by GNAT in order to deal with delayed aspects - -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority, - -- Aspect_Secondary_Stack_Size) that don't have corresponding pragmas or - -- user-referencable attributes. + -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that + -- don't have corresponding pragmas or user-referencable attributes. -- It is convenient to have these internal attributes available for -- processing the aspects, since the normal approach is to convert an @@ -1070,7 +1069,6 @@ package Snames is Name_CPU : constant Name_Id := N + $; Name_Dispatching_Domain : constant Name_Id := N + $; Name_Interrupt_Priority : constant Name_Id := N + $; - Name_Secondary_Stack_Size : constant Name_Id := N + $; -- GNAT Last_Internal_Attribute_Name : constant Name_Id := N + $; -- Names of recognized locking policy identifiers @@ -1684,11 +1682,10 @@ package Snames is Attribute_CPU, Attribute_Dispatching_Domain, - Attribute_Interrupt_Priority, - Attribute_Secondary_Stack_Size); + Attribute_Interrupt_Priority); subtype Internal_Attribute_Id is Attribute_Id range - Attribute_CPU .. Attribute_Secondary_Stack_Size; + Attribute_CPU .. Attribute_Interrupt_Priority; type Attribute_Class_Array is array (Attribute_Id) of Boolean; -- Type used to build attribute classification flag arrays @@ -1996,7 +1993,6 @@ package Snames is Pragma_Interrupt_Priority, Pragma_Lock_Free, Pragma_Priority, - Pragma_Secondary_Stack_Size, Pragma_Storage_Size, Pragma_Storage_Unit, @@ -2039,8 +2035,7 @@ package Snames is function Is_Internal_Attribute_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of an INT attribute (Name_CPU, - -- Name_Dispatching_Domain, Name_Interrupt_Priority, - -- Name_Secondary_Stack_Size). + -- Name_Dispatching_Domain, Name_Interrupt_Priority). function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of a recognized attribute that -- 2.30.2