OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
Arnaud Charlet 2005-09-05 09:48:10 +02:00
parent 10b93b2ef0
commit 920c9376df
4 changed files with 59 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
gcc/ada/a-tasatt.adb
View File

@ -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;

68
gcc/ada/s-tasini.adb
View File

@ -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 --
----------------------
-------------------
-- 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;
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 --
-----------------------

8
gcc/ada/s-tasini.ads
View File

@ -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

12
gcc/ada/s-tataat.adb
View File

@ -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 =>