-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-with Ada.Exceptions;
--- Used for Exception_ID
--- Null_Id
--- Transfer_Occurrence
--- Raise_Exception
-
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
-- If this is a call made inside of an abort deferred region,
-- the call should be never abortable.
- if Self_Id.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_Id.Deferral_Level > 1
+ then Never_Abortable
+ else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := Get_Priority (Self_Id);
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.
-- we would not have gotten this far, so now we should
-- (re)enqueue the call, if the mode permits that.
- if Entry_Call.Mode /= Conditional_Call
- or else not With_Abort
+ -- If the call is timed, it may have timed out before the requeue,
+ -- in the unusual case where the current accept has taken longer than
+ -- the given delay. In that case the requeue is cancelled, and the
+ -- outer timed call will be aborted.
+
+ if Entry_Call.Mode = Conditional_Call
+ or else
+ (Entry_Call.Mode = Timed_Call
+ and then Entry_Call.With_Abort
+ and then Entry_Call.Cancellation_Attempted)
then
+ STPO.Unlock (Acceptor);
+
+ if Parent_Locked then
+ STPO.Unlock (Parent);
+ end if;
+
+ STPO.Write_Lock (Entry_Call.Self);
+
+ pragma Assert (Entry_Call.State >= Was_Abortable);
+
+ Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
+ STPO.Unlock (Entry_Call.Self);
+
+ else
-- Timed_Call, Simple_Call, or Asynchronous_Call
Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_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 Old_State /= Entry_Call.State
and then Entry_Call.State = Now_Abortable
- and then Entry_Call.Mode > Simple_Call
+ and then Entry_Call.Mode /= Simple_Call
and then Entry_Call.Self /= Self_ID
-- Asynchronous_Call or Conditional_Call
STPO.Unlock (Entry_Call.Self);
end if;
-
- else
- -- Conditional_Call and With_Abort
-
- STPO.Unlock (Acceptor);
-
- if Parent_Locked then
- STPO.Unlock (Parent);
- end if;
-
- STPO.Write_Lock (Entry_Call.Self);
-
- pragma Assert (Entry_Call.State >= Was_Abortable);
-
- Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
- STPO.Unlock (Entry_Call.Self);
end if;
return True;
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_Delay_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
- Sleep (Self_Id, Acceptor_Sleep);
+ Sleep (Self_Id, Acceptor_Delay_Sleep);
else
if Parameters.Runtime_Traces then
Send_Trace_Info (WT_Select,
end if;
STPO.Timed_Sleep (Self_Id, Timeout, Mode,
- Acceptor_Sleep, Timedout, Yielded);
+ Acceptor_Delay_Sleep, Timedout, Yielded);
end if;
if Timedout then
-- 3) Spurious wakeup
Self_Id.Open_Accepts := null;
- Self_Id.Common.State := Acceptor_Sleep;
-
- Initialization.Poll_Base_Priority_Change (Self_Id);
+ Self_Id.Common.State := Acceptor_Delay_Sleep;
- STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
+ STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Delay_Sleep,
Timedout, Yielded);
Self_Id.Common.State := Runnable;
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);
-- If this is a call made inside of an abort deferred region,
-- the call should be never abortable.
- if Self_Id.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_Id.Deferral_Level > 1
+ then Never_Abortable
+ else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := Get_Priority (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
