From: Arnaud Charlet Date: Fri, 6 Jan 2017 11:15:32 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=229fa5dbde6e8a58c8409712a9e09d76793677c0;p=gcc.git [multiple changes] 2017-01-06 Ed Schonberg * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1dc59581701..ce482e34e0e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-01-06 Ed Schonberg + + * 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 + + * 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 * sem_eval.adb (Check_Expression_Against_Static_Predicate): diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index efb36840185..61e1ad4fed9 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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 diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index d069ebc5866..90bfa89f398 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -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 diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index e242bb06283..a6f6c993d4e 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -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) + + Queue_Length := Queuing.Count_Waiting (Object.Entry_Queues (E)); + + 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; + Entry_Call.Exception_To_Raise := Program_Error'Identity; - if Single_Lock then - STPO.Lock_RTS; - end if; + 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); + 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; + if Single_Lock then + STPO.Unlock_RTS; + end if; + + return; 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