OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2017-01-06 12:15:32 +01:00
parent d9c59db455
commit 229fa5dbde
4 changed files with 66 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -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):

8
gcc/ada/checks.adb
View File

@ -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

5
gcc/ada/s-tpoben.ads
View File

@ -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

66
gcc/ada/s-tpobop.adb
View File

@ -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