mirror of git://gcc.gnu.org/git/gcc.git
aspects.adb, [...]: Reverted previous change for now.
2017-01-06 Patrick Bernardi <bernardi@adacore.com> * 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
This commit is contained in:
parent
e666e74478
commit
eae66578ce
|
|
@ -1,3 +1,11 @@
|
||||||
|
2017-01-06 Patrick Bernardi <bernardi@adacore.com>
|
||||||
|
|
||||||
|
* 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 <schonberg@adacore.com>
|
2017-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
* exp_ch3.adb (Build_Initialization_Call): Apply predicate
|
* exp_ch3.adb (Build_Initialization_Call): Apply predicate
|
||||||
|
|
|
||||||
|
|
@ -599,7 +599,6 @@ package body Aspects is
|
||||||
Aspect_Read => Aspect_Read,
|
Aspect_Read => Aspect_Read,
|
||||||
Aspect_Relative_Deadline => Aspect_Relative_Deadline,
|
Aspect_Relative_Deadline => Aspect_Relative_Deadline,
|
||||||
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
|
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
|
||||||
Aspect_Secondary_Stack_Size => Aspect_Secondary_Stack_Size,
|
|
||||||
Aspect_Shared => Aspect_Atomic,
|
Aspect_Shared => Aspect_Atomic,
|
||||||
Aspect_Shared_Passive => Aspect_Shared_Passive,
|
Aspect_Shared_Passive => Aspect_Shared_Passive,
|
||||||
Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool,
|
Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool,
|
||||||
|
|
|
||||||
|
|
@ -135,7 +135,6 @@ package Aspects is
|
||||||
Aspect_Refined_State, -- GNAT
|
Aspect_Refined_State, -- GNAT
|
||||||
Aspect_Relative_Deadline,
|
Aspect_Relative_Deadline,
|
||||||
Aspect_Scalar_Storage_Order, -- GNAT
|
Aspect_Scalar_Storage_Order, -- GNAT
|
||||||
Aspect_Secondary_Stack_Size, -- GNAT
|
|
||||||
Aspect_Simple_Storage_Pool, -- GNAT
|
Aspect_Simple_Storage_Pool, -- GNAT
|
||||||
Aspect_Size,
|
Aspect_Size,
|
||||||
Aspect_Small,
|
Aspect_Small,
|
||||||
|
|
@ -256,7 +255,6 @@ package Aspects is
|
||||||
Aspect_Pure_Function => True,
|
Aspect_Pure_Function => True,
|
||||||
Aspect_Remote_Access_Type => True,
|
Aspect_Remote_Access_Type => True,
|
||||||
Aspect_Scalar_Storage_Order => True,
|
Aspect_Scalar_Storage_Order => True,
|
||||||
Aspect_Secondary_Stack_Size => True,
|
|
||||||
Aspect_Shared => True,
|
Aspect_Shared => True,
|
||||||
Aspect_Simple_Storage_Pool => True,
|
Aspect_Simple_Storage_Pool => True,
|
||||||
Aspect_Simple_Storage_Pool_Type => True,
|
Aspect_Simple_Storage_Pool_Type => True,
|
||||||
|
|
@ -376,7 +374,6 @@ package Aspects is
|
||||||
Aspect_Refined_State => Expression,
|
Aspect_Refined_State => Expression,
|
||||||
Aspect_Relative_Deadline => Expression,
|
Aspect_Relative_Deadline => Expression,
|
||||||
Aspect_Scalar_Storage_Order => Expression,
|
Aspect_Scalar_Storage_Order => Expression,
|
||||||
Aspect_Secondary_Stack_Size => Expression,
|
|
||||||
Aspect_Simple_Storage_Pool => Name,
|
Aspect_Simple_Storage_Pool => Name,
|
||||||
Aspect_Size => Expression,
|
Aspect_Size => Expression,
|
||||||
Aspect_Small => Expression,
|
Aspect_Small => Expression,
|
||||||
|
|
@ -497,7 +494,6 @@ package Aspects is
|
||||||
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
|
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
|
||||||
Aspect_Remote_Types => Name_Remote_Types,
|
Aspect_Remote_Types => Name_Remote_Types,
|
||||||
Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order,
|
Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order,
|
||||||
Aspect_Secondary_Stack_Size => Name_Secondary_Stack_Size,
|
|
||||||
Aspect_Shared => Name_Shared,
|
Aspect_Shared => Name_Shared,
|
||||||
Aspect_Shared_Passive => Name_Shared_Passive,
|
Aspect_Shared_Passive => Name_Shared_Passive,
|
||||||
Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool,
|
Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool,
|
||||||
|
|
@ -696,7 +692,6 @@ package Aspects is
|
||||||
Aspect_Remote_Access_Type => Always_Delay,
|
Aspect_Remote_Access_Type => Always_Delay,
|
||||||
Aspect_Remote_Call_Interface => Always_Delay,
|
Aspect_Remote_Call_Interface => Always_Delay,
|
||||||
Aspect_Remote_Types => Always_Delay,
|
Aspect_Remote_Types => Always_Delay,
|
||||||
Aspect_Secondary_Stack_Size => Always_Delay,
|
|
||||||
Aspect_Shared => Always_Delay,
|
Aspect_Shared => Always_Delay,
|
||||||
Aspect_Shared_Passive => Always_Delay,
|
Aspect_Shared_Passive => Always_Delay,
|
||||||
Aspect_Simple_Storage_Pool => Always_Delay,
|
Aspect_Simple_Storage_Pool => Always_Delay,
|
||||||
|
|
|
||||||
|
|
@ -1485,7 +1485,7 @@ package body Exp_Ch3 is
|
||||||
-- The constraints come from the discriminant default exps,
|
-- The constraints come from the discriminant default exps,
|
||||||
-- they must be reevaluated, so we use New_Copy_Tree but we
|
-- they must be reevaluated, so we use New_Copy_Tree but we
|
||||||
-- ensure the proper Sloc (for any embedded calls).
|
-- 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.
|
-- of the discriminant, insert it ahead of the call.
|
||||||
|
|
||||||
Arg := New_Copy_Tree (Arg, New_Sloc => Loc);
|
Arg := New_Copy_Tree (Arg, New_Sloc => Loc);
|
||||||
|
|
@ -1495,7 +1495,7 @@ package body Exp_Ch3 is
|
||||||
and then not Predicates_Ignored (Etype (Discr))
|
and then not Predicates_Ignored (Etype (Discr))
|
||||||
then
|
then
|
||||||
Prepend_To (Res,
|
Prepend_To (Res,
|
||||||
Make_Predicate_Check (Etype (Discr), Arg));
|
Make_Predicate_Check (Etype (Discr), Arg));
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
@ -1741,7 +1741,7 @@ package body Exp_Ch3 is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- If a component type has a predicate, add check to the component
|
-- 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.
|
-- which provides for a better error message.
|
||||||
|
|
||||||
if Comes_From_Source (Exp)
|
if Comes_From_Source (Exp)
|
||||||
|
|
@ -2730,17 +2730,15 @@ package body Exp_Ch3 is
|
||||||
Actions := Build_Assignment (Id, Expression (Decl));
|
Actions := Build_Assignment (Id, Expression (Decl));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- CPU, Dispatching_Domain, Priority and
|
-- CPU, Dispatching_Domain, Priority and Size components are
|
||||||
-- Secondary_Stack_Size components are filled with the
|
-- filled with the corresponding rep item expression of the
|
||||||
-- corresponding rep item expression of the concurrent
|
-- concurrent type (if any).
|
||||||
-- type (if any).
|
|
||||||
|
|
||||||
elsif Ekind (Scope (Id)) = E_Record_Type
|
elsif Ekind (Scope (Id)) = E_Record_Type
|
||||||
and then Present (Corresponding_Concurrent_Type (Scope (Id)))
|
and then Present (Corresponding_Concurrent_Type (Scope (Id)))
|
||||||
and then Nam_In (Chars (Id), Name_uCPU,
|
and then Nam_In (Chars (Id), Name_uCPU,
|
||||||
Name_uDispatching_Domain,
|
Name_uDispatching_Domain,
|
||||||
Name_uPriority,
|
Name_uPriority)
|
||||||
Name_uSecondary_Stack_Size)
|
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
Exp : Node_Id;
|
Exp : Node_Id;
|
||||||
|
|
@ -2756,9 +2754,6 @@ package body Exp_Ch3 is
|
||||||
|
|
||||||
elsif Chars (Id) = Name_uPriority then
|
elsif Chars (Id) = Name_uPriority then
|
||||||
Nam := Name_Priority;
|
Nam := Name_Priority;
|
||||||
|
|
||||||
elsif Chars (Id) = Name_uSecondary_Stack_Size then
|
|
||||||
Nam := Name_Secondary_Stack_Size;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Get the Rep Item (aspect specification, attribute
|
-- Get the Rep Item (aspect specification, attribute
|
||||||
|
|
|
||||||
|
|
@ -11553,15 +11553,14 @@ package body Exp_Ch9 is
|
||||||
-- values of this task. The general form of this type declaration is
|
-- values of this task. The general form of this type declaration is
|
||||||
|
|
||||||
-- type taskV (discriminants) is record
|
-- type taskV (discriminants) is record
|
||||||
-- _Task_Id : Task_Id;
|
-- _Task_Id : Task_Id;
|
||||||
-- entry_family : array (bounds) of Void;
|
-- entry_family : array (bounds) of Void;
|
||||||
-- _Priority : Integer := priority_expression;
|
-- _Priority : Integer := priority_expression;
|
||||||
-- _Size : Size_Type := size_expression;
|
-- _Size : Size_Type := size_expression;
|
||||||
-- _Secondary_Stack_Size : Size_Type := size_expression;
|
-- _Task_Info : Task_Info_Type := task_info_expression;
|
||||||
-- _Task_Info : Task_Info_Type := task_info_expression;
|
-- _CPU : Integer := cpu_range_expression;
|
||||||
-- _CPU : Integer := cpu_range_expression;
|
-- _Relative_Deadline : Time_Span := time_span_expression;
|
||||||
-- _Relative_Deadline : Time_Span := time_span_expression;
|
-- _Domain : Dispatching_Domain := dd_expression;
|
||||||
-- _Domain : Dispatching_Domain := dd_expression;
|
|
||||||
-- end record;
|
-- end record;
|
||||||
|
|
||||||
-- The discriminants are present only if the corresponding task type has
|
-- 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
|
-- in the pragma, and is used to override the task stack size otherwise
|
||||||
-- associated with the task type.
|
-- 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
|
-- The _Priority field is present only if the task entity has a Priority or
|
||||||
-- Interrupt_Priority rep item (pragma, aspect specification or attribute
|
-- Interrupt_Priority rep item (pragma, aspect specification or attribute
|
||||||
-- definition clause). It will be filled at the freeze point, when the
|
-- 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))))))));
|
Get_Rep_Pragma (TaskId, Name_Storage_Size))))))));
|
||||||
end if;
|
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
|
-- Add the _Task_Info component if a Task_Info pragma is present
|
||||||
|
|
||||||
if Has_Rep_Pragma (TaskId, Name_Task_Info, Check_Parents => False) then
|
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));
|
New_Occurrence_Of (Storage_Size_Variable (Ttyp), Loc));
|
||||||
end if;
|
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 parameter. Set to Unspecified_Task_Info unless there is a
|
||||||
-- Task_Info pragma, in which case we take the value from the pragma.
|
-- Task_Info pragma, in which case we take the value from the pragma.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1452,7 +1452,6 @@ begin
|
||||||
Pragma_Ravenscar |
|
Pragma_Ravenscar |
|
||||||
Pragma_Rename_Pragma |
|
Pragma_Rename_Pragma |
|
||||||
Pragma_Reviewable |
|
Pragma_Reviewable |
|
||||||
Pragma_Secondary_Stack_Size |
|
|
||||||
Pragma_Share_Generic |
|
Pragma_Share_Generic |
|
||||||
Pragma_Shared |
|
Pragma_Shared |
|
||||||
Pragma_Shared_Passive |
|
Pragma_Shared_Passive |
|
||||||
|
|
|
||||||
|
|
@ -170,15 +170,6 @@ package body System.Secondary_Stack is
|
||||||
Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr);
|
Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr);
|
||||||
-- Convert from address stored in task data structures
|
-- 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 --
|
-- Allocate --
|
||||||
--------------
|
--------------
|
||||||
|
|
@ -441,7 +432,7 @@ package body System.Secondary_Stack is
|
||||||
Fixed_Stack.Top := 0;
|
Fixed_Stack.Top := 0;
|
||||||
Fixed_Stack.Max := 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;
|
Fixed_Stack.Last := 0;
|
||||||
else
|
else
|
||||||
Fixed_Stack.Last :=
|
Fixed_Stack.Last :=
|
||||||
|
|
|
||||||
|
|
@ -42,10 +42,6 @@ package System.Secondary_Stack is
|
||||||
-- which causes the binder to generate an appropriate assignment in the
|
-- which causes the binder to generate an appropriate assignment in the
|
||||||
-- binder generated file.
|
-- 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
|
procedure SS_Init
|
||||||
(Stk : in out Address;
|
(Stk : in out Address;
|
||||||
Size : Natural := Default_Secondary_Stack_Size);
|
Size : Natural := Default_Secondary_Stack_Size);
|
||||||
|
|
|
||||||
|
|
@ -116,17 +116,16 @@ package body System.Tasking.Restricted.Stages is
|
||||||
-- This should only be called by the Task_Wrapper procedure.
|
-- This should only be called by the Task_Wrapper procedure.
|
||||||
|
|
||||||
procedure Create_Restricted_Task
|
procedure Create_Restricted_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Storage_Elements.Storage_Offset;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id);
|
||||||
Created_Task : Task_Id);
|
|
||||||
-- Code shared between Create_Restricted_Task (the concurrent version) and
|
-- Code shared between Create_Restricted_Task (the concurrent version) and
|
||||||
-- Create_Restricted_Task_Sequential. See comment of the former in the
|
-- Create_Restricted_Task_Sequential. See comment of the former in the
|
||||||
-- specification of this package.
|
-- 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.
|
-- DO NOT delete ID. As noted, it is needed on some targets.
|
||||||
|
|
||||||
function Secondary_Stack_Size return Storage_Elements.Storage_Offset;
|
use type SSE.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.
|
|
||||||
|
|
||||||
function Secondary_Stack_Size return Storage_Elements.Storage_Offset is
|
Secondary_Stack : aliased SSE.Storage_Array
|
||||||
use System.Storage_Elements;
|
(1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
|
||||||
use System.Parameters;
|
SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100);
|
||||||
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;
|
for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
|
||||||
-- This is the secondary stack data. Note that it is critical that this
|
-- 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.
|
-- 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
|
procedure Create_Restricted_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id)
|
||||||
Created_Task : Task_Id)
|
|
||||||
is
|
is
|
||||||
Self_ID : constant Task_Id := STPO.Self;
|
Self_ID : constant Task_Id := STPO.Self;
|
||||||
Base_Priority : System.Any_Priority;
|
Base_Priority : System.Any_Priority;
|
||||||
|
|
@ -595,8 +573,7 @@ package body System.Tasking.Restricted.Stages is
|
||||||
|
|
||||||
Initialize_ATCB
|
Initialize_ATCB
|
||||||
(Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
|
(Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
|
||||||
Base_CPU, null, Task_Info, Size, Secondary_Stack_Size,
|
Base_CPU, null, Task_Info, Size, Created_Task, Success);
|
||||||
Created_Task, Success);
|
|
||||||
|
|
||||||
-- If we do our job right then there should never be any failures, which
|
-- 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
|
-- 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;
|
end Create_Restricted_Task;
|
||||||
|
|
||||||
procedure Create_Restricted_Task
|
procedure Create_Restricted_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Types;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Chain : in out Activation_Chain;
|
||||||
Chain : in out Activation_Chain;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id)
|
||||||
Created_Task : Task_Id)
|
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Partition_Elaboration_Policy = 'S' then
|
if Partition_Elaboration_Policy = 'S' then
|
||||||
|
|
@ -655,15 +631,13 @@ package body System.Tasking.Restricted.Stages is
|
||||||
-- sequential, activation must be deferred.
|
-- sequential, activation must be deferred.
|
||||||
|
|
||||||
Create_Restricted_Task_Sequential
|
Create_Restricted_Task_Sequential
|
||||||
(Priority, Stack_Address, Size, Secondary_Stack_Size,
|
(Priority, Stack_Address, Size, Task_Info, CPU, State,
|
||||||
Task_Info, CPU, State, Discriminants, Elaborated,
|
Discriminants, Elaborated, Task_Image, Created_Task);
|
||||||
Task_Image, Created_Task);
|
|
||||||
|
|
||||||
else
|
else
|
||||||
Create_Restricted_Task
|
Create_Restricted_Task
|
||||||
(Priority, Stack_Address, Size, Secondary_Stack_Size,
|
(Priority, Stack_Address, Size, Task_Info, CPU, State,
|
||||||
Task_Info, CPU, State, Discriminants, Elaborated,
|
Discriminants, Elaborated, Task_Image, Created_Task);
|
||||||
Task_Image, Created_Task);
|
|
||||||
|
|
||||||
-- Append this task to the activation chain
|
-- Append this task to the activation chain
|
||||||
|
|
||||||
|
|
@ -677,20 +651,18 @@ package body System.Tasking.Restricted.Stages is
|
||||||
---------------------------------------
|
---------------------------------------
|
||||||
|
|
||||||
procedure Create_Restricted_Task_Sequential
|
procedure Create_Restricted_Task_Sequential
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id) is
|
||||||
Created_Task : Task_Id) is
|
|
||||||
begin
|
begin
|
||||||
Create_Restricted_Task (Priority, Stack_Address, Size,
|
Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info,
|
||||||
Secondary_Stack_Size, Task_Info,
|
|
||||||
CPU, State, Discriminants, Elaborated,
|
CPU, State, Discriminants, Elaborated,
|
||||||
Task_Image, Created_Task);
|
Task_Image, Created_Task);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -128,18 +128,17 @@ package System.Tasking.Restricted.Stages is
|
||||||
-- by the binder generated code, before calling elaboration code.
|
-- by the binder generated code, before calling elaboration code.
|
||||||
|
|
||||||
procedure Create_Restricted_Task
|
procedure Create_Restricted_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Chain : in out Activation_Chain;
|
||||||
Chain : in out Activation_Chain;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id);
|
||||||
Created_Task : Task_Id);
|
|
||||||
-- Compiler interface only. Do not call from within the RTS.
|
-- Compiler interface only. Do not call from within the RTS.
|
||||||
-- This must be called to create a new task, when the partition
|
-- This must be called to create a new task, when the partition
|
||||||
-- elaboration policy is not specified (or is concurrent).
|
-- 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
|
-- 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
|
-- Task_Info is the task info associated with the created task, or
|
||||||
-- Unspecified_Task_Info if none.
|
-- 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
|
-- This procedure can raise Storage_Error if the task creation fails
|
||||||
|
|
||||||
procedure Create_Restricted_Task_Sequential
|
procedure Create_Restricted_Task_Sequential
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Stack_Address : System.Address;
|
Stack_Address : System.Address;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : Task_Id);
|
||||||
Created_Task : Task_Id);
|
|
||||||
-- Compiler interface only. Do not call from within the RTS.
|
-- Compiler interface only. Do not call from within the RTS.
|
||||||
-- This must be called to create a new task, when the sequential partition
|
-- This must be called to create a new task, when the sequential partition
|
||||||
-- elaboration policy is used.
|
-- elaboration policy is used.
|
||||||
|
|
|
||||||
|
|
@ -86,19 +86,18 @@ package body System.Tasking is
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
procedure Initialize_ATCB
|
procedure Initialize_ATCB
|
||||||
(Self_ID : Task_Id;
|
(Self_ID : Task_Id;
|
||||||
Task_Entry_Point : Task_Procedure_Access;
|
Task_Entry_Point : Task_Procedure_Access;
|
||||||
Task_Arg : System.Address;
|
Task_Arg : System.Address;
|
||||||
Parent : Task_Id;
|
Parent : Task_Id;
|
||||||
Elaborated : Access_Boolean;
|
Elaborated : Access_Boolean;
|
||||||
Base_Priority : System.Any_Priority;
|
Base_Priority : System.Any_Priority;
|
||||||
Base_CPU : System.Multiprocessors.CPU_Range;
|
Base_CPU : System.Multiprocessors.CPU_Range;
|
||||||
Domain : Dispatching_Domain_Access;
|
Domain : Dispatching_Domain_Access;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Stack_Size : System.Parameters.Size_Type;
|
Stack_Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
T : Task_Id;
|
||||||
T : Task_Id;
|
Success : out Boolean)
|
||||||
Success : out Boolean)
|
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
T.Common.State := Unactivated;
|
T.Common.State := Unactivated;
|
||||||
|
|
@ -147,7 +146,6 @@ package body System.Tasking is
|
||||||
T.Common.Specific_Handler := null;
|
T.Common.Specific_Handler := null;
|
||||||
T.Common.Debug_Events := (others => False);
|
T.Common.Debug_Events := (others => False);
|
||||||
T.Common.Task_Image_Len := 0;
|
T.Common.Task_Image_Len := 0;
|
||||||
T.Common.Secondary_Stack_Size := Secondary_Stack_Size;
|
|
||||||
|
|
||||||
if T.Common.Parent = null then
|
if T.Common.Parent = null then
|
||||||
|
|
||||||
|
|
@ -234,19 +232,18 @@ package body System.Tasking is
|
||||||
|
|
||||||
T := STPO.New_ATCB (0);
|
T := STPO.New_ATCB (0);
|
||||||
Initialize_ATCB
|
Initialize_ATCB
|
||||||
(Self_ID => null,
|
(Self_ID => null,
|
||||||
Task_Entry_Point => null,
|
Task_Entry_Point => null,
|
||||||
Task_Arg => Null_Address,
|
Task_Arg => Null_Address,
|
||||||
Parent => Null_Task,
|
Parent => Null_Task,
|
||||||
Elaborated => null,
|
Elaborated => null,
|
||||||
Base_Priority => Base_Priority,
|
Base_Priority => Base_Priority,
|
||||||
Base_CPU => Base_CPU,
|
Base_CPU => Base_CPU,
|
||||||
Domain => System_Domain,
|
Domain => System_Domain,
|
||||||
Task_Info => Task_Info.Unspecified_Task_Info,
|
Task_Info => Task_Info.Unspecified_Task_Info,
|
||||||
Stack_Size => 0,
|
Stack_Size => 0,
|
||||||
Secondary_Stack_Size => Parameters.Unspecified_Size,
|
T => T,
|
||||||
T => T,
|
Success => Success);
|
||||||
Success => Success);
|
|
||||||
pragma Assert (Success);
|
pragma Assert (Success);
|
||||||
|
|
||||||
STPO.Initialize (T);
|
STPO.Initialize (T);
|
||||||
|
|
|
||||||
|
|
@ -702,13 +702,6 @@ package System.Tasking is
|
||||||
-- need to do different things depending on the situation.
|
-- need to do different things depending on the situation.
|
||||||
--
|
--
|
||||||
-- Protection: Self.L
|
-- 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;
|
end record;
|
||||||
|
|
||||||
---------------------------------------
|
---------------------------------------
|
||||||
|
|
@ -1163,19 +1156,18 @@ package System.Tasking is
|
||||||
-- System.Tasking.Initialization being present, as was done before.
|
-- System.Tasking.Initialization being present, as was done before.
|
||||||
|
|
||||||
procedure Initialize_ATCB
|
procedure Initialize_ATCB
|
||||||
(Self_ID : Task_Id;
|
(Self_ID : Task_Id;
|
||||||
Task_Entry_Point : Task_Procedure_Access;
|
Task_Entry_Point : Task_Procedure_Access;
|
||||||
Task_Arg : System.Address;
|
Task_Arg : System.Address;
|
||||||
Parent : Task_Id;
|
Parent : Task_Id;
|
||||||
Elaborated : Access_Boolean;
|
Elaborated : Access_Boolean;
|
||||||
Base_Priority : System.Any_Priority;
|
Base_Priority : System.Any_Priority;
|
||||||
Base_CPU : System.Multiprocessors.CPU_Range;
|
Base_CPU : System.Multiprocessors.CPU_Range;
|
||||||
Domain : Dispatching_Domain_Access;
|
Domain : Dispatching_Domain_Access;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Stack_Size : System.Parameters.Size_Type;
|
Stack_Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Parameters.Size_Type;
|
T : Task_Id;
|
||||||
T : Task_Id;
|
Success : out Boolean);
|
||||||
Success : out Boolean);
|
|
||||||
-- Initialize fields of the TCB for task T, and link into global TCB
|
-- Initialize fields of the TCB for task T, and link into global TCB
|
||||||
-- structures. Call this only with abort deferred and holding RTS_Lock.
|
-- structures. Call this only with abort deferred and holding RTS_Lock.
|
||||||
-- Self_ID is the calling task (normally the activator of T). Success is
|
-- Self_ID is the calling task (normally the activator of T). Success is
|
||||||
|
|
|
||||||
|
|
@ -472,21 +472,20 @@ package body System.Tasking.Stages is
|
||||||
-- called to create a new task.
|
-- called to create a new task.
|
||||||
|
|
||||||
procedure Create_Task
|
procedure Create_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Storage_Elements.Storage_Offset;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
Relative_Deadline : Ada.Real_Time.Time_Span;
|
||||||
Relative_Deadline : Ada.Real_Time.Time_Span;
|
Domain : Dispatching_Domain_Access;
|
||||||
Domain : Dispatching_Domain_Access;
|
Num_Entries : Task_Entry_Index;
|
||||||
Num_Entries : Task_Entry_Index;
|
Master : Master_Level;
|
||||||
Master : Master_Level;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Chain : in out Activation_Chain;
|
||||||
Chain : in out Activation_Chain;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : out Task_Id)
|
||||||
Created_Task : out Task_Id)
|
|
||||||
is
|
is
|
||||||
T, P : Task_Id;
|
T, P : Task_Id;
|
||||||
Self_ID : constant Task_Id := STPO.Self;
|
Self_ID : constant Task_Id := STPO.Self;
|
||||||
|
|
@ -612,8 +611,7 @@ package body System.Tasking.Stages is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
|
Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
|
||||||
Base_Priority, Base_CPU, Domain, Task_Info, Size,
|
Base_Priority, Base_CPU, Domain, Task_Info, Size, T, Success);
|
||||||
Secondary_Stack_Size, T, Success);
|
|
||||||
|
|
||||||
if not Success then
|
if not Success then
|
||||||
Free (T);
|
Free (T);
|
||||||
|
|
@ -1039,31 +1037,12 @@ package body System.Tasking.Stages is
|
||||||
Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
|
Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
|
||||||
-- Whether to use above alternate signal stack for stack overflows
|
-- Whether to use above alternate signal stack for stack overflows
|
||||||
|
|
||||||
function Secondary_Stack_Size return Storage_Elements.Storage_Offset;
|
Secondary_Stack_Size :
|
||||||
-- Returns the size of the secondary stack for the task. The function
|
constant SSE.Storage_Offset :=
|
||||||
-- will return the ATCB field Secondary_Stack_Size if it is not set to
|
Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
|
||||||
-- Unspecified_Size, otherwise a percentage of the stack is reserved
|
SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100;
|
||||||
-- using the System.Parameters.Sec_Stack_Percentage property.
|
|
||||||
|
|
||||||
function Secondary_Stack_Size return Storage_Elements.Storage_Offset is
|
Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
|
||||||
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;
|
for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
|
||||||
-- Actual area allocated for secondary stack. Note that it is critical
|
-- Actual area allocated for secondary stack. Note that it is critical
|
||||||
-- that this have maximum alignment, since any kind of data can be
|
-- that this have maximum alignment, since any kind of data can be
|
||||||
|
|
|
||||||
|
|
@ -167,28 +167,26 @@ package System.Tasking.Stages is
|
||||||
-- now in order to wake up the activator (the environment task).
|
-- now in order to wake up the activator (the environment task).
|
||||||
|
|
||||||
procedure Create_Task
|
procedure Create_Task
|
||||||
(Priority : Integer;
|
(Priority : Integer;
|
||||||
Size : System.Parameters.Size_Type;
|
Size : System.Parameters.Size_Type;
|
||||||
Secondary_Stack_Size : System.Storage_Elements.Storage_Offset;
|
Task_Info : System.Task_Info.Task_Info_Type;
|
||||||
Task_Info : System.Task_Info.Task_Info_Type;
|
CPU : Integer;
|
||||||
CPU : Integer;
|
Relative_Deadline : Ada.Real_Time.Time_Span;
|
||||||
Relative_Deadline : Ada.Real_Time.Time_Span;
|
Domain : Dispatching_Domain_Access;
|
||||||
Domain : Dispatching_Domain_Access;
|
Num_Entries : Task_Entry_Index;
|
||||||
Num_Entries : Task_Entry_Index;
|
Master : Master_Level;
|
||||||
Master : Master_Level;
|
State : Task_Procedure_Access;
|
||||||
State : Task_Procedure_Access;
|
Discriminants : System.Address;
|
||||||
Discriminants : System.Address;
|
Elaborated : Access_Boolean;
|
||||||
Elaborated : Access_Boolean;
|
Chain : in out Activation_Chain;
|
||||||
Chain : in out Activation_Chain;
|
Task_Image : String;
|
||||||
Task_Image : String;
|
Created_Task : out Task_Id);
|
||||||
Created_Task : out Task_Id);
|
|
||||||
-- Compiler interface only. Do not call from within the RTS.
|
-- Compiler interface only. Do not call from within the RTS.
|
||||||
-- This must be called to create a new task.
|
-- This must be called to create a new task.
|
||||||
--
|
--
|
||||||
-- Priority is the task's priority (assumed to be in range of type
|
-- Priority is the task's priority (assumed to be in range of type
|
||||||
-- System.Any_Priority)
|
-- System.Any_Priority)
|
||||||
-- Size is the stack size of the task to create
|
-- 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
|
-- Task_Info is the task info associated with the created task, or
|
||||||
-- Unspecified_Task_Info if none.
|
-- Unspecified_Task_Info if none.
|
||||||
-- CPU is the task affinity. Passed as an Integer because the undefined
|
-- CPU is the task affinity. Passed as an Integer because the undefined
|
||||||
|
|
|
||||||
|
|
@ -2065,7 +2065,6 @@ package body Sem_Ch13 is
|
||||||
Aspect_Scalar_Storage_Order |
|
Aspect_Scalar_Storage_Order |
|
||||||
Aspect_Size |
|
Aspect_Size |
|
||||||
Aspect_Small |
|
Aspect_Small |
|
||||||
Aspect_Secondary_Stack_Size |
|
|
||||||
Aspect_Simple_Storage_Pool |
|
Aspect_Simple_Storage_Pool |
|
||||||
Aspect_Storage_Pool |
|
Aspect_Storage_Pool |
|
||||||
Aspect_Stream_Size |
|
Aspect_Stream_Size |
|
||||||
|
|
@ -2429,7 +2428,7 @@ package body Sem_Ch13 is
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
-- Handling for these aspects in subprograms is complete
|
-- Handling for these Aspects in subprograms is complete
|
||||||
|
|
||||||
goto Continue;
|
goto Continue;
|
||||||
|
|
||||||
|
|
@ -5697,47 +5696,6 @@ package body Sem_Ch13 is
|
||||||
end if;
|
end if;
|
||||||
end Scalar_Storage_Order;
|
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 --
|
-- Size --
|
||||||
----------
|
----------
|
||||||
|
|
@ -9191,9 +9149,6 @@ package body Sem_Ch13 is
|
||||||
when Aspect_Relative_Deadline =>
|
when Aspect_Relative_Deadline =>
|
||||||
T := RTE (RE_Time_Span);
|
T := RTE (RE_Time_Span);
|
||||||
|
|
||||||
when Aspect_Secondary_Stack_Size =>
|
|
||||||
T := Standard_Integer;
|
|
||||||
|
|
||||||
when Aspect_Small =>
|
when Aspect_Small =>
|
||||||
T := Universal_Real;
|
T := Universal_Real;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -19046,6 +19046,7 @@ package body Sem_Prag is
|
||||||
when Pragma_Rename_Pragma => Rename_Pragma : declare
|
when Pragma_Rename_Pragma => Rename_Pragma : declare
|
||||||
New_Name : constant Node_Id := Get_Pragma_Arg (Arg1);
|
New_Name : constant Node_Id := Get_Pragma_Arg (Arg1);
|
||||||
Old_Name : constant Node_Id := Get_Pragma_Arg (Arg2);
|
Old_Name : constant Node_Id := Get_Pragma_Arg (Arg2);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
GNAT_Pragma;
|
GNAT_Pragma;
|
||||||
Check_Valid_Configuration_Pragma;
|
Check_Valid_Configuration_Pragma;
|
||||||
|
|
@ -20602,50 +20603,6 @@ package body Sem_Prag is
|
||||||
|
|
||||||
rv;
|
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 --
|
-- Short_Circuit_And_Or --
|
||||||
--------------------------
|
--------------------------
|
||||||
|
|
@ -28862,7 +28819,6 @@ package body Sem_Prag is
|
||||||
Pragma_Restriction_Warnings => 0,
|
Pragma_Restriction_Warnings => 0,
|
||||||
Pragma_Restrictions => 0,
|
Pragma_Restrictions => 0,
|
||||||
Pragma_Reviewable => -1,
|
Pragma_Reviewable => -1,
|
||||||
Pragma_Secondary_Stack_Size => -1,
|
|
||||||
Pragma_Short_Circuit_And_Or => 0,
|
Pragma_Short_Circuit_And_Or => 0,
|
||||||
Pragma_Share_Generic => 0,
|
Pragma_Share_Generic => 0,
|
||||||
Pragma_Shared => 0,
|
Pragma_Shared => 0,
|
||||||
|
|
|
||||||
|
|
@ -100,7 +100,6 @@ package Sem_Prag is
|
||||||
Pragma_Remote_Access_Type => True,
|
Pragma_Remote_Access_Type => True,
|
||||||
Pragma_Remote_Call_Interface => True,
|
Pragma_Remote_Call_Interface => True,
|
||||||
Pragma_Remote_Types => True,
|
Pragma_Remote_Types => True,
|
||||||
Pragma_Secondary_Stack_Size => True,
|
|
||||||
Pragma_Shared => True,
|
Pragma_Shared => True,
|
||||||
Pragma_Shared_Passive => True,
|
Pragma_Shared_Passive => True,
|
||||||
Pragma_Simple_Storage_Pool_Type => True,
|
Pragma_Simple_Storage_Pool_Type => True,
|
||||||
|
|
|
||||||
|
|
@ -134,8 +134,6 @@ package body Snames is
|
||||||
return Attribute_Dispatching_Domain;
|
return Attribute_Dispatching_Domain;
|
||||||
elsif N = Name_Interrupt_Priority then
|
elsif N = Name_Interrupt_Priority then
|
||||||
return Attribute_Interrupt_Priority;
|
return Attribute_Interrupt_Priority;
|
||||||
elsif N = Name_Secondary_Stack_Size then
|
|
||||||
return Attribute_Secondary_Stack_Size;
|
|
||||||
else
|
else
|
||||||
return Attribute_Id'Val (N - First_Attribute_Name);
|
return Attribute_Id'Val (N - First_Attribute_Name);
|
||||||
end if;
|
end if;
|
||||||
|
|
@ -231,8 +229,6 @@ package body Snames is
|
||||||
return Pragma_Lock_Free;
|
return Pragma_Lock_Free;
|
||||||
when Name_Priority =>
|
when Name_Priority =>
|
||||||
return Pragma_Priority;
|
return Pragma_Priority;
|
||||||
when Name_Secondary_Stack_Size =>
|
|
||||||
return Pragma_Secondary_Stack_Size;
|
|
||||||
when Name_Storage_Size =>
|
when Name_Storage_Size =>
|
||||||
return Pragma_Storage_Size;
|
return Pragma_Storage_Size;
|
||||||
when Name_Storage_Unit =>
|
when Name_Storage_Unit =>
|
||||||
|
|
@ -460,7 +456,6 @@ package body Snames is
|
||||||
or else N = Name_Interrupt_Priority
|
or else N = Name_Interrupt_Priority
|
||||||
or else N = Name_Lock_Free
|
or else N = Name_Lock_Free
|
||||||
or else N = Name_Priority
|
or else N = Name_Priority
|
||||||
or else N = Name_Secondary_Stack_Size
|
|
||||||
or else N = Name_Storage_Size
|
or else N = Name_Storage_Size
|
||||||
or else N = Name_Storage_Unit;
|
or else N = Name_Storage_Unit;
|
||||||
end Is_Pragma_Name;
|
end Is_Pragma_Name;
|
||||||
|
|
|
||||||
|
|
@ -175,7 +175,6 @@ package Snames is
|
||||||
Name_uRelative_Deadline : constant Name_Id := N + $;
|
Name_uRelative_Deadline : constant Name_Id := N + $;
|
||||||
Name_uResult : constant Name_Id := N + $;
|
Name_uResult : constant Name_Id := N + $;
|
||||||
Name_uSecondary_Stack : 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_uService : constant Name_Id := N + $;
|
||||||
Name_uSize : constant Name_Id := N + $;
|
Name_uSize : constant Name_Id := N + $;
|
||||||
Name_uStack : constant Name_Id := N + $;
|
Name_uStack : constant Name_Id := N + $;
|
||||||
|
|
@ -805,6 +804,7 @@ package Snames is
|
||||||
Name_Robustness : constant Name_Id := N + $;
|
Name_Robustness : constant Name_Id := N + $;
|
||||||
Name_Runtime : constant Name_Id := N + $;
|
Name_Runtime : constant Name_Id := N + $;
|
||||||
Name_SB : 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_Section : constant Name_Id := N + $;
|
||||||
Name_Semaphore : constant Name_Id := N + $;
|
Name_Semaphore : constant Name_Id := N + $;
|
||||||
Name_Simple_Barriers : 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 of internal attributes. They are not real attributes but special
|
||||||
-- names used internally by GNAT in order to deal with delayed aspects
|
-- names used internally by GNAT in order to deal with delayed aspects
|
||||||
-- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority,
|
-- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
|
||||||
-- Aspect_Secondary_Stack_Size) that don't have corresponding pragmas or
|
-- don't have corresponding pragmas or user-referencable attributes.
|
||||||
-- user-referencable attributes.
|
|
||||||
|
|
||||||
-- It is convenient to have these internal attributes available for
|
-- It is convenient to have these internal attributes available for
|
||||||
-- processing the aspects, since the normal approach is to convert an
|
-- 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_CPU : constant Name_Id := N + $;
|
||||||
Name_Dispatching_Domain : constant Name_Id := N + $;
|
Name_Dispatching_Domain : constant Name_Id := N + $;
|
||||||
Name_Interrupt_Priority : 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 + $;
|
Last_Internal_Attribute_Name : constant Name_Id := N + $;
|
||||||
|
|
||||||
-- Names of recognized locking policy identifiers
|
-- Names of recognized locking policy identifiers
|
||||||
|
|
@ -1684,11 +1682,10 @@ package Snames is
|
||||||
|
|
||||||
Attribute_CPU,
|
Attribute_CPU,
|
||||||
Attribute_Dispatching_Domain,
|
Attribute_Dispatching_Domain,
|
||||||
Attribute_Interrupt_Priority,
|
Attribute_Interrupt_Priority);
|
||||||
Attribute_Secondary_Stack_Size);
|
|
||||||
|
|
||||||
subtype Internal_Attribute_Id is Attribute_Id range
|
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 Attribute_Class_Array is array (Attribute_Id) of Boolean;
|
||||||
-- Type used to build attribute classification flag arrays
|
-- Type used to build attribute classification flag arrays
|
||||||
|
|
@ -1996,7 +1993,6 @@ package Snames is
|
||||||
Pragma_Interrupt_Priority,
|
Pragma_Interrupt_Priority,
|
||||||
Pragma_Lock_Free,
|
Pragma_Lock_Free,
|
||||||
Pragma_Priority,
|
Pragma_Priority,
|
||||||
Pragma_Secondary_Stack_Size,
|
|
||||||
Pragma_Storage_Size,
|
Pragma_Storage_Size,
|
||||||
Pragma_Storage_Unit,
|
Pragma_Storage_Unit,
|
||||||
|
|
||||||
|
|
@ -2039,8 +2035,7 @@ package Snames is
|
||||||
|
|
||||||
function Is_Internal_Attribute_Name (N : Name_Id) return Boolean;
|
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,
|
-- 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;
|
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
|
-- Test to see if the name N is the name of a recognized attribute that
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue