[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>
|
2017-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
* sem_eval.adb (Check_Expression_Against_Static_Predicate):
|
* sem_eval.adb (Check_Expression_Against_Static_Predicate):
|
||||||
|
|
|
@ -5709,6 +5709,14 @@ package body Checks is
|
||||||
elsif Expr_Known_Valid (Expr) then
|
elsif Expr_Known_Valid (Expr) then
|
||||||
return;
|
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
|
-- Ignore case of enumeration with holes where the flag is set not to
|
||||||
-- worry about holes, since no special validity check is needed
|
-- 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
|
-- A function which maps the entry index in a call (which denotes the
|
||||||
-- queue of the proper entry) into the body of the entry.
|
-- 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;
|
Entry_Queue_Maxes : Protected_Entry_Queue_Max_Access;
|
||||||
-- Access to an array of naturals representing the max value for each
|
-- Access to an array of naturals representing the max value for each
|
||||||
-- entry's queue length. A value of 0 signifies no max.
|
-- 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.
|
-- An array of string names which denotes entry [family member] names.
|
||||||
-- The structure is indexed by protected entry index and contains Num_
|
-- The structure is indexed by protected entry index and contains Num_
|
||||||
-- Entries components.
|
-- Entries components.
|
||||||
|
|
||||||
|
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
|
||||||
|
-- Action and barrier subprograms for the protected type.
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
-- No default initial values for this type, since call records will need to
|
-- 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
|
is
|
||||||
E : constant Protected_Entry_Index :=
|
E : constant Protected_Entry_Index :=
|
||||||
Protected_Entry_Index (Entry_Call.E);
|
Protected_Entry_Index (Entry_Call.E);
|
||||||
|
Index : constant Protected_Entry_Index :=
|
||||||
|
Object.Find_Body_Index (Object.Compiler_Info, E);
|
||||||
Barrier_Value : Boolean;
|
Barrier_Value : Boolean;
|
||||||
|
Queue_Length : Natural;
|
||||||
begin
|
begin
|
||||||
-- When the Action procedure for an entry body returns, it is either
|
-- When the Action procedure for an entry body returns, it is either
|
||||||
-- completed (having called [Exceptional_]Complete_Entry_Body) or it
|
-- completed (having called [Exceptional_]Complete_Entry_Body) or it
|
||||||
-- is queued, having executed a requeue statement.
|
-- is queued, having executed a requeue statement.
|
||||||
|
|
||||||
Barrier_Value :=
|
Barrier_Value :=
|
||||||
Object.Entry_Bodies (
|
Object.Entry_Bodies (Index).Barrier (Object.Compiler_Info, E);
|
||||||
Object.Find_Body_Index (Object.Compiler_Info, E)).
|
|
||||||
Barrier (Object.Compiler_Info, E);
|
|
||||||
|
|
||||||
if Barrier_Value then
|
if Barrier_Value then
|
||||||
|
|
||||||
|
@ -316,8 +316,7 @@ package body System.Tasking.Protected_Objects.Operations is
|
||||||
|
|
||||||
pragma Debug
|
pragma Debug
|
||||||
(Debug.Trace (Self_ID, "PODOQ: start entry body", 'P'));
|
(Debug.Trace (Self_ID, "PODOQ: start entry body", 'P'));
|
||||||
Object.Entry_Bodies (
|
Object.Entry_Bodies (Index).Action (
|
||||||
Object.Find_Body_Index (Object.Compiler_Info, E)).Action (
|
|
||||||
Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
|
Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
|
||||||
|
|
||||||
if Object.Call_In_Progress /= null then
|
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
|
or else not Entry_Call.With_Abort
|
||||||
then
|
then
|
||||||
if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
||||||
and then Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
|
or else Object.Entry_Queue_Maxes /= null
|
||||||
Queuing.Count_Waiting (Object.Entry_Queues (E))
|
|
||||||
then
|
then
|
||||||
-- This violates the Max_Entry_Queue_Length restriction, raise
|
-- Need to check the queue length. Computing the length is an
|
||||||
-- Program_Error.
|
-- 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
|
if (Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
|
||||||
STPO.Lock_RTS;
|
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;
|
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;
|
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
|
else
|
||||||
-- Conditional_Call and With_Abort
|
-- Conditional_Call and With_Abort
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue