public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Remove System.Parameters.Single_Lock
@ 2020-06-10 3:33 Jiu Fu Guo
0 siblings, 0 replies; only message in thread
From: Jiu Fu Guo @ 2020-06-10 3:33 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:b68c1670b7d40b09be2995e1e730ce4c87eb688c
commit b68c1670b7d40b09be2995e1e730ce4c87eb688c
Author: Arnaud Charlet <charlet@adacore.com>
Date: Tue Jan 21 06:44:25 2020 -0500
[Ada] Remove System.Parameters.Single_Lock
2020-06-04 Arnaud Charlet <charlet@adacore.com>
gcc/ada/
* libgnarl/a-dynpri.adb, libgnarl/a-taside.adb,
libgnarl/a-taster.adb, libgnarl/s-interr.adb,
libgnarl/s-interr__sigaction.adb, libgnarl/s-taasde.adb,
libgnarl/s-taenca.adb, libgnarl/s-taenca.ads,
libgnarl/s-taprop.ads, libgnarl/s-taprop__hpux-dce.adb,
libgnarl/s-taprop__linux.adb, libgnarl/s-taprop__mingw.adb,
libgnarl/s-taprop__posix.adb, libgnarl/s-taprop__qnx.adb,
libgnarl/s-taprop__solaris.adb, libgnarl/s-taprop__vxworks.adb,
libgnarl/s-tarest.adb, libgnarl/s-tasini.adb,
libgnarl/s-tasque.adb, libgnarl/s-tasque.ads,
libgnarl/s-tasren.adb, libgnarl/s-tasren.ads,
libgnarl/s-tassta.adb, libgnarl/s-tasuti.adb,
libgnarl/s-tasuti.ads, libgnarl/s-tpoben.adb,
libgnarl/s-tpobop.adb, libgnarl/s-tpopmo.adb,
libgnarl/s-tposen.adb, libgnat/s-parame.ads,
libgnat/s-parame__ae653.ads, libgnat/s-parame__hpux.ads,
libgnat/s-parame__vxworks.ads: Remove references to Single_Lock
and Global_Lock.
Diff:
---
gcc/ada/libgnarl/a-dynpri.adb | 10 --
gcc/ada/libgnarl/a-taside.adb | 26 +---
gcc/ada/libgnarl/a-taster.adb | 33 ------
gcc/ada/libgnarl/s-interr.adb | 41 -------
gcc/ada/libgnarl/s-interr__sigaction.adb | 12 --
gcc/ada/libgnarl/s-taasde.adb | 31 -----
gcc/ada/libgnarl/s-taenca.adb | 82 +------------
gcc/ada/libgnarl/s-taenca.ads | 3 +-
gcc/ada/libgnarl/s-taprop.ads | 25 +---
gcc/ada/libgnarl/s-taprop__hpux-dce.adb | 103 ++++++----------
gcc/ada/libgnarl/s-taprop__linux.adb | 66 ++++-------
gcc/ada/libgnarl/s-taprop__mingw.adb | 97 ++++-----------
gcc/ada/libgnarl/s-taprop__posix.adb | 120 ++++++++-----------
gcc/ada/libgnarl/s-taprop__qnx.adb | 70 ++++-------
gcc/ada/libgnarl/s-taprop__solaris.adb | 153 +++++++-----------------
gcc/ada/libgnarl/s-taprop__vxworks.adb | 109 +++++------------
gcc/ada/libgnarl/s-tarest.adb | 50 +-------
gcc/ada/libgnarl/s-tasini.adb | 15 +--
gcc/ada/libgnarl/s-tasque.adb | 13 +-
gcc/ada/libgnarl/s-tasque.ads | 5 +-
gcc/ada/libgnarl/s-tasren.adb | 197 ++-----------------------------
gcc/ada/libgnarl/s-tasren.ads | 3 +-
gcc/ada/libgnarl/s-tassta.adb | 130 +++-----------------
gcc/ada/libgnarl/s-tasuti.adb | 14 +--
gcc/ada/libgnarl/s-tasuti.ads | 5 +-
gcc/ada/libgnarl/s-tpoben.adb | 21 ----
gcc/ada/libgnarl/s-tpobop.adb | 119 ++-----------------
gcc/ada/libgnarl/s-tpopmo.adb | 17 +--
gcc/ada/libgnarl/s-tposen.adb | 36 ------
gcc/ada/libgnat/s-parame.ads | 13 --
gcc/ada/libgnat/s-parame__ae653.ads | 13 --
gcc/ada/libgnat/s-parame__hpux.ads | 13 --
gcc/ada/libgnat/s-parame__vxworks.ads | 13 --
33 files changed, 283 insertions(+), 1375 deletions(-)
diff --git a/gcc/ada/libgnarl/a-dynpri.adb b/gcc/ada/libgnarl/a-dynpri.adb
index efee64e93e5..a7e11f3db91 100644
--- a/gcc/ada/libgnarl/a-dynpri.adb
+++ b/gcc/ada/libgnarl/a-dynpri.adb
@@ -31,7 +31,6 @@
with System.Task_Primitives.Operations;
with System.Tasking;
-with System.Parameters;
with System.Soft_Links;
with Ada.Unchecked_Conversion;
@@ -41,7 +40,6 @@ package body Ada.Dynamic_Priorities is
package STPO renames System.Task_Primitives.Operations;
package SSL renames System.Soft_Links;
- use System.Parameters;
use System.Tasking;
function Convert_Ids is new
@@ -103,10 +101,6 @@ package body Ada.Dynamic_Priorities is
SSL.Abort_Defer.all;
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Target);
Target.Common.Base_Priority := Priority;
@@ -141,10 +135,6 @@ package body Ada.Dynamic_Priorities is
STPO.Unlock (Target);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
if STPO.Self = Target and then Yield_Needed then
-- Yield is needed to enforce FIFO task dispatching
diff --git a/gcc/ada/libgnarl/a-taside.adb b/gcc/ada/libgnarl/a-taside.adb
index 5284f2ac118..9df547f8dff 100644
--- a/gcc/ada/libgnarl/a-taside.adb
+++ b/gcc/ada/libgnarl/a-taside.adb
@@ -30,7 +30,6 @@
------------------------------------------------------------------------------
with System.Address_Image;
-with System.Parameters;
with System.Soft_Links;
with System.Task_Primitives;
with System.Task_Primitives.Operations;
@@ -48,9 +47,6 @@ pragma Warnings (On);
package body Ada.Task_Identification with
SPARK_Mode => Off
is
-
- use System.Parameters;
-
package STPO renames System.Task_Primitives.Operations;
-----------------------
@@ -165,20 +161,11 @@ is
raise Program_Error;
else
System.Soft_Links.Abort_Defer.all;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Id);
Result := Id.Callable;
STPO.Unlock (Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
System.Soft_Links.Abort_Undefer.all;
+
return Result;
end if;
end Is_Callable;
@@ -198,20 +185,11 @@ is
raise Program_Error;
else
System.Soft_Links.Abort_Defer.all;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Id);
Result := Id.Common.State = Terminated;
STPO.Unlock (Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
System.Soft_Links.Abort_Undefer.all;
+
return Result;
end if;
end Is_Terminated;
diff --git a/gcc/ada/libgnarl/a-taster.adb b/gcc/ada/libgnarl/a-taster.adb
index 1ccbdac8dfd..fdf4811a09d 100644
--- a/gcc/ada/libgnarl/a-taster.adb
+++ b/gcc/ada/libgnarl/a-taster.adb
@@ -31,7 +31,6 @@
with System.Tasking;
with System.Task_Primitives.Operations;
-with System.Parameters;
with System.Soft_Links;
with Ada.Unchecked_Conversion;
@@ -43,8 +42,6 @@ package body Ada.Task_Termination is
package STPO renames System.Task_Primitives.Operations;
package SSL renames System.Soft_Links;
- use System.Parameters;
-
-----------------------
-- Local subprograms --
-----------------------
@@ -82,21 +79,11 @@ package body Ada.Task_Termination is
begin
SSL.Abort_Defer.all;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Self);
Self.Common.Fall_Back_Handler := To_ST (Handler);
STPO.Unlock (Self);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
SSL.Abort_Undefer.all;
end Set_Dependents_Fallback_Handler;
@@ -123,21 +110,11 @@ package body Ada.Task_Termination is
begin
SSL.Abort_Defer.all;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Target);
Target.Common.Specific_Handler := To_ST (Handler);
STPO.Unlock (Target);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
SSL.Abort_Undefer.all;
end;
end if;
@@ -166,21 +143,11 @@ package body Ada.Task_Termination is
begin
SSL.Abort_Defer.all;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Target);
TH := To_TT (Target.Common.Specific_Handler);
STPO.Unlock (Target);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
SSL.Abort_Undefer.all;
return TH;
diff --git a/gcc/ada/libgnarl/s-interr.adb b/gcc/ada/libgnarl/s-interr.adb
index e8caeac890c..c386c4742a2 100644
--- a/gcc/ada/libgnarl/s-interr.adb
+++ b/gcc/ada/libgnarl/s-interr.adb
@@ -1288,11 +1288,6 @@ package body System.Interrupts is
loop
System.Tasking.Initialization.Defer_Abort (Self_ID);
-
- if Single_Lock then
- POP.Lock_RTS;
- end if;
-
POP.Write_Lock (Self_ID);
if User_Handler (Interrupt).H = null
@@ -1327,10 +1322,6 @@ package body System.Interrupts is
Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
POP.Unlock (Self_ID);
- if Single_Lock then
- POP.Unlock_RTS;
- end if;
-
-- Avoid race condition when terminating application and
-- System.Parameters.No_Abort is True.
@@ -1347,18 +1338,9 @@ package body System.Interrupts is
-- Inform the Interrupt_Manager of wakeup from above sigwait
POP.Abort_Task (Interrupt_Manager_ID);
-
- if Single_Lock then
- POP.Lock_RTS;
- end if;
-
POP.Write_Lock (Self_ID);
else
- if Single_Lock then
- POP.Lock_RTS;
- end if;
-
POP.Write_Lock (Self_ID);
if Ret_Interrupt /= Interrupt then
@@ -1383,17 +1365,7 @@ package body System.Interrupts is
-- RTS calls should not be made with self being locked
POP.Unlock (Self_ID);
-
- if Single_Lock then
- POP.Unlock_RTS;
- end if;
-
Tmp_Handler.all;
-
- if Single_Lock then
- POP.Lock_RTS;
- end if;
-
POP.Write_Lock (Self_ID);
elsif User_Entry (Interrupt).T /= Null_Task then
@@ -1402,10 +1374,6 @@ package body System.Interrupts is
-- RTS calls should not be made with self being locked
- if Single_Lock then
- POP.Unlock_RTS;
- end if;
-
POP.Unlock (Self_ID);
System.Tasking.Rendezvous.Call_Simple
@@ -1413,10 +1381,6 @@ package body System.Interrupts is
POP.Write_Lock (Self_ID);
- if Single_Lock then
- POP.Lock_RTS;
- end if;
-
else
-- This is a situation that this task wakes up receiving
-- an Interrupt and before it gets the lock the Interrupt
@@ -1432,11 +1396,6 @@ package body System.Interrupts is
end if;
POP.Unlock (Self_ID);
-
- if Single_Lock then
- POP.Unlock_RTS;
- end if;
-
System.Tasking.Initialization.Undefer_Abort (Self_ID);
if Self_ID.Pending_Action then
diff --git a/gcc/ada/libgnarl/s-interr__sigaction.adb b/gcc/ada/libgnarl/s-interr__sigaction.adb
index e770a019407..83bd36c2efa 100644
--- a/gcc/ada/libgnarl/s-interr__sigaction.adb
+++ b/gcc/ada/libgnarl/s-interr__sigaction.adb
@@ -42,11 +42,9 @@ with System.Tasking.Utilities;
with System.Tasking.Rendezvous;
with System.Tasking.Initialization;
with System.Interrupt_Management;
-with System.Parameters;
package body System.Interrupts is
- use Parameters;
use Tasking;
use System.OS_Interface;
use Interfaces.C;
@@ -644,21 +642,11 @@ package body System.Interrupts is
end loop;
Initialization.Defer_Abort (Self_Id);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
Self_Id.Common.State := Interrupt_Server_Idle_Sleep;
STPO.Sleep (Self_Id, Interrupt_Server_Idle_Sleep);
Self_Id.Common.State := Runnable;
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
-- Undefer abort here to allow a window for this task to be aborted
diff --git a/gcc/ada/libgnarl/s-taasde.adb b/gcc/ada/libgnarl/s-taasde.adb
index c18c65118c8..dc7dac16cca 100644
--- a/gcc/ada/libgnarl/s-taasde.adb
+++ b/gcc/ada/libgnarl/s-taasde.adb
@@ -51,8 +51,6 @@ package body System.Tasking.Async_Delays is
package STI renames System.Tasking.Initialization;
package OSP renames System.OS_Primitives;
- use Parameters;
-
function To_System is new Ada.Unchecked_Conversion
(Ada.Task_Identification.Task_Id, Task_Id);
@@ -118,11 +116,6 @@ package body System.Tasking.Async_Delays is
-- Remove self from timer queue
STI.Defer_Abort_Nestable (D.Self_Id);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Timer_Server_ID);
Dpred := D.Pred;
Dsucc := D.Succ;
@@ -141,11 +134,6 @@ package body System.Tasking.Async_Delays is
STPO.Write_Lock (D.Self_Id);
STU.Exit_One_ATC_Level (D.Self_Id);
STPO.Unlock (D.Self_Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
STI.Undefer_Abort_Nestable (D.Self_Id);
end Cancel_Async_Delay;
@@ -217,11 +205,6 @@ package body System.Tasking.Async_Delays is
D.Level := Self_Id.ATC_Nesting_Level;
D.Self_Id := Self_Id;
D.Resume_Time := T;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Timer_Server_ID);
-- Previously, there was code here to dynamically create
@@ -258,10 +241,6 @@ package body System.Tasking.Async_Delays is
end if;
STPO.Unlock (Timer_Server_ID);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end Time_Enqueue;
---------------
@@ -305,11 +284,6 @@ package body System.Tasking.Async_Delays is
loop
STI.Defer_Abort (Timer_Server_ID);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Timer_Server_ID);
-- The timer server needs to catch pending aborts after finalization
@@ -383,11 +357,6 @@ package body System.Tasking.Async_Delays is
-- an actual delay in this server.
STPO.Unlock (Timer_Server_ID);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
STI.Undefer_Abort (Timer_Server_ID);
end loop;
end Timer_Server;
diff --git a/gcc/ada/libgnarl/s-taenca.adb b/gcc/ada/libgnarl/s-taenca.adb
index 84552a939d9..49c4c3026f7 100644
--- a/gcc/ada/libgnarl/s-taenca.adb
+++ b/gcc/ada/libgnarl/s-taenca.adb
@@ -35,13 +35,11 @@ with System.Tasking.Protected_Objects.Entries;
with System.Tasking.Protected_Objects.Operations;
with System.Tasking.Queuing;
with System.Tasking.Utilities;
-with System.Parameters;
package body System.Tasking.Entry_Calls is
package STPO renames System.Task_Primitives.Operations;
- use Parameters;
use Protected_Objects.Entries;
use Protected_Objects.Operations;
@@ -71,24 +69,18 @@ package body System.Tasking.Entry_Calls is
-- permitted. Since the server cannot be obtained reliably, it must be
-- obtained unreliably and then checked again once it has been locked.
--
- -- If Single_Lock and server is a PO, release RTS_Lock
- --
-- This should only be called by the Entry_Call.Self.
-- It should be holding no other ATCB locks at the time.
procedure Unlock_Server (Entry_Call : Entry_Call_Link);
-- STPO.Unlock the server targeted by Entry_Call. The server must
-- be locked before calling this.
- --
- -- If Single_Lock and server is a PO, take RTS_Lock on exit.
procedure Unlock_And_Update_Server
(Self_ID : Task_Id;
Entry_Call : Entry_Call_Link);
-- Similar to Unlock_Server, but services entry calls if the
-- server is a protected object.
- --
- -- If Single_Lock and server is a PO, take RTS_Lock on exit.
procedure Check_Pending_Actions_For_Entry_Call
(Self_ID : Task_Id;
@@ -200,19 +192,9 @@ package body System.Tasking.Entry_Calls is
-- We had very bad luck, interleaving with TWO different
-- requeue operations. Go around the loop and try again.
- if Single_Lock then
- STPO.Unlock_RTS;
- STPO.Yield;
- STPO.Lock_RTS;
- else
- STPO.Yield;
- end if;
+ STPO.Yield;
else
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
Lock_Entries_With_Status (Test_PO, Ceiling_Violation);
-- ???
@@ -232,10 +214,6 @@ package body System.Tasking.Entry_Calls is
Old_Base_Priority : System.Any_Priority;
begin
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Current_Task);
Old_Base_Priority := Current_Task.Common.Base_Priority;
Current_Task.New_Base_Priority := Test_PO.Ceiling;
@@ -243,10 +221,6 @@ package body System.Tasking.Entry_Calls is
(Current_Task);
STPO.Unlock (Current_Task);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
-- Following lock should not fail
Lock_Entries (Test_PO);
@@ -258,10 +232,6 @@ package body System.Tasking.Entry_Calls is
exit when To_Address (Test_PO) = Entry_Call.Called_PO;
Unlock_Entries (Test_PO);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
end if;
else
@@ -343,11 +313,6 @@ package body System.Tasking.Entry_Calls is
pragma Assert (Entry_Call.Mode = Asynchronous_Call);
Initialization.Defer_Abort_Nestable (Self_ID);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_ID);
Entry_Call.Cancellation_Attempted := True;
@@ -357,13 +322,7 @@ package body System.Tasking.Entry_Calls is
Entry_Calls.Wait_For_Completion (Entry_Call);
STPO.Unlock (Self_ID);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
Succeeded := Entry_Call.State = Cancelled;
-
Initialization.Undefer_Abort_Nestable (Self_ID);
-- Ideally, abort should no longer be deferred at this point, so we
@@ -401,26 +360,13 @@ package body System.Tasking.Entry_Calls is
if Called_PO.Pending_Action then
Called_PO.Pending_Action := False;
Caller := STPO.Self;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
Initialization.Change_Base_Priority (Caller);
STPO.Unlock (Caller);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end if;
Unlock_Entries (Called_PO);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
end if;
end Unlock_And_Update_Server;
@@ -441,26 +387,13 @@ package body System.Tasking.Entry_Calls is
if Called_PO.Pending_Action then
Called_PO.Pending_Action := False;
Caller := STPO.Self;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
Initialization.Change_Base_Priority (Caller);
STPO.Unlock (Caller);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end if;
Unlock_Entries (Called_PO);
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
end if;
end Unlock_Server;
@@ -481,21 +414,13 @@ package body System.Tasking.Entry_Calls is
-- a chance of getting ready immediately, using Unlock & Yield.
-- See similar action in Wait_For_Call & Timed_Selective_Wait.
- if Single_Lock then
- STPO.Unlock_RTS;
- else
- STPO.Unlock (Self_Id);
- end if;
+ STPO.Unlock (Self_Id);
if Entry_Call.State < Done then
STPO.Yield;
end if;
- if Single_Lock then
- STPO.Lock_RTS;
- else
- STPO.Write_Lock (Self_Id);
- end if;
+ STPO.Write_Lock (Self_Id);
loop
Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
@@ -507,7 +432,6 @@ package body System.Tasking.Entry_Calls is
Self_Id.Common.State := Runnable;
Utilities.Exit_One_ATC_Level (Self_Id);
-
end Wait_For_Completion;
--------------------------------------
diff --git a/gcc/ada/libgnarl/s-taenca.ads b/gcc/ada/libgnarl/s-taenca.ads
index 96ab07fc128..2b013eb5ba7 100644
--- a/gcc/ada/libgnarl/s-taenca.ads
+++ b/gcc/ada/libgnarl/s-taenca.ads
@@ -61,8 +61,7 @@ package System.Tasking.Entry_Calls is
Call : Entry_Call_Link);
-- This procedure suspends the calling task until the specified entry
-- call is queued abortably or completes.
- -- Abortion must be deferred when calling this procedure, and the global
- -- RTS lock taken when Single_Lock.
+ -- Abortion must be deferred when calling this procedure.
procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean);
pragma Inline (Try_To_Cancel_Entry_Call);
diff --git a/gcc/ada/libgnarl/s-taprop.ads b/gcc/ada/libgnarl/s-taprop.ads
index a01cf88a9c3..32faac57485 100644
--- a/gcc/ada/libgnarl/s-taprop.ads
+++ b/gcc/ada/libgnarl/s-taprop.ads
@@ -181,11 +181,8 @@ package System.Task_Primitives.Operations is
procedure Write_Lock
(L : not null access Lock;
Ceiling_Violation : out Boolean);
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False);
- procedure Write_Lock
- (T : ST.Task_Id);
+ procedure Write_Lock (L : not null access RTS_Lock);
+ procedure Write_Lock (T : ST.Task_Id);
pragma Inline (Write_Lock);
-- Lock a lock object for write access. After this operation returns,
-- the calling task holds write permission for the lock object. No other
@@ -198,9 +195,6 @@ package System.Task_Primitives.Operations is
-- operation failed, which will happen if there is a priority ceiling
-- violation.
--
- -- For the operation on RTS_Lock, Global_Lock should be set to True
- -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
- --
-- For the operation on ST.Task_Id, the lock is the special lock object
-- associated with that task's ATCB. This lock has effective ceiling
-- priority high enough that it is safe to call by a task with any
@@ -235,11 +229,8 @@ package System.Task_Primitives.Operations is
procedure Unlock
(L : not null access Lock);
- procedure Unlock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False);
- procedure Unlock
- (T : ST.Task_Id);
+ procedure Unlock (L : not null access RTS_Lock);
+ procedure Unlock (T : ST.Task_Id);
pragma Inline (Unlock);
-- Unlock a locked lock object
--
@@ -249,9 +240,6 @@ package System.Task_Primitives.Operations is
-- read or write permission. (That is, matching pairs of Lock and Unlock
-- operations on each lock object must be properly nested.)
- -- For the operation on RTS_Lock, Global_Lock should be set to True if L
- -- is a global lock (Single_RTS_Lock, Global_Task_Lock).
- --
-- Note that Write_Lock for RTS_Lock does not have an out-parameter.
-- RTS_Locks are used in situations where we have not made provision for
-- recovery from ceiling violations. We do not expect them to occur inside
@@ -424,10 +412,7 @@ package System.Task_Primitives.Operations is
-- Following two routines are used for possible operations needed to be
-- setup/cleared upon entrance/exit of RTS while maintaining a single
- -- thread of control in the RTS. Since we intend these routines to be used
- -- for implementing the Single_Lock RTS, Lock_RTS should follow the first
- -- Defer_Abort operation entering RTS. In the same fashion Unlock_RTS
- -- should precede the last Undefer_Abort exiting RTS.
+ -- thread of control in the RTS.
--
-- These routines also replace the functions Lock/Unlock_All_Tasks_List
diff --git a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
index a441cd08c6a..99049f11b37 100644
--- a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
+++ b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
@@ -83,7 +83,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task
@@ -325,25 +325,18 @@ package body System.Task_Primitives.Operations is
Ceiling_Violation := False;
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_lock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (L);
+ pragma Assert (Result = 0);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_lock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Write_Lock;
---------------
@@ -369,25 +362,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_unlock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (L);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_unlock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -421,9 +407,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access));
+ mutex => Self_ID.Common.LL.L'Access);
-- EINTR is not considered a failure
@@ -467,9 +451,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
+ mutex => Self_ID.Common.LL.L'Access,
abstime => Request'Access);
exit when Abs_Time <= Monotonic_Clock;
@@ -504,10 +486,6 @@ package body System.Task_Primitives.Operations is
pragma Warnings (Off, Result);
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
Abs_Time :=
@@ -525,9 +503,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
+ mutex => Self_ID.Common.LL.L'Access,
abstime => Request'Access);
exit when Abs_Time <= Monotonic_Clock;
@@ -541,11 +517,6 @@ package body System.Task_Primitives.Operations is
end if;
Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Result := sched_yield;
end Timed_Delay;
@@ -733,26 +704,24 @@ package body System.Task_Primitives.Operations is
Cond_Attr : aliased pthread_condattr_t;
begin
- if not Single_Lock then
- Result := pthread_mutexattr_init (Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = 0 then
- Result :=
- pthread_mutex_init
- (Self_ID.Common.LL.L'Access, Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
- end if;
+ Result := pthread_mutexattr_init (Mutex_Attr'Access);
+ pragma Assert (Result = 0 or else Result = ENOMEM);
- if Result /= 0 then
- Succeeded := False;
- return;
- end if;
+ if Result = 0 then
+ Result :=
+ pthread_mutex_init
+ (Self_ID.Common.LL.L'Access, Mutex_Attr'Access);
+ pragma Assert (Result = 0 or else Result = ENOMEM);
+ end if;
- Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
- pragma Assert (Result = 0);
+ if Result /= 0 then
+ Succeeded := False;
+ return;
end if;
+ Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+ pragma Assert (Result = 0);
+
Result := pthread_condattr_init (Cond_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -767,10 +736,8 @@ package body System.Task_Primitives.Operations is
if Result = 0 then
Succeeded := True;
else
- if not Single_Lock then
- Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Succeeded := False;
end if;
@@ -841,10 +808,8 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_destroy (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Result := pthread_cond_destroy (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
@@ -1093,7 +1058,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1102,7 +1067,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
------------------
diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
index 2c0d21f68ac..03f5a7ba4cf 100644
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -75,7 +75,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task
@@ -304,7 +304,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -313,7 +313,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
-----------------
@@ -484,25 +484,18 @@ package body System.Task_Primitives.Operations is
Ceiling_Violation := Result = EINVAL;
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_lock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (L);
+ pragma Assert (Result = 0);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_lock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Write_Lock;
---------------
@@ -542,25 +535,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_unlock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (L);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_unlock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -596,9 +582,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access));
+ mutex => Self_ID.Common.LL.L'Access);
-- EINTR is not considered a failure
@@ -860,13 +844,9 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := Null_Thread_Id;
- if not Single_Lock then
- if Init_Mutex
- (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0
- then
- Succeeded := False;
- return;
- end if;
+ if Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0 then
+ Succeeded := False;
+ return;
end if;
Result := pthread_condattr_init (Cond_Attr'Access);
@@ -885,10 +865,8 @@ package body System.Task_Primitives.Operations is
if Result = 0 then
Succeeded := True;
else
- if not Single_Lock then
- Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Succeeded := False;
end if;
@@ -1070,10 +1048,8 @@ package body System.Task_Primitives.Operations is
Result : C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_destroy (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Result := pthread_cond_destroy (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index 9e7652ceefc..8fa5435a600 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -111,7 +111,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Time_Slice_Val : Integer;
pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
@@ -290,7 +290,7 @@ package body System.Task_Primitives.Operations is
Result_Bool := ResetEvent (HANDLE (Cond.all));
pragma Assert (Result_Bool = Win32.TRUE);
- Unlock (L, Global_Lock => True);
+ Unlock (L);
-- No problem if we are interrupted here: if the condition is signaled,
-- WaitForSingleObject will simply not block
@@ -298,7 +298,7 @@ package body System.Task_Primitives.Operations is
Result := WaitForSingleObject (HANDLE (Cond.all), Wait_Infinite);
pragma Assert (Result = 0);
- Write_Lock (L, Global_Lock => True);
+ Write_Lock (L);
end Cond_Wait;
---------------------
@@ -330,7 +330,7 @@ package body System.Task_Primitives.Operations is
Result := ResetEvent (HANDLE (Cond.all));
pragma Assert (Result = Win32.TRUE);
- Unlock (L, Global_Lock => True);
+ Unlock (L);
-- No problem if we are interrupted here: if the condition is signaled,
-- WaitForSingleObject will simply not block.
@@ -355,7 +355,7 @@ package body System.Task_Primitives.Operations is
end if;
end if;
- Write_Lock (L, Global_Lock => True);
+ Write_Lock (L);
-- Ensure post-condition
@@ -465,21 +465,14 @@ package body System.Task_Primitives.Operations is
Ceiling_Violation := False;
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
begin
- if not Single_Lock or else Global_Lock then
- EnterCriticalSection (L);
- end if;
+ EnterCriticalSection (L);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
begin
- if not Single_Lock then
- EnterCriticalSection (T.Common.LL.L'Access);
- end if;
+ EnterCriticalSection (T.Common.LL.L'Access);
end Write_Lock;
---------------
@@ -501,19 +494,14 @@ package body System.Task_Primitives.Operations is
LeaveCriticalSection (L.Mutex'Access);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock (L : not null access RTS_Lock) is
begin
- if not Single_Lock or else Global_Lock then
- LeaveCriticalSection (L);
- end if;
+ LeaveCriticalSection (L);
end Unlock;
procedure Unlock (T : Task_Id) is
begin
- if not Single_Lock then
- LeaveCriticalSection (T.Common.LL.L'Access);
- end if;
+ LeaveCriticalSection (T.Common.LL.L'Access);
end Unlock;
-----------------
@@ -544,11 +532,7 @@ package body System.Task_Primitives.Operations is
begin
pragma Assert (Self_ID = Self);
- if Single_Lock then
- Cond_Wait (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
- else
- Cond_Wait (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
- end if;
+ Cond_Wait (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
if Self_ID.Deferral_Level = 0
and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
@@ -599,19 +583,12 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
- if Single_Lock then
- Cond_Timed_Wait
- (Self_ID.Common.LL.CV'Access,
- Single_RTS_Lock'Access,
- Rel_Time, Local_Timedout, Result);
- else
- Cond_Timed_Wait
- (Self_ID.Common.LL.CV'Access,
- Self_ID.Common.LL.L'Access,
- Rel_Time, Local_Timedout, Result);
- end if;
-
+ Cond_Timed_Wait
+ (Self_ID.Common.LL.CV'Access,
+ Self_ID.Common.LL.L'Access,
+ Rel_Time, Local_Timedout, Result);
Check_Time := Monotonic_Clock;
+
exit when Abs_Time <= Check_Time;
if not Local_Timedout then
@@ -645,10 +622,6 @@ package body System.Task_Primitives.Operations is
pragma Unreferenced (Timedout, Result);
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
if Mode = Relative then
@@ -665,19 +638,12 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
- if Single_Lock then
- Cond_Timed_Wait
- (Self_ID.Common.LL.CV'Access,
- Single_RTS_Lock'Access,
- Rel_Time, Timedout, Result);
- else
- Cond_Timed_Wait
- (Self_ID.Common.LL.CV'Access,
- Self_ID.Common.LL.L'Access,
- Rel_Time, Timedout, Result);
- end if;
-
+ Cond_Timed_Wait
+ (Self_ID.Common.LL.CV'Access,
+ Self_ID.Common.LL.L'Access,
+ Rel_Time, Timedout, Result);
Check_Time := Monotonic_Clock;
+
exit when Abs_Time <= Check_Time;
Rel_Time := Abs_Time - Check_Time;
@@ -687,11 +653,6 @@ package body System.Task_Primitives.Operations is
end if;
Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Yield;
end Timed_Delay;
@@ -845,10 +806,7 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := Null_Thread_Id;
Initialize_Cond (Self_ID.Common.LL.CV'Access);
-
- if not Single_Lock then
- Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level);
- end if;
+ Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level);
Succeeded := True;
end Initialize_TCB;
@@ -976,10 +934,7 @@ package body System.Task_Primitives.Operations is
pragma Unreferenced (Succeeded);
begin
- if not Single_Lock then
- Finalize_Lock (T.Common.LL.L'Access);
- end if;
-
+ Finalize_Lock (T.Common.LL.L'Access);
Finalize_Cond (T.Common.LL.CV'Access);
if T.Known_Tasks_Index /= -1 then
@@ -1035,7 +990,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1044,7 +999,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
----------------
diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb
index 5573f017f10..c983c77e37e 100644
--- a/gcc/ada/libgnarl/s-taprop__posix.adb
+++ b/gcc/ada/libgnarl/s-taprop__posix.adb
@@ -82,7 +82,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task
@@ -443,25 +443,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0 or else Ceiling_Violation);
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_lock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (L);
+ pragma Assert (Result = 0);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_lock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Write_Lock;
---------------
@@ -485,24 +478,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock; Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_unlock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (L);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_unlock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -536,9 +523,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access));
+ mutex => Self_ID.Common.LL.L'Access);
-- EINTR is not considered a failure
@@ -728,48 +713,46 @@ package body System.Task_Primitives.Operations is
Next_Serial_Number := Next_Serial_Number + 1;
pragma Assert (Next_Serial_Number /= 0);
- if not Single_Lock then
- Result := pthread_mutexattr_init (Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = 0 then
- if Locking_Policy = 'C' then
- Result :=
- pthread_mutexattr_setprotocol
- (Mutex_Attr'Access,
- PTHREAD_PRIO_PROTECT);
- pragma Assert (Result = 0);
+ Result := pthread_mutexattr_init (Mutex_Attr'Access);
+ pragma Assert (Result = 0 or else Result = ENOMEM);
- Result :=
- pthread_mutexattr_setprioceiling
- (Mutex_Attr'Access,
- Interfaces.C.int (System.Any_Priority'Last));
- pragma Assert (Result = 0);
+ if Result = 0 then
+ if Locking_Policy = 'C' then
+ Result :=
+ pthread_mutexattr_setprotocol
+ (Mutex_Attr'Access,
+ PTHREAD_PRIO_PROTECT);
+ pragma Assert (Result = 0);
- elsif Locking_Policy = 'I' then
- Result :=
- pthread_mutexattr_setprotocol
- (Mutex_Attr'Access,
- PTHREAD_PRIO_INHERIT);
- pragma Assert (Result = 0);
- end if;
+ Result :=
+ pthread_mutexattr_setprioceiling
+ (Mutex_Attr'Access,
+ Interfaces.C.int (System.Any_Priority'Last));
+ pragma Assert (Result = 0);
+ elsif Locking_Policy = 'I' then
Result :=
- pthread_mutex_init
- (Self_ID.Common.LL.L'Access,
- Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pthread_mutexattr_setprotocol
+ (Mutex_Attr'Access,
+ PTHREAD_PRIO_INHERIT);
+ pragma Assert (Result = 0);
end if;
- if Result /= 0 then
- Succeeded := False;
- return;
- end if;
+ Result :=
+ pthread_mutex_init
+ (Self_ID.Common.LL.L'Access,
+ Mutex_Attr'Access);
+ pragma Assert (Result = 0 or else Result = ENOMEM);
+ end if;
- Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
- pragma Assert (Result = 0);
+ if Result /= 0 then
+ Succeeded := False;
+ return;
end if;
+ Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+ pragma Assert (Result = 0);
+
Result := pthread_condattr_init (Cond_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -786,11 +769,8 @@ package body System.Task_Primitives.Operations is
if Result = 0 then
Succeeded := True;
else
- if not Single_Lock then
- Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
-
+ Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Succeeded := False;
end if;
@@ -915,10 +895,8 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_destroy (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Result := pthread_cond_destroy (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
@@ -1212,7 +1190,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1221,7 +1199,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
------------------
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb
index 3479ca5fc49..52d353c5ca0 100644
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ b/gcc/ada/libgnarl/s-taprop__qnx.adb
@@ -82,7 +82,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task
@@ -458,25 +458,18 @@ package body System.Task_Primitives.Operations is
end if;
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_lock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (L);
+ pragma Assert (Result = 0);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_lock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_lock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Write_Lock;
---------------
@@ -500,24 +493,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock; Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- Result := pthread_mutex_unlock (L);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (L);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_unlock (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -551,9 +538,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_cond_wait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access));
+ mutex => Self_ID.Common.LL.L'Access);
-- EINTR is not considered a failure
@@ -713,8 +698,7 @@ package body System.Task_Primitives.Operations is
-- Initialize_TCB --
--------------------
- procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean)
- is
+ procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
Result : Interfaces.C.int;
Cond_Attr : aliased pthread_condattr_t;
@@ -725,14 +709,12 @@ package body System.Task_Primitives.Operations is
Next_Serial_Number := Next_Serial_Number + 1;
pragma Assert (Next_Serial_Number /= 0);
- if not Single_Lock then
- Result := Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last);
- pragma Assert (Result = 0);
+ Result := Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last);
+ pragma Assert (Result = 0);
- if Result /= 0 then
- Succeeded := False;
- return;
- end if;
+ if Result /= 0 then
+ Succeeded := False;
+ return;
end if;
Result := pthread_condattr_init (Cond_Attr'Access);
@@ -751,10 +733,8 @@ package body System.Task_Primitives.Operations is
if Result = 0 then
Succeeded := True;
else
- if not Single_Lock then
- Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Succeeded := False;
end if;
@@ -894,10 +874,8 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- Result := pthread_mutex_destroy (T.Common.LL.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+ pragma Assert (Result = 0);
Result := pthread_cond_destroy (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
@@ -1191,7 +1169,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1200,7 +1178,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
------------------
diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb
index ea76aca6087..8b0183d7f7d 100644
--- a/gcc/ada/libgnarl/s-taprop__solaris.adb
+++ b/gcc/ada/libgnarl/s-taprop__solaris.adb
@@ -91,7 +91,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
-- a time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Next_Serial_Number : Task_Serial_Number := 100;
-- We start at 100, to reserve some special values for
@@ -653,29 +653,22 @@ package body System.Task_Primitives.Operations is
pragma Assert (Record_Lock (Lock_Ptr (L)));
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- pragma Assert (Check_Lock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
- Result := mutex_lock (L.L'Access);
- pragma Assert (Result = 0);
- pragma Assert (Record_Lock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
- end if;
+ pragma Assert (Check_Lock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
+ Result := mutex_lock (L.L'Access);
+ pragma Assert (Result = 0);
+ pragma Assert (Record_Lock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- pragma Assert (Check_Lock (To_Lock_Ptr (T.Common.LL.L'Access)));
- Result := mutex_lock (T.Common.LL.L.L'Access);
- pragma Assert (Result = 0);
- pragma Assert (Record_Lock (To_Lock_Ptr (T.Common.LL.L'Access)));
- end if;
+ pragma Assert (Check_Lock (To_Lock_Ptr (T.Common.LL.L'Access)));
+ Result := mutex_lock (T.Common.LL.L.L'Access);
+ pragma Assert (Result = 0);
+ pragma Assert (Record_Lock (To_Lock_Ptr (T.Common.LL.L'Access)));
end Write_Lock;
---------------
@@ -717,27 +710,20 @@ package body System.Task_Primitives.Operations is
end if;
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
- if not Single_Lock or else Global_Lock then
- pragma Assert (Check_Unlock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
- Result := mutex_unlock (L.L'Access);
- pragma Assert (Result = 0);
- end if;
+ pragma Assert (Check_Unlock (To_Lock_Ptr (RTS_Lock_Ptr (L))));
+ Result := mutex_unlock (L.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : Interfaces.C.int;
begin
- if not Single_Lock then
- pragma Assert (Check_Unlock (To_Lock_Ptr (T.Common.LL.L'Access)));
- Result := mutex_unlock (T.Common.LL.L.L'Access);
- pragma Assert (Result = 0);
- end if;
+ pragma Assert (Check_Unlock (To_Lock_Ptr (T.Common.LL.L'Access)));
+ Result := mutex_unlock (T.Common.LL.L.L'Access);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -929,14 +915,12 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := Null_Thread_Id;
- if not Single_Lock then
- Result :=
- mutex_init
- (Self_ID.Common.LL.L.L'Access, USYNC_THREAD, System.Null_Address);
- Self_ID.Common.LL.L.Level :=
- Private_Task_Serial_Number (Self_ID.Serial_Number);
- pragma Assert (Result = 0 or else Result = ENOMEM);
- end if;
+ Result :=
+ mutex_init
+ (Self_ID.Common.LL.L.L'Access, USYNC_THREAD, System.Null_Address);
+ Self_ID.Common.LL.L.Level :=
+ Private_Task_Serial_Number (Self_ID.Serial_Number);
+ pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = 0 then
Result := cond_init (Self_ID.Common.LL.CV'Access, USYNC_THREAD, 0);
@@ -946,10 +930,8 @@ package body System.Task_Primitives.Operations is
if Result = 0 then
Succeeded := True;
else
- if not Single_Lock then
- Result := mutex_destroy (Self_ID.Common.LL.L.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := mutex_destroy (Self_ID.Common.LL.L.L'Access);
+ pragma Assert (Result = 0);
Succeeded := False;
end if;
@@ -1049,10 +1031,8 @@ package body System.Task_Primitives.Operations is
begin
T.Common.LL.Thread := Null_Thread_Id;
- if not Single_Lock then
- Result := mutex_destroy (T.Common.LL.L.L'Access);
- pragma Assert (Result = 0);
- end if;
+ Result := mutex_destroy (T.Common.LL.L.L'Access);
+ pragma Assert (Result = 0);
Result := cond_destroy (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
@@ -1107,15 +1087,9 @@ package body System.Task_Primitives.Operations is
begin
pragma Assert (Check_Sleep (Reason));
- if Single_Lock then
- Result :=
- cond_wait
- (Self_ID.Common.LL.CV'Access, Single_RTS_Lock.L'Access);
- else
- Result :=
- cond_wait
- (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L.L'Access);
- end if;
+ Result :=
+ cond_wait
+ (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L.L'Access);
pragma Assert
(Record_Wakeup (To_Lock_Ptr (Self_ID.Common.LL.L'Access), Reason));
@@ -1221,21 +1195,13 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
- if Single_Lock then
- Result :=
- cond_timedwait
- (Self_ID.Common.LL.CV'Access,
- Single_RTS_Lock.L'Access, Request'Access);
- else
- Result :=
- cond_timedwait
- (Self_ID.Common.LL.CV'Access,
- Self_ID.Common.LL.L.L'Access, Request'Access);
- end if;
-
+ Result :=
+ cond_timedwait
+ (Self_ID.Common.LL.CV'Access,
+ Self_ID.Common.LL.L.L'Access, Request'Access);
Yielded := True;
-
Check_Time := Monotonic_Clock;
+
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
if Result = 0 or Result = EINTR then
@@ -1271,10 +1237,6 @@ package body System.Task_Primitives.Operations is
Yielded : Boolean := False;
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
Abs_Time :=
@@ -1291,23 +1253,14 @@ package body System.Task_Primitives.Operations is
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
- if Single_Lock then
- Result :=
- cond_timedwait
- (Self_ID.Common.LL.CV'Access,
- Single_RTS_Lock.L'Access,
- Request'Access);
- else
- Result :=
- cond_timedwait
- (Self_ID.Common.LL.CV'Access,
- Self_ID.Common.LL.L.L'Access,
- Request'Access);
- end if;
-
+ Result :=
+ cond_timedwait
+ (Self_ID.Common.LL.CV'Access,
+ Self_ID.Common.LL.L.L'Access,
+ Request'Access);
Yielded := True;
-
Check_Time := Monotonic_Clock;
+
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
pragma Assert
@@ -1325,10 +1278,6 @@ package body System.Task_Primitives.Operations is
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
if not Yielded then
thr_yield;
end if;
@@ -1412,10 +1361,6 @@ package body System.Task_Primitives.Operations is
return False;
end if;
- if Single_Lock then
- return True;
- end if;
-
-- Check that TCB lock order rules are satisfied
P := Self_ID.Common.LL.Locks;
@@ -1451,10 +1396,6 @@ package body System.Task_Primitives.Operations is
L.Owner := To_Owner_ID (To_Address (Self_ID));
- if Single_Lock then
- return True;
- end if;
-
-- Check that TCB lock order rules are satisfied
P := Self_ID.Common.LL.Locks;
@@ -1485,10 +1426,6 @@ package body System.Task_Primitives.Operations is
return False;
end if;
- if Single_Lock then
- return True;
- end if;
-
-- Check that caller is holding own lock, on top of list
if Self_ID.Common.LL.Locks /=
@@ -1528,10 +1465,6 @@ package body System.Task_Primitives.Operations is
L.Owner := To_Owner_ID (To_Address (Self_ID));
- if Single_Lock then
- return True;
- end if;
-
-- Check that TCB lock order rules are satisfied
P := Self_ID.Common.LL.Locks;
@@ -1880,7 +1813,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1889,7 +1822,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
------------------
diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb
index a537f7199f4..32c301dc8c0 100644
--- a/gcc/ada/libgnarl/s-taprop__vxworks.adb
+++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb
@@ -101,7 +101,7 @@ package body System.Task_Primitives.Operations is
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at a
-- time; it is used to execute in mutual exclusion from all other tasks.
- -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+ -- Used to protect All_Tasks_List
Time_Slice_Val : Integer;
pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
@@ -374,25 +374,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Write_Lock;
- procedure Write_Lock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Write_Lock (L : not null access RTS_Lock) is
Result : int;
begin
- if not Single_Lock or else Global_Lock then
- Result := semTake (L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
- end if;
+ Result := semTake (L.Mutex, WAIT_FOREVER);
+ pragma Assert (Result = 0);
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
Result : int;
begin
- if not Single_Lock then
- Result := semTake (T.Common.LL.L.Mutex, WAIT_FOREVER);
- pragma Assert (Result = 0);
- end if;
+ Result := semTake (T.Common.LL.L.Mutex, WAIT_FOREVER);
+ pragma Assert (Result = 0);
end Write_Lock;
---------------
@@ -401,8 +394,7 @@ package body System.Task_Primitives.Operations is
procedure Read_Lock
(L : not null access Lock;
- Ceiling_Violation : out Boolean)
- is
+ Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
@@ -418,25 +410,18 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock
- (L : not null access RTS_Lock;
- Global_Lock : Boolean := False)
- is
+ procedure Unlock (L : not null access RTS_Lock) is
Result : int;
begin
- if not Single_Lock or else Global_Lock then
- Result := semGive (L.Mutex);
- pragma Assert (Result = 0);
- end if;
+ Result := semGive (L.Mutex);
+ pragma Assert (Result = 0);
end Unlock;
procedure Unlock (T : Task_Id) is
Result : int;
begin
- if not Single_Lock then
- Result := semGive (T.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
- end if;
+ Result := semGive (T.Common.LL.L.Mutex);
+ pragma Assert (Result = 0);
end Unlock;
-----------------
@@ -468,10 +453,7 @@ package body System.Task_Primitives.Operations is
-- Release the mutex before sleeping
- Result :=
- semGive (if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex);
+ Result := semGive (Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
-- Perform a blocking operation to take the CV semaphore. Note that a
@@ -484,10 +466,7 @@ package body System.Task_Primitives.Operations is
-- Take the mutex back
- Result :=
- semTake ((if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
+ Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
pragma Assert (Result = 0);
end Sleep;
@@ -540,10 +519,7 @@ package body System.Task_Primitives.Operations is
loop
-- Release the mutex before sleeping
- Result :=
- semGive (if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex);
+ Result := semGive (Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
-- Perform a blocking operation to take the CV semaphore. Note
@@ -583,10 +559,7 @@ package body System.Task_Primitives.Operations is
-- Take the mutex back
- Result :=
- semTake ((if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
+ Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
pragma Assert (Result = 0);
exit when Timedout or Wakeup;
@@ -597,16 +570,9 @@ package body System.Task_Primitives.Operations is
-- Should never hold a lock while yielding
- if Single_Lock then
- Result := semGive (Single_RTS_Lock.Mutex);
- Result := taskDelay (0);
- Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
-
- else
- Result := semGive (Self_ID.Common.LL.L.Mutex);
- Result := taskDelay (0);
- Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
- end if;
+ Result := semGive (Self_ID.Common.LL.L.Mutex);
+ Result := taskDelay (0);
+ Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
end if;
end Timed_Sleep;
@@ -653,10 +619,7 @@ package body System.Task_Primitives.Operations is
-- Modifying State, locking the TCB
- Result :=
- semTake ((if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
+ Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
pragma Assert (Result = 0);
@@ -668,10 +631,7 @@ package body System.Task_Primitives.Operations is
-- Release the TCB before sleeping
- Result :=
- semGive (if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex);
+ Result := semGive (Self_ID.Common.LL.L.Mutex);
pragma Assert (Result = 0);
exit when Aborted;
@@ -697,11 +657,7 @@ package body System.Task_Primitives.Operations is
-- Take back the lock after having slept, to protect further
-- access to Self_ID.
- Result :=
- semTake
- ((if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex), WAIT_FOREVER);
+ Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER);
pragma Assert (Result = 0);
@@ -710,11 +666,7 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.State := Runnable;
- Result :=
- semGive
- (if Single_Lock
- then Single_RTS_Lock.Mutex
- else Self_ID.Common.LL.L.Mutex);
+ Result := semGive (Self_ID.Common.LL.L.Mutex);
else
Result := taskDelay (0);
@@ -875,10 +827,7 @@ package body System.Task_Primitives.Operations is
else
Succeeded := True;
-
- if not Single_Lock then
- Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level);
- end if;
+ Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level);
end if;
end Initialize_TCB;
@@ -996,10 +945,8 @@ package body System.Task_Primitives.Operations is
Result : int;
begin
- if not Single_Lock then
- Result := semDelete (T.Common.LL.L.Mutex);
- pragma Assert (Result = 0);
- end if;
+ Result := semDelete (T.Common.LL.L.Mutex);
+ pragma Assert (Result = 0);
T.Common.LL.Thread := Null_Thread_Id;
@@ -1251,7 +1198,7 @@ package body System.Task_Primitives.Operations is
procedure Lock_RTS is
begin
- Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+ Write_Lock (Single_RTS_Lock'Access);
end Lock_RTS;
----------------
@@ -1260,7 +1207,7 @@ package body System.Task_Primitives.Operations is
procedure Unlock_RTS is
begin
- Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+ Unlock (Single_RTS_Lock'Access);
end Unlock_RTS;
------------------
diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb
index 43c78d1750a..ddaa9839dbb 100644
--- a/gcc/ada/libgnarl/s-tarest.adb
+++ b/gcc/ada/libgnarl/s-tarest.adb
@@ -62,7 +62,6 @@ package body System.Tasking.Restricted.Stages is
use Ada.Exceptions;
- use Parameters;
use Task_Primitives.Operations;
Tasks_Activation_Chain : Task_Id;
@@ -153,7 +152,7 @@ package body System.Tasking.Restricted.Stages is
Self_ID.Common.Global_Task_Lock_Nesting + 1;
if Self_ID.Common.Global_Task_Lock_Nesting = 1 then
- STPO.Write_Lock (Global_Task_Lock'Access, Global_Lock => True);
+ STPO.Write_Lock (Global_Task_Lock'Access);
end if;
end Task_Lock;
@@ -170,7 +169,7 @@ package body System.Tasking.Restricted.Stages is
Self_ID.Common.Global_Task_Lock_Nesting - 1;
if Self_ID.Common.Global_Task_Lock_Nesting = 0 then
- STPO.Unlock (Global_Task_Lock'Access, Global_Lock => True);
+ STPO.Unlock (Global_Task_Lock'Access);
end if;
end Task_Unlock;
@@ -265,20 +264,12 @@ package body System.Tasking.Restricted.Stages is
TH : Termination_Handler := null;
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID.Common.Parent);
TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
Unlock (Self_ID.Common.Parent);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Execute the task termination handler if we found it
if TH /= null then
@@ -347,10 +338,6 @@ package body System.Tasking.Restricted.Stages is
pragma Assert (Self_ID = Environment_Task);
pragma Assert (Self_ID.Common.Wait_Count = 0);
- if Single_Lock then
- Lock_RTS;
- end if;
-
-- Lock self, to prevent activated tasks from racing ahead before we
-- finish activating the chain.
@@ -403,10 +390,6 @@ package body System.Tasking.Restricted.Stages is
Self_ID.Common.State := Runnable;
Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
end Activate_Tasks;
------------------------------------
@@ -423,10 +406,6 @@ package body System.Tasking.Restricted.Stages is
Activator : constant Task_Id := Self_ID.Common.Activator;
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Activator);
Write_Lock (Self_ID);
@@ -449,10 +428,6 @@ package body System.Tasking.Restricted.Stages is
Unlock (Self_ID);
Unlock (Activator);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- After the activation, active priority should be the same as base
-- priority. We must unlock the Activator first, though, since it should
-- not wait if we have lower priority.
@@ -533,10 +508,6 @@ package body System.Tasking.Restricted.Stages is
else System.Multiprocessors.CPU_Range (CPU));
end if;
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
-- With no task hierarchy, the parent of all non-Environment tasks that
@@ -554,11 +525,6 @@ package body System.Tasking.Restricted.Stages is
if not Success then
Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
raise Program_Error;
end if;
@@ -581,10 +547,6 @@ package body System.Tasking.Restricted.Stages is
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- 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. If the
-- compiler has not allocated a secondary stack, a stack will be
@@ -681,10 +643,6 @@ package body System.Tasking.Restricted.Stages is
begin
pragma Assert (Self_ID = STPO.Environment_Task);
- if Single_Lock then
- Lock_RTS;
- end if;
-
-- Handle normal task termination by the environment task, but only for
-- the normal task termination. In the case of Abnormal and
-- Unhandled_Exception they must have been handled before, and the task
@@ -705,10 +663,6 @@ package body System.Tasking.Restricted.Stages is
Sleep (Self_ID, Master_Completion_Sleep);
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Should never return from Master Completion Sleep
raise Program_Error;
diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
index b8292887ab3..cdcb0ba7534 100644
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -44,7 +44,6 @@ with System.Soft_Links;
with System.Soft_Links.Tasking;
with System.Tasking.Debug;
with System.Tasking.Task_Attributes;
-with System.Parameters;
with System.Secondary_Stack;
pragma Elaborate_All (System.Secondary_Stack);
@@ -244,18 +243,10 @@ package body System.Tasking.Initialization is
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
Self_ID.Pending_Action := False;
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Restore the original Deferral value
Self_ID.Deferral_Level := Self_ID.Deferral_Level - 1;
@@ -309,7 +300,7 @@ package body System.Tasking.Initialization is
procedure Final_Task_Unlock (Self_ID : Task_Id) is
begin
pragma Assert (Self_ID.Common.Global_Task_Lock_Nesting = 1);
- Unlock (Global_Task_Lock'Access, Global_Lock => True);
+ Unlock (Global_Task_Lock'Access);
end Final_Task_Unlock;
--------------
@@ -563,7 +554,7 @@ package body System.Tasking.Initialization is
if Self_ID.Common.Global_Task_Lock_Nesting = 1 then
Defer_Abort_Nestable (Self_ID);
- Write_Lock (Global_Task_Lock'Access, Global_Lock => True);
+ Write_Lock (Global_Task_Lock'Access);
end if;
end Task_Lock;
@@ -593,7 +584,7 @@ package body System.Tasking.Initialization is
Self_ID.Common.Global_Task_Lock_Nesting - 1;
if Self_ID.Common.Global_Task_Lock_Nesting = 0 then
- Unlock (Global_Task_Lock'Access, Global_Lock => True);
+ Unlock (Global_Task_Lock'Access);
Undefer_Abort_Nestable (Self_ID);
end if;
end Task_Unlock;
diff --git a/gcc/ada/libgnarl/s-tasque.adb b/gcc/ada/libgnarl/s-tasque.adb
index c3d7bb09c41..7a9211a7346 100644
--- a/gcc/ada/libgnarl/s-tasque.adb
+++ b/gcc/ada/libgnarl/s-tasque.adb
@@ -35,11 +35,9 @@
with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
-with System.Parameters;
package body System.Tasking.Queuing is
- use Parameters;
use Task_Primitives.Operations;
use Protected_Objects;
use Protected_Objects.Entries;
@@ -68,15 +66,10 @@ package body System.Tasking.Queuing is
procedure Broadcast_Program_Error
(Self_ID : Task_Id;
Object : Protection_Entries_Access;
- Pending_Call : Entry_Call_Link;
- RTS_Locked : Boolean := False)
+ Pending_Call : Entry_Call_Link)
is
Entry_Call : Entry_Call_Link;
begin
- if Single_Lock and then not RTS_Locked then
- Lock_RTS;
- end if;
-
if Pending_Call /= null then
Send_Program_Error (Self_ID, Pending_Call);
end if;
@@ -91,10 +84,6 @@ package body System.Tasking.Queuing is
Dequeue_Head (Object.Entry_Queues (E), Entry_Call);
end loop;
end loop;
-
- if Single_Lock and then not RTS_Locked then
- Unlock_RTS;
- end if;
end Broadcast_Program_Error;
-----------------
diff --git a/gcc/ada/libgnarl/s-tasque.ads b/gcc/ada/libgnarl/s-tasque.ads
index 7ea51cb2e2c..07540196dee 100644
--- a/gcc/ada/libgnarl/s-tasque.ads
+++ b/gcc/ada/libgnarl/s-tasque.ads
@@ -38,13 +38,10 @@ package System.Tasking.Queuing is
procedure Broadcast_Program_Error
(Self_ID : Task_Id;
Object : POE.Protection_Entries_Access;
- Pending_Call : Entry_Call_Link;
- RTS_Locked : Boolean := False);
+ Pending_Call : Entry_Call_Link);
-- Raise Program_Error in all tasks calling the protected entries of Object
-- The exception will not be raised immediately for the calling task; it
-- will be deferred until it calls Check_Exception.
- -- RTS_Locked indicates whether the global RTS lock is taken (only
- -- relevant if Single_Lock is True).
procedure Enqueue (E : in out Entry_Queue; Call : Entry_Call_Link);
-- Enqueue Call at the end of entry_queue E
diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb
index 23e2d968669..567b955dc6b 100644
--- a/gcc/ada/libgnarl/s-tasren.adb
+++ b/gcc/ada/libgnarl/s-tasren.adb
@@ -37,7 +37,6 @@ with System.Tasking.Utilities;
with System.Tasking.Protected_Objects.Operations;
with System.Tasking.Debug;
with System.Restrictions;
-with System.Parameters;
package body System.Tasking.Rendezvous is
@@ -45,7 +44,6 @@ package body System.Tasking.Rendezvous is
package POO renames Protected_Objects.Operations;
package POE renames Protected_Objects.Entries;
- use Parameters;
use Task_Primitives.Operations;
type Select_Treatment is (
@@ -155,11 +153,6 @@ package body System.Tasking.Rendezvous is
begin
Initialization.Defer_Abort (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
@@ -168,11 +161,6 @@ package body System.Tasking.Rendezvous is
pragma Assert (Self_Id.Pending_Action);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
-- Should never get here ???
@@ -221,13 +209,7 @@ package body System.Tasking.Rendezvous is
-- return, we will start the rendezvous.
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
-
end Accept_Call;
--------------------
@@ -242,11 +224,6 @@ package body System.Tasking.Rendezvous is
begin
Initialization.Defer_Abort_Nestable (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
@@ -255,11 +232,6 @@ package body System.Tasking.Rendezvous is
pragma Assert (Self_Id.Pending_Action);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort_Nestable (Self_Id);
-- Should never get here ???
@@ -303,10 +275,6 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Caller);
end if;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort_Nestable (Self_Id);
end Accept_Trivial;
@@ -401,20 +369,12 @@ package body System.Tasking.Rendezvous is
-- Note: the caller will undefer abort on return (see WARNING above)
- if Single_Lock then
- Lock_RTS;
- end if;
-
if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Local_Undefer_Abort (Self_Id);
+
raise Tasking_Error;
end if;
@@ -426,11 +386,6 @@ package body System.Tasking.Rendezvous is
(Debug.Trace (Self_Id, "Call_Synchronous: done waiting", 'R'));
Rendezvous_Successful := Entry_Call.State = Done;
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Local_Undefer_Abort (Self_Id);
Entry_Calls.Check_Exception (Self_Id, Entry_Call);
end Call_Synchronous;
@@ -445,20 +400,11 @@ package body System.Tasking.Rendezvous is
begin
Initialization.Defer_Abort_Nestable (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (T);
Result := T.Callable;
STPO.Unlock (T);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort_Nestable (Self_Id);
+
return Result;
end Callable;
@@ -545,10 +491,6 @@ package body System.Tasking.Rendezvous is
-- it was aborted.
if Ex = Standard'Abort_Signal'Identity then
- if Single_Lock then
- Lock_RTS;
- end if;
-
while Entry_Call /= null loop
Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
@@ -568,11 +510,6 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Caller);
Entry_Call := Entry_Call.Acceptor_Prev_Call;
end loop;
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
else
Caller := Entry_Call.Self;
@@ -588,23 +525,10 @@ package body System.Tasking.Rendezvous is
-- Requeue to another task entry
- if Single_Lock then
- Lock_RTS;
- end if;
-
if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
raise Tasking_Error;
end if;
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
else
-- Requeue to a protected entry
@@ -614,20 +538,11 @@ package body System.Tasking.Rendezvous is
if Ceiling_Violation then
pragma Assert (Ex = Ada.Exceptions.Null_Id);
Entry_Call.Exception_To_Raise := Program_Error'Identity;
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Initialization.Wakeup_Entry_Caller
(Self_Id, Entry_Call, Done);
STPO.Unlock (Caller);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
else
POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
POO.PO_Service_Entries (Self_Id, Called_PO);
@@ -642,11 +557,6 @@ package body System.Tasking.Rendezvous is
Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
Entry_Call.Exception_To_Raise := Ex;
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
-- Done with Caller locked to make sure that Wakeup is not lost
@@ -661,11 +571,6 @@ package body System.Tasking.Rendezvous is
Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
STPO.Unlock (Caller);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
end if;
end if;
@@ -733,11 +638,6 @@ package body System.Tasking.Rendezvous is
begin
Initialization.Defer_Abort (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
@@ -747,10 +647,6 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- ??? In some cases abort is deferred more than once. Need to
-- figure out why this happens.
@@ -902,10 +798,6 @@ package body System.Tasking.Rendezvous is
STPO.Unlock (Self_Id);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Index := Self_Id.Chosen_Index;
Initialization.Undefer_Abort_Nestable (Self_Id);
@@ -961,21 +853,11 @@ package body System.Tasking.Rendezvous is
else
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
- raise Program_Error with
- "entry call not a delay mode";
+ raise Program_Error with "entry call not a delay mode";
end if;
end case;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Caller has been chosen
-- Self_Id.Common.Call should already be updated by the Caller.
@@ -1018,19 +900,9 @@ package body System.Tasking.Rendezvous is
begin
Initialization.Defer_Abort (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
Return_Count := Queuing.Count_Waiting (Self_Id.Entry_Queues (E));
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
return Return_Count;
@@ -1306,19 +1178,10 @@ package body System.Tasking.Rendezvous is
Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
Entry_Call.With_Abort := True;
- if Single_Lock then
- Lock_RTS;
- end if;
-
if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
raise Tasking_Error;
@@ -1335,10 +1198,6 @@ package body System.Tasking.Rendezvous is
Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
end if;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Note: following assignment needs to be atomic
Rendezvous_Successful := Entry_Call.State = Done;
@@ -1392,10 +1251,6 @@ package body System.Tasking.Rendezvous is
-- If we are aborted here, the effect will be pending
- if Single_Lock then
- Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
@@ -1404,11 +1259,6 @@ package body System.Tasking.Rendezvous is
pragma Assert (Self_Id.Pending_Action);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
-- Should never get here ???
@@ -1484,21 +1334,13 @@ package body System.Tasking.Rendezvous is
-- caller a chance of getting ready immediately, using Unlock
-- Yield. See similar action in Wait_For_Completion/Wait_For_Call.
- if Single_Lock then
- Unlock_RTS;
- else
- Unlock (Self_Id);
- end if;
+ Unlock (Self_Id);
if Self_Id.Open_Accepts /= null then
Yield;
end if;
- if Single_Lock then
- Lock_RTS;
- else
- Write_Lock (Self_Id);
- end if;
+ Write_Lock (Self_Id);
-- Check if this task has been aborted while the lock was released
@@ -1574,10 +1416,6 @@ package body System.Tasking.Rendezvous is
null;
end case;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
if not Yielded then
Yield;
end if;
@@ -1657,19 +1495,10 @@ package body System.Tasking.Rendezvous is
-- Note: the caller will undefer abort on return (see WARNING above)
- if Single_Lock then
- Lock_RTS;
- end if;
-
if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
raise Tasking_Error;
@@ -1680,10 +1509,6 @@ package body System.Tasking.Rendezvous is
(Entry_Call, Timeout, Mode, Yielded);
Unlock (Self_Id);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- ??? Do we need to yield in case Yielded is False
Rendezvous_Successful := Entry_Call.State = Done;
@@ -1703,21 +1528,13 @@ package body System.Tasking.Rendezvous is
-- a chance of getting ready immediately, using Unlock & Yield.
-- See similar action in Wait_For_Completion & Timed_Selective_Wait.
- if Single_Lock then
- Unlock_RTS;
- else
- Unlock (Self_Id);
- end if;
+ Unlock (Self_Id);
if Self_Id.Open_Accepts /= null then
Yield;
end if;
- if Single_Lock then
- Lock_RTS;
- else
- Write_Lock (Self_Id);
- end if;
+ Write_Lock (Self_Id);
-- Check if this task has been aborted while the lock was released
diff --git a/gcc/ada/libgnarl/s-tasren.ads b/gcc/ada/libgnarl/s-tasren.ads
index b64ff37dd99..52b21c34e48 100644
--- a/gcc/ada/libgnarl/s-tasren.ads
+++ b/gcc/ada/libgnarl/s-tasren.ads
@@ -317,8 +317,7 @@ package System.Tasking.Rendezvous is
function Task_Do_Or_Queue
(Self_ID : Task_Id;
Entry_Call : Entry_Call_Link) return Boolean;
- -- Call this only with abort deferred and holding no locks, except
- -- the global RTS lock when Single_Lock is True which must be owned.
+ -- Call this only with abort deferred and holding no locks.
-- Returns False iff the call cannot be served or queued, as is the
-- case if the caller is not callable; i.e., a False return value
-- indicates that Tasking_Error should be raised.
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index 14da52f981b..4c7029eee8c 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -74,7 +74,6 @@ package body System.Tasking.Stages is
use Ada.Exceptions;
- use Parameters;
use Secondary_Stack;
use Task_Primitives;
use Task_Primitives.Operations;
@@ -341,9 +340,7 @@ package body System.Tasking.Stages is
C := C.Common.Activation_Link;
end loop;
- if not Single_Lock then
- Unlock_RTS;
- end if;
+ Unlock_RTS;
-- Close the entries of any tasks that failed thread creation, and count
-- those that have not finished activation.
@@ -382,10 +379,6 @@ package body System.Tasking.Stages is
Self_ID.Common.State := Runnable;
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Remove the tasks from the chain
Chain_Access.T_ID := null;
@@ -406,17 +399,7 @@ package body System.Tasking.Stages is
begin
Initialization.Defer_Abort_Nestable (Self_ID);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
Vulnerable_Complete_Activation (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort_Nestable (Self_ID);
-- ??? Why do we need to allow for nested deferral here?
@@ -846,12 +829,8 @@ package body System.Tasking.Stages is
-- Force termination of "independent" library-level server tasks
Lock_RTS;
-
Abort_Dependents (Self_ID);
-
- if not Single_Lock then
- Unlock_RTS;
- end if;
+ Unlock_RTS;
-- We need to explicitly wait for the task to be terminated here
-- because on true concurrent system, we may end this procedure before
@@ -891,10 +870,6 @@ package body System.Tasking.Stages is
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Complete the environment task
Vulnerable_Complete_Task (Self_ID);
@@ -1294,10 +1269,6 @@ package body System.Tasking.Stages is
-- the environment task. The task termination code for the environment
-- task is executed by SSL.Task_Termination_Handler.
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
if Self_ID.Common.Specific_Handler /= null then
@@ -1320,10 +1291,6 @@ package body System.Tasking.Stages is
Unlock (Self_ID);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- Execute the task termination handler if we found it
if TH /= null then
@@ -1393,26 +1360,16 @@ package body System.Tasking.Stages is
Initialization.Task_Lock (Self_ID);
- if Single_Lock then
- Lock_RTS;
- end if;
-
Master_Of_Task := Self_ID.Master_Of_Task;
-- Check if the current task is an independent task If so, decrement
-- the Independent_Task_Count value.
if Master_Of_Task = Independent_Task_Level then
- if Single_Lock then
- Utilities.Independent_Task_Count :=
- Utilities.Independent_Task_Count - 1;
-
- else
- Write_Lock (Environment_Task);
- Utilities.Independent_Task_Count :=
- Utilities.Independent_Task_Count - 1;
- Unlock (Environment_Task);
- end if;
+ Write_Lock (Environment_Task);
+ Utilities.Independent_Task_Count :=
+ Utilities.Independent_Task_Count - 1;
+ Unlock (Environment_Task);
end if;
-- Unprotect the guard page if needed
@@ -1422,10 +1379,6 @@ package body System.Tasking.Stages is
Utilities.Make_Passive (Self_ID, Task_Completed => True);
Deallocate := Self_ID.Free_On_Termination;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
pragma Assert (Check_Exit (Self_ID));
SSL.Destroy_TSD (Self_ID.Common.Compiler_Data);
@@ -1454,20 +1407,11 @@ package body System.Tasking.Stages is
begin
Initialization.Defer_Abort_Nestable (Self_ID);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (T);
Result := T.Common.State = Terminated;
Unlock (T);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort_Nestable (Self_ID);
+
return Result;
end Terminated;
@@ -1600,10 +1544,7 @@ package body System.Tasking.Stages is
function Check_Unactivated_Tasks return Boolean is
begin
- if not Single_Lock then
- Lock_RTS;
- end if;
-
+ Lock_RTS;
Write_Lock (Self_ID);
C := All_Tasks_List;
@@ -1626,10 +1567,7 @@ package body System.Tasking.Stages is
end loop;
Unlock (Self_ID);
-
- if not Single_Lock then
- Unlock_RTS;
- end if;
+ Unlock_RTS;
return True;
end Check_Unactivated_Tasks;
@@ -1698,10 +1636,7 @@ package body System.Tasking.Stages is
Self_ID.Common.State := Master_Completion_Sleep;
Unlock (Self_ID);
-
- if not Single_Lock then
- Unlock_RTS;
- end if;
+ Unlock_RTS;
-- Wait until dependent tasks are all terminated or ready to terminate.
-- While waiting, the task may be awakened if the task's priority needs
@@ -1718,15 +1653,11 @@ package body System.Tasking.Stages is
if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
and then not Self_ID.Dependents_Aborted
then
- if Single_Lock then
- Abort_Dependents (Self_ID);
- else
- Unlock (Self_ID);
- Lock_RTS;
- Abort_Dependents (Self_ID);
- Unlock_RTS;
- Write_Lock (Self_ID);
- end if;
+ Unlock (Self_ID);
+ Lock_RTS;
+ Abort_Dependents (Self_ID);
+ Unlock_RTS;
+ Write_Lock (Self_ID);
else
pragma Debug
(Debug.Trace (Self_ID, "master_completion_sleep", 'C'));
@@ -1753,10 +1684,7 @@ package body System.Tasking.Stages is
-- Force any remaining dependents to terminate by aborting them
- if not Single_Lock then
- Lock_RTS;
- end if;
-
+ Lock_RTS;
Abort_Dependents (Self_ID);
-- Above, when we "abort" the dependents we are simply using this
@@ -1801,10 +1729,7 @@ package body System.Tasking.Stages is
Self_ID.Common.State := Master_Phase_2_Sleep;
Unlock (Self_ID);
-
- if not Single_Lock then
- Unlock_RTS;
- end if;
+ Unlock_RTS;
-- Wait for all counted tasks to finish terminating themselves
@@ -1828,10 +1753,7 @@ package body System.Tasking.Stages is
-- locks. Instead, we put those ATCBs to be freed onto a temporary list,
-- called To_Be_Freed.
- if not Single_Lock then
- Lock_RTS;
- end if;
-
+ Lock_RTS;
C := All_Tasks_List;
P := null;
while C /= null loop
@@ -1986,10 +1908,6 @@ package body System.Tasking.Stages is
pragma Debug (Debug.Trace (Self_ID, "V_Complete_Task", 'C'));
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
Self_ID.Callable := False;
@@ -2005,10 +1923,6 @@ package body System.Tasking.Stages is
Vulnerable_Complete_Activation (Self_ID);
end if;
- if Single_Lock then
- Unlock_RTS;
- end if;
-
-- If Self_ID.Master_Within = Self_ID.Master_Of_Task + 2 we may have
-- dependent tasks for which we need to wait. Otherwise we just exit.
@@ -2035,18 +1949,10 @@ package body System.Tasking.Stages is
begin
pragma Debug (Debug.Trace (Self, "Vulnerable_Free_Task", 'C', T));
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (T);
Initialization.Finalize_Attributes (T);
Unlock (T);
- if Single_Lock then
- Unlock_RTS;
- end if;
-
System.Task_Primitives.Operations.Finalize_TCB (T);
end Vulnerable_Free_Task;
diff --git a/gcc/ada/libgnarl/s-tasuti.adb b/gcc/ada/libgnarl/s-tasuti.adb
index 4a552745458..90c5bd9935a 100644
--- a/gcc/ada/libgnarl/s-tasuti.adb
+++ b/gcc/ada/libgnarl/s-tasuti.adb
@@ -41,13 +41,11 @@ with System.Tasking.Debug;
with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
with System.Tasking.Queuing;
-with System.Parameters;
package body System.Tasking.Utilities is
package STPO renames System.Task_Primitives.Operations;
- use Parameters;
use Tasking.Debug;
use Task_Primitives;
use Task_Primitives.Operations;
@@ -58,7 +56,7 @@ package body System.Tasking.Utilities is
-- Similar to Locked_Abort_To_Level (Self_ID, T, Level_Completed_Task),
-- but:
- -- (1) caller should be holding no locks except RTS_Lock when Single_Lock
+ -- (1) caller should be holding no locks
-- (2) may be called for tasks that have not yet been activated
-- (3) always aborts whole task
@@ -248,11 +246,6 @@ package body System.Tasking.Utilities is
end if;
Initialization.Defer_Abort (Self_Id);
-
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Environment_Task);
Write_Lock (Self_Id);
@@ -277,11 +270,6 @@ package body System.Tasking.Utilities is
pragma Assert (Environment_Task.Common.State /= Master_Completion_Sleep);
Unlock (Environment_Task);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
Initialization.Undefer_Abort (Self_Id);
-- Return True. Actually the return value is junk, since we expect it
diff --git a/gcc/ada/libgnarl/s-tasuti.ads b/gcc/ada/libgnarl/s-tasuti.ads
index 64d70992fa9..1ef237e8d16 100644
--- a/gcc/ada/libgnarl/s-tasuti.ads
+++ b/gcc/ada/libgnarl/s-tasuti.ads
@@ -102,7 +102,7 @@ package System.Tasking.Utilities is
procedure Cancel_Queued_Entry_Calls (T : Task_Id);
-- Cancel any entry calls queued on target task.
- -- Call this while holding T's lock (or RTS_Lock in Single_Lock mode).
+ -- Call this while holding T's lock.
procedure Exit_One_ATC_Level (Self_ID : Task_Id);
pragma Inline (Exit_One_ATC_Level);
@@ -124,7 +124,6 @@ package System.Tasking.Utilities is
procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean);
-- Update counts to indicate current task is either terminated or
-- accepting on a terminate alternative. Call holding no locks except
- -- Global_Task_Lock when calling from Terminate_Task, and RTS_Lock when
- -- Single_Lock is True.
+ -- Global_Task_Lock when calling from Terminate_Task.
end System.Tasking.Utilities;
diff --git a/gcc/ada/libgnarl/s-tpoben.adb b/gcc/ada/libgnarl/s-tpoben.adb
index 2cb7cf42b91..ae06edec6fa 100644
--- a/gcc/ada/libgnarl/s-tpoben.adb
+++ b/gcc/ada/libgnarl/s-tpoben.adb
@@ -43,7 +43,6 @@
with System.Task_Primitives.Operations;
with System.Restrictions;
-with System.Parameters;
with System.Tasking.Initialization;
pragma Elaborate_All (System.Tasking.Initialization);
@@ -53,7 +52,6 @@ package body System.Tasking.Protected_Objects.Entries is
package STPO renames System.Task_Primitives.Operations;
- use Parameters;
use Task_Primitives.Operations;
----------------
@@ -81,10 +79,6 @@ package body System.Tasking.Protected_Objects.Entries is
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
- if Single_Lock then
- Lock_RTS;
- end if;
-
if Ceiling_Violation then
-- Dip our own priority down to ceiling of lock. See similar code in
@@ -95,21 +89,12 @@ package body System.Tasking.Protected_Objects.Entries is
Self_ID.New_Base_Priority := Object.Ceiling;
Initialization.Change_Base_Priority (Self_ID);
STPO.Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "ceiling violation";
end if;
- if Single_Lock then
- Lock_RTS;
- end if;
-
Object.Old_Base_Priority := Old_Base_Priority;
Object.Pending_Action := True;
end if;
@@ -133,13 +118,7 @@ package body System.Tasking.Protected_Objects.Entries is
end loop;
Object.Finalized := True;
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
STPO.Unlock (Object.L'Unrestricted_Access);
-
STPO.Finalize_Lock (Object.L'Unrestricted_Access);
end Finalize;
diff --git a/gcc/ada/libgnarl/s-tpobop.adb b/gcc/ada/libgnarl/s-tpobop.adb
index 7d8afda04dd..5537c1a4b1f 100644
--- a/gcc/ada/libgnarl/s-tpobop.adb
+++ b/gcc/ada/libgnarl/s-tpobop.adb
@@ -48,7 +48,6 @@ with System.Tasking.Queuing;
with System.Tasking.Rendezvous;
with System.Tasking.Utilities;
with System.Tasking.Debug;
-with System.Parameters;
with System.Restrictions;
with System.Tasking.Initialization;
@@ -59,7 +58,6 @@ package body System.Tasking.Protected_Objects.Operations is
package STPO renames System.Task_Primitives.Operations;
- use Parameters;
use Ada.Exceptions;
use Entries;
@@ -313,19 +311,10 @@ package body System.Tasking.Protected_Objects.Operations is
-- Body of current entry served call to completion
Object.Call_In_Progress := null;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
STPO.Unlock (Entry_Call.Self);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
else
Requeue_Call (Self_ID, Object, Entry_Call);
end if;
@@ -353,19 +342,10 @@ package body System.Tasking.Protected_Objects.Operations is
-- Max_Queue_Length bound, raise Program_Error.
Entry_Call.Exception_To_Raise := Program_Error'Identity;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
STPO.Unlock (Entry_Call.Self);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
return;
end if;
end if;
@@ -379,18 +359,10 @@ package body System.Tasking.Protected_Objects.Operations is
else
-- Conditional_Call and With_Abort
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
pragma Assert (Entry_Call.State /= Not_Yet_Abortable);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
STPO.Unlock (Entry_Call.Self);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end if;
exception
@@ -437,8 +409,7 @@ package body System.Tasking.Protected_Objects.Operations is
exception
when others =>
- Queuing.Broadcast_Program_Error
- (Self_ID, Object, Entry_Call);
+ Queuing.Broadcast_Program_Error (Self_ID, Object, Entry_Call);
end;
if Object.Call_In_Progress = null then
@@ -448,18 +419,9 @@ package body System.Tasking.Protected_Objects.Operations is
else
Object.Call_In_Progress := null;
Caller := Entry_Call.Self;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
STPO.Unlock (Caller);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end if;
end loop;
@@ -608,18 +570,10 @@ package body System.Tasking.Protected_Objects.Operations is
-- Once State >= Done it will not change any more
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_ID);
Utilities.Exit_One_ATC_Level (Self_ID);
STPO.Unlock (Self_ID);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
Block.Enqueued := False;
Block.Cancelled := Entry_Call.State = Cancelled;
Initialization.Undefer_Abort_Nestable (Self_ID);
@@ -640,13 +594,7 @@ package body System.Tasking.Protected_Objects.Operations is
-- Try to avoid an expensive call
if not Initially_Abortable then
- if Single_Lock then
- STPO.Lock_RTS;
- Entry_Calls.Wait_Until_Abortable (Self_ID, Entry_Call);
- STPO.Unlock_RTS;
- else
- Entry_Calls.Wait_Until_Abortable (Self_ID, Entry_Call);
- end if;
+ Entry_Calls.Wait_Until_Abortable (Self_ID, Entry_Call);
end if;
else
@@ -654,16 +602,9 @@ package body System.Tasking.Protected_Objects.Operations is
when Conditional_Call
| Simple_Call
=>
- if Single_Lock then
- STPO.Lock_RTS;
- Entry_Calls.Wait_For_Completion (Entry_Call);
- STPO.Unlock_RTS;
-
- else
- STPO.Write_Lock (Self_ID);
- Entry_Calls.Wait_For_Completion (Entry_Call);
- STPO.Unlock (Self_ID);
- end if;
+ STPO.Write_Lock (Self_ID);
+ Entry_Calls.Wait_For_Completion (Entry_Call);
+ STPO.Unlock (Self_ID);
Block.Cancelled := Entry_Call.State = Cancelled;
@@ -700,21 +641,11 @@ package body System.Tasking.Protected_Objects.Operations is
-- Call is to be requeued to a task entry
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
Result := Rendezvous.Task_Do_Or_Queue (Self_Id, Entry_Call);
if not Result then
- Queuing.Broadcast_Program_Error
- (Self_Id, Object, Entry_Call, RTS_Locked => True);
+ Queuing.Broadcast_Program_Error (Self_Id, Object, Entry_Call);
end if;
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
else
-- Call should be requeued to a PO
@@ -767,19 +698,11 @@ package body System.Tasking.Protected_Objects.Operations is
Entry_Call.Exception_To_Raise := Program_Error'Identity;
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
Initialization.Wakeup_Entry_Caller
(Self_Id, Entry_Call, Done);
STPO.Unlock (Entry_Call.Self);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
else
Queuing.Enqueue
(New_Object.Entry_Queues (E), Entry_Call);
@@ -993,23 +916,13 @@ package body System.Tasking.Protected_Objects.Operations is
PO_Do_Or_Queue (Self_Id, Object, Entry_Call);
PO_Service_Entries (Self_Id, Object);
-
- if Single_Lock then
- STPO.Lock_RTS;
- else
- STPO.Write_Lock (Self_Id);
- end if;
+ STPO.Write_Lock (Self_Id);
-- Try to avoid waiting for completed or cancelled calls
if Entry_Call.State >= Done then
Utilities.Exit_One_ATC_Level (Self_Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- else
- STPO.Unlock (Self_Id);
- end if;
+ STPO.Unlock (Self_Id);
Entry_Call_Successful := Entry_Call.State = Done;
Initialization.Undefer_Abort_Nestable (Self_Id);
@@ -1019,12 +932,7 @@ package body System.Tasking.Protected_Objects.Operations is
Entry_Calls.Wait_For_Completion_With_Timeout
(Entry_Call, Timeout, Mode, Yielded);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- else
- STPO.Unlock (Self_Id);
- end if;
+ STPO.Unlock (Self_Id);
-- ??? Do we need to yield in case Yielded is False
@@ -1075,10 +983,6 @@ package body System.Tasking.Protected_Objects.Operations is
if Old < Was_Abortable and then
Entry_Call.State = Now_Abortable
then
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
if Entry_Call.Self.Common.State = Async_Select_Sleep then
@@ -1086,11 +990,6 @@ package body System.Tasking.Protected_Objects.Operations is
end if;
STPO.Unlock (Entry_Call.Self);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
end if;
elsif Entry_Call.Mode = Conditional_Call then
diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb
index 17c7ae60a9e..ab706798589 100644
--- a/gcc/ada/libgnarl/s-tpopmo.adb
+++ b/gcc/ada/libgnarl/s-tpopmo.adb
@@ -193,9 +193,7 @@ package body Monotonic is
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
+ mutex => Self_ID.Common.LL.L'Access,
abstime => Request'Access);
case Result is
@@ -244,10 +242,6 @@ package body Monotonic is
Exit_Outer : Boolean := False;
begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
Write_Lock (Self_ID);
Compute_Deadline
@@ -286,9 +280,7 @@ package body Monotonic is
Result :=
pthread_cond_timedwait
(cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
+ mutex => Self_ID.Common.LL.L'Access,
abstime => Request'Access);
case Result is
@@ -314,11 +306,6 @@ package body Monotonic is
end if;
Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
pragma Unreferenced (Result);
Result := sched_yield;
end Timed_Delay;
diff --git a/gcc/ada/libgnarl/s-tposen.adb b/gcc/ada/libgnarl/s-tposen.adb
index 8f3be1cdb0c..3545435f738 100644
--- a/gcc/ada/libgnarl/s-tposen.adb
+++ b/gcc/ada/libgnarl/s-tposen.adb
@@ -62,14 +62,11 @@ pragma Suppress (All_Checks);
with Ada.Exceptions;
with System.Task_Primitives.Operations;
-with System.Parameters;
package body System.Tasking.Protected_Objects.Single_Entry is
package STPO renames System.Task_Primitives.Operations;
- use Parameters;
-
-----------------------
-- Local Subprograms --
-----------------------
@@ -143,18 +140,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
begin
Entry_Call.Exception_To_Raise := Program_Error'Identity;
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Wakeup_Entry_Caller (Entry_Call);
STPO.Unlock (Caller);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end Send_Program_Error;
-------------------------
@@ -286,18 +274,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is
(Object.Compiler_Info, Entry_Call.Uninterpreted_Data, 1);
Object.Call_In_Progress := null;
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Entry_Call.Self);
Wakeup_Entry_Caller (Entry_Call);
STPO.Unlock (Entry_Call.Self);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
else
pragma Assert (Entry_Call.Mode = Simple_Call);
@@ -370,17 +350,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
pragma Assert (Entry_Call.State /= Cancelled);
if Entry_Call.State /= Done then
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Self_Id);
Wait_For_Completion (Entry_Call'Access);
STPO.Unlock (Self_Id);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
end if;
Check_Exception (Self_Id, Entry_Call'Access);
@@ -427,18 +399,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is
Caller := Entry_Call.Self;
Unlock_Entry (Object);
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
STPO.Write_Lock (Caller);
Wakeup_Entry_Caller (Entry_Call);
STPO.Unlock (Caller);
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
else
-- Just unlock the entry
diff --git a/gcc/ada/libgnat/s-parame.ads b/gcc/ada/libgnat/s-parame.ads
index 7ec524b65a1..f9bc3d00633 100644
--- a/gcc/ada/libgnat/s-parame.ads
+++ b/gcc/ada/libgnat/s-parame.ads
@@ -147,19 +147,6 @@ package System.Parameters is
-- allow some optimizations and fine tuning within the tasking run time
-- based on restrictions on the tasking features.
- ----------------------
- -- Locking Strategy --
- ----------------------
-
- Single_Lock : constant Boolean := False;
- -- Indicates whether a single lock should be used within the tasking
- -- run-time to protect internal structures. If True, a single lock
- -- will be used, meaning less locking/unlocking operations, but also
- -- more global contention. In general, Single_Lock should be set to
- -- True on single processor machines, and to False to multi-processor
- -- systems, but this can vary from application to application and also
- -- depends on the scheduling policy.
-
-------------------
-- Task Abortion --
-------------------
diff --git a/gcc/ada/libgnat/s-parame__ae653.ads b/gcc/ada/libgnat/s-parame__ae653.ads
index 6f1bff23fcd..3e73f5e2897 100644
--- a/gcc/ada/libgnat/s-parame__ae653.ads
+++ b/gcc/ada/libgnat/s-parame__ae653.ads
@@ -147,19 +147,6 @@ package System.Parameters is
-- allow some optimizations and fine tuning within the tasking run time
-- based on restrictions on the tasking features.
- ----------------------
- -- Locking Strategy --
- ----------------------
-
- Single_Lock : constant Boolean := False;
- -- Indicates whether a single lock should be used within the tasking
- -- run-time to protect internal structures. If True, a single lock
- -- will be used, meaning less locking/unlocking operations, but also
- -- more global contention. In general, Single_Lock should be set to
- -- True on single processor machines, and to False to multi-processor
- -- systems, but this can vary from application to application and also
- -- depends on the scheduling policy.
-
-------------------
-- Task Abortion --
-------------------
diff --git a/gcc/ada/libgnat/s-parame__hpux.ads b/gcc/ada/libgnat/s-parame__hpux.ads
index 70462f37eb8..e09313f6e59 100644
--- a/gcc/ada/libgnat/s-parame__hpux.ads
+++ b/gcc/ada/libgnat/s-parame__hpux.ads
@@ -145,19 +145,6 @@ package System.Parameters is
-- allow some optimizations and fine tuning within the tasking run time
-- based on restrictions on the tasking features.
- ----------------------
- -- Locking Strategy --
- ----------------------
-
- Single_Lock : constant Boolean := False;
- -- Indicates whether a single lock should be used within the tasking
- -- run-time to protect internal structures. If True, a single lock
- -- will be used, meaning less locking/unlocking operations, but also
- -- more global contention. In general, Single_Lock should be set to
- -- True on single processor machines, and to False to multi-processor
- -- systems, but this can vary from application to application and also
- -- depends on the scheduling policy.
-
-------------------
-- Task Abortion --
-------------------
diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads
index 24ed74392f1..c836444a326 100644
--- a/gcc/ada/libgnat/s-parame__vxworks.ads
+++ b/gcc/ada/libgnat/s-parame__vxworks.ads
@@ -147,19 +147,6 @@ package System.Parameters is
-- allow some optimizations and fine tuning within the tasking run time
-- based on restrictions on the tasking features.
- ----------------------
- -- Locking Strategy --
- ----------------------
-
- Single_Lock : constant Boolean := False;
- -- Indicates whether a single lock should be used within the tasking
- -- run-time to protect internal structures. If True, a single lock
- -- will be used, meaning less locking/unlocking operations, but also
- -- more global contention. In general, Single_Lock should be set to
- -- True on single processor machines, and to False to multi-processor
- -- systems, but this can vary from application to application and also
- -- depends on the scheduling policy.
-
-------------------
-- Task Abortion --
-------------------
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-10 3:33 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-10 3:33 [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Remove System.Parameters.Single_Lock Jiu Fu Guo
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).