OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size.

Browse Source 
2017-01-06  Patrick Bernardi  <bernardi@adacore.com>

	* 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
This commit is contained in:
Patrick Bernardi 2017-01-06 12:02:09 +00:00 committed by Arnaud Charlet
parent f6c5454e6b
commit 73bfca7886
19 changed files with 449 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/ChangeLog
View File

@ -1,3 +1,45 @@
2017-01-06 Patrick Bernardi <bernardi@adacore.com>
* 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 <obry@adacore.com>
* a-direio.adb, a-direio.ads, a-sequio.adb, a-sequio.ads: Add Flush to

1
gcc/ada/aspects.adb
View File

@ -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,

5
gcc/ada/aspects.ads
View File

@ -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,

13
gcc/ada/exp_ch3.adb
View File

@ -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

65
gcc/ada/exp_ch9.adb
View File

@ -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.

1
gcc/ada/par-prag.adb
View File

@ -1452,6 +1452,7 @@ begin
Pragma_Ravenscar |
Pragma_Rename_Pragma |
Pragma_Reviewable |
Pragma_Secondary_Stack_Size |
Pragma_Share_Generic |
Pragma_Shared |
Pragma_Shared_Passive |

11
gcc/ada/s-secsta.adb
View File

@ -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 :=

6
gcc/ada/s-secsta.ads
View File

@ -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);

132
gcc/ada/s-tarest.adb
View File

@ -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);

48
gcc/ada/s-tarest.ads
View File

@ -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.

51
gcc/ada/s-taskin.adb
View File

@ -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);

32
gcc/ada/s-taskin.ads
View File

@ -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

61
gcc/ada/s-tassta.adb
View File

@ -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

32
gcc/ada/s-tassta.ads
View File

@ -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

47
gcc/ada/sem_ch13.adb
View File

@ -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;

45
gcc/ada/sem_prag.adb
View File

@ -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,

1
gcc/ada/sem_prag.ads
View File

@ -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,

5
gcc/ada/snames.adb-tmpl
View File

@ -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;

17
gcc/ada/snames.ads-tmpl
View File

@ -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