diff options
Diffstat (limited to 'gcc')
33 files changed, 283 insertions, 1375 deletions
diff --git a/gcc/ada/libgnarl/a-dynpri.adb b/gcc/ada/libgnarl/a-dynpri.adb index efee64e..a7e11f3 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 5284f2ac..9df547f 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 1ccbdac..fdf4811a 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 e8caeac..c386c47 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 e770a01..83bd36c 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 c18c651..dc7dac1 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 84552a9..49c4c30 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 96ab07f..2b013eb 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 a01cf88..32faac5 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 a441cd0..99049f1 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 2c0d21f..03f5a7b 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 9e7652c..8fa5435 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 5573f01..c983c77 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 3479ca5..52d353c 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 ea76aca..8b0183d 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 a537f71..32c301d 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 43c78d1..ddaa983 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 b829288..cdcb0ba 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 c3d7bb0..7a9211a 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 7ea51cb..0754019 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 23e2d96..567b955 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 b64ff37..52b21c3 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 14da52f..4c7029e 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 4a55274..90c5bd9 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 64d7099..1ef237e 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 2cb7cf4..ae06ede 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 7d8afda..5537c1a 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 17c7ae6..ab70679 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 8f3be1c..3545435 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 7ec524b..f9bc3d0 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 6f1bff2..3e73f5e 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 70462f3..e09313f 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 24ed743..c836444 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 -- ------------------- |