diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/a-tasatt.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/s-tasini.adb | 68 | ||||
| -rw-r--r-- | gcc/ada/s-tasini.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/s-tataat.adb | 12 |
4 files changed, 59 insertions, 87 deletions
diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb index b0ceb3de..5afab9e 100644 --- a/gcc/ada/a-tasatt.adb +++ b/gcc/ada/a-tasatt.adb @@ -419,17 +419,18 @@ package body Ada.Task_Attributes is else declare - P : Access_Node := To_Access_Node (TT.Indirect_Attributes); - W : Access_Wrapper; + P : Access_Node := To_Access_Node (TT.Indirect_Attributes); + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); POP.Lock_RTS; while P /= null loop if P.Instance = Access_Instance'(Local'Unchecked_Access) then POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return To_Access_Wrapper (P.Wrapper).Value'Access; end if; @@ -450,13 +451,13 @@ package body Ada.Task_Attributes is P.Next := To_Access_Node (TT.Indirect_Attributes); TT.Indirect_Attributes := To_Access_Address (P); POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return W.Value'Access; exception when others => POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); raise; end; end if; @@ -496,10 +497,12 @@ package body Ada.Task_Attributes is Set_Value (Initial_Value, T); else declare - P, Q : Access_Node; - W : Access_Wrapper; + P, Q : Access_Node; + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; + begin - Defer_Abortion; + Defer_Abort (Self_Id); POP.Lock_RTS; Q := To_Access_Node (TT.Indirect_Attributes); @@ -514,7 +517,7 @@ package body Ada.Task_Attributes is W := To_Access_Wrapper (Q.Wrapper); Free (W); POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return; end if; @@ -523,12 +526,12 @@ package body Ada.Task_Attributes is end loop; POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); exception when others => POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); raise; end; end if; @@ -581,11 +584,12 @@ package body Ada.Task_Attributes is -- Not directly addressed declare - P : Access_Node := To_Access_Node (TT.Indirect_Attributes); - W : Access_Wrapper; + P : Access_Node := To_Access_Node (TT.Indirect_Attributes); + W : Access_Wrapper; + Self_Id : constant Task_Id := POP.Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); POP.Lock_RTS; while P /= null loop @@ -593,7 +597,7 @@ package body Ada.Task_Attributes is if P.Instance = Access_Instance'(Local'Unchecked_Access) then To_Access_Wrapper (P.Wrapper).Value := Val; POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return; end if; @@ -613,12 +617,12 @@ package body Ada.Task_Attributes is TT.Indirect_Attributes := To_Access_Address (P); POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); exception when others => POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); raise; end; @@ -669,11 +673,12 @@ package body Ada.Task_Attributes is -- Not directly addressed declare - P : Access_Node; - Result : Attribute; + P : Access_Node; + Result : Attribute; + Self_Id : constant Task_Id := POP.Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); POP.Lock_RTS; P := To_Access_Node (TT.Indirect_Attributes); @@ -681,7 +686,7 @@ package body Ada.Task_Attributes is if P.Instance = Access_Instance'(Local'Unchecked_Access) then Result := To_Access_Wrapper (P.Wrapper).Value; POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return Result; end if; @@ -689,13 +694,13 @@ package body Ada.Task_Attributes is end loop; POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); return Initial_Value; exception when others => POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); raise; end; @@ -720,8 +725,9 @@ begin declare Two_To_J : Direct_Index_Vector; + Self_Id : constant Task_Id := POP.Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); -- Need protection for updating links to per-task initialization and -- finalization routines, in case some task is being created or @@ -798,6 +804,6 @@ begin end if; POP.Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); end; end Ada.Task_Attributes; diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb index bd9ff83..3aff427 100644 --- a/gcc/ada/s-tasini.adb +++ b/gcc/ada/s-tasini.adb @@ -43,10 +43,6 @@ pragma Polling (Off); with Ada.Exceptions; -- Used for Exception_Occurrence_Access -with System.Tasking; -pragma Elaborate_All (System.Tasking); --- Ensure that the first step initializations have been performed - with System.Task_Primitives; -- Used for Lock @@ -94,6 +90,12 @@ package body System.Tasking.Initialization is -- Tasking versions of some services needed by non-tasking programs -- ---------------------------------------------------------------------- + procedure Abort_Defer; + -- NON-INLINE versions without Self_ID for soft links + + procedure Abort_Undefer; + -- NON-INLINE versions without Self_ID for soft links + procedure Task_Lock; -- Locks out other tasks. Preceding a section of code by Task_Lock and -- following it by Task_Unlock creates a critical region. This is used @@ -107,13 +109,6 @@ package body System.Tasking.Initialization is -- all nested locks must be released before other tasks competing for the -- tasking lock are released. - function Get_Exc_Stack_Addr return Address; - -- Get the exception stack for the current task - - procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address); - -- Self_ID is the Task_Id of the task that gets the exception stack. - -- For Self_ID = Null_Address, the current task gets the exception stack. - function Get_Stack_Info return Stack_Checking.Stack_Access; -- Get access to the current task's Stack_Info @@ -237,13 +232,12 @@ package body System.Tasking.Initialization is Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1; end Defer_Abort_Nestable; - -------------------- - -- Defer_Abortion -- - -------------------- + ----------------- + -- Abort_Defer -- + ----------------- - procedure Defer_Abortion is + procedure Abort_Defer is Self_ID : Task_Id; - begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -251,7 +245,7 @@ package body System.Tasking.Initialization is Self_ID := STPO.Self; Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1; - end Defer_Abortion; + end Abort_Defer; ----------------------- -- Do_Pending_Action -- @@ -346,8 +340,9 @@ package body System.Tasking.Initialization is procedure Init_RTS is Self_Id : Task_Id; - begin + Tasking.Initialize; + -- Terminate run time (regular vs restricted) specific initialization -- of the environment task. @@ -381,21 +376,17 @@ package body System.Tasking.Initialization is -- the tasking version of the soft links can be used. if not No_Abort or else Dynamic_Priority_Support then - SSL.Abort_Defer := Defer_Abortion'Access; - SSL.Abort_Undefer := Undefer_Abortion'Access; + SSL.Abort_Defer := Abort_Defer'Access; + SSL.Abort_Undefer := Abort_Undefer'Access; end if; SSL.Update_Exception := Update_Exception'Access; SSL.Lock_Task := Task_Lock'Access; SSL.Unlock_Task := Task_Unlock'Access; - SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access; - SSL.Set_Exc_Stack_Addr := Set_Exc_Stack_Addr'Access; SSL.Check_Abort_Status := Check_Abort_Status'Access; SSL.Get_Stack_Info := Get_Stack_Info'Access; SSL.Task_Name := Task_Name'Access; - SSL.Set_Exc_Stack_Addr (Null_Address, SSL.Get_Exc_Stack_Addr_NT); - -- Initialize the tasking soft links (if not done yet) that are common -- to the full and the restricted run times. @@ -757,16 +748,12 @@ package body System.Tasking.Initialization is end if; end Undefer_Abort_Nestable; - ---------------------- - -- Undefer_Abortion -- - ---------------------- - - -- Phase out RTS-internal use of Undefer_Abortion to reduce overhead due - -- to multiple calls to Self. + ------------------- + -- Abort_Undefer -- + ------------------- - procedure Undefer_Abortion is + procedure Abort_Undefer is Self_ID : Task_Id; - begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -800,7 +787,7 @@ package body System.Tasking.Initialization is Do_Pending_Action (Self_ID); end if; end if; - end Undefer_Abortion; + end Abort_Undefer; ---------------------- -- Update_Exception -- @@ -908,26 +895,11 @@ package body System.Tasking.Initialization is -- Soft-Link Bodies -- ---------------------- - function Get_Exc_Stack_Addr return Address is - begin - return STPO.Self.Common.Compiler_Data.Exc_Stack_Addr; - end Get_Exc_Stack_Addr; - function Get_Stack_Info return Stack_Checking.Stack_Access is begin return STPO.Self.Common.Compiler_Data.Pri_Stack_Info'Access; end Get_Stack_Info; - procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address) is - Me : Task_Id := To_Task_Id (Self_ID); - begin - if Me = Null_Task then - Me := STPO.Self; - end if; - - Me.Common.Compiler_Data.Exc_Stack_Addr := Addr; - end Set_Exc_Stack_Addr; - ----------------------- -- Soft-Link Dummies -- ----------------------- diff --git a/gcc/ada/s-tasini.ads b/gcc/ada/s-tasini.ads index c4928d8..bacde3c 100644 --- a/gcc/ada/s-tasini.ads +++ b/gcc/ada/s-tasini.ads @@ -120,14 +120,6 @@ package System.Tasking.Initialization is procedure Undefer_Abort_Nestable (Self_ID : Task_Id); pragma Inline (Undefer_Abort_Nestable); - -- NON-INLINE versions without Self_ID for code generated by the - -- expander and for soft links - - procedure Defer_Abortion; - procedure Undefer_Abortion; - - -- Try to phase out all uses of the above versions ??? - procedure Do_Pending_Action (Self_ID : Task_Id); -- Only call with no locks, and when Self_ID.Pending_Action = True Perform -- necessary pending actions (e.g. abort, priority change). This procedure diff --git a/gcc/ada/s-tataat.adb b/gcc/ada/s-tataat.adb index a147cd9..528de08 100644 --- a/gcc/ada/s-tataat.adb +++ b/gcc/ada/s-tataat.adb @@ -61,9 +61,10 @@ package body System.Tasking.Task_Attributes is procedure Finalize (X : in out Instance) is Q, To_Be_Freed : Access_Node; + Self_Id : constant Task_Id := Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); Lock_RTS; -- Remove this instantiation from the list of all instantiations. @@ -142,7 +143,7 @@ package body System.Tasking.Task_Attributes is X.Deallocate.all (Q); end loop; - Undefer_Abortion; + Undefer_Abort (Self_Id); exception when others => @@ -186,10 +187,11 @@ package body System.Tasking.Task_Attributes is -- This is to be called by System.Tasking.Stages.Create_Task procedure Initialize_Attributes (T : Task_Id) is - P : Access_Instance; + P : Access_Instance; + Self_Id : constant Task_Id := Self; begin - Defer_Abortion; + Defer_Abort (Self_Id); Lock_RTS; -- Initialize all the direct-access attributes of this task @@ -207,7 +209,7 @@ package body System.Tasking.Task_Attributes is end loop; Unlock_RTS; - Undefer_Abortion; + Undefer_Abort (Self_Id); exception when others => |