From 73bfca7886a32ab7b806b6c8f7dc32663f83b44a Mon Sep 17 00:00:00 2001 From: Patrick Bernardi Date: Fri, 6 Jan 2017 12:02:09 +0000 Subject: [PATCH] aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size. 2017-01-06 Patrick Bernardi * aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size. * exp_ch3.adb (Build_Init_Statements): As part of initialising the value record of a task, set its _Secondary_Stack_Size field if present. * exp_ch9.adb (Expand_N_Task_Type_Declaration): Create a _Secondary_Stack_Size field in the value record of the task if a Secondary_Stack_Size rep item is present. (Make_Task_Create_Call): Include secondary stack size parameter. If No_Secondary_Stack restriction is in place, passes stack size of 0. * par-prag.adb, sem_prag.adb, sem_prag.ads: Added new pragma Secondary_Stack_Size. * s-secsta.adb, s-secsta.ads (Minimum_Secondary_Stack_Size): New function to define the overhead of the secondary stack. * s-tarest.adb (Create_Restricted_Task, Create_Restricted_Task_Sequential): Functions now include Secondary_Stack_Size parameter to pass to Initialize_ATCB. * s-tarest.adb (Create_Restricted_Task, Create_Restricted_Task_Sequential): Calls to Initialize_ATCB now include Secondary_Stack_Size parameter. (Task_Wrapper): Secondary stack now allocated to the size specified by the Secondary_Stack_Size parameter in the task's ATCB. * s-taskin.adb, s-taskin.adb (Common_ATCB, Initialise_ATCB): New Secondary_Stack_Size component. * s-tassta.adb, s-tassta.ads (Create_Restricted_Task, Create_Restricted_Task_Sequential): Function now include Secondary_Stack_Size parameter. (Task_Wrapper): Secondary stack now allocated to the size specified by the Secondary_Stack_Size parameter in the task's ATCB. * sem_ch13.adb (Analyze_Aspect_Specification): Add support for Secondary_Stack_Size aspect, turning the aspect into its corresponding internal attribute. (Analyze_Attribute_Definition): Process Secondary_Stack_Size attribute. * snames.adb-tmpl, snames.ads-tmpl: Added names Name_Secondary_Stack_Size, Name_uSecondary_Stack_Size, Attribute_Secondary_Stack_Size and Pragma_Secondary_Stack_Size. From-SVN: r244146 --- gcc/ada/ChangeLog | 42 +++++++++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 5 ++ gcc/ada/exp_ch3.adb | 13 ++-- gcc/ada/exp_ch9.adb | 65 +++++++++++++++++--- gcc/ada/par-prag.adb | 1 + gcc/ada/s-secsta.adb | 11 +++- gcc/ada/s-secsta.ads | 6 +- gcc/ada/s-tarest.adb | 132 ++++++++++++++++++++++++---------------- gcc/ada/s-tarest.ads | 48 ++++++++------- gcc/ada/s-taskin.adb | 51 ++++++++-------- gcc/ada/s-taskin.ads | 32 ++++++---- gcc/ada/s-tassta.adb | 61 +++++++++++++------ gcc/ada/s-tassta.ads | 32 +++++----- gcc/ada/sem_ch13.adb | 47 +++++++++++++- gcc/ada/sem_prag.adb | 45 ++++++++++++++ gcc/ada/sem_prag.ads | 1 + gcc/ada/snames.adb-tmpl | 5 ++ gcc/ada/snames.ads-tmpl | 17 ++++-- 19 files changed, 449 insertions(+), 166 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 13e11887183..3be774d8172 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,45 @@ +2017-01-06 Patrick Bernardi + + * aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size. + * exp_ch3.adb (Build_Init_Statements): As part of initialising + the value record of a task, set its _Secondary_Stack_Size field + if present. + * exp_ch9.adb (Expand_N_Task_Type_Declaration): Create + a _Secondary_Stack_Size field in the value record of + the task if a Secondary_Stack_Size rep item is present. + (Make_Task_Create_Call): Include secondary stack size + parameter. If No_Secondary_Stack restriction is in place, passes + stack size of 0. + * par-prag.adb, sem_prag.adb, sem_prag.ads: Added new pragma + Secondary_Stack_Size. + * s-secsta.adb, s-secsta.ads (Minimum_Secondary_Stack_Size): New + function to define the overhead of the secondary stack. + * s-tarest.adb (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Functions now include + Secondary_Stack_Size parameter to pass to Initialize_ATCB. + * s-tarest.adb (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Calls to Initialize_ATCB + now include Secondary_Stack_Size parameter. + (Task_Wrapper): + Secondary stack now allocated to the size specified by the + Secondary_Stack_Size parameter in the task's ATCB. + * s-taskin.adb, s-taskin.adb (Common_ATCB, Initialise_ATCB): New + Secondary_Stack_Size component. + * s-tassta.adb, s-tassta.ads (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Function now include + Secondary_Stack_Size parameter. + (Task_Wrapper): Secondary stack + now allocated to the size specified by the Secondary_Stack_Size + parameter in the task's ATCB. + * sem_ch13.adb (Analyze_Aspect_Specification): Add support + for Secondary_Stack_Size aspect, turning the aspect into its + corresponding internal attribute. + (Analyze_Attribute_Definition): + Process Secondary_Stack_Size attribute. + * snames.adb-tmpl, snames.ads-tmpl: Added names + Name_Secondary_Stack_Size, Name_uSecondary_Stack_Size, + Attribute_Secondary_Stack_Size and Pragma_Secondary_Stack_Size. + 2017-01-06 Pascal Obry * a-direio.adb, a-direio.ads, a-sequio.adb, a-sequio.ads: Add Flush to diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 0da6b812c97..49eddf42851 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -599,6 +599,7 @@ 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 5de6539b0a5..586d35fea32 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -135,6 +135,7 @@ 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, @@ -255,6 +256,7 @@ 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, @@ -374,6 +376,7 @@ 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, @@ -494,6 +497,7 @@ 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, @@ -692,6 +696,7 @@ 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 81eaf8c861a..ae2ed500f9a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2708,15 +2708,17 @@ package body Exp_Ch3 is Actions := Build_Assignment (Id, Expression (Decl)); end if; - -- CPU, Dispatching_Domain, Priority and Size components are - -- filled with the corresponding rep item expression of the - -- concurrent type (if any). + -- CPU, Dispatching_Domain, Priority and + -- Secondary_Stack_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_uPriority, + Name_uSecondary_Stack_Size) then declare Exp : Node_Id; @@ -2732,6 +2734,9 @@ 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 7eb38b5e4d1..91f8d37435c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11553,14 +11553,15 @@ 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; - -- _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; + -- _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; -- end record; -- The discriminants are present only if the corresponding task type has @@ -11584,6 +11585,13 @@ 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 @@ -11923,6 +11931,24 @@ 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 @@ -14114,6 +14140,29 @@ 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 ff939f6848d..865343695d6 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1452,6 +1452,7 @@ 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 30e03debf46..6f8a0e832d6 100644 --- a/gcc/ada/s-secsta.adb +++ b/gcc/ada/s-secsta.adb @@ -170,6 +170,15 @@ 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 -- -------------- @@ -432,7 +441,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 a1685e02193..c5a0eadf29f 100644 --- a/gcc/ada/s-secsta.ads +++ b/gcc/ada/s-secsta.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -42,6 +42,10 @@ 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 5d44196216c..67ad33909b1 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2016, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -116,16 +116,17 @@ 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; - 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; + 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); -- 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. @@ -205,11 +206,31 @@ package body System.Tasking.Restricted.Stages is -- -- DO NOT delete ID. As noted, it is needed on some targets. - use type SSE.Storage_Offset; + 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 : aliased SSE.Storage_Array - (1 .. 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 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); 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. @@ -505,16 +526,17 @@ package body System.Tasking.Restricted.Stages is ---------------------------- procedure Create_Restricted_Task - (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) + (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 Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; @@ -573,7 +595,8 @@ package body System.Tasking.Restricted.Stages is Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Base_CPU, null, Task_Info, Size, Created_Task, Success); + Base_CPU, null, Task_Info, Size, Secondary_Stack_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 @@ -610,17 +633,18 @@ 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; - 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; + 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) is begin if Partition_Elaboration_Policy = 'S' then @@ -631,13 +655,15 @@ package body System.Tasking.Restricted.Stages is -- sequential, activation must be deferred. Create_Restricted_Task_Sequential - (Priority, Stack_Address, Size, Task_Info, CPU, State, - Discriminants, Elaborated, Task_Image, Created_Task); + (Priority, Stack_Address, Size, Secondary_Stack_Size, + Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); else Create_Restricted_Task - (Priority, Stack_Address, Size, Task_Info, CPU, State, - Discriminants, Elaborated, Task_Image, Created_Task); + (Priority, Stack_Address, Size, Secondary_Stack_Size, + Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); -- Append this task to the activation chain @@ -651,18 +677,20 @@ package body System.Tasking.Restricted.Stages is --------------------------------------- procedure Create_Restricted_Task_Sequential - (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 + (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 begin - Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, + Create_Restricted_Task (Priority, Stack_Address, Size, + Secondary_Stack_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 90c1f2cc134..6a53289144f 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -128,17 +128,18 @@ 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; - 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; + 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); -- 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). @@ -153,6 +154,8 @@ 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. -- @@ -182,16 +185,17 @@ 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; - 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; + 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); -- 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 153fe79b2fa..bddbe115b83 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -86,18 +86,19 @@ 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; - 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; + Secondary_Stack_Size : System.Parameters.Size_Type; + T : Task_Id; + Success : out Boolean) is begin T.Common.State := Unactivated; @@ -146,6 +147,7 @@ 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 @@ -232,18 +234,19 @@ 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, - 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, + Secondary_Stack_Size => Parameters.Unspecified_Size, + 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 c1fe020f5b8..a0b5879048a 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -702,6 +702,13 @@ 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; --------------------------------------- @@ -1156,18 +1163,19 @@ 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; - 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; + Secondary_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 7566629ebe0..edf4911da69 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -472,20 +472,21 @@ package body System.Tasking.Stages is -- called to create a new task. procedure Create_Task - (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) + (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) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -611,7 +612,8 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Base_CPU, Domain, Task_Info, Size, T, Success); + Base_Priority, Base_CPU, Domain, Task_Info, Size, + Secondary_Stack_Size, T, Success); if not Success then Free (T); @@ -1037,12 +1039,31 @@ 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 - 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; + -- 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 : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size); + 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); 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 e37fd59b665..347b306801b 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -167,26 +167,28 @@ 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; - 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; + 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); -- 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 1685ff3d336..c240918e080 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2065,6 +2065,7 @@ 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 | @@ -2428,7 +2429,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; @@ -5696,6 +5697,47 @@ 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 -- ---------- @@ -9149,6 +9191,9 @@ 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 a5ae0d0d39e..4738c60a869 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -20602,6 +20602,50 @@ 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 -- -------------------------- @@ -28818,6 +28862,7 @@ 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 b229a6c8fe7..5bbeb8a1c73 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -100,6 +100,7 @@ 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 fe239983110..886a13c7d14 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -134,6 +134,8 @@ 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; @@ -229,6 +231,8 @@ 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 => @@ -456,6 +460,7 @@ 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 a45b895d09f..9ed79ff3d94 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -175,6 +175,7 @@ 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 + $; @@ -804,7 +805,6 @@ 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,8 +1052,9 @@ 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) that - -- don't have corresponding pragmas or user-referencable attributes. + -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority, + -- Aspect_Secondary_Stack_Size) 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 @@ -1069,6 +1070,7 @@ 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 @@ -1682,10 +1684,11 @@ package Snames is Attribute_CPU, Attribute_Dispatching_Domain, - Attribute_Interrupt_Priority); + Attribute_Interrupt_Priority, + Attribute_Secondary_Stack_Size); subtype Internal_Attribute_Id is Attribute_Id range - Attribute_CPU .. Attribute_Interrupt_Priority; + Attribute_CPU .. Attribute_Secondary_Stack_Size; type Attribute_Class_Array is array (Attribute_Id) of Boolean; -- Type used to build attribute classification flag arrays @@ -1993,6 +1996,7 @@ package Snames is Pragma_Interrupt_Priority, Pragma_Lock_Free, Pragma_Priority, + Pragma_Secondary_Stack_Size, Pragma_Storage_Size, Pragma_Storage_Unit, @@ -2035,7 +2039,8 @@ 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_Dispatching_Domain, Name_Interrupt_Priority, + -- Name_Secondary_Stack_Size). 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