diff options
Diffstat (limited to 'gcc/ada/libgnarl')
| -rw-r--r-- | gcc/ada/libgnarl/s-solita.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprob.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__linux.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__mingw.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__posix.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__solaris.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taprop__vxworks.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-tarest.adb | 189 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-tarest.ads | 65 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taskin.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-taskin.ads | 14 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-tassta.adb | 93 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-tassta.ads | 21 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-tporft.adb | 21 |
14 files changed, 211 insertions, 283 deletions
diff --git a/gcc/ada/libgnarl/s-solita.adb b/gcc/ada/libgnarl/s-solita.adb index bb38578b06f..a5485aa268d 100644 --- a/gcc/ada/libgnarl/s-solita.adb +++ b/gcc/ada/libgnarl/s-solita.adb @@ -44,6 +44,7 @@ with Ada.Exceptions.Is_Null_Occurrence; with System.Task_Primitives.Operations; with System.Tasking; with System.Stack_Checking; +with System.Secondary_Stack; package body System.Soft_Links.Tasking is @@ -52,6 +53,8 @@ package body System.Soft_Links.Tasking is use Ada.Exceptions; + use type System.Secondary_Stack.SS_Stack_Ptr; + use type System.Tasking.Task_Id; use type System.Tasking.Termination_Handler; @@ -71,8 +74,8 @@ package body System.Soft_Links.Tasking is procedure Set_Jmpbuf_Address (Addr : Address); -- Get/Set Jmpbuf_Address for current task - function Get_Sec_Stack_Addr return Address; - procedure Set_Sec_Stack_Addr (Addr : Address); + function Get_Sec_Stack return SST.SS_Stack_Ptr; + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr); -- Get/Set location of current task's secondary stack procedure Timed_Delay_T (Time : Duration; Mode : Integer); @@ -93,14 +96,14 @@ package body System.Soft_Links.Tasking is return STPO.Self.Common.Compiler_Data.Jmpbuf_Address; end Get_Jmpbuf_Address; - function Get_Sec_Stack_Addr return Address is + function Get_Sec_Stack return SST.SS_Stack_Ptr is begin - return Result : constant Address := - STPO.Self.Common.Compiler_Data.Sec_Stack_Addr + return Result : constant SST.SS_Stack_Ptr := + STPO.Self.Common.Compiler_Data.Sec_Stack_Ptr do - pragma Assert (Result /= Null_Address); + pragma Assert (Result /= null); end return; - end Get_Sec_Stack_Addr; + end Get_Sec_Stack; function Get_Stack_Info return Stack_Checking.Stack_Access is begin @@ -116,10 +119,10 @@ package body System.Soft_Links.Tasking is STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr; end Set_Jmpbuf_Address; - procedure Set_Sec_Stack_Addr (Addr : Address) is + procedure Set_Sec_Stack (Stack : SST.SS_Stack_Ptr) is begin - STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr; - end Set_Sec_Stack_Addr; + STPO.Self.Common.Compiler_Data.Sec_Stack_Ptr := Stack; + end Set_Sec_Stack; ------------------- -- Timed_Delay_T -- @@ -213,20 +216,20 @@ package body System.Soft_Links.Tasking is SSL.Get_Jmpbuf_Address := Get_Jmpbuf_Address'Access; SSL.Set_Jmpbuf_Address := Set_Jmpbuf_Address'Access; - SSL.Get_Sec_Stack_Addr := Get_Sec_Stack_Addr'Access; + SSL.Get_Sec_Stack := Get_Sec_Stack'Access; SSL.Get_Stack_Info := Get_Stack_Info'Access; - SSL.Set_Sec_Stack_Addr := Set_Sec_Stack_Addr'Access; + SSL.Set_Sec_Stack := Set_Sec_Stack'Access; SSL.Timed_Delay := Timed_Delay_T'Access; SSL.Task_Termination_Handler := Task_Termination_Handler_T'Access; -- No need to create a new secondary stack, since we will use the -- default one created in s-secsta.adb. - SSL.Set_Sec_Stack_Addr (SSL.Get_Sec_Stack_Addr_NT); + SSL.Set_Sec_Stack (SSL.Get_Sec_Stack_NT); SSL.Set_Jmpbuf_Address (SSL.Get_Jmpbuf_Address_NT); end if; - pragma Assert (Get_Sec_Stack_Addr /= Null_Address); + pragma Assert (Get_Sec_Stack /= null); end Init_Tasking_Soft_Links; end System.Soft_Links.Tasking; diff --git a/gcc/ada/libgnarl/s-taprob.adb b/gcc/ada/libgnarl/s-taprob.adb index 517b92d8af2..c4d33c53365 100644 --- a/gcc/ada/libgnarl/s-taprob.adb +++ b/gcc/ada/libgnarl/s-taprob.adb @@ -75,7 +75,7 @@ package body System.Tasking.Protected_Objects is begin if Init_Priority = Unspecified_Priority then - Init_Priority := System.Priority'Last; + Init_Priority := System.Priority'Last; end if; Initialize_Lock (Init_Priority, Object.L'Access); diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 1dfcf39dd81..ba5a09907c1 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -152,11 +152,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index fa966514568..b14444ad185 100644 --- a/gcc/ada/libgnarl/s-taprop__mingw.adb +++ b/gcc/ada/libgnarl/s-taprop__mingw.adb @@ -190,11 +190,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ---------------------------------- -- Condition Variable Functions -- diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb index 3efc1e0de1a..a614507bd04 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -156,11 +156,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb index e97662c12b1..26d83e584d6 100644 --- a/gcc/ada/libgnarl/s-taprop__solaris.adb +++ b/gcc/ada/libgnarl/s-taprop__solaris.adb @@ -237,11 +237,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ------------ -- Checks -- diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index b77fb106b37..83ebc22312e 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -149,11 +149,16 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread + function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id; + -- Allocate and initialize a new ATCB for the current Thread. The size of + -- the secondary stack can be optionally specified. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id is separate; ----------------------- -- Local Subprograms -- diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb index daff5c1c3ae..7b9f260927e 100644 --- a/gcc/ada/libgnarl/s-tarest.adb +++ b/gcc/ada/libgnarl/s-tarest.adb @@ -47,12 +47,6 @@ with Ada.Exceptions; with System.Task_Primitives.Operations; with System.Soft_Links.Tasking; -with System.Storage_Elements; - -with System.Secondary_Stack; -pragma Elaborate_All (System.Secondary_Stack); --- Make sure the body of Secondary_Stack is elaborated before calling --- Init_Tasking_Soft_Links. See comments for this routine for explanation. with System.Soft_Links; -- Used for the non-tasking routines (*_NT) that refer to global data. They @@ -65,8 +59,6 @@ package body System.Tasking.Restricted.Stages is package STPO renames System.Task_Primitives.Operations; package SSL renames System.Soft_Links; - package SSE renames System.Storage_Elements; - package SST renames System.Secondary_Stack; use Ada.Exceptions; @@ -115,17 +107,18 @@ package body System.Tasking.Restricted.Stages is -- This should only be called by the Task_Wrapper procedure. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.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; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_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. @@ -205,54 +198,6 @@ package body System.Tasking.Restricted.Stages is -- -- DO NOT delete ID. As noted, it is needed on some targets. - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. 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. - - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - 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. - - pragma Warnings (Off); - Secondary_Stack_Address : System.Address := Secondary_Stack'Address; - pragma Warnings (On); - -- Address of secondary stack. In the fixed secondary stack case, this - -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). - Cause : Cause_Of_Termination := Normal; -- Indicates the reason why this task terminates. Normal corresponds to -- a task terminating due to completing the last statement of its body. @@ -266,15 +211,7 @@ package body System.Tasking.Restricted.Stages is -- execution of its task body, then EO will contain the associated -- exception occurrence. Otherwise, it will contain Null_Occurrence. - -- Start of processing for Task_Wrapper - begin - if not Parameters.Sec_Stack_Dynamic then - Self_ID.Common.Compiler_Data.Sec_Stack_Addr := - Secondary_Stack'Address; - SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); - end if; - -- Initialize low-level TCB components, that cannot be initialized by -- the creator. @@ -539,17 +476,18 @@ package body System.Tasking.Restricted.Stages is ---------------------------- procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_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; @@ -608,8 +546,7 @@ package body System.Tasking.Restricted.Stages is Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Base_CPU, null, Task_Info, Size, Secondary_Stack_Size, - Created_Task, Success); + Base_CPU, null, Task_Info, 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 @@ -639,25 +576,31 @@ package body System.Tasking.Restricted.Stages is Unlock_RTS; end if; - -- Create TSD as early as possible in the creation of a task, since it - -- may be used by the operation of Ada code within the task. + -- Create TSD as early as possible in the creation of a task, since + -- it may be used by the operation of Ada code within the task. If the + -- compiler has not allocated a secondary stack, a stack will be + -- allocated fromt the binder generated pool. - SSL.Create_TSD (Created_Task.Common.Compiler_Data); + SSL.Create_TSD + (Created_Task.Common.Compiler_Data, + Sec_Stack_Address, + Sec_Stack_Size); end Create_Restricted_Task; procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_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; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_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 @@ -668,14 +611,14 @@ package body System.Tasking.Restricted.Stages is -- sequential, activation must be deferred. Create_Restricted_Task_Sequential - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); else Create_Restricted_Task - (Priority, Stack_Address, Size, Secondary_Stack_Size, - Task_Info, CPU, State, Discriminants, Elaborated, + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); -- Append this task to the activation chain @@ -690,22 +633,24 @@ package body System.Tasking.Restricted.Stages is --------------------------------------- procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) is + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_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, - Secondary_Stack_Size, Task_Info, - CPU, State, Discriminants, Elaborated, - Task_Image, Created_Task); + Create_Restricted_Task + (Priority, Stack_Address, Stack_Size, Sec_Stack_Address, + Sec_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); -- Append this task to the activation chain diff --git a/gcc/ada/libgnarl/s-tarest.ads b/gcc/ada/libgnarl/s-tarest.ads index ccc5683bd31..e51fa58ca61 100644 --- a/gcc/ada/libgnarl/s-tarest.ads +++ b/gcc/ada/libgnarl/s-tarest.ads @@ -43,8 +43,9 @@ -- The restricted GNARLI is also composed of System.Protected_Objects and -- System.Protected_Objects.Single_Entry -with System.Task_Info; with System.Parameters; +with System.Secondary_Stack; +with System.Task_Info; package System.Tasking.Restricted.Stages is pragma Elaborate_Body; @@ -128,33 +129,38 @@ package System.Tasking.Restricted.Stages is -- by the binder generated code, before calling elaboration code. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_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). -- -- Priority is the task's priority (assumed to be in the - -- System.Any_Priority'Range) + -- System.Any_Priority'Range). -- -- Stack_Address is the start address of the stack associated to the task, -- in case it has been preallocated by the compiler; it is equal to -- Null_Address when the stack needs to be allocated by the underlying -- operating system. -- - -- Size is the stack size of the task to create + -- Stack_Size is the stack size of the task to create. + -- + -- Sec_Stack_Address is the pointer to the secondary stack created by the + -- compiler. If null, the secondary stack is either allocated by the binder + -- or the run-time. -- - -- Secondary_Stack_Size is the secondary 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. @@ -164,7 +170,7 @@ package System.Tasking.Restricted.Stages is -- checks are performed when analyzing the pragma, and dynamic ones are -- performed before setting the affinity at run time. -- - -- State is the compiler generated task's procedure body + -- State is the compiler generated task's procedure body. -- -- Discriminants is a pointer to a limited record whose discriminants are -- those of the task to create. This parameter should be passed as the @@ -182,20 +188,21 @@ package System.Tasking.Restricted.Stages is -- -- Created_Task is the resulting task. -- - -- 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 - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Secondary_Stack_Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Stack_Size : System.Parameters.Size_Type; + Sec_Stack_Address : System.Secondary_Stack.SS_Stack_Ptr; + Sec_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the sequential partition -- elaboration policy is used. diff --git a/gcc/ada/libgnarl/s-taskin.adb b/gcc/ada/libgnarl/s-taskin.adb index 462e229645c..d9fc6e3213b 100644 --- a/gcc/ada/libgnarl/s-taskin.adb +++ b/gcc/ada/libgnarl/s-taskin.adb @@ -96,7 +96,6 @@ package body System.Tasking is 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 @@ -147,7 +146,6 @@ package body System.Tasking is T.Common.Specific_Handler := null; T.Common.Debug_Events := (others => False); T.Common.Task_Image_Len := 0; - T.Common.Secondary_Stack_Size := Secondary_Stack_Size; if T.Common.Parent = null then @@ -244,7 +242,6 @@ package body System.Tasking is 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); diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads index cd53cf93471..7c8b44b952c 100644 --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -37,12 +37,12 @@ with Ada.Exceptions; with Ada.Unchecked_Conversion; +with System.Multiprocessors; with System.Parameters; -with System.Task_Info; with System.Soft_Links; -with System.Task_Primitives; with System.Stack_Usage; -with System.Multiprocessors; +with System.Task_Info; +with System.Task_Primitives; package System.Tasking is pragma Preelaborate; @@ -702,13 +702,6 @@ package System.Tasking is -- need to do different things depending on the situation. -- -- Protection: Self.L - - Secondary_Stack_Size : System.Parameters.Size_Type; - -- Secondary_Stack_Size is the size of the secondary stack for the - -- task. Defined here since it is the responsibility of the task to - -- creates its own secondary stack. - -- - -- Protected: Only accessed by Self end record; --------------------------------------- @@ -1173,7 +1166,6 @@ package System.Tasking is 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 diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb index 44c054fec3e..518a02c8b48 100644 --- a/gcc/ada/libgnarl/s-tassta.adb +++ b/gcc/ada/libgnarl/s-tassta.adb @@ -71,11 +71,11 @@ package body System.Tasking.Stages is package STPO renames System.Task_Primitives.Operations; package SSL renames System.Soft_Links; package SSE renames System.Storage_Elements; - package SST renames System.Secondary_Stack; use Ada.Exceptions; use Parameters; + use Secondary_Stack; use Task_Primitives; use Task_Primitives.Operations; @@ -465,7 +465,7 @@ package body System.Tasking.Stages is procedure Create_Task (Priority : Integer; - Size : System.Parameters.Size_Type; + Stack_Size : System.Parameters.Size_Type; Secondary_Stack_Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; CPU : Integer; @@ -604,8 +604,7 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Base_CPU, Domain, Task_Info, Size, - Secondary_Stack_Size, T, Success); + Base_Priority, Base_CPU, Domain, Task_Info, Stack_Size, T, Success); if not Success then Free (T); @@ -692,10 +691,18 @@ package body System.Tasking.Stages is Dispatching_Domain_Tasks (Base_CPU) + 1; end if; - -- Create TSD as early as possible in the creation of a task, since it - -- may be used by the operation of Ada code within the task. + -- Create the secondary stack for the task as early as possible during + -- in the creation of a task, since it may be used by the operation of + -- Ada code within the task. + + begin + SSL.Create_TSD (T.Common.Compiler_Data, null, Secondary_Stack_Size); + exception + when others => + Initialization.Undefer_Abort_Nestable (Self_ID); + raise Storage_Error with "Secondary stack could not be allocated"; + end; - SSL.Create_TSD (T.Common.Compiler_Data); T.Common.Activation_Link := Chain.T_ID; Chain.T_ID := T; Created_Task := T; @@ -914,8 +921,8 @@ package body System.Tasking.Stages is SSL.Unlock_Task := SSL.Task_Unlock_NT'Access; SSL.Get_Jmpbuf_Address := SSL.Get_Jmpbuf_Address_NT'Access; SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access; - SSL.Get_Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT'Access; - SSL.Set_Sec_Stack_Addr := SSL.Set_Sec_Stack_Addr_NT'Access; + SSL.Get_Sec_Stack := SSL.Get_Sec_Stack_NT'Access; + SSL.Set_Sec_Stack := SSL.Set_Sec_Stack_NT'Access; SSL.Check_Abort_Status := SSL.Check_Abort_Status_NT'Access; SSL.Get_Stack_Info := SSL.Get_Stack_Info_NT'Access; @@ -1014,7 +1021,6 @@ package body System.Tasking.Stages is -- at-end handler that the compiler generates. procedure Task_Wrapper (Self_ID : Task_Id) is - use type SSE.Storage_Offset; use System.Standard_Library; use System.Stack_Usage; @@ -1027,52 +1033,6 @@ package body System.Tasking.Stages is Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; -- Whether to use above alternate signal stack for stack overflows - function Secondary_Stack_Size return Storage_Elements.Storage_Offset; - -- Returns the size of the secondary stack for the task. 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. - - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - function Secondary_Stack_Size return Storage_Elements.Storage_Offset is - use System.Storage_Elements; - - 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 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 - -- allocated here. - - Secondary_Stack_Address : System.Address := Secondary_Stack'Address; - -- Address of secondary stack. In the fixed secondary stack case, this - -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). But why is so much *more* bracketed??? - SEH_Table : aliased SSE.Storage_Array (1 .. 8); -- Structured Exception Registration table (2 words) @@ -1136,14 +1096,6 @@ package body System.Tasking.Stages is Debug.Master_Hook (Self_ID, Self_ID.Common.Parent, Self_ID.Master_of_Task); - -- Assume a size of the stack taken at this stage - - if not Parameters.Sec_Stack_Dynamic then - Self_ID.Common.Compiler_Data.Sec_Stack_Addr := - Secondary_Stack'Address; - SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); - end if; - if Use_Alternate_Stack then Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address; end if; @@ -1197,15 +1149,6 @@ package body System.Tasking.Stages is Stack_Base := Bottom_Of_Stack'Address; - -- Also reduce the size of the stack to take into account the - -- secondary stack array declared in this frame. This is for - -- sure very conservative. - - if not Parameters.Sec_Stack_Dynamic then - Pattern_Size := - Pattern_Size - Natural (Secondary_Stack_Size); - end if; - -- Adjustments for inner frames Pattern_Size := Pattern_Size - @@ -1973,10 +1916,10 @@ package body System.Tasking.Stages is then Initialization.Task_Lock (Self_ID); - -- If Sec_Stack_Addr is not null, it means that Destroy_TSD + -- If Sec_Stack_Ptr is not null, it means that Destroy_TSD -- has not been called yet (case of an unactivated task). - if T.Common.Compiler_Data.Sec_Stack_Addr /= Null_Address then + if T.Common.Compiler_Data.Sec_Stack_Ptr /= null then SSL.Destroy_TSD (T.Common.Compiler_Data); end if; diff --git a/gcc/ada/libgnarl/s-tassta.ads b/gcc/ada/libgnarl/s-tassta.ads index bc837fc9af8..a1129a1085a 100644 --- a/gcc/ada/libgnarl/s-tassta.ads +++ b/gcc/ada/libgnarl/s-tassta.ads @@ -70,7 +70,7 @@ package System.Tasking.Stages is -- tE : aliased boolean := false; -- tZ : size_type := unspecified_size; -- type tV (discr : integer) is limited record - -- _task_id : task_id; + -- _task_id : task_id; -- end record; -- procedure tB (_task : access tV); -- freeze tV [ @@ -168,7 +168,7 @@ package System.Tasking.Stages is procedure Create_Task (Priority : Integer; - Size : System.Parameters.Size_Type; + Stack_Size : System.Parameters.Size_Type; Secondary_Stack_Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; CPU : Integer; @@ -187,31 +187,44 @@ package System.Tasking.Stages is -- -- 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 + -- + -- Stack_Size is the stack size of the task to create + -- + -- Secondary_Stack_Size is the size of the secondary stack to be used by + -- the task. + -- -- 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 -- value is not in the range of CPU_Range. Static range checks are -- performed when analyzing the pragma, and dynamic ones are performed -- before setting the affinity at run time. + -- -- Relative_Deadline is the relative deadline associated with the created -- task by means of a pragma Relative_Deadline, or 0.0 if none. + -- -- Domain is the dispatching domain associated with the created task by -- means of a Dispatching_Domain pragma or aspect, or null if none. + -- -- State is the compiler generated task's procedure body + -- -- Discriminants is a pointer to a limited record whose discriminants -- are those of the task to create. This parameter should be passed as -- the single argument to State. + -- -- Elaborated is a pointer to a Boolean that must be set to true on exit -- if the task could be successfully elaborated. + -- -- Chain is a linked list of task that needs to be created. On exit, -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID -- will be Created_Task (e.g the created task will be linked at the front -- of Chain). + -- -- Task_Image is a string created by the compiler that the -- run time can store to ease the debugging and the -- Ada.Task_Identification facility. + -- -- Created_Task is the resulting task. -- -- This procedure can raise Storage_Error if the task creation failed. diff --git a/gcc/ada/libgnarl/s-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb index 7b8a59276f8..56eda26e6a1 100644 --- a/gcc/ada/libgnarl/s-tporft.adb +++ b/gcc/ada/libgnarl/s-tporft.adb @@ -29,16 +29,16 @@ -- -- ------------------------------------------------------------------------------ -with System.Task_Info; --- Use for Unspecified_Task_Info - -with System.Soft_Links; --- used to initialize TSD for a C thread, in function Self - with System.Multiprocessors; +with System.Soft_Links; +with System.Task_Info; separate (System.Task_Primitives.Operations) -function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is +function Register_Foreign_Thread + (Thread : Thread_Id; + Sec_Stack_Size : Size_Type := Unspecified_Size) + return Task_Id +is Local_ATCB : aliased Ada_Task_Control_Block (0); Self_Id : Task_Id; Succeeded : Boolean; @@ -66,7 +66,7 @@ begin (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, 0, Self_Id, Succeeded); + Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded); Unlock_RTS; pragma Assert (Succeeded); @@ -92,7 +92,10 @@ begin Self_Id.Common.Task_Alternate_Stack := Null_Address; - System.Soft_Links.Create_TSD (Self_Id.Common.Compiler_Data); + -- Create the TSD for the task + + System.Soft_Links.Create_TSD + (Self_Id.Common.Compiler_Data, null, Sec_Stack_Size); Enter_Task (Self_Id); |