-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
with System.Tasking.Initialization;
-- used for Defer_Abort
-- Undefer_Abort
--- Poll_Base_Priority_Change
-- Do_Pending_Action
with System.Tasking.Queuing;
with System.Tasking.Debug;
-- used for Trace
+with System.Restrictions;
+-- used for Abort_Allowed
+
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
Entry_Call.Called_Task := Acceptor;
Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+ Entry_Call.With_Abort := True;
-- Note: the caller will undefer abort on return (see WARNING above)
Lock_RTS;
end if;
- if not Task_Do_Or_Queue
- (Self_Id, Entry_Call, With_Abort => True)
- then
+ if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
Send_Trace_Info (E_Missed, Acceptor);
end if;
- Initialization.Undefer_Abort (Self_Id);
+ Local_Undefer_Abort (Self_Id);
raise Tasking_Error;
end if;
Self_Id : constant Task_Id := STPO.Self;
begin
- Initialization.Defer_Abort (Self_Id);
+ Initialization.Defer_Abort_Nestable (Self_Id);
if Single_Lock then
Lock_RTS;
Unlock_RTS;
end if;
- Initialization.Undefer_Abort (Self_Id);
+ Initialization.Undefer_Abort_Nestable (Self_Id);
return Result;
end Callable;
Lock_RTS;
end if;
- if not Task_Do_Or_Queue
- (Self_Id, Entry_Call, Entry_Call.Requeue_With_Abort)
- then
+ if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
if Single_Lock then
Unlock_RTS;
end if;
end if;
else
- POO.PO_Do_Or_Queue
- (Self_Id, Called_PO, Entry_Call,
- Entry_Call.Requeue_With_Abort);
+ POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
POO.PO_Service_Entries (Self_Id, Called_PO);
end if;
end if;
Entry_Call.E := Entry_Index (E);
Entry_Call.Called_Task := Acceptor;
Entry_Call.Called_PO := Null_Address;
- Entry_Call.Requeue_With_Abort := With_Abort;
+ Entry_Call.With_Abort := With_Abort;
Object.Call_In_Progress := null;
end Requeue_Protected_To_Task_Entry;
begin
Initialization.Defer_Abort (Self_Id);
Entry_Call.Needs_Requeue := True;
- Entry_Call.Requeue_With_Abort := With_Abort;
+ Entry_Call.With_Abort := With_Abort;
Entry_Call.E := Entry_Index (E);
Entry_Call.Called_Task := Acceptor;
Initialization.Undefer_Abort (Self_Id);
then
Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
- pragma Assert (Self_Id.Deferral_Level = 1);
+ pragma Assert
+ (Self_Id.Deferral_Level = 1
+ or else
+ (Self_Id.Deferral_Level = 0
+ and then not Restrictions.Abort_Allowed));
Initialization.Defer_Abort_Nestable (Self_Id);
Self_Id.Common.State := Delay_Sleep;
loop
- Initialization.Poll_Base_Priority_Change (Self_Id);
exit when
Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
Sleep (Self_Id, Delay_Sleep);
end if;
Initialization.Undefer_Abort (Self_Id);
+
+ -- Call Yield to let other tasks get a chance to run as this is a
+ -- potential dispatching point.
+
+ Yield (Do_Yield => False);
return Return_Count;
end Task_Count;
function Task_Do_Or_Queue
(Self_ID : Task_Id;
- Entry_Call : Entry_Call_Link;
- With_Abort : Boolean) return Boolean
+ Entry_Call : Entry_Call_Link) return Boolean
is
E : constant Task_Entry_Index :=
- Task_Entry_Index (Entry_Call.E);
+ Task_Entry_Index (Entry_Call.E);
Old_State : constant Entry_Call_State := Entry_Call.State;
Acceptor : constant Task_Id := Entry_Call.Called_Task;
Parent : constant Task_Id := Acceptor.Common.Parent;
Null_Body : Boolean;
begin
- -- Find out whether Entry_Call can be accepted immediately.
+ -- Find out whether Entry_Call can be accepted immediately
+
-- If the Acceptor is not callable, return False.
-- If the rendezvous can start, initiate it.
-- If the accept-body is trivial, also complete the rendezvous.
-- (re)enqueue the call, if the mode permits that.
if Entry_Call.Mode /= Conditional_Call
- or else not With_Abort
+ or else not Entry_Call.With_Abort
then
-- Timed_Call, Simple_Call, or Asynchronous_Call
pragma Assert (Old_State < Done);
- Entry_Call.State := New_State (With_Abort, Entry_Call.State);
+ Entry_Call.State :=
+ New_State (Entry_Call.With_Abort, Entry_Call.State);
STPO.Unlock (Acceptor);
Entry_Call.Called_Task := Acceptor;
Entry_Call.Called_PO := Null_Address;
Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+ Entry_Call.With_Abort := True;
if Single_Lock then
Lock_RTS;
end if;
- if not Task_Do_Or_Queue
- (Self_Id, Entry_Call, With_Abort => True)
- then
+ if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
-- Wait for a normal call and a pending action until the
-- Wakeup_Time is reached.
+ Self_Id.Common.State := Acceptor_Sleep;
+
-- 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.
Self_Id.Open_Accepts := null;
end if;
- Self_Id.Common.State := Acceptor_Sleep;
-
loop
- Initialization.Poll_Base_Priority_Change (Self_Id);
exit when Self_Id.Open_Accepts = null;
if Timedout then
Self_Id.Open_Accepts := null;
Self_Id.Common.State := Acceptor_Sleep;
- Initialization.Poll_Base_Priority_Change (Self_Id);
-
STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
Timedout, Yielded);
Entry_Call.Called_Task := Acceptor;
Entry_Call.Called_PO := Null_Address;
Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+ Entry_Call.With_Abort := True;
-- Note: the caller will undefer abort on return (see WARNING above)
Lock_RTS;
end if;
- if not Task_Do_Or_Queue
- (Self_Id, Entry_Call, With_Abort => True)
- then
+ if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
STPO.Write_Lock (Self_Id);
Utilities.Exit_One_ATC_Level (Self_Id);
STPO.Unlock (Self_Id);
procedure Wait_For_Call (Self_Id : Task_Id) is
begin
+ Self_Id.Common.State := Acceptor_Sleep;
+
-- 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 & Selective_Wait.
+ -- See similar action in Wait_For_Completion & Timed_Selective_Wait.
if Single_Lock then
Unlock_RTS;
Self_Id.Open_Accepts := null;
end if;
- Self_Id.Common.State := Acceptor_Sleep;
-
loop
- Initialization.Poll_Base_Priority_Change (Self_Id);
-
exit when Self_Id.Open_Accepts = null;
-
Sleep (Self_Id, Acceptor_Sleep);
end loop;
OSDN Git Service
