with System.Tasking.Rendezvous;
-- used for Task_Do_Or_Queue
+with System.Tasking.Utilities;
+-- used for Exit_One_ATC_Level
+
with System.Tasking.Debug;
-- used for Trace
-- Call this only while holding the PO's lock.
-- It returns with the PO's lock still held.
+ procedure Requeue_Call
+ (Self_Id : Task_Id;
+ Object : Protection_Entries_Access;
+ Entry_Call : Entry_Call_Link;
+ With_Abort : Boolean);
+ -- Handle requeue of Entry_Call.
+ -- In particular, queue the call if needed, or service it immediately
+ -- if possible.
+
---------------------------------
-- Cancel_Protected_Entry_Call --
---------------------------------
--------------------
procedure PO_Do_Or_Queue
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Object : Protection_Entries_Access;
Entry_Call : Entry_Call_Link;
With_Abort : Boolean)
is
- E : Protected_Entry_Index := Protected_Entry_Index (Entry_Call.E);
- New_Object : Protection_Entries_Access;
- Ceiling_Violation : Boolean;
- Barrier_Value : Boolean;
- Result : Boolean;
+ E : constant Protected_Entry_Index :=
+ Protected_Entry_Index (Entry_Call.E);
+ Barrier_Value : Boolean;
begin
-- When the Action procedure for an entry body returns, it is either
end if;
else
- -- Body of current entry requeued the call
- New_Object := To_Protection (Entry_Call.Called_PO);
-
- if New_Object = null then
-
- -- Call was requeued to a task
-
- if Single_Lock then
- STPO.Lock_RTS;
- end if;
-
- Result := Rendezvous.Task_Do_Or_Queue
- (Self_ID, Entry_Call,
- With_Abort => Entry_Call.Requeue_With_Abort);
-
- if not Result then
- Queuing.Broadcast_Program_Error
- (Self_ID, Object, Entry_Call, RTS_Locked => True);
- end if;
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
- return;
- end if;
-
- if Object /= New_Object then
- -- Requeue is on a different object
-
- Lock_Entries (New_Object, Ceiling_Violation);
-
- if Ceiling_Violation then
- Object.Call_In_Progress := null;
- Queuing.Broadcast_Program_Error
- (Self_ID, Object, Entry_Call);
-
- else
- PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call, With_Abort);
- PO_Service_Entries (Self_ID, New_Object);
- end if;
-
- else
- -- Requeue is on same protected object
-
- if Entry_Call.Requeue_With_Abort
- and then Entry_Call.Cancellation_Attempted
- then
- -- If this is a requeue with abort and someone tried
- -- to cancel this call, cancel it at this point.
-
- Entry_Call.State := Cancelled;
- return;
- end if;
-
- if not With_Abort or else
- Entry_Call.Mode /= Conditional_Call
- then
- E := Protected_Entry_Index (Entry_Call.E);
- Queuing.Enqueue
- (New_Object.Entry_Queues (E), Entry_Call);
- Update_For_Queue_To_PO (Entry_Call, With_Abort);
-
- else
- -- ?????
- -- Can we convert this recursion to a loop?
-
- PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call, With_Abort);
- end if;
- end if;
+ Requeue_Call (Self_ID, Object, Entry_Call, With_Abort);
end if;
- elsif Entry_Call.Mode /= Conditional_Call or else
- not With_Abort then
+ elsif Entry_Call.Mode /= Conditional_Call
+ or else not With_Abort
+ then
Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
Update_For_Queue_To_PO (Entry_Call, With_Abort);
------------------------
procedure PO_Service_Entries
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Object : Entries.Protection_Entries_Access;
Unlock_Object : Boolean := True)
is
- procedure Requeue_Call
- (Entry_Call : Entry_Call_Link;
- Call_Cancelled : out Boolean);
- -- Handle requeue of Entry_Call.
- -- Call_Cancelled is set to True of call was cancelled.
-
- ------------------
- -- Requeue_Call --
- ------------------
-
- procedure Requeue_Call
- (Entry_Call : Entry_Call_Link;
- Call_Cancelled : out Boolean)
- is
- New_Object : Protection_Entries_Access;
- Ceiling_Violation : Boolean;
- Result : Boolean;
- E : Protected_Entry_Index;
-
- begin
- Call_Cancelled := False;
- New_Object := To_Protection (Entry_Call.Called_PO);
-
- if New_Object = null then
-
- -- 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,
- With_Abort => Entry_Call.Requeue_With_Abort);
-
- if not Result then
- Queuing.Broadcast_Program_Error
- (Self_ID, Object, Entry_Call, RTS_Locked => True);
- end if;
-
- if Single_Lock then
- STPO.Unlock_RTS;
- end if;
-
- else
- -- Call should be requeued to a PO
-
- if Object /= New_Object then
-
- -- Requeue is to different PO
-
- Lock_Entries (New_Object, Ceiling_Violation);
-
- if Ceiling_Violation then
- Object.Call_In_Progress := null;
- Queuing.Broadcast_Program_Error
- (Self_ID, Object, Entry_Call);
-
- else
- PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
- Entry_Call.Requeue_With_Abort);
- PO_Service_Entries (Self_ID, New_Object);
- end if;
-
- else
- -- Requeue is to same protected object
-
- if Entry_Call.Requeue_With_Abort
- and then Entry_Call.Cancellation_Attempted
- then
- -- If this is a requeue with abort and someone tried
- -- to cancel this call, cancel it at this point.
-
- Entry_Call.State := Cancelled;
- Call_Cancelled := True;
- return;
- end if;
-
- if not Entry_Call.Requeue_With_Abort or else
- Entry_Call.Mode /= Conditional_Call
- then
- E := Protected_Entry_Index (Entry_Call.E);
- Queuing.Enqueue
- (New_Object.Entry_Queues (E), Entry_Call);
- Update_For_Queue_To_PO (Entry_Call,
- Entry_Call.Requeue_With_Abort);
-
- else
- PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
- Entry_Call.Requeue_With_Abort);
- end if;
- end if;
- end if;
- end Requeue_Call;
-
E : Protected_Entry_Index;
- Caller : Task_ID;
+ Caller : Task_Id;
Entry_Call : Entry_Call_Link;
- Cancelled : Boolean;
begin
loop
end;
if Object.Call_In_Progress = null then
- Requeue_Call (Entry_Call, Cancelled);
- exit when Cancelled;
+ Requeue_Call
+ (Self_ID, Object, Entry_Call, Entry_Call.Requeue_With_Abort);
+ exit when Entry_Call.State = Cancelled;
else
Object.Call_In_Progress := null;
Mode : Call_Modes;
Block : out Communication_Block)
is
- Self_ID : Task_ID := STPO.Self;
+ Self_ID : constant Task_Id := STPO.Self;
Entry_Call : Entry_Call_Link;
Initially_Abortable : Boolean;
Ceiling_Violation : Boolean;
Initially_Abortable := Entry_Call.State = Now_Abortable;
PO_Service_Entries (Self_ID, Object);
- -- Try to prevent waiting later (in Cancel_Protected_Entry_Call)
+ -- Try to prevent waiting later (in Try_To_Cancel_Protected_Entry_Call)
-- for completed or cancelled calls. (This is a heuristic, only.)
if Entry_Call.State >= Done then
-- Once State >= Done it will not change any more.
- Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1;
- pragma Debug
- (Debug.Trace (Self_ID, "PEC: exited to ATC level: " &
- ATC_Level'Image (Self_ID.ATC_Nesting_Level), 'A'));
+ 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 (Self_ID);
Entry_Calls.Check_Exception (Self_ID, Entry_Call);
end Protected_Entry_Call;
+ ------------------
+ -- Requeue_Call --
+ ------------------
+
+ procedure Requeue_Call
+ (Self_Id : Task_Id;
+ Object : Protection_Entries_Access;
+ Entry_Call : Entry_Call_Link;
+ With_Abort : Boolean)
+ is
+ New_Object : Protection_Entries_Access;
+ Ceiling_Violation : Boolean;
+ Result : Boolean;
+ E : Protected_Entry_Index;
+
+ begin
+ New_Object := To_Protection (Entry_Call.Called_PO);
+
+ if New_Object = null then
+
+ -- 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,
+ With_Abort => Entry_Call.Requeue_With_Abort);
+
+ if not Result then
+ Queuing.Broadcast_Program_Error
+ (Self_Id, Object, Entry_Call, RTS_Locked => True);
+ end if;
+
+ if Single_Lock then
+ STPO.Unlock_RTS;
+ end if;
+
+ else
+ -- Call should be requeued to a PO
+
+ if Object /= New_Object then
+
+ -- Requeue is to different PO
+
+ Lock_Entries (New_Object, Ceiling_Violation);
+
+ if Ceiling_Violation then
+ Object.Call_In_Progress := null;
+ Queuing.Broadcast_Program_Error
+ (Self_Id, Object, Entry_Call);
+
+ else
+ PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
+ PO_Service_Entries (Self_Id, New_Object);
+ end if;
+
+ else
+ -- Requeue is to same protected object
+
+ if Entry_Call.Requeue_With_Abort
+ and then Entry_Call.Cancellation_Attempted
+ then
+ -- If this is a requeue with abort and someone tried
+ -- to cancel this call, cancel it at this point.
+
+ Entry_Call.State := Cancelled;
+ return;
+ end if;
+
+ if not With_Abort
+ or else Entry_Call.Mode /= Conditional_Call
+ then
+ E := Protected_Entry_Index (Entry_Call.E);
+ Queuing.Enqueue
+ (New_Object.Entry_Queues (E), Entry_Call);
+ Update_For_Queue_To_PO (Entry_Call, With_Abort);
+
+ else
+ PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
+ end if;
+ end if;
+ end if;
+ end Requeue_Call;
+
----------------------------
-- Protected_Entry_Caller --
----------------------------
function Protected_Entry_Caller
- (Object : Protection_Entries'Class) return Task_ID is
+ (Object : Protection_Entries'Class) return Task_Id is
begin
return Object.Call_In_Progress.Self;
end Protected_Entry_Caller;
E : Protected_Entry_Index;
With_Abort : Boolean)
is
- Self_ID : constant Task_ID := STPO.Self;
+ Self_ID : constant Task_Id := STPO.Self;
Entry_Call : constant Entry_Call_Link := Self_ID.Common.Call;
begin
---------------------
procedure Service_Entries (Object : Protection_Entries_Access) is
- Self_ID : constant Task_ID := STPO.Self;
+ Self_ID : constant Task_Id := STPO.Self;
begin
PO_Service_Entries (Self_ID, Object);
end Service_Entries;
Mode : Delay_Modes;
Entry_Call_Successful : out Boolean)
is
- Self_Id : constant Task_ID := STPO.Self;
+ Self_Id : constant Task_Id := STPO.Self;
Entry_Call : Entry_Call_Link;
Ceiling_Violation : Boolean;
Yielded : Boolean;
PO_Do_Or_Queue (Self_Id, Object, Entry_Call, With_Abort => True);
PO_Service_Entries (Self_Id, Object);
+ if Single_Lock then
+ STPO.Lock_RTS;
+ else
+ STPO.Write_Lock (Self_Id);
+ end if;
+
-- Try to avoid waiting for completed or cancelled calls.
if Entry_Call.State >= Done then
- Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level - 1;
- pragma Debug
- (Debug.Trace (Self_Id, "TPEC: exited to ATC level: " &
- ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
+ Utilities.Exit_One_ATC_Level (Self_Id);
+
+ if Single_Lock then
+ STPO.Unlock_RTS;
+ else
+ STPO.Unlock (Self_Id);
+ end if;
+
Entry_Call_Successful := Entry_Call.State = Done;
Initialization.Undefer_Abort (Self_Id);
Entry_Calls.Check_Exception (Self_Id, Entry_Call);
return;
end if;
- if Single_Lock then
- STPO.Lock_RTS;
- else
- STPO.Write_Lock (Self_Id);
- end if;
-
Entry_Calls.Wait_For_Completion_With_Timeout
(Entry_Call, Timeout, Mode, Yielded);
OSDN Git Service
