From 4fb5f0a021cd23ac3f41aa7e3043bb2d5f58920c Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 4 Oct 2012 09:10:08 +0000 Subject: [PATCH] 2012-10-04 Robert Dewar * checks.adb (Minimize_Eliminate_Overflow_Checks): Dont reanalyze if/case expression if nothing has changed (just reexpand). Stops case expression from generating incorrect temporary. * exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and paste typo for range analysis in NE (not equal) case. * sem_eval.adb (Compile_Time_Compare): Small optimization to catch some more cases. * types.ads (Suppressed_Or_Checked): New subtype of Overflow_Check_Type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@192070 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 12 +++++++ gcc/ada/checks.adb | 92 ++++++++++++++++++++++++++++++++-------------------- gcc/ada/exp_ch4.adb | 6 ++-- gcc/ada/sem_eval.adb | 80 ++++++++++++++++++++++++--------------------- gcc/ada/types.ads | 4 ++- 5 files changed, 118 insertions(+), 76 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bb4f042..66a0466 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2012-10-04 Robert Dewar + + * checks.adb (Minimize_Eliminate_Overflow_Checks): Dont reanalyze + if/case expression if nothing has changed (just reexpand). Stops + case expression from generating incorrect temporary. + * exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow): + Fix cut and paste typo for range analysis in NE (not equal) case. + * sem_eval.adb (Compile_Time_Compare): Small optimization to + catch some more cases. + * types.ads (Suppressed_Or_Checked): New subtype of + Overflow_Check_Type. + 2012-10-04 Javier Miranda * exp_disp.adb (Set_CPP_Constructors_Old): Removed. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index d74a05c..075eb14 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -34,6 +34,7 @@ with Exp_Pakd; use Exp_Pakd; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Elists; use Elists; +with Expander; use Expander; with Eval_Fat; use Eval_Fat; with Freeze; use Freeze; with Lib; use Lib; @@ -1272,8 +1273,7 @@ package body Checks is Apply_Range_Check (N, Typ); end if; - elsif (Is_Record_Type (Typ) - or else Is_Private_Type (Typ)) + elsif (Is_Record_Type (Typ) or else Is_Private_Type (Typ)) and then Has_Discriminants (Base_Type (Typ)) and then Is_Constrained (Typ) then @@ -6709,10 +6709,12 @@ package body Checks is -- to be done in bignum mode), and the determined ranges of the operands. -- After possible rewriting of a constituent subexpression node, a call is - -- made to reanalyze the node after setting Analyzed to False. To avoid a - -- recursive call into the whole overflow apparatus, and important rule for - -- this reanalysis call is that either Do_Overflow_Check must be False, or - -- if it is set, then the overflow checking mode must be temporarily set + -- made to either reexpand the node (if nothing has changed) or reanalyze + -- the node (if it has been modified by the overflow check processing). + -- The Analyzed_flag is set False before the reexpand/reanalyze. To avoid + -- a recursive call into the whole overflow apparatus, and important rule + -- for this call is that either Do_Overflow_Check must be False, or if + -- it is set, then the overflow checking mode must be temporarily set -- to Checked/Suppressed. Either step will avoid the unwanted recursion. procedure Minimize_Eliminate_Overflow_Checks @@ -6761,6 +6763,17 @@ package body Checks is -- range, then we must convert such operands back to the result type. -- This switch is properly set only when Bignum_Operands is False. + procedure Reexpand (C : Suppressed_Or_Checked); + -- This is called when we have not modifed the node, so we do not need + -- to reanalyze it. But we do want to reexpand it in either CHECKED + -- or SUPPRESSED mode (as indicated by the argument C) to get proper + -- expansion. It is important that we reset the mode to SUPPRESSED or + -- CHECKED, since if we leave it in MINIMIZED or ELIMINATED mode we + -- would reenter this routine recursively which would not be good! + -- Note that this is not just an optimization, testing has showed up + -- several complex cases in which renalyzing an already analyzed node + -- causes incorrect behavior. + function In_Result_Range return Boolean; -- Returns True iff Lo .. Hi are within range of the result type @@ -6813,6 +6826,24 @@ package body Checks is end if; end Min; + -------------- + -- Reexpand -- + -------------- + + procedure Reexpand (C : Suppressed_Or_Checked) is + Svg : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + Sva : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_Assertions; + begin + Scope_Suppress.Overflow_Checks_General := C; + Scope_Suppress.Overflow_Checks_Assertions := C; + Set_Analyzed (N, False); + Expand (N); + Scope_Suppress.Overflow_Checks_General := Svg; + Scope_Suppress.Overflow_Checks_Assertions := Sva; + end Reexpand; + -- Start of processing for Minimize_Eliminate_Overflow_Checks begin @@ -6890,13 +6921,13 @@ package body Checks is -- If we have no Long_Long_Integer operands, then we are in result -- range, since it means that none of our operands felt the need -- to worry about overflow (otherwise it would have already been - -- converted to long long integer or bignum). We reanalyze to - -- complete the expansion of the if expression + -- converted to long long integer or bignum). We reexpand to + -- complete the expansion of the if expression (but we do not + -- need to reanalyze). elsif not Long_Long_Integer_Operands then Set_Do_Overflow_Check (N, False); - Set_Analyzed (N, False); - Analyze_And_Resolve (N, Suppress => Overflow_Check); + Reexpand (Suppressed); -- Otherwise convert us to long long integer mode. Note that we -- don't need any further overflow checking at this level. @@ -6953,14 +6984,13 @@ package body Checks is -- that none of our dependent expressions could raise overflow. -- In this case, we simply return with no changes except for -- resetting the overflow flag, since we are done with overflow - -- checks for this node. We will reset the Analyzed flag so that - -- we will properly reexpand and get the needed expansion for - -- the case expression. + -- checks for this node. We will reexpand to get the needed + -- expansion for the case expression, but we do not need to + -- renalyze, since nothing has changed. if not (Bignum_Operands or Long_Long_Integer_Operands) then Set_Do_Overflow_Check (N, False); - Set_Analyzed (N, False); - Analyze_And_Resolve (N, Suppress => Overflow_Check); + Reexpand (Suppressed); -- Otherwise we are going to rebuild the case expression using -- either bignum or long long integer operands throughout. @@ -7381,18 +7411,20 @@ package body Checks is end case; end if; - -- If we know we are in the result range, and we do not have Bignum - -- operands or Long_Long_Integer operands, we can just renalyze with - -- overflow checks turned off (since we know we cannot have overflow). - -- As always the reanalysis is required to complete expansion of the - -- operator, and we prevent recursion by suppressing the check. + -- Here for the case where we have not rewritten anything (no bignum + -- operands or long long integer operands), and we know the result If we + -- know we are in the result range, and we do not have Bignum operands + -- or Long_Long_Integer operands, we can just reexpand with overflow + -- checks turned off (since we know we cannot have overflow). As always + -- the reexpansion is required to complete expansion of the operator, + -- but we do not need to reanalyze, and we prevent recursion by + -- suppressing the check, if not (Bignum_Operands or Long_Long_Integer_Operands) and then In_Result_Range then Set_Do_Overflow_Check (N, False); - Set_Analyzed (N, False); - Analyze_And_Resolve (N, Suppress => Overflow_Check); + Reexpand (Suppressed); return; -- Here we know that we are not in the result range, and in the general @@ -7427,20 +7459,10 @@ package body Checks is -- eliminated overflow processing which is not what we want. Here -- we are at the top level, and we need a check against the result -- mode (i.e. we want to use Checked mode). So do exactly that! + -- Also, we have not modified the node, so this is a case where + -- we need to reexpand, but not reanalyze. - declare - Svg : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_General; - Sva : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_Assertions; - begin - Scope_Suppress.Overflow_Checks_General := Checked; - Scope_Suppress.Overflow_Checks_Assertions := Checked; - Analyze_And_Resolve (N); - Scope_Suppress.Overflow_Checks_General := Svg; - Scope_Suppress.Overflow_Checks_Assertions := Sva; - end; - + Reexpand (Checked); return; -- Cases where we do the operation in Bignum mode. This happens either diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 9357be6..8691437 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2331,7 +2331,7 @@ package body Exp_Ch4 is when N_Op_Eq => if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then Set_True; - elsif Llo > Rhi or else Rlo > Lhi then + elsif Llo > Rhi or else Lhi < Rlo then Set_False; end if; @@ -2365,9 +2365,9 @@ package body Exp_Ch4 is when N_Op_Ne => if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then - Set_True; - elsif Llo > Rhi or else Rlo > Lhi then Set_False; + elsif Llo > Rhi or else Lhi < Rlo then + Set_True; end if; end case; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 116864a..f42bfb3 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -942,7 +942,49 @@ package body Sem_Eval is end if; end if; - -- Try range analysis on variables and see if ranges are disjoint + -- First attempt is to decompose the expressions to extract a + -- constant offset resulting from the use of any of the forms: + + -- expr + literal + -- expr - literal + -- typ'Succ (expr) + -- typ'Pred (expr) + + -- Then we see if the two expressions are the same value, and if so + -- the result is obtained by comparing the offsets. + + -- Note: the reason we do this test first is that it returns only + -- decisive results (with diff set), where other tests, like the + -- range test, may not be as so decisive. Consider for example + -- J .. J + 1. This code can conclude LT with a difference of 1, + -- even if the range of J is not known. + + declare + Lnode : Node_Id; + Loffs : Uint; + Rnode : Node_Id; + Roffs : Uint; + + begin + Compare_Decompose (L, Lnode, Loffs); + Compare_Decompose (R, Rnode, Roffs); + + if Is_Same_Value (Lnode, Rnode) then + if Loffs = Roffs then + return EQ; + + elsif Loffs < Roffs then + Diff.all := Roffs - Loffs; + return LT; + + else + Diff.all := Loffs - Roffs; + return GT; + end if; + end if; + end; + + -- Next, try range analysis and see if operand ranges are disjoint declare LOK, ROK : Boolean; @@ -1074,42 +1116,6 @@ package body Sem_Eval is end if; end if; - -- Next attempt is to decompose the expressions to extract - -- a constant offset resulting from the use of any of the forms: - - -- expr + literal - -- expr - literal - -- typ'Succ (expr) - -- typ'Pred (expr) - - -- Then we see if the two expressions are the same value, and if so - -- the result is obtained by comparing the offsets. - - declare - Lnode : Node_Id; - Loffs : Uint; - Rnode : Node_Id; - Roffs : Uint; - - begin - Compare_Decompose (L, Lnode, Loffs); - Compare_Decompose (R, Rnode, Roffs); - - if Is_Same_Value (Lnode, Rnode) then - if Loffs = Roffs then - return EQ; - - elsif Loffs < Roffs then - Diff.all := Roffs - Loffs; - return LT; - - else - Diff.all := Loffs - Roffs; - return GT; - end if; - end if; - end; - -- Next attempt is to see if we have an entity compared with a -- compile time known value, where there is a current value -- conditional for the entity which can tell us the result. diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 73b11ac..277bfd5 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -737,7 +737,9 @@ package Types is subtype Minimized_Or_Eliminated is Overflow_Check_Type range Minimized .. Eliminated; - -- Definte subtypes so that clients don't need to know ordering. Note that + subtype Suppressed_Or_Checked is + Overflow_Check_Type range Suppressed .. Checked; + -- Define subtypes so that clients don't need to know ordering. Note that -- Overflow_Check_Type is not marked as an ordered enumeration type. -- The following structure captures the state of check suppression or -- 2.7.4