Commit 920c9376 by Arnaud Charlet

s-tataat.adb, [...]: Replace calls to Defer/Undefer_Abortion by Defer/Undefer_Abort.

	* s-tataat.adb, a-tasatt.adb:
	Replace calls to Defer/Undefer_Abortion by Defer/Undefer_Abort.

	* s-tasini.ads, s-tasini.adb (Defer_Abortion, Undefer_Abortion): Moved
	these procedures to body, and renamed Abort_Defer, Abort_Undefer.
	(Get_Exc_Stack_Addr, Set_Exc_Stack_Addr): Removed, no
	longer used.

From-SVN: r103851
parent 10b93b2e
...@@ -421,15 +421,16 @@ package body Ada.Task_Attributes is ...@@ -421,15 +421,16 @@ package body Ada.Task_Attributes is
declare declare
P : Access_Node := To_Access_Node (TT.Indirect_Attributes); P : Access_Node := To_Access_Node (TT.Indirect_Attributes);
W : Access_Wrapper; W : Access_Wrapper;
Self_Id : constant Task_Id := POP.Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
POP.Lock_RTS; POP.Lock_RTS;
while P /= null loop while P /= null loop
if P.Instance = Access_Instance'(Local'Unchecked_Access) then if P.Instance = Access_Instance'(Local'Unchecked_Access) then
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return To_Access_Wrapper (P.Wrapper).Value'Access; return To_Access_Wrapper (P.Wrapper).Value'Access;
end if; end if;
...@@ -450,13 +451,13 @@ package body Ada.Task_Attributes is ...@@ -450,13 +451,13 @@ package body Ada.Task_Attributes is
P.Next := To_Access_Node (TT.Indirect_Attributes); P.Next := To_Access_Node (TT.Indirect_Attributes);
TT.Indirect_Attributes := To_Access_Address (P); TT.Indirect_Attributes := To_Access_Address (P);
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return W.Value'Access; return W.Value'Access;
exception exception
when others => when others =>
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
raise; raise;
end; end;
end if; end if;
...@@ -498,8 +499,10 @@ package body Ada.Task_Attributes is ...@@ -498,8 +499,10 @@ package body Ada.Task_Attributes is
declare declare
P, Q : Access_Node; P, Q : Access_Node;
W : Access_Wrapper; W : Access_Wrapper;
Self_Id : constant Task_Id := POP.Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
POP.Lock_RTS; POP.Lock_RTS;
Q := To_Access_Node (TT.Indirect_Attributes); Q := To_Access_Node (TT.Indirect_Attributes);
...@@ -514,7 +517,7 @@ package body Ada.Task_Attributes is ...@@ -514,7 +517,7 @@ package body Ada.Task_Attributes is
W := To_Access_Wrapper (Q.Wrapper); W := To_Access_Wrapper (Q.Wrapper);
Free (W); Free (W);
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return; return;
end if; end if;
...@@ -523,12 +526,12 @@ package body Ada.Task_Attributes is ...@@ -523,12 +526,12 @@ package body Ada.Task_Attributes is
end loop; end loop;
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
exception exception
when others => when others =>
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
raise; raise;
end; end;
end if; end if;
...@@ -583,9 +586,10 @@ package body Ada.Task_Attributes is ...@@ -583,9 +586,10 @@ package body Ada.Task_Attributes is
declare declare
P : Access_Node := To_Access_Node (TT.Indirect_Attributes); P : Access_Node := To_Access_Node (TT.Indirect_Attributes);
W : Access_Wrapper; W : Access_Wrapper;
Self_Id : constant Task_Id := POP.Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
POP.Lock_RTS; POP.Lock_RTS;
while P /= null loop while P /= null loop
...@@ -593,7 +597,7 @@ package body Ada.Task_Attributes is ...@@ -593,7 +597,7 @@ package body Ada.Task_Attributes is
if P.Instance = Access_Instance'(Local'Unchecked_Access) then if P.Instance = Access_Instance'(Local'Unchecked_Access) then
To_Access_Wrapper (P.Wrapper).Value := Val; To_Access_Wrapper (P.Wrapper).Value := Val;
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return; return;
end if; end if;
...@@ -613,12 +617,12 @@ package body Ada.Task_Attributes is ...@@ -613,12 +617,12 @@ package body Ada.Task_Attributes is
TT.Indirect_Attributes := To_Access_Address (P); TT.Indirect_Attributes := To_Access_Address (P);
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
exception exception
when others => when others =>
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
raise; raise;
end; end;
...@@ -671,9 +675,10 @@ package body Ada.Task_Attributes is ...@@ -671,9 +675,10 @@ package body Ada.Task_Attributes is
declare declare
P : Access_Node; P : Access_Node;
Result : Attribute; Result : Attribute;
Self_Id : constant Task_Id := POP.Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
POP.Lock_RTS; POP.Lock_RTS;
P := To_Access_Node (TT.Indirect_Attributes); P := To_Access_Node (TT.Indirect_Attributes);
...@@ -681,7 +686,7 @@ package body Ada.Task_Attributes is ...@@ -681,7 +686,7 @@ package body Ada.Task_Attributes is
if P.Instance = Access_Instance'(Local'Unchecked_Access) then if P.Instance = Access_Instance'(Local'Unchecked_Access) then
Result := To_Access_Wrapper (P.Wrapper).Value; Result := To_Access_Wrapper (P.Wrapper).Value;
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return Result; return Result;
end if; end if;
...@@ -689,13 +694,13 @@ package body Ada.Task_Attributes is ...@@ -689,13 +694,13 @@ package body Ada.Task_Attributes is
end loop; end loop;
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
return Initial_Value; return Initial_Value;
exception exception
when others => when others =>
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
raise; raise;
end; end;
...@@ -720,8 +725,9 @@ begin ...@@ -720,8 +725,9 @@ begin
declare declare
Two_To_J : Direct_Index_Vector; Two_To_J : Direct_Index_Vector;
Self_Id : constant Task_Id := POP.Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
-- Need protection for updating links to per-task initialization and -- Need protection for updating links to per-task initialization and
-- finalization routines, in case some task is being created or -- finalization routines, in case some task is being created or
...@@ -798,6 +804,6 @@ begin ...@@ -798,6 +804,6 @@ begin
end if; end if;
POP.Unlock_RTS; POP.Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
end; end;
end Ada.Task_Attributes; end Ada.Task_Attributes;
...@@ -43,10 +43,6 @@ pragma Polling (Off); ...@@ -43,10 +43,6 @@ pragma Polling (Off);
with Ada.Exceptions; with Ada.Exceptions;
-- Used for Exception_Occurrence_Access -- 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; with System.Task_Primitives;
-- Used for Lock -- Used for Lock
...@@ -94,6 +90,12 @@ package body System.Tasking.Initialization is ...@@ -94,6 +90,12 @@ package body System.Tasking.Initialization is
-- Tasking versions of some services needed by non-tasking programs -- -- 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; procedure Task_Lock;
-- Locks out other tasks. Preceding a section of code by Task_Lock and -- 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 -- following it by Task_Unlock creates a critical region. This is used
...@@ -107,13 +109,6 @@ package body System.Tasking.Initialization is ...@@ -107,13 +109,6 @@ package body System.Tasking.Initialization is
-- all nested locks must be released before other tasks competing for the -- all nested locks must be released before other tasks competing for the
-- tasking lock are released. -- 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; function Get_Stack_Info return Stack_Checking.Stack_Access;
-- Get access to the current task's Stack_Info -- Get access to the current task's Stack_Info
...@@ -237,13 +232,12 @@ package body System.Tasking.Initialization is ...@@ -237,13 +232,12 @@ package body System.Tasking.Initialization is
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1; Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
end Defer_Abort_Nestable; end Defer_Abort_Nestable;
-------------------- -----------------
-- Defer_Abortion -- -- Abort_Defer --
-------------------- -----------------
procedure Defer_Abortion is procedure Abort_Defer is
Self_ID : Task_Id; Self_ID : Task_Id;
begin begin
if No_Abort and then not Dynamic_Priority_Support then if No_Abort and then not Dynamic_Priority_Support then
return; return;
...@@ -251,7 +245,7 @@ package body System.Tasking.Initialization is ...@@ -251,7 +245,7 @@ package body System.Tasking.Initialization is
Self_ID := STPO.Self; Self_ID := STPO.Self;
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1; Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
end Defer_Abortion; end Abort_Defer;
----------------------- -----------------------
-- Do_Pending_Action -- -- Do_Pending_Action --
...@@ -346,8 +340,9 @@ package body System.Tasking.Initialization is ...@@ -346,8 +340,9 @@ package body System.Tasking.Initialization is
procedure Init_RTS is procedure Init_RTS is
Self_Id : Task_Id; Self_Id : Task_Id;
begin begin
Tasking.Initialize;
-- Terminate run time (regular vs restricted) specific initialization -- Terminate run time (regular vs restricted) specific initialization
-- of the environment task. -- of the environment task.
...@@ -381,21 +376,17 @@ package body System.Tasking.Initialization is ...@@ -381,21 +376,17 @@ package body System.Tasking.Initialization is
-- the tasking version of the soft links can be used. -- the tasking version of the soft links can be used.
if not No_Abort or else Dynamic_Priority_Support then if not No_Abort or else Dynamic_Priority_Support then
SSL.Abort_Defer := Defer_Abortion'Access; SSL.Abort_Defer := Abort_Defer'Access;
SSL.Abort_Undefer := Undefer_Abortion'Access; SSL.Abort_Undefer := Abort_Undefer'Access;
end if; end if;
SSL.Update_Exception := Update_Exception'Access; SSL.Update_Exception := Update_Exception'Access;
SSL.Lock_Task := Task_Lock'Access; SSL.Lock_Task := Task_Lock'Access;
SSL.Unlock_Task := Task_Unlock'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.Check_Abort_Status := Check_Abort_Status'Access;
SSL.Get_Stack_Info := Get_Stack_Info'Access; SSL.Get_Stack_Info := Get_Stack_Info'Access;
SSL.Task_Name := Task_Name'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 -- Initialize the tasking soft links (if not done yet) that are common
-- to the full and the restricted run times. -- to the full and the restricted run times.
...@@ -757,16 +748,12 @@ package body System.Tasking.Initialization is ...@@ -757,16 +748,12 @@ package body System.Tasking.Initialization is
end if; end if;
end Undefer_Abort_Nestable; end Undefer_Abort_Nestable;
---------------------- -------------------
-- Undefer_Abortion -- -- Abort_Undefer --
---------------------- -------------------
-- Phase out RTS-internal use of Undefer_Abortion to reduce overhead due
-- to multiple calls to Self.
procedure Undefer_Abortion is procedure Abort_Undefer is
Self_ID : Task_Id; Self_ID : Task_Id;
begin begin
if No_Abort and then not Dynamic_Priority_Support then if No_Abort and then not Dynamic_Priority_Support then
return; return;
...@@ -800,7 +787,7 @@ package body System.Tasking.Initialization is ...@@ -800,7 +787,7 @@ package body System.Tasking.Initialization is
Do_Pending_Action (Self_ID); Do_Pending_Action (Self_ID);
end if; end if;
end if; end if;
end Undefer_Abortion; end Abort_Undefer;
---------------------- ----------------------
-- Update_Exception -- -- Update_Exception --
...@@ -908,26 +895,11 @@ package body System.Tasking.Initialization is ...@@ -908,26 +895,11 @@ package body System.Tasking.Initialization is
-- Soft-Link Bodies -- -- 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 function Get_Stack_Info return Stack_Checking.Stack_Access is
begin begin
return STPO.Self.Common.Compiler_Data.Pri_Stack_Info'Access; return STPO.Self.Common.Compiler_Data.Pri_Stack_Info'Access;
end Get_Stack_Info; 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 -- -- Soft-Link Dummies --
----------------------- -----------------------
......
...@@ -120,14 +120,6 @@ package System.Tasking.Initialization is ...@@ -120,14 +120,6 @@ package System.Tasking.Initialization is
procedure Undefer_Abort_Nestable (Self_ID : Task_Id); procedure Undefer_Abort_Nestable (Self_ID : Task_Id);
pragma Inline (Undefer_Abort_Nestable); 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); procedure Do_Pending_Action (Self_ID : Task_Id);
-- Only call with no locks, and when Self_ID.Pending_Action = True Perform -- Only call with no locks, and when Self_ID.Pending_Action = True Perform
-- necessary pending actions (e.g. abort, priority change). This procedure -- necessary pending actions (e.g. abort, priority change). This procedure
......
...@@ -61,9 +61,10 @@ package body System.Tasking.Task_Attributes is ...@@ -61,9 +61,10 @@ package body System.Tasking.Task_Attributes is
procedure Finalize (X : in out Instance) is procedure Finalize (X : in out Instance) is
Q, To_Be_Freed : Access_Node; Q, To_Be_Freed : Access_Node;
Self_Id : constant Task_Id := Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
Lock_RTS; Lock_RTS;
-- Remove this instantiation from the list of all instantiations. -- Remove this instantiation from the list of all instantiations.
...@@ -142,7 +143,7 @@ package body System.Tasking.Task_Attributes is ...@@ -142,7 +143,7 @@ package body System.Tasking.Task_Attributes is
X.Deallocate.all (Q); X.Deallocate.all (Q);
end loop; end loop;
Undefer_Abortion; Undefer_Abort (Self_Id);
exception exception
when others => when others =>
...@@ -187,9 +188,10 @@ package body System.Tasking.Task_Attributes is ...@@ -187,9 +188,10 @@ package body System.Tasking.Task_Attributes is
procedure Initialize_Attributes (T : Task_Id) is procedure Initialize_Attributes (T : Task_Id) is
P : Access_Instance; P : Access_Instance;
Self_Id : constant Task_Id := Self;
begin begin
Defer_Abortion; Defer_Abort (Self_Id);
Lock_RTS; Lock_RTS;
-- Initialize all the direct-access attributes of this task -- Initialize all the direct-access attributes of this task
...@@ -207,7 +209,7 @@ package body System.Tasking.Task_Attributes is ...@@ -207,7 +209,7 @@ package body System.Tasking.Task_Attributes is
end loop; end loop;
Unlock_RTS; Unlock_RTS;
Undefer_Abortion; Undefer_Abort (Self_Id);
exception exception
when others => when others =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment