aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2005-09-05 09:48:10 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2005-09-05 09:48:10 +0200
commit920c9376df4cbfabe61991fe2d8857cb6be0bc19 (patch)
treef7462b20707db57d024d78ae3b2dcb8b3cdeb188 /gcc/ada
parent10b93b2ef042757e76a53294442789b22c39599e (diff)
downloadgcc-920c9376df4cbfabe61991fe2d8857cb6be0bc19.zip
gcc-920c9376df4cbfabe61991fe2d8857cb6be0bc19.tar.gz
gcc-920c9376df4cbfabe61991fe2d8857cb6be0bc19.tar.bz2
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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/a-tasatt.adb58
-rw-r--r--gcc/ada/s-tasini.adb68
-rw-r--r--gcc/ada/s-tasini.ads8
-rw-r--r--gcc/ada/s-tataat.adb12
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 =>