diff options
Diffstat (limited to 'gcc/ada/s-tposen.adb')
| -rw-r--r-- | gcc/ada/s-tposen.adb | 206 |
1 files changed, 22 insertions, 184 deletions
diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index 356da5aa461..697ee9dabb1 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -74,9 +74,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Local Subprograms -- ----------------------- - procedure Send_Program_Error - (Self_Id : Task_Id; - Entry_Call : Entry_Call_Link); + procedure Send_Program_Error (Entry_Call : Entry_Call_Link); pragma Inline (Send_Program_Error); -- Raise Program_Error in the caller of the specified entry call @@ -84,19 +82,12 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Entry Calls Handling -- -------------------------- - procedure Wakeup_Entry_Caller - (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - New_State : Entry_Call_State); + procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link); pragma Inline (Wakeup_Entry_Caller); -- This is called at the end of service of an entry call, -- to abort the caller if he is in an abortable part, and -- to wake up the caller if he is on Entry_Caller_Sleep. -- Call it holding the lock of Entry_Call.Self. - -- - -- Timed_Call or Simple_Call: - -- The caller is waiting on Entry_Caller_Sleep, in - -- Wait_For_Completion, or Wait_For_Completion_With_Timeout. procedure Wait_For_Completion (Entry_Call : Entry_Call_Link); pragma Inline (Wait_For_Completion); @@ -105,13 +96,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- queued. This waits for calls on protected entries. -- Call this only when holding Self_ID locked. - procedure Wait_For_Completion_With_Timeout - (Entry_Call : Entry_Call_Link; - Wakeup_Time : Duration; - Mode : Delay_Modes); - -- Same as Wait_For_Completion but it waits for a timeout with the value - -- specified in Wakeup_Time as well. - procedure Check_Exception (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); @@ -122,8 +106,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- The caller should not be holding any locks, or there will be deadlock. procedure PO_Do_Or_Queue - (Self_Id : Task_Id; - Object : Protection_Entry_Access; + (Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link); -- This procedure executes or queues an entry call, depending -- on the status of the corresponding barrier. It assumes that the @@ -157,9 +140,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Send_Program_Error -- ------------------------ - procedure Send_Program_Error - (Self_Id : Task_Id; - Entry_Call : Entry_Call_Link) + procedure Send_Program_Error (Entry_Call : Entry_Call_Link) is Caller : constant Task_Id := Entry_Call.Self; begin @@ -170,7 +151,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is end if; STPO.Write_Lock (Caller); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Caller); if Single_Lock then @@ -190,51 +171,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is Self_Id.Common.State := Runnable; end Wait_For_Completion; - -------------------------------------- - -- Wait_For_Completion_With_Timeout -- - -------------------------------------- - - procedure Wait_For_Completion_With_Timeout - (Entry_Call : Entry_Call_Link; - Wakeup_Time : Duration; - Mode : Delay_Modes) - is - Self_Id : constant Task_Id := Entry_Call.Self; - Timedout : Boolean; - - Yielded : Boolean; - pragma Unreferenced (Yielded); - - use type Ada.Exceptions.Exception_Id; - - begin - -- 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 the - -- following possible reasons: - - -- 1) The entry call is done being served. - -- 2) The timeout has expired (Timedout = True) - - -- 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 Sleep - -- with a timeout. We just sleep until we get a wakeup for some status - -- change. - - pragma Assert (Entry_Call.Mode = Timed_Call); - Self_Id.Common.State := Entry_Caller_Sleep; - - STPO.Timed_Sleep - (Self_Id, Wakeup_Time, Mode, Entry_Caller_Sleep, Timedout, Yielded); - - Entry_Call.State := (if Timedout then Cancelled else Done); - Self_Id.Common.State := Runnable; - end Wait_For_Completion_With_Timeout; - ------------------------- -- Wakeup_Entry_Caller -- ------------------------- @@ -246,31 +182,18 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- (This enforces the rule that a task must be off-queue if its state is -- Done or Cancelled.) Call it holding the lock of Entry_Call.Self. - -- Timed_Call or Simple_Call: - -- The caller is waiting on Entry_Caller_Sleep, in - -- Wait_For_Completion, or Wait_For_Completion_With_Timeout. - - -- Conditional_Call: - -- The caller might be in Wait_For_Completion, - -- waiting for a rendezvous (possibly requeued without abort) - -- to complete. + -- The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion. procedure Wakeup_Entry_Caller - (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - New_State : Entry_Call_State) + (Entry_Call : Entry_Call_Link) is - pragma Warnings (Off, Self_ID); - Caller : constant Task_Id := Entry_Call.Self; - begin - pragma Assert (New_State = Done or else New_State = Cancelled); pragma Assert (Caller.Common.State /= Terminated and then Caller.Common.State /= Unactivated); - Entry_Call.State := New_State; + Entry_Call.State := Done; STPO.Wakeup (Caller, Entry_Caller_Sleep); end Wakeup_Entry_Caller; @@ -338,8 +261,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -------------------- procedure PO_Do_Or_Queue - (Self_Id : Task_Id; - Object : Protection_Entry_Access; + (Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link) is Barrier_Value : Boolean; @@ -356,7 +278,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- This violates the No_Entry_Queue restriction, send -- Program_Error to the caller. - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); return; end if; @@ -370,45 +292,32 @@ package body System.Tasking.Protected_Objects.Single_Entry is end if; STPO.Write_Lock (Entry_Call.Self); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Entry_Call.Self); if Single_Lock then STPO.Unlock_RTS; end if; - elsif Entry_Call.Mode /= Conditional_Call then + else + pragma Assert (Entry_Call.Mode = Simple_Call); + if Object.Entry_Queue /= null then -- This violates the No_Entry_Queue restriction, send -- Program_Error to the caller. - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); return; else Object.Entry_Queue := Entry_Call; end if; - else - -- Conditional_Call - - if Single_Lock then - STPO.Lock_RTS; - end if; - - STPO.Write_Lock (Entry_Call.Self); - 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 when others => - Send_Program_Error - (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); end PO_Do_Or_Queue; ---------------------------- @@ -430,8 +339,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is procedure Protected_Single_Entry_Call (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Mode : Call_Modes) + Uninterpreted_Data : System.Address) is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); @@ -448,12 +356,12 @@ package body System.Tasking.Protected_Objects.Single_Entry is Lock_Entry (Object); - Entry_Call.Mode := Mode; + Entry_Call.Mode := Simple_Call; Entry_Call.State := Now_Abortable; Entry_Call.Uninterpreted_Data := Uninterpreted_Data; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; - PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access); + PO_Do_Or_Queue (Object, Entry_Call'Access); Unlock_Entry (Object); -- The call is either `Done' or not. It cannot be cancelled since there @@ -493,7 +401,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is ------------------- procedure Service_Entry (Object : Protection_Entry_Access) is - Self_Id : constant Task_Id := STPO.Self; Entry_Call : constant Entry_Call_Link := Object.Entry_Queue; Caller : Task_Id; @@ -507,7 +414,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Violation of No_Entry_Queue restriction, raise exception - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); Unlock_Entry (Object); return; end if; @@ -524,7 +431,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is end if; STPO.Write_Lock (Caller); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Caller); if Single_Lock then @@ -539,79 +446,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is exception when others => - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); Unlock_Entry (Object); end Service_Entry; - --------------------------------------- - -- Timed_Protected_Single_Entry_Call -- - --------------------------------------- - - -- Compiler interface only (do not call from within the RTS) - - procedure Timed_Protected_Single_Entry_Call - (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Timeout : Duration; - Mode : Delay_Modes; - Entry_Call_Successful : out Boolean) - is - Self_Id : constant Task_Id := STPO.Self; - Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); - - begin - -- If pragma Detect_Blocking is active then Program_Error must be - -- raised if this potentially blocking operation is called from a - -- protected action. - - if Detect_Blocking - and then Self_Id.Common.Protected_Action_Nesting > 0 - then - raise Program_Error with "potentially blocking operation"; - end if; - - Lock (Object.Common'Access); - - Entry_Call.Mode := Timed_Call; - Entry_Call.State := Now_Abortable; - Entry_Call.Uninterpreted_Data := Uninterpreted_Data; - Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; - - PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access); - Unlock_Entry (Object); - - -- Try to avoid waiting for completed calls. - -- The call is either `Done' or not. It cannot be cancelled since there - -- is no ATC construct and the timed wait has not started yet. - - pragma Assert (Entry_Call.State /= Cancelled); - - if Entry_Call.State = Done then - Check_Exception (Self_Id, Entry_Call'Access); - Entry_Call_Successful := True; - return; - end if; - - if Single_Lock then - STPO.Lock_RTS; - else - STPO.Write_Lock (Self_Id); - end if; - - Wait_For_Completion_With_Timeout (Entry_Call'Access, Timeout, Mode); - - if Single_Lock then - STPO.Unlock_RTS; - else - STPO.Unlock (Self_Id); - end if; - - pragma Assert (Entry_Call.State >= Done); - - Check_Exception (Self_Id, Entry_Call'Access); - Entry_Call_Successful := Entry_Call.State = Done; - end Timed_Protected_Single_Entry_Call; - ------------------ -- Unlock_Entry -- ------------------ |