X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fs-taenca.adb;fp=gcc%2Fada%2Fs-taenca.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=bd32d3049d9ed94114064948ae327597123f8c02;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb deleted file mode 100644 index bd32d304..00000000 --- a/gcc/ada/s-taenca.adb +++ /dev/null @@ -1,713 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . T A S K I N G . E N T R Y _ C A L L S -- --- -- --- B o d y -- --- -- --- $Revision: 1.1 $ --- -- --- Copyright (C) 1991-2001, Florida State University -- --- -- --- 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. It is -- --- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- --- State University (http://www.gnat.com). -- --- -- ------------------------------------------------------------------------------- - --- This package provides internal RTS calls implementing operations --- that apply to general entry calls, that is, calls to either --- protected or task entries. - --- These declarations are not part of the GNARL interface - -with System.Task_Primitives.Operations; --- used for STPO.Write_Lock --- Unlock --- STPO.Get_Priority --- Sleep --- Timed_Sleep - -with System.Tasking.Initialization; --- used for Change_Base_Priority --- Poll_Base_Priority_Change_At_Entry_Call --- Dynamic_Priority_Support --- Defer_Abort/Undefer_Abort - -with System.Tasking.Protected_Objects.Entries; --- used for To_Protection - -with System.Tasking.Protected_Objects.Operations; --- used for PO_Service_Entries - -with System.Tasking.Queuing; --- used for Requeue_Call_With_New_Prio --- Onqueue --- Dequeue_Call - -with System.Tasking.Utilities; --- used for Exit_One_ATC_Level - -package body System.Tasking.Entry_Calls is - - package STPO renames System.Task_Primitives.Operations; - - use System.Task_Primitives; - use System.Tasking.Protected_Objects.Entries; - use System.Tasking.Protected_Objects.Operations; - - -- DO NOT use Protected_Objects.Lock or Protected_Objects.Unlock - -- internally. Those operations will raise Program_Error, which - -- we do are not prepared to handle inside the RTS. Instead, use - -- System.Task_Primitives lock operations directly on Protection.L. - - ----------------------- - -- Local Subprograms -- - ----------------------- - - procedure Lock_Server (Entry_Call : Entry_Call_Link); - -- This locks the server targeted by Entry_Call. - -- - -- This may be a task or a protected object, - -- depending on the target of the original call or any subsequent - -- requeues. - -- - -- This routine is needed because the field specifying the server - -- for this call must be protected by the server's mutex. If it were - -- protected by the caller's mutex, accessing the server's queues would - -- require locking the caller to get the server, locking the server, - -- and then accessing the queues. This involves holding two ATCB - -- locks at once, something which we can guarantee that it will always - -- be done in the same order, or locking a protected object while we - -- hold an ATCB lock, something which is not permitted. Since - -- the server cannot be obtained reliably, it must be obtained unreliably - -- and then checked again once it has been locked. - - procedure Unlock_Server (Entry_Call : Entry_Call_Link); - -- STPO.Unlock the server targeted by Entry_Call. The server must - -- be locked before calling this. - - 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. - - procedure Check_Pending_Actions_For_Entry_Call - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link); - pragma Inline (Check_Pending_Actions_For_Entry_Call); - -- This procedure performs priority change of a queued call and - -- dequeuing of an entry call when an the call is cancelled. - -- If the call is dequeued the state should be set to Cancelled. - - procedure Poll_Base_Priority_Change_At_Entry_Call - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link); - pragma Inline (Poll_Base_Priority_Change_At_Entry_Call); - -- Has to be called with the Self_ID's ATCB write-locked. - -- May temporariliy release the lock. - - --------------------- - -- Check_Exception -- - --------------------- - - -- Raise any pending exception from the Entry_Call. - - -- This should be called at the end of every compiler interface - -- procedure that implements an entry call. - - -- In principle, the caller should not be abort-deferred (unless - -- the application program violates the Ada language rules by doing - -- entry calls from within protected operations -- an erroneous practice - -- apparently followed with success by some adventurous GNAT users). - -- Absolutely, the caller should not be holding any locks, or there - -- will be deadlock. - - procedure Check_Exception - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link) - is - use type Ada.Exceptions.Exception_Id; - - procedure Internal_Raise (X : Ada.Exceptions.Exception_Id); - pragma Import (C, Internal_Raise, "__gnat_raise_with_msg"); - - E : constant Ada.Exceptions.Exception_Id := - Entry_Call.Exception_To_Raise; - begin - -- pragma Assert (Self_ID.Deferral_Level = 0); - -- The above may be useful for debugging, but the Florist packages - -- contain critical sections that defer abort and then do entry calls, - -- which causes the above Assert to trip. - - if E /= Ada.Exceptions.Null_Id then - Internal_Raise (E); - end if; - end Check_Exception; - - ----------------------------------------- - -- Check_Pending_Actions_For_Entry_Call -- - ----------------------------------------- - - -- Call only with abort deferred and holding lock of Self_ID. This - -- is a bit of common code for all entry calls. The effect is to do - -- any deferred base priority change operation, in case some other - -- task called STPO.Set_Priority while the current task had abort deferred, - -- and to dequeue the call if the call has been aborted. - - procedure Check_Pending_Actions_For_Entry_Call - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link) - is - begin - pragma Assert (Self_ID = Entry_Call.Self); - - Poll_Base_Priority_Change_At_Entry_Call (Self_ID, Entry_Call); - - if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level - and then Entry_Call.State = Now_Abortable - then - STPO.Unlock (Self_ID); - Lock_Server (Entry_Call); - - if Queuing.Onqueue (Entry_Call) - and then Entry_Call.State = Now_Abortable - then - Queuing.Dequeue_Call (Entry_Call); - - if Entry_Call.Cancellation_Attempted then - Entry_Call.State := Cancelled; - else - Entry_Call.State := Done; - end if; - - Unlock_And_Update_Server (Self_ID, Entry_Call); - - else - Unlock_Server (Entry_Call); - end if; - - STPO.Write_Lock (Self_ID); - end if; - end Check_Pending_Actions_For_Entry_Call; - - ----------------- - -- Lock_Server -- - ----------------- - - -- This should only be called by the Entry_Call.Self. - -- It should be holding no other ATCB locks at the time. - - procedure Lock_Server (Entry_Call : Entry_Call_Link) is - Test_Task : Task_ID; - Test_PO : Protection_Entries_Access; - Ceiling_Violation : Boolean; - Failures : Integer := 0; - - begin - Test_Task := Entry_Call.Called_Task; - - loop - if Test_Task = null then - - -- Entry_Call was queued on a protected object, - -- or in transition, when we last fetched Test_Task. - - Test_PO := To_Protection (Entry_Call.Called_PO); - - if Test_PO = null then - - -- We had very bad luck, interleaving with TWO different - -- requeue operations. Go around the loop and try again. - - STPO.Yield; - - else - Lock_Entries (Test_PO, Ceiling_Violation); - - -- ???? - -- The following code allows Lock_Server to be called - -- when cancelling a call, to allow for the possibility - -- that the priority of the caller has been raised - -- beyond that of the protected entry call by - -- Ada.Dynamic_Priorities.STPO.Set_Priority. - - -- If the current task has a higher priority than the ceiling - -- of the protected object, temporarily lower it. It will - -- be reset in Unlock. - - if Ceiling_Violation then - declare - Current_Task : Task_ID := STPO.Self; - Old_Base_Priority : System.Any_Priority; - - begin - STPO.Write_Lock (Current_Task); - Old_Base_Priority := Current_Task.Common.Base_Priority; - Current_Task.New_Base_Priority := Test_PO.Ceiling; - System.Tasking.Initialization.Change_Base_Priority - (Current_Task); - STPO.Unlock (Current_Task); - - -- Following lock should not fail - - Lock_Entries (Test_PO); - - Test_PO.Old_Base_Priority := Old_Base_Priority; - Test_PO.Pending_Action := True; - end; - end if; - - exit when To_Address (Test_PO) = Entry_Call.Called_PO; - Unlock_Entries (Test_PO); - end if; - - else - STPO.Write_Lock (Test_Task); - exit when Test_Task = Entry_Call.Called_Task; - STPO.Unlock (Test_Task); - end if; - - Test_Task := Entry_Call.Called_Task; - Failures := Failures + 1; - pragma Assert (Failures <= 5); - end loop; - end Lock_Server; - - --------------------------------------------- - -- Poll_Base_Priority_Change_At_Entry_Call -- - --------------------------------------------- - - -- A specialized version of Poll_Base_Priority_Change, - -- that does the optional entry queue reordering. - - procedure Poll_Base_Priority_Change_At_Entry_Call - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link) - is - begin - if Initialization.Dynamic_Priority_Support - and then Self_ID.Pending_Priority_Change - then - -- Check for ceiling violations ??? - - Self_ID.Pending_Priority_Change := False; - - if Self_ID.Common.Base_Priority = Self_ID.New_Base_Priority then - STPO.Unlock (Self_ID); - STPO.Yield; - STPO.Write_Lock (Self_ID); - - else - if Self_ID.Common.Base_Priority < Self_ID.New_Base_Priority then - - -- Raising priority - - Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority; - STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority); - - else - -- Lowering priority - - Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority; - STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority); - STPO.Unlock (Self_ID); - STPO.Yield; - STPO.Write_Lock (Self_ID); - end if; - end if; - - -- Requeue the entry call at the new priority. - -- We need to requeue even if the new priority is the same than - -- the previous (see ACVC cxd4006). - - STPO.Unlock (Self_ID); - Lock_Server (Entry_Call); - Queuing.Requeue_Call_With_New_Prio - (Entry_Call, STPO.Get_Priority (Self_ID)); - Unlock_And_Update_Server (Self_ID, Entry_Call); - STPO.Write_Lock (Self_ID); - end if; - end Poll_Base_Priority_Change_At_Entry_Call; - - -------------------- - -- Reset_Priority -- - -------------------- - - -- Reset the priority of a task completing an accept statement to - -- the value it had before the call. - - procedure Reset_Priority - (Acceptor_Prev_Priority : Rendezvous_Priority; - Acceptor : Task_ID) is - begin - if Acceptor_Prev_Priority /= Priority_Not_Boosted then - STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority, - Loss_Of_Inheritance => True); - end if; - end Reset_Priority; - - -- ??? - -- Check why we don't need any kind of lock to do this. - -- Do we limit this kind of "active" priority change to be done - -- by the task for itself only? - - ------------------------------ - -- Try_To_Cancel_Entry_Call -- - ------------------------------ - - -- This is used to implement the Cancel_Task_Entry_Call and - -- Cancel_Protected_Entry_Call. - -- Try to cancel async. entry call. - -- Effect includes Abort_To_Level and Wait_For_Completion. - -- Cancelled = True iff the cancelation was successful, i.e., - -- the call was not Done before this call. - -- On return, the call is off-queue and the ATC level is reduced by one. - - procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is - Entry_Call : Entry_Call_Link; - Self_ID : constant Task_ID := STPO.Self; - - use type Ada.Exceptions.Exception_Id; - - begin - Entry_Call := Self_ID.Entry_Calls (Self_ID.ATC_Nesting_Level)'Access; - - -- Experimentation has shown that abort is sometimes (but not - -- always) already deferred when Cancel_X_Entry_Call is called. - -- That may indicate an error. Find out what is going on. ??? - - pragma Assert (Entry_Call.Mode = Asynchronous_Call); - pragma Assert (Self_ID = Self); - - Initialization.Defer_Abort_Nestable (Self_ID); - STPO.Write_Lock (Self_ID); - Entry_Call.Cancellation_Attempted := True; - - if Self_ID.Pending_ATC_Level >= Entry_Call.Level then - Self_ID.Pending_ATC_Level := Entry_Call.Level - 1; - end if; - - Entry_Calls.Wait_For_Completion (Self_ID, Entry_Call); - STPO.Unlock (Self_ID); - Succeeded := Entry_Call.State = Cancelled; - - if Succeeded then - Initialization.Undefer_Abort_Nestable (Self_ID); - else - -- ???? - - Initialization.Undefer_Abort_Nestable (Self_ID); - - -- Ideally, abort should no longer be deferred at this - -- point, so we should be able to call Check_Exception. - -- The loop below should be considered temporary, - -- to work around the possiblility that abort may be deferred - -- more than one level deep. - - if Entry_Call.Exception_To_Raise /= Ada.Exceptions.Null_Id then - while Self_ID.Deferral_Level > 0 loop - System.Tasking.Initialization.Undefer_Abort_Nestable (Self_ID); - end loop; - - Entry_Calls.Check_Exception (Self_ID, Entry_Call); - end if; - end if; - end Try_To_Cancel_Entry_Call; - - ------------------------------ - -- Unlock_And_Update_Server -- - ------------------------------ - - procedure Unlock_And_Update_Server - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link) - is - Called_PO : Protection_Entries_Access; - Caller : Task_ID; - - begin - if Entry_Call.Called_Task /= null then - STPO.Unlock (Entry_Call.Called_Task); - else - Called_PO := To_Protection (Entry_Call.Called_PO); - PO_Service_Entries (Self_ID, Called_PO); - - if Called_PO.Pending_Action then - Called_PO.Pending_Action := False; - Caller := STPO.Self; - STPO.Write_Lock (Caller); - Caller.New_Base_Priority := Called_PO.Old_Base_Priority; - Initialization.Change_Base_Priority (Caller); - STPO.Unlock (Caller); - end if; - - Unlock_Entries (Called_PO); - end if; - end Unlock_And_Update_Server; - - ------------------- - -- Unlock_Server -- - ------------------- - - procedure Unlock_Server (Entry_Call : Entry_Call_Link) is - Caller : Task_ID; - Called_PO : Protection_Entries_Access; - - begin - if Entry_Call.Called_Task /= null then - STPO.Unlock (Entry_Call.Called_Task); - else - Called_PO := To_Protection (Entry_Call.Called_PO); - - if Called_PO.Pending_Action then - Called_PO.Pending_Action := False; - Caller := STPO.Self; - STPO.Write_Lock (Caller); - Caller.New_Base_Priority := Called_PO.Old_Base_Priority; - Initialization.Change_Base_Priority (Caller); - STPO.Unlock (Caller); - end if; - - Unlock_Entries (Called_PO); - end if; - end Unlock_Server; - - ------------------------- - -- Wait_For_Completion-- - ------------------------- - - -- Call this only when holding Self_ID locked - - -- If this is a conditional call, it should be cancelled when it - -- becomes abortable. This is checked in the loop below. - - -- We do the same thing for Asynchronous_Call. Executing the following - -- loop will clear the Pending_Action field if there is no - -- Pending_Action. We want the call made from Cancel_Task_Entry_Call - -- to check the abortion level so that we make sure that the Cancelled - -- field reflect the status of an Asynchronous_Call properly. - -- This problem came up when the triggered statement and the abortable - -- part depend on entries of the same task. When a cancellation is - -- delivered, Undefer_Abort in the call made from abortable part - -- sets the Pending_Action bit to false. However, the call is actually - -- made to cancel the Asynchronous Call so that we need to check its - -- status here again. Otherwise we may end up waiting for a cancelled - -- call forever. - - -- ????? ......... - -- Recheck the logic of the above old comment. It may be stale. - - procedure Wait_For_Completion - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link) - is - begin - pragma Assert (Self_ID = Entry_Call.Self); - Self_ID.Common.State := Entry_Caller_Sleep; - - loop - Check_Pending_Actions_For_Entry_Call (Self_ID, Entry_Call); - exit when Entry_Call.State >= Done; - STPO.Sleep (Self_ID, Entry_Caller_Sleep); - end loop; - - Self_ID.Common.State := Runnable; - Utilities.Exit_One_ATC_Level (Self_ID); - end Wait_For_Completion; - - -------------------------------------- - -- Wait_For_Completion_With_Timeout -- - -------------------------------------- - - -- This routine will lock Self_ID. - - -- This procedure waits for the entry call to - -- be served, with a timeout. It tries to cancel the - -- call if the timeout expires before the call is served. - - -- If we wake up from the timed sleep operation here, - -- it may be for several possible reasons: - - -- 1) The entry call is done being served. - -- 2) There is an abort or priority change to be served. - -- 3) The timeout has expired (Timedout = True) - -- 4) There has been a spurious wakeup. - - -- Once the timeout has expired we may need to continue to wait if - -- the call is already being serviced. In that case, we want to go - -- back to sleep, but without any timeout. The variable Timedout is - -- used to control this. If the Timedout flag is set, we do not need - -- to STPO.Sleep with a timeout. We just sleep until we get a wakeup for - -- some status change. - - -- The original call may have become abortable after waking up. - -- We want to check Check_Pending_Actions_For_Entry_Call again - -- in any case. - - procedure Wait_For_Completion_With_Timeout - (Self_ID : Task_ID; - Entry_Call : Entry_Call_Link; - Wakeup_Time : Duration; - Mode : Delay_Modes) - is - Timedout : Boolean := False; - Yielded : Boolean := False; - - use type Ada.Exceptions.Exception_Id; - - begin - Initialization.Defer_Abort_Nestable (Self_ID); - STPO.Write_Lock (Self_ID); - - pragma Assert (Entry_Call.Self = Self_ID); - pragma Assert (Entry_Call.Mode = Timed_Call); - Self_ID.Common.State := Entry_Caller_Sleep; - - -- Looping is necessary in case the task wakes up early from the - -- timed sleep, due to a "spurious wakeup". Spurious wakeups are - -- a weakness of POSIX condition variables. A thread waiting for - -- a condition variable is allowed to wake up at any time, not just - -- when the condition is signaled. See the same loop in the - -- ordinary Wait_For_Completion, above. - - loop - Check_Pending_Actions_For_Entry_Call (Self_ID, Entry_Call); - exit when Entry_Call.State >= Done; - - STPO.Timed_Sleep (Self_ID, Wakeup_Time, Mode, - Entry_Caller_Sleep, Timedout, Yielded); - - if Timedout then - - -- Try to cancel the call (see Try_To_Cancel_Entry_Call for - -- corresponding code in the ATC case). - - Entry_Call.Cancellation_Attempted := True; - - if Self_ID.Pending_ATC_Level >= Entry_Call.Level then - Self_ID.Pending_ATC_Level := Entry_Call.Level - 1; - end if; - - -- The following loop is the same as the loop and exit code - -- from the ordinary Wait_For_Completion. If we get here, we - -- have timed out but we need to keep waiting until the call - -- has actually completed or been cancelled successfully. - - loop - Check_Pending_Actions_For_Entry_Call (Self_ID, Entry_Call); - exit when Entry_Call.State >= Done; - STPO.Sleep (Self_ID, Entry_Caller_Sleep); - end loop; - - Self_ID.Common.State := Runnable; - Utilities.Exit_One_ATC_Level (Self_ID); - - STPO.Unlock (Self_ID); - - if Entry_Call.State = Cancelled then - Initialization.Undefer_Abort_Nestable (Self_ID); - else - -- ???? - - Initialization.Undefer_Abort_Nestable (Self_ID); - - -- Ideally, abort should no longer be deferred at this - -- point, so we should be able to call Check_Exception. - -- The loop below should be considered temporary, - -- to work around the possiblility that abort may be - -- deferred more than one level deep. - - if Entry_Call.Exception_To_Raise /= - Ada.Exceptions.Null_Id then - - while Self_ID.Deferral_Level > 0 loop - Initialization.Undefer_Abort_Nestable (Self_ID); - end loop; - - Entry_Calls.Check_Exception (Self_ID, Entry_Call); - end if; - end if; - - return; - end if; - end loop; - - -- This last part is the same as ordinary Wait_For_Completion, - -- and is only executed if the call completed without timing out. - - Self_ID.Common.State := Runnable; - Utilities.Exit_One_ATC_Level (Self_ID); - STPO.Unlock (Self_ID); - - Initialization.Undefer_Abort_Nestable (Self_ID); - - if not Yielded then - STPO.Yield; - end if; - end Wait_For_Completion_With_Timeout; - - -------------------------- - -- Wait_Until_Abortable -- - -------------------------- - - -- Wait to start the abortable part of an async. select statement - -- until the trigger entry call becomes abortable. - - procedure Wait_Until_Abortable - (Self_ID : Task_ID; - Call : Entry_Call_Link) - is - begin - pragma Assert (Self_ID.ATC_Nesting_Level > 0); - pragma Assert (Call.Mode = Asynchronous_Call); - - STPO.Write_Lock (Self_ID); - Self_ID.Common.State := Entry_Caller_Sleep; - - loop - Check_Pending_Actions_For_Entry_Call (Self_ID, Call); - exit when Call.State >= Was_Abortable; - STPO.Sleep (Self_ID, Async_Select_Sleep); - end loop; - - Self_ID.Common.State := Runnable; - STPO.Unlock (Self_ID); - end Wait_Until_Abortable; - - -- It might seem that we should be holding the server's lock when - -- we test Call.State above. - - -- In an earlier version, the code above temporarily unlocked the - -- caller and locked the server just for checking Call.State. - -- The unlocking of the caller risked missing a wakeup - -- (an error) and locking the server had no apparent value. - -- We should not need the server's lock, since once Call.State - -- is set to Was_Abortable or beyond, it never goes back below - -- Was_Abortable until this task starts another entry call. - - -- ???? - -- It seems that other calls to Lock_Server may also risk missing - -- wakeups. We need to check that they do not have this problem. - -end System.Tasking.Entry_Calls;