+2017-01-12 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_util.adb (Unique_Entity): For concurrent
+ bodies that are defined with stubs and complete a declaration
+ of a single concurrent object return the entity of an implicit
+ concurrent type, not the entity of the anonymous concurrent
+ object.
+ * debug.adb: -gnatd.J is no longer used.
+ * make.adb (Globalize): Removed, no longer used.
+ * sem_ch9.adb: minor typo in comment for entry index
+
+2017-01-12 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, Initialize_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.
+ * s-tproft.adb (Register_Foreign_Thread): Amended Initialize_ATCB call
+ to include Secondary_Stack_Size parameter.
+ * 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-12 Yannick Moy <moy@adacore.com>
* exp_spark.adb (Expand_SPARK_Potential_Renaming): Fix sloc of copied
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,
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,
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,
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,
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,
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,
-- d.G Ignore calls through generic formal parameters for elaboration
-- d.H GNSA mode for ASIS
-- d.I Do not ignore enum representation clauses in CodePeer mode
- -- d.J Disable parallel SCIL generation mode
+ -- d.J
-- d.K Enable generation of contract-only procedures in CodePeer mode
-- d.L Depend on back end for limited types in if and case expressions
-- d.M Relaxed RM semantics
-- cases being able to change this default might be useful to remove
-- some false positives.
- -- d.J Disable parallel SCIL generation. Normally SCIL file generation is
- -- done in parallel to speed processing. This switch disables this
- -- behavior.
-
-- d.K Enable generation of contract-only procedures in CodePeer mode and
-- report a warning on subprograms for which the contract-only body
-- cannot be built. Currently reported on subprograms defined in
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;
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
-- 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
-- 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
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
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.
Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
-- Default compiler, binder, linker programs
- Globalizer : constant String := "codepeer_globalizer";
- -- CodePeer globalizer executable name
-
Saved_Gcc : String_Access := null;
Saved_Gnatbind : String_Access := null;
Saved_Gnatlink : String_Access := null;
-- Path for compiler, binder, linker programs, defaulted now for gnatdist.
-- Changed later if overridden on command line.
- Globalizer_Path : constant String_Access :=
- GNAT.OS_Lib.Locate_Exec_On_Path (Globalizer);
- -- Path for CodePeer globalizer
-
Comp_Flag : constant String_Access := new String'("-c");
Output_Flag : constant String_Access := new String'("-o");
Ada_Flag_1 : constant String_Access := new String'("-x");
-- during a compilation are also transitively included in the W section
-- of the originally compiled file.
- procedure Globalize (Success : out Boolean);
- -- Call the CodePeer globalizer on all the project's object directories,
- -- or on the current directory if no projects.
-
procedure Initialize
(Project_Node_Tree : out Project_Node_Tree_Ref;
Env : out Prj.Tree.Environment);
Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted;
- ---------------
- -- Globalize --
- ---------------
-
- procedure Globalize (Success : out Boolean) is
- Quiet_Str : aliased String := "-quiet";
- Globalizer_Args : constant Argument_List :=
- (1 => Quiet_Str'Unchecked_Access);
- Previous_Dir : String_Access;
-
- procedure Globalize_Dir (Dir : String);
- -- Call CodePeer globalizer on Dir
-
- -------------------
- -- Globalize_Dir --
- -------------------
-
- procedure Globalize_Dir (Dir : String) is
- Result : Boolean;
- begin
- if Previous_Dir = null or else Dir /= Previous_Dir.all then
- Free (Previous_Dir);
- Previous_Dir := new String'(Dir);
- Change_Dir (Dir);
- GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Result);
- Success := Success and Result;
- end if;
- end Globalize_Dir;
-
- procedure Globalize_Dirs is new
- Prj.Env.For_All_Object_Dirs (Globalize_Dir);
-
- -- Start of processing for Globalize
-
- begin
- Success := True;
- Display (Globalizer, Globalizer_Args);
-
- if Globalizer_Path = null then
- Make_Failed ("error, unable to locate " & Globalizer);
- end if;
-
- if Main_Project = No_Project then
- GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
- else
- Globalize_Dirs (Main_Project, Project_Tree);
- end if;
- end Globalize;
-
-------------------
-- Linking_Phase --
-------------------
end if;
end loop Multiple_Main_Loop;
- if CodePeer_Mode then
- declare
- Success : Boolean := False;
- begin
- Globalize (Success);
-
- if not Success then
- Set_Standard_Error;
- Write_Str ("*** globalize failed.");
-
- if Commands_To_Stdout then
- Set_Standard_Output;
- end if;
- end if;
- end;
- end if;
-
if Failed_Links.Last > 0 then
for Index in 1 .. Successful_Links.Last loop
Write_Str ("Linking of """);
Pragma_Ravenscar |
Pragma_Rename_Pragma |
Pragma_Reviewable |
+ Pragma_Secondary_Stack_Size |
Pragma_Share_Generic |
Pragma_Shared |
Pragma_Shared_Passive |
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 --
--------------
Put_Line (
" Current allocated space : "
- & SS_Ptr'Image (Fixed_Stack.Top - 1)
+ & SS_Ptr'Image (Fixed_Stack.Top)
& " bytes");
end;
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 :=
-- 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);
-- 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.Parameters.Size_Type;
+ Task_Info : System.Task_Info.Task_Info_Type;
+ CPU : Integer;
+ State : Task_Procedure_Access;
+ Discriminants : System.Address;
+ Elaborated : Access_Boolean;
+ Task_Image : String;
+ Created_Task : Task_Id);
-- Code shared between Create_Restricted_Task (the concurrent version) and
-- Create_Restricted_Task_Sequential. See comment of the former in the
-- specification of this package.
--
-- 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. For fixed
+ -- secondary stacks, 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);
+ -- Dynamic secondary stacks are allocated in System.Soft_Links.
+ -- Create_TSD and thus the function returns 0 to suppress the
+ -- creation of the fixed secondary stack in the primary stack.
+
+ function Secondary_Stack_Size return Storage_Elements.Storage_Offset is
+ use System.Storage_Elements;
+ use System.Secondary_Stack;
+
+ begin
+ if Parameters.Sec_Stack_Dynamic then
+ return 0;
+
+ elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then
+ return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size
+ * SSE.Storage_Offset (Sec_Stack_Percentage) / 100);
+ else
+ -- Use the size specified by aspect Secondary_Stack_Size padded
+ -- by the amount of space used by the stack data structure.
+
+ 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.
----------------------------
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;
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
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_Type;
+ Task_Info : System.Task_Info.Task_Info_Type;
+ CPU : Integer;
+ State : Task_Procedure_Access;
+ Discriminants : System.Address;
+ Elaborated : Access_Boolean;
+ Chain : in out Activation_Chain;
+ Task_Image : String;
+ Created_Task : Task_Id)
is
begin
if Partition_Elaboration_Policy = 'S' then
-- 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
---------------------------------------
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);
-- 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).
--
-- 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.
--
-- 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.
---------------------
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;
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
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);
-- 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;
---------------------------------------
-- 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
with System.Tasking.Rendezvous;
with System.OS_Primitives;
with System.Secondary_Stack;
-with System.Storage_Elements;
with System.Restrictions;
with System.Standard_Library;
with System.Traces.Tasking;
with System.Stack_Usage;
+with System.Storage_Elements;
with System.Soft_Links;
-- These are procedure pointers to non-tasking routines that use task
-- 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.Parameters.Size_Type;
+ Task_Info : System.Task_Info.Task_Info_Type;
+ CPU : Integer;
+ Relative_Deadline : Ada.Real_Time.Time_Span;
+ Domain : Dispatching_Domain_Access;
+ Num_Entries : Task_Entry_Index;
+ Master : Master_Level;
+ State : Task_Procedure_Access;
+ Discriminants : System.Address;
+ Elaborated : Access_Boolean;
+ Chain : in out Activation_Chain;
+ Task_Image : String;
+ Created_Task : out Task_Id)
is
T, P : Task_Id;
Self_ID : constant Task_Id := STPO.Self;
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);
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. For fixed
+ -- secondary stacks, 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.
+
+ -- Dynamic secondary stacks are allocated in System.Soft_Links.
+ -- Create_TSD and thus the function returns 0 to suppress the
+ -- creation of the fixed secondary stack in the primary stack.
+
+ function Secondary_Stack_Size return Storage_Elements.Storage_Offset is
+ use System.Storage_Elements;
+ use System.Secondary_Stack;
+
+ begin
+ if Parameters.Sec_Stack_Dynamic then
+ return 0;
+
+ elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then
+ return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size
+ * SSE.Storage_Offset (Sec_Stack_Percentage) / 100);
+ else
+ -- Use the size specified by aspect Secondary_Stack_Size padded
+ -- by the amount of space used by the stack data structure.
+
+ return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) +
+ Storage_Offset (SST.Minimum_Secondary_Stack_Size);
+ end if;
+ end Secondary_Stack_Size;
- Secondary_Stack : aliased SSE.Storage_Array (1 .. 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
-- 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.Parameters.Size_Type;
+ Task_Info : System.Task_Info.Task_Info_Type;
+ CPU : Integer;
+ Relative_Deadline : Ada.Real_Time.Time_Span;
+ Domain : Dispatching_Domain_Access;
+ Num_Entries : Task_Entry_Index;
+ Master : Master_Level;
+ State : Task_Procedure_Access;
+ Discriminants : System.Address;
+ Elaborated : Access_Boolean;
+ Chain : in out Activation_Chain;
+ Task_Image : String;
+ Created_Task : out Task_Id);
-- Compiler interface only. Do not call from within the RTS.
-- This must be called to create a new task.
--
-- Priority is the task's priority (assumed to be in range of type
-- System.Any_Priority)
-- Size is the stack size of the task to create
+ -- Secondary_Stack_Size is the secondary stack size of the task to create
-- Task_Info is the task info associated with the created task, or
-- Unspecified_Task_Info if none.
-- CPU is the task affinity. Passed as an Integer because the undefined
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-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- --
(Self_Id, null, Null_Address, Null_Task,
Foreign_Task_Elaborated'Access,
System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, null,
- Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded);
+ Task_Info.Unspecified_Task_Info, 0, 0, Self_Id, Succeeded);
Unlock_RTS;
pragma Assert (Succeeded);
Aspect_Scalar_Storage_Order |
Aspect_Size |
Aspect_Small |
+ Aspect_Secondary_Stack_Size |
Aspect_Simple_Storage_Pool |
Aspect_Storage_Pool |
Aspect_Stream_Size |
end if;
end;
- -- Handling for these Aspects in subprograms is complete
+ -- Handling for these aspects in subprograms is complete
goto Continue;
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 --
----------
when Aspect_Relative_Deadline =>
T := RTE (RE_Time_Span);
+ when Aspect_Secondary_Stack_Size =>
+ T := Standard_Integer;
+
when Aspect_Small =>
T := Universal_Real;
-- The Defining_Identifier of the entry index specification is local to the
-- entry body, but it must be available in the entry barrier which is
-- evaluated outside of the entry body. The index is eventually renamed as
- -- a run-time object, so is visibility is strictly a front-end concern. In
+ -- a run-time object, so its visibility is strictly a front-end concern. In
-- order to make it available to the barrier, we create an additional
-- scope, as for a loop, whose only declaration is the index name. This
-- loop is not attached to the tree and does not appear as an entity local
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 --
--------------------------
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,
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,
and then Present (Corresponding_Spec_Of_Stub (P))
then
U := Corresponding_Spec_Of_Stub (P);
+
+ if Is_Single_Protected_Object (U) then
+ U := Etype (U);
+ end if;
end if;
when E_Subprogram_Body =>
and then Present (Corresponding_Spec_Of_Stub (P))
then
U := Corresponding_Spec_Of_Stub (P);
+
+ if Is_Single_Task_Object (U) then
+ U := Etype (U);
+ end if;
end if;
when Type_Kind =>
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;
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 =>
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;
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 + $;
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 + $;
-- 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
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
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
Pragma_Interrupt_Priority,
Pragma_Lock_Free,
Pragma_Priority,
+ Pragma_Secondary_Stack_Size,
Pragma_Storage_Size,
Pragma_Storage_Unit,
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
projects / gcc.git / commitdiff