-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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.Task_Primitives.Operations;
--- used for Get_Priority
--- Set_Priority
--- Write_Lock
--- Unlock
--- Sleep
--- Wakeup
--- Timed_Sleep
-
with System.Tasking.Entry_Calls;
--- Used for Wait_For_Completion
--- Wait_For_Completion_With_Timeout
--- Wait_Until_Abortable
-
with System.Tasking.Initialization;
--- used for Defer_Abort
--- Undefer_Abort
--- Poll_Base_Priority_Change
--- Do_Pending_Action
-
with System.Tasking.Queuing;
--- used for Enqueue
--- Dequeue_Head
--- Select_Task_Entry_Call
--- Count_Waiting
-
with System.Tasking.Utilities;
--- used for Check_Exception
--- Make_Passive
--- Wakeup_Entry_Caller
--- Exit_One_ATC_Level
-
with System.Tasking.Protected_Objects.Operations;
--- used for PO_Do_Or_Queue
--- PO_Service_Entries
--- Lock_Entries
-
with System.Tasking.Debug;
--- used for Trace
-
+with System.Restrictions;
with System.Parameters;
--- used for Single_Lock
--- Runtime_Traces
-
with System.Traces.Tasking;
--- used for Send_Trace_Info
package body System.Tasking.Rendezvous is
Uninterpreted_Data : System.Address)
is
Rendezvous_Successful : Boolean;
+ pragma Unreferenced (Rendezvous_Successful);
begin
-- If pragma Detect_Blocking is active then Program_Error must be
if System.Tasking.Detect_Blocking
and then STPO.Self.Common.Protected_Action_Nesting > 0
then
- Ada.Exceptions.Raise_Exception
- (Program_Error'Identity, "potentially blocking operation");
+ raise Program_Error with "potentially blocking operation";
end if;
Call_Synchronous
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);
- Ada.Exceptions.Raise_Exception
- (Program_Error'Identity, "Entry call not a delay mode");
+ raise Program_Error with "Entry call not a delay mode";
end if;
end case;
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);
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
- Ada.Exceptions.Raise_Exception
- (Program_Error'Identity, "potentially blocking operation");
+ raise Program_Error with "potentially blocking operation";
end if;
if Parameters.Runtime_Traces then
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);
Self_Id : constant Task_Id := STPO.Self;
Level : ATC_Level;
Entry_Call : Entry_Call_Link;
- Yielded : Boolean;
+
+ Yielded : Boolean;
+ pragma Unreferenced (Yielded);
begin
-- If pragma Detect_Blocking is active then Program_Error must be
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
- Ada.Exceptions.Raise_Exception
- (Program_Error'Identity, "potentially blocking operation");
+ raise Program_Error with "potentially blocking operation";
end if;
Initialization.Defer_Abort (Self_Id);
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
