diff options
Diffstat (limited to 'gcc/ada/s-tassta.adb')
| -rw-r--r-- | gcc/ada/s-tassta.adb | 57 |
1 files changed, 5 insertions, 52 deletions
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 08886c157bb..cf63a304546 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -33,6 +33,10 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during tasking -- operations. It causes infinite loops and other problems. +pragma Partition_Elaboration_Policy (Concurrent); +-- This package only implements the concurrent elaboration policy. This pragma +-- will enforce it (and detect conflicts with user specified policy). + with Ada.Exceptions; with Ada.Unchecked_Deallocation; @@ -87,9 +91,6 @@ package body System.Tasking.Stages is procedure Free is new Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); - procedure Free_Entry_Names (T : Task_Id); - -- Deallocate all string names associated with task entries - procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id); -- This procedure outputs the task specific message for exception -- tracing purposes. @@ -483,8 +484,7 @@ package body System.Tasking.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_Id; - Build_Entry_Names : Boolean) + Created_Task : out Task_Id) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -702,14 +702,6 @@ package body System.Tasking.Stages is Dispatching_Domain_Tasks (Base_CPU) + 1; end if; - -- Note: we should not call 'new' while holding locks since new may use - -- locks (e.g. RTS_Lock under Windows) itself and cause a deadlock. - - if Build_Entry_Names then - T.Entry_Names := - new Entry_Names_Array (1 .. Entry_Index (Num_Entries)); - 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. @@ -938,26 +930,6 @@ package body System.Tasking.Stages is end Finalize_Global_Tasks; - ---------------------- - -- Free_Entry_Names -- - ---------------------- - - procedure Free_Entry_Names (T : Task_Id) is - Names : Entry_Names_Array_Access := T.Entry_Names; - - procedure Free_Entry_Names_Array_Access is new - Ada.Unchecked_Deallocation - (Entry_Names_Array, Entry_Names_Array_Access); - - begin - if Names = null then - return; - end if; - - Free_Entry_Names_Array (Names.all); - Free_Entry_Names_Array_Access (Names); - end Free_Entry_Names; - --------------- -- Free_Task -- --------------- @@ -979,7 +951,6 @@ package body System.Tasking.Stages is Initialization.Task_Unlock (Self_Id); - Free_Entry_Names (T); System.Task_Primitives.Operations.Finalize_TCB (T); else @@ -1037,23 +1008,6 @@ package body System.Tasking.Stages is Initialization.Undefer_Abort (Self_ID); end Move_Activation_Chain; - -- Compiler interface only. Do not call from within the RTS - - -------------------- - -- Set_Entry_Name -- - -------------------- - - procedure Set_Entry_Name - (T : Task_Id; - Pos : Task_Entry_Index; - Val : String_Access) - is - begin - pragma Assert (T.Entry_Names /= null); - - T.Entry_Names (Entry_Index (Pos)) := Val; - end Set_Entry_Name; - ------------------ -- Task_Wrapper -- ------------------ @@ -2115,7 +2069,6 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - Free_Entry_Names (T); System.Task_Primitives.Operations.Finalize_TCB (T); end Vulnerable_Free_Task; |