2005-06-14 Arnaud Charlet <charlet@adacore.com>
Jose Ruiz <ruiz@adacore.com> * s-tposen.adb, s-tpobop.adb (Exceptional_Complete_Rendezvous): Save the occurrence and not only the exception id. (PO_Do_Or_Queue): Before queuing a task on an entry queue we check that there is no violation of the Max_Entry_Queue_Length restriction (if it has been set); Program_Error is raised otherwise. (Requeue_Call): Before requeuing the task on the target entry queue we check that there is no violation of the Max_Entry_Queue_Length restriction (if it has been set); Program_Error is raised otherwise. From-SVN: r101064
This commit is contained in:
Arnaud Charlet
parent
f51ab33b26
commit
ff7cce69d5
@ -1,8 +1,9 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS --
|
||||
-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
|
||||
-- O P E R A T I O N S --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
@ -93,6 +94,9 @@ with System.Parameters;
|
||||
with System.Traces.Tasking;
|
||||
-- used for Send_Trace_Info
|
||||
|
||||
with System.Restrictions;
|
||||
-- used for Run_Time_Restrictions
|
||||
|
||||
package body System.Tasking.Protected_Objects.Operations is
|
||||
|
||||
package STPO renames System.Task_Primitives.Operations;
|
||||
@ -102,6 +106,8 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
use Ada.Exceptions;
|
||||
use Entries;
|
||||
|
||||
use System.Restrictions;
|
||||
use System.Restrictions.Rident;
|
||||
use System.Traces;
|
||||
use System.Traces.Tasking;
|
||||
|
||||
@ -265,6 +271,11 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
(Object : Protection_Entries_Access;
|
||||
Ex : Ada.Exceptions.Exception_Id)
|
||||
is
|
||||
procedure Transfer_Occurrence
|
||||
(Target : Ada.Exceptions.Exception_Occurrence_Access;
|
||||
Source : Ada.Exceptions.Exception_Occurrence);
|
||||
pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
|
||||
|
||||
Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress;
|
||||
begin
|
||||
pragma Debug
|
||||
@ -278,6 +289,12 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
|
||||
Entry_Call.Exception_To_Raise := Ex;
|
||||
|
||||
if Ex /= Ada.Exceptions.Null_Id then
|
||||
Transfer_Occurrence
|
||||
(Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
|
||||
STPO.Self.Common.Compiler_Data.Current_Excep);
|
||||
end if;
|
||||
|
||||
-- Wakeup_Entry_Caller will be called from PO_Do_Or_Queue or
|
||||
-- PO_Service_Entries on return.
|
||||
end if;
|
||||
@ -352,9 +369,32 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
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);
|
||||
|
||||
if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
||||
and then
|
||||
Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
|
||||
Queuing.Count_Waiting (Object.Entry_Queues (E))
|
||||
then
|
||||
-- This violates the Max_Entry_Queue_Length restriction,
|
||||
-- raise Program_Error.
|
||||
|
||||
Entry_Call.Exception_To_Raise := Program_Error'Identity;
|
||||
|
||||
if Single_Lock then
|
||||
STPO.Lock_RTS;
|
||||
end if;
|
||||
|
||||
STPO.Write_Lock (Entry_Call.Self);
|
||||
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
|
||||
STPO.Unlock (Entry_Call.Self);
|
||||
|
||||
if Single_Lock then
|
||||
STPO.Unlock_RTS;
|
||||
end if;
|
||||
else
|
||||
Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
|
||||
Update_For_Queue_To_PO (Entry_Call, With_Abort);
|
||||
end if;
|
||||
else
|
||||
-- Conditional_Call and With_Abort
|
||||
|
||||
@ -734,9 +774,34 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||
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);
|
||||
|
||||
if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
||||
and then
|
||||
Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
|
||||
Queuing.Count_Waiting (Object.Entry_Queues (E))
|
||||
then
|
||||
-- This violates the Max_Entry_Queue_Length restriction,
|
||||
-- raise Program_Error.
|
||||
|
||||
Entry_Call.Exception_To_Raise := Program_Error'Identity;
|
||||
|
||||
if Single_Lock then
|
||||
STPO.Lock_RTS;
|
||||
end if;
|
||||
|
||||
STPO.Write_Lock (Entry_Call.Self);
|
||||
Initialization.Wakeup_Entry_Caller
|
||||
(Self_Id, Entry_Call, Done);
|
||||
STPO.Unlock (Entry_Call.Self);
|
||||
|
||||
if Single_Lock then
|
||||
STPO.Unlock_RTS;
|
||||
end if;
|
||||
else
|
||||
Queuing.Enqueue
|
||||
(New_Object.Entry_Queues (E), Entry_Call);
|
||||
Update_For_Queue_To_PO (Entry_Call, With_Abort);
|
||||
end if;
|
||||
|
||||
else
|
||||
PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY --
|
||||
-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
|
||||
-- S I N G L E _ E N T R Y --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
@ -37,16 +38,16 @@ pragma Style_Checks (All_Checks);
|
||||
|
||||
-- This package provides an optimized version of Protected_Objects.Operations
|
||||
-- and Protected_Objects.Entries making the following assumptions:
|
||||
--
|
||||
-- PO have only one entry
|
||||
-- There is only one caller at a time (No_Entry_Queue)
|
||||
-- There is no dynamic priority support (No_Dynamic_Priorities)
|
||||
-- No Abort Statements
|
||||
-- (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0)
|
||||
-- PO are at library level
|
||||
-- No Requeue
|
||||
-- None of the tasks will terminate (no need for finalization)
|
||||
--
|
||||
|
||||
-- PO has only one entry
|
||||
-- There is only one caller at a time (No_Entry_Queue)
|
||||
-- There is no dynamic priority support (No_Dynamic_Priorities)
|
||||
-- No Abort Statements
|
||||
-- (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0)
|
||||
-- PO are at library level
|
||||
-- No Requeue
|
||||
-- None of the tasks will terminate (no need for finalization)
|
||||
|
||||
-- This interface is intended to be used in the ravenscar and restricted
|
||||
-- profiles, the compiler is responsible for ensuring that the conditions
|
||||
-- mentioned above are respected, except for the No_Entry_Queue restriction
|
||||
@ -492,7 +493,17 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||
end if;
|
||||
|
||||
elsif Entry_Call.Mode /= Conditional_Call then
|
||||
Object.Entry_Queue := Entry_Call;
|
||||
if Object.Entry_Queue /= null then
|
||||
|
||||
-- This violates the No_Entry_Queue restriction, send
|
||||
-- Program_Error to the caller.
|
||||
|
||||
Send_Program_Error (Self_Id, Entry_Call);
|
||||
return;
|
||||
else
|
||||
Object.Entry_Queue := Entry_Call;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- Conditional_Call
|
||||
|
||||
@ -755,7 +766,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
|
||||
|
||||
Object.Owner := Null_Task;
|
||||
|
||||
|
||||
Self_Id.Common.Protected_Action_Nesting :=
|
||||
Self_Id.Common.Protected_Action_Nesting - 1;
|
||||
end;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user