diff options
Diffstat (limited to 'gcc/ada/s-tasren.adb')
| -rw-r--r-- | gcc/ada/s-tasren.adb | 89 |
1 files changed, 46 insertions, 43 deletions
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 9002eeeb031..6bdd8d27738 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -154,7 +154,7 @@ package body System.Tasking.Rendezvous is procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id); pragma Inline (Boost_Priority); - -- Call this only with abort deferred and holding lock of Acceptor. + -- Call this only with abort deferred and holding lock of Acceptor procedure Call_Synchronous (Acceptor : Task_Id; @@ -255,7 +255,7 @@ package body System.Tasking.Rendezvous is Uninterpreted_Data := Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data; else - -- Case of an aborted task. + -- Case of an aborted task Uninterpreted_Data := System.Null_Address; end if; @@ -701,7 +701,7 @@ package body System.Tasking.Rendezvous is (Self_Id, Entry_Call.Acceptor_Prev_Priority); else - -- The call does not need to be requeued. + -- The call does not need to be requeued Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call; Entry_Call.Exception_To_Raise := Ex; @@ -712,7 +712,7 @@ package body System.Tasking.Rendezvous is STPO.Write_Lock (Caller); - -- Done with Caller locked to make sure that Wakeup is not lost. + -- Done with Caller locked to make sure that Wakeup is not lost if Ex /= Ada.Exceptions.Null_Id then Transfer_Occurrence @@ -844,7 +844,7 @@ package body System.Tasking.Rendezvous is Queuing.Select_Task_Entry_Call (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative); - -- Determine the kind and disposition of the select. + -- Determine the kind and disposition of the select Treatment := Default_Treatment (Select_Mode); Self_Id.Chosen_Index := No_Rendezvous; @@ -865,7 +865,7 @@ package body System.Tasking.Rendezvous is end if; end if; - -- Handle the select according to the disposition selected above. + -- Handle the select according to the disposition selected above case Treatment is when Accept_Alternative_Selected => @@ -882,7 +882,8 @@ package body System.Tasking.Rendezvous is STPO.Unlock (Self_Id); when Accept_Alternative_Completed => - -- Accept body is null, so rendezvous is over immediately. + + -- Accept body is null, so rendezvous is over immediately if Parameters.Runtime_Traces then Send_Trace_Info (M_RDV_Complete, Entry_Call.Self); @@ -896,7 +897,8 @@ package body System.Tasking.Rendezvous is STPO.Unlock (Caller); when Accept_Alternative_Open => - -- Wait for caller. + + -- Wait for caller Self_Id.Open_Accepts := Open_Accepts; pragma Debug @@ -913,9 +915,9 @@ package body System.Tasking.Rendezvous is -- Self_Id.Common.Call should already be updated by the Caller if -- not aborted. It might also be ready to do rendezvous even if - -- this wakes up due to an abortion. - -- Therefore, if the call is not empty we need to do the - -- rendezvous if the accept body is not Null_Body. + -- this wakes up due to an abort. Therefore, if the call is not + -- empty we need to do the rendezvous if the accept body is not + -- Null_Body. -- Aren't the first two conditions below redundant??? @@ -949,7 +951,7 @@ package body System.Tasking.Rendezvous is Self_Id.Open_Accepts := Open_Accepts; Self_Id.Common.State := Acceptor_Sleep; - -- Notify ancestors that this task is on a terminate alternative. + -- Notify ancestors that this task is on a terminate alternative STPO.Unlock (Self_Id); Utilities.Make_Passive (Self_Id, Task_Completed => False); @@ -1154,7 +1156,7 @@ package body System.Tasking.Rendezvous is STPO.Write_Lock (Acceptor); - -- If the acceptor is not callable, abort the call and return False. + -- If the acceptor is not callable, abort the call and return False if not Acceptor.Callable then STPO.Unlock (Acceptor); @@ -1176,35 +1178,35 @@ package body System.Tasking.Rendezvous is return False; end if; - -- Try to serve the call immediately. + -- Try to serve the call immediately if Acceptor.Open_Accepts /= null then for J in Acceptor.Open_Accepts'Range loop if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then - -- Commit acceptor to rendezvous with us. + -- Commit acceptor to rendezvous with us Acceptor.Chosen_Index := J; Null_Body := Acceptor.Open_Accepts (J).Null_Body; Acceptor.Open_Accepts := null; - -- Prevent abort while call is being served. + -- Prevent abort while call is being served if Entry_Call.State = Now_Abortable then Entry_Call.State := Was_Abortable; end if; if Acceptor.Terminate_Alternative then - -- Cancel terminate alternative. - -- See matching code in Selective_Wait and - -- Vulnerable_Complete_Master. + + -- Cancel terminate alternative. See matching code in + -- Selective_Wait and Vulnerable_Complete_Master. Acceptor.Terminate_Alternative := False; Acceptor.Awake_Count := Acceptor.Awake_Count + 1; if Acceptor.Awake_Count = 1 then - -- Notify parent that acceptor is awake. + -- Notify parent that acceptor is awake pragma Assert (Parent.Awake_Count > 0); @@ -1220,7 +1222,8 @@ package body System.Tasking.Rendezvous is end if; if Null_Body then - -- Rendezvous is over immediately. + + -- Rendezvous is over immediately STPO.Wakeup (Acceptor, Acceptor_Sleep); STPO.Unlock (Acceptor); @@ -1237,8 +1240,8 @@ package body System.Tasking.Rendezvous is else Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor); - -- For terminate_alternative, acceptor may not be - -- asleep yet, so we skip the wakeup + -- For terminate_alternative, acceptor may not be asleep + -- yet, so we skip the wakeup if Acceptor.Common.State /= Runnable then STPO.Wakeup (Acceptor, Acceptor_Sleep); @@ -1255,7 +1258,7 @@ package body System.Tasking.Rendezvous is end if; end loop; - -- The acceptor is accepting, but not this entry. + -- The acceptor is accepting, but not this entry end if; -- If the acceptor was ready to accept this call, @@ -1360,11 +1363,11 @@ package body System.Tasking.Rendezvous is else -- This is an asynchronous call - -- Abortion must already be deferred by the compiler-generated - -- code. Without this, an abortion that occurs between the time - -- that this call is made and the time that the abortable part's - -- cleanup handler is set up might miss the cleanup handler and - -- leave the call pending. + -- Abort must already be deferred by the compiler-generated code. + -- Without this, an abort that occurs between the time that this + -- call is made and the time that the abortable part's cleanup + -- handler is set up might miss the cleanup handler and leave the + -- call pending. Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1; pragma Debug @@ -1421,7 +1424,7 @@ package body System.Tasking.Rendezvous is Unlock_RTS; end if; - -- Note: following assignment needs to be atomic. + -- Note: following assignment needs to be atomic Rendezvous_Successful := Entry_Call.State = Done; end if; @@ -1506,7 +1509,7 @@ package body System.Tasking.Rendezvous is Queuing.Select_Task_Entry_Call (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative); - -- Determine the kind and disposition of the select. + -- Determine the kind and disposition of the select Treatment := Default_Treatment (Select_Mode); Self_Id.Chosen_Index := No_Rendezvous; @@ -1528,7 +1531,7 @@ package body System.Tasking.Rendezvous is end if; end if; - -- Handle the select according to the disposition selected above. + -- Handle the select according to the disposition selected above case Treatment is when Accept_Alternative_Selected => @@ -1555,7 +1558,8 @@ package body System.Tasking.Rendezvous is STPO.Unlock (Caller); when Accept_Alternative_Open => - -- Wait for caller. + + -- Wait for caller Self_Id.Open_Accepts := Open_Accepts; @@ -1563,9 +1567,8 @@ package body System.Tasking.Rendezvous is -- Wakeup_Time is reached. -- Try to remove calls to Sleep in the loop below by letting the - -- caller a chance of getting ready immediately, using Unlock & - -- Yield. - -- See similar action in Wait_For_Completion & Wait_For_Call. + -- 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; @@ -1622,9 +1625,9 @@ package body System.Tasking.Rendezvous is -- Self_Id.Common.Call should already be updated by the Caller if -- not aborted. It might also be ready to do rendezvous even if - -- this wakes up due to an abortion. - -- Therefore, if the call is not empty we need to do the - -- rendezvous if the accept body is not Null_Body. + -- this wakes up due to an abort. Therefore, if the call is not + -- empty we need to do the rendezvous if the accept body is not + -- Null_Body. if Self_Id.Chosen_Index /= No_Rendezvous and then Self_Id.Common.Call /= null @@ -1648,7 +1651,7 @@ package body System.Tasking.Rendezvous is -- for several reasons: -- 1) Delay is expired -- 2) Pending_Action needs to be checked - -- (Abortion, Priority change) + -- (Abort, Priority change) -- 3) Spurious wakeup Self_Id.Open_Accepts := null; @@ -1753,7 +1756,7 @@ package body System.Tasking.Rendezvous is Entry_Call.Called_PO := Null_Address; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; - -- Note: the caller will undefer abortion on return (see WARNING above) + -- Note: the caller will undefer abort on return (see WARNING above) if Single_Lock then Lock_RTS; @@ -1820,7 +1823,7 @@ package body System.Tasking.Rendezvous is Write_Lock (Self_Id); end if; - -- Check if this task has been aborted while the lock was released. + -- Check if this task has been aborted while the lock was released if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then Self_Id.Open_Accepts := null; |
