with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
with System.Tasking.Protected_Objects.Entries;
with System.Tasking.Protected_Objects.Operations;
with System.Tasking.Queuing;
with System.Tasking.Utilities;
with System.Parameters;
with System.Traces;
package body System.Tasking.Entry_Calls is
package STPO renames System.Task_Primitives.Operations;
use Parameters;
use Task_Primitives;
use Protected_Objects.Entries;
use Protected_Objects.Operations;
use System.Traces;
procedure Lock_Server (Entry_Call : Entry_Call_Link);
procedure Unlock_Server (Entry_Call : Entry_Call_Link);
procedure Unlock_And_Update_Server
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link);
procedure Check_Pending_Actions_For_Entry_Call
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link);
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);
procedure Check_Exception
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link)
is
pragma Warnings (Off, Self_ID);
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
if E /= Ada.Exceptions.Null_Id then
Internal_Raise (E);
end if;
end Check_Exception;
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;
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
Test_PO := To_Protection (Entry_Call.Called_PO);
if Test_PO = null then
if Single_Lock then
STPO.Unlock_RTS;
STPO.Yield;
STPO.Lock_RTS;
else
STPO.Yield;
end if;
else
if Single_Lock then
STPO.Unlock_RTS;
end if;
Lock_Entries (Test_PO, Ceiling_Violation);
if Ceiling_Violation then
declare
Current_Task : Task_ID := STPO.Self;
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;
System.Tasking.Initialization.Change_Base_Priority
(Current_Task);
STPO.Unlock (Current_Task);
if Single_Lock then
STPO.Unlock_RTS;
end if;
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);
if Single_Lock then
STPO.Lock_RTS;
end if;
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;
procedure Poll_Base_Priority_Change_At_Entry_Call
(Self_ID : Task_ID;
Entry_Call : Entry_Call_Link) is
begin
if Dynamic_Priority_Support and then Self_ID.Pending_Priority_Change then
Self_ID.Pending_Priority_Change := False;
if Self_ID.Common.Base_Priority = Self_ID.New_Base_Priority then
if Single_Lock then
STPO.Unlock_RTS;
STPO.Yield;
STPO.Lock_RTS;
else
STPO.Unlock (Self_ID);
STPO.Yield;
STPO.Write_Lock (Self_ID);
end if;
else
if Self_ID.Common.Base_Priority < Self_ID.New_Base_Priority then
Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
else
Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
if Single_Lock then
STPO.Unlock_RTS;
STPO.Yield;
STPO.Lock_RTS;
else
STPO.Unlock (Self_ID);
STPO.Yield;
STPO.Write_Lock (Self_ID);
end if;
end if;
end if;
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;
procedure Reset_Priority
(Acceptor : Task_ID;
Acceptor_Prev_Priority : Rendezvous_Priority) is
begin
pragma Assert (Acceptor = STPO.Self);
if Acceptor_Prev_Priority /= Priority_Not_Boosted then
STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority,
Loss_Of_Inheritance => True);
end if;
end Reset_Priority;
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;
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;
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 (Entry_Call);
STPO.Unlock (Self_ID);
if Single_Lock then
STPO.Unlock_RTS;
end if;
Succeeded := Entry_Call.State = Cancelled;
if Succeeded then
Initialization.Undefer_Abort_Nestable (Self_ID);
else
Initialization.Undefer_Abort_Nestable (Self_ID);
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;
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;
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;
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;
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;
procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is
Self_Id : constant Task_ID := Entry_Call.Self;
begin
if Parameters.Runtime_Traces then
Send_Trace_Info (W_Completion);
end if;
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);
if Parameters.Runtime_Traces then
Send_Trace_Info (M_Call_Complete);
end if;
end Wait_For_Completion;
procedure Wait_For_Completion_With_Timeout
(Entry_Call : Entry_Call_Link;
Wakeup_Time : Duration;
Mode : Delay_Modes;
Yielded : out Boolean)
is
Self_Id : constant Task_ID := Entry_Call.Self;
Timedout : Boolean := False;
use type Ada.Exceptions.Exception_Id;
begin
pragma Assert (Entry_Call.Mode = Timed_Call);
Yielded := False;
Self_Id.Common.State := Entry_Caller_Sleep;
if Parameters.Runtime_Traces then
Send_Trace_Info (WT_Completion, Wakeup_Time);
end if;
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
if Parameters.Runtime_Traces then
Send_Trace_Info (E_Timeout);
end if;
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;
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);
return;
end if;
end loop;
if Parameters.Runtime_Traces then
Send_Trace_Info (M_Call_Complete);
end if;
Self_Id.Common.State := Runnable;
Utilities.Exit_One_ATC_Level (Self_Id);
end Wait_For_Completion_With_Timeout;
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);
if Parameters.Runtime_Traces then
Send_Trace_Info (W_Completion);
end if;
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);
if Parameters.Runtime_Traces then
Send_Trace_Info (M_Call_Complete);
end if;
end Wait_Until_Abortable;
end System.Tasking.Entry_Calls;