[multiple changes]
2017-01-06 Ed Schonberg <schonberg@adacore.com> * checks.adb (Ensure_Valid): Do not generate a validity check within a generated predicate function, validity checks will have been applied earlier when required. 2017-01-06 Tristan Gingold <gingold@adacore.com> * s-tpoben.ads (Protection_Entries): Add comment and reorder components for performances. * s-tpobop.adb (PO_Do_Or_Queue): Implement Max_Queue_Length runtime semantic. From-SVN: r244136
This commit is contained in:
parent
d9c59db455
commit
229fa5dbde
|
@ -1,3 +1,16 @@
|
|||
2017-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* checks.adb (Ensure_Valid): Do not generate a validity check
|
||||
within a generated predicate function, validity checks will have
|
||||
been applied earlier when required.
|
||||
|
||||
2017-01-06 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* s-tpoben.ads (Protection_Entries): Add comment and reorder
|
||||
components for performances.
|
||||
* s-tpobop.adb (PO_Do_Or_Queue): Implement Max_Queue_Length runtime
|
||||
semantic.
|
||||
|
||||
2017-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_eval.adb (Check_Expression_Against_Static_Predicate):
|
||||
|
|
|
@ -5709,6 +5709,14 @@ package body Checks is
|
|||
elsif Expr_Known_Valid (Expr) then
|
||||
return;
|
||||
|
||||
-- No check needed within a generated predicate function. Validity
|
||||
-- of input value will have been checked earlier.
|
||||
|
||||
elsif Ekind (Current_Scope) = E_Function
|
||||
and then Is_Predicate_Function (Current_Scope)
|
||||
then
|
||||
return;
|
||||
|
||||
-- Ignore case of enumeration with holes where the flag is set not to
|
||||
-- worry about holes, since no special validity check is needed
|
||||
|
||||
|
|
|
@ -148,8 +148,6 @@ package System.Tasking.Protected_Objects.Entries is
|
|||
-- A function which maps the entry index in a call (which denotes the
|
||||
-- queue of the proper entry) into the body of the entry.
|
||||
|
||||
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
|
||||
|
||||
Entry_Queue_Maxes : Protected_Entry_Queue_Max_Access;
|
||||
-- Access to an array of naturals representing the max value for each
|
||||
-- entry's queue length. A value of 0 signifies no max.
|
||||
|
@ -158,6 +156,9 @@ package System.Tasking.Protected_Objects.Entries is
|
|||
-- An array of string names which denotes entry [family member] names.
|
||||
-- The structure is indexed by protected entry index and contains Num_
|
||||
-- Entries components.
|
||||
|
||||
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
|
||||
-- Action and barrier subprograms for the protected type.
|
||||
end record;
|
||||
|
||||
-- No default initial values for this type, since call records will need to
|
||||
|
|
|
@ -292,17 +292,17 @@ package body System.Tasking.Protected_Objects.Operations is
|
|||
is
|
||||
E : constant Protected_Entry_Index :=
|
||||
Protected_Entry_Index (Entry_Call.E);
|
||||
Index : constant Protected_Entry_Index :=
|
||||
Object.Find_Body_Index (Object.Compiler_Info, E);
|
||||
Barrier_Value : Boolean;
|
||||
|
||||
Queue_Length : Natural;
|
||||
begin
|
||||
-- When the Action procedure for an entry body returns, it is either
|
||||
-- completed (having called [Exceptional_]Complete_Entry_Body) or it
|
||||
-- is queued, having executed a requeue statement.
|
||||
|
||||
Barrier_Value :=
|
||||
Object.Entry_Bodies (
|
||||
Object.Find_Body_Index (Object.Compiler_Info, E)).
|
||||
Barrier (Object.Compiler_Info, E);
|
||||
Object.Entry_Bodies (Index).Barrier (Object.Compiler_Info, E);
|
||||
|
||||
if Barrier_Value then
|
||||
|
||||
|
@ -316,8 +316,7 @@ package body System.Tasking.Protected_Objects.Operations is
|
|||
|
||||
pragma Debug
|
||||
(Debug.Trace (Self_ID, "PODOQ: start entry body", 'P'));
|
||||
Object.Entry_Bodies (
|
||||
Object.Find_Body_Index (Object.Compiler_Info, E)).Action (
|
||||
Object.Entry_Bodies (Index).Action (
|
||||
Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
|
||||
|
||||
if Object.Call_In_Progress /= null then
|
||||
|
@ -346,29 +345,48 @@ package body System.Tasking.Protected_Objects.Operations is
|
|||
or else not Entry_Call.With_Abort
|
||||
then
|
||||
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))
|
||||
or else Object.Entry_Queue_Maxes /= null
|
||||
then
|
||||
-- This violates the Max_Entry_Queue_Length restriction, raise
|
||||
-- Program_Error.
|
||||
-- Need to check the queue length. Computing the length is an
|
||||
-- unusual case and is slow (need to walk the queue)
|
||||
|
||||
Entry_Call.Exception_To_Raise := Program_Error'Identity;
|
||||
Queue_Length := Queuing.Count_Waiting (Object.Entry_Queues (E));
|
||||
|
||||
if Single_Lock then
|
||||
STPO.Lock_RTS;
|
||||
if (Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
||||
and then Queue_Length >=
|
||||
Run_Time_Restrictions.Value (Max_Entry_Queue_Length))
|
||||
or else
|
||||
(Object.Entry_Queue_Maxes /= null
|
||||
and then Object.Entry_Queue_Maxes (Index) /= 0
|
||||
and then Queue_Length >= Object.Entry_Queue_Maxes (Index))
|
||||
then
|
||||
-- This violates the Max_Entry_Queue_Length restriction or the
|
||||
-- Max_Queue_Length bound, 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;
|
||||
|
||||
return;
|
||||
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, Entry_Call.With_Abort);
|
||||
end if;
|
||||
|
||||
-- Do the work: queue the call
|
||||
|
||||
Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
|
||||
Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort);
|
||||
|
||||
return;
|
||||
else
|
||||
-- Conditional_Call and With_Abort
|
||||
|
||||
|
|
Loading…
Reference in New Issue