From: Arnaud Charlet Date: Mon, 1 Oct 2012 13:15:21 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: misc/gccgo-go1_1_2~517 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=6cb3037c69f90344dd3c5f9504b0a79422932b12;p=thirdparty%2Fgcc.git [multiple changes] 2012-10-01 Robert Dewar * checks.adb (Minimize_Eliminate_Overflow_Checks): Changes for exponentiation. * exp_ch4.adb (Expand_N_Op_Expon): Changes for Minimize/Eliminate overflow checks. * s-bignum.adb (Compare): Fix bad precondition. 2012-10-01 Ed Schonberg * sem_ch3.adb (Build_Derived_Record_Type): If the derived type has new discriminantss that constrain inherited ones, use the discriminant type in the original declaration to check for conformance, because in the presence of array components with a smaller range that are constrained by the origina discriminant, the compiler will have created a narrower subtype for that discriminant. From-SVN: r191919 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 775307730b88..ef3d7aac1904 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2012-10-01 Robert Dewar + + * checks.adb (Minimize_Eliminate_Overflow_Checks): Changes + for exponentiation. + * exp_ch4.adb (Expand_N_Op_Expon): Changes for Minimize/Eliminate + overflow checks. + * s-bignum.adb (Compare): Fix bad precondition. + +2012-10-01 Ed Schonberg + + * sem_ch3.adb (Build_Derived_Record_Type): If the derived + type has new discriminantss that constrain inherited ones, use + the discriminant type in the original declaration to check for + conformance, because in the presence of array components with a + smaller range that are constrained by the origina discriminant, + the compiler will have created a narrower subtype for that + discriminant. + 2012-10-01 Robert Dewar * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b83c87fdb7ea..3844d1e1550d 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6548,7 +6548,7 @@ package body Checks is when N_Op_Abs => Lo := Uint_0; - Hi := UI_Max (UI_Abs (Rlo), UI_Abs (Rhi)); + Hi := UI_Max (abs Rlo, abs Rhi); -- Addition @@ -6564,7 +6564,79 @@ package body Checks is -- Exponentiation when N_Op_Expon => - raise Program_Error; + + -- Discard negative values for the exponent, since they will + -- simply result in an exception in any case. + + if Rhi < 0 then + Rhi := Uint_0; + elsif Rlo < 0 then + Rlo := Uint_0; + end if; + + -- Estimate number of bits in result before we go computing + -- giant useless bounds. Basically the number of bits in the + -- result is the number of bits in the base multiplied by the + -- value of the exponent. If this is big enough that the result + -- definitely won't fit in Long_Long_Integer, switch to bignum + -- mode immediately, and avoid computing giant bounds. + + -- The comparison here is approximate, but conservative, it + -- only clicks on cases that are sure to exceed the bounds. + + if Num_Bits (UI_Max (abs Llo, abs Lhi)) * Rhi + 1 > 100 then + Lo := No_Uint; + Hi := No_Uint; + + -- If right operand is zero then result is 1 + + elsif Rhi = 0 then + Lo := Uint_1; + Hi := Uint_1; + + else + -- High bound comes either from exponentiation of largest + -- positive value to largest exponent value, or from the + -- exponentiation of most negative value to an odd exponent. + + declare + Hi1, Hi2 : Uint; + + begin + if Lhi >= 0 then + Hi1 := Lhi ** Rhi; + else + Hi1 := Uint_0; + end if; + + if Llo < 0 then + if Rhi mod 2 = 0 then + Hi2 := Llo ** (Rhi - 1); + else + Hi2 := Llo ** Rhi; + end if; + else + Hi2 := Uint_0; + end if; + + Hi := UI_Max (Hi1, Hi2); + end; + + -- Result can only be negative if base can be negative + + if Llo < 0 then + if UI_Mod (Rhi, 2) = 0 then + Lo := Llo ** (Rhi - 1); + else + Lo := Llo ** Rhi; + end if; + + -- Otherwise low bound is minimium ** minimum + + else + Lo := Llo ** Rlo; + end if; + end if; -- Negation @@ -6623,13 +6695,13 @@ package body Checks is when others => raise Program_Error; - end case; end if; -- Case where we do the operation in Bignum mode. This happens either -- because one of our operands is in Bignum mode already, or because - -- the computed bounds are outside the bounds of Long_Long_Integer. + -- the computed bounds are outside the bounds of Long_Long_Integer, + -- which in some cases can be indicated by Hi and Lo being No_Uint. -- Note: we could do better here and in some cases switch back from -- Bignum mode to normal mode, e.g. big mod 2 must be in the range @@ -6641,21 +6713,13 @@ package body Checks is if Lo = No_Uint or else Lo < LLLo or else Hi > LLHi then - -- In MINIMIZED mode, just give up and apply an overflow check + -- In MINIMIZED mode, note that an overflow check is required -- Note that we know we don't have a Bignum, since Bignums only -- appear in Eliminated mode. if Check_Mode = Minimized then - pragma Assert (Lo /= No_Uint); Enable_Overflow_Check (N); - -- It's fine to just return here, we may generate an overflow - -- exception, but this is the case in MINIMIZED mode where we - -- can't avoid this possibility. - - Apply_Arithmetic_Overflow_Normal (N); - return; - -- Otherwise we are in ELIMINATED mode, switch to bignum else @@ -6721,38 +6785,64 @@ package body Checks is Name => New_Occurrence_Of (Fent, Loc), Parameter_Associations => Args)); Analyze_And_Resolve (N, RTE (RE_Bignum)); + return; end; end if; -- Otherwise we are in range of Long_Long_Integer, so no overflow - -- check is required, at least not yet. Adjust the operands to - -- Long_Long_Integer and mark the result type as Long_Long_Integer. + -- check is required, at least not yet. else - -- Convert right or only operand to Long_Long_Integer, except that - -- we do not touch the exponentiation right operand. + Set_Do_Overflow_Check (N, False); + end if; - if Nkind (N) /= N_Op_Expon then - Convert_To_And_Rewrite (LLIB, Right_Opnd (N)); - end if; + -- Here we will do the operation in Long_Long_Integer. We do this even + -- if we know an overflow check is required, better to do this in long + -- long integer mode, since we are less likely to overflow! - -- Convert left operand to Long_Long_Integer for binary case + -- Convert right or only operand to Long_Long_Integer, except that + -- we do not touch the exponentiation right operand. - if Binary then - Convert_To_And_Rewrite (LLIB, Left_Opnd (N)); - end if; + if Nkind (N) /= N_Op_Expon then + Convert_To_And_Rewrite (LLIB, Right_Opnd (N)); + end if; - -- Reset node to unanalyzed + -- Convert left operand to Long_Long_Integer for binary case - Set_Analyzed (N, False); - Set_Etype (N, Empty); - Set_Entity (N, Empty); - Set_Do_Overflow_Check (N, False); + if Binary then + Convert_To_And_Rewrite (LLIB, Left_Opnd (N)); + end if; + + -- Reset node to unanalyzed + + Set_Analyzed (N, False); + Set_Etype (N, Empty); + Set_Entity (N, Empty); + + -- Now analyze this new node - -- Now analyze this new node with checks off (since we know that - -- we do not need an overflow check). + -- If no overflow check, suppress all checks + if not Do_Overflow_Check (N) then Analyze_And_Resolve (N, LLIB, Suppress => All_Checks); + + -- If an overflow check is required, do it in normal CHECKED mode. + -- That avoids an infinite recursion, makes sure we get a normal + -- overflow check, and also completes expansion of Exponentiation. + + else + declare + SG : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + SA : 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, LLIB); + Scope_Suppress.Overflow_Checks_General := SG; + Scope_Suppress.Overflow_Checks_Assertions := SA; + end; end if; end Minimize_Eliminate_Overflow_Checks; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0da35541e4c6..d87dd8fd34d0 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3708,7 +3708,6 @@ package body Exp_Ch4 is (N => Cnode, Msg => "concatenation result upper bound out of range?", Reason => CE_Range_Check_Failed); - -- Set_Etype (Cnode, Atyp); end Expand_Concatenate; --------------------------------------------------- @@ -7134,7 +7133,7 @@ package body Exp_Ch4 is Reason => PE_Unchecked_Union_Restriction)); -- Prevent Gigi from generating incorrect code by rewriting the - -- equality as a standard False. + -- equality as a standard False. (is this documented somewhere???) Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); @@ -7161,7 +7160,7 @@ package body Exp_Ch4 is Reason => PE_Unchecked_Union_Restriction)); -- Prevent Gigi from generating incorrect code by rewriting - -- the equality as a standard False. + -- the equality as a standard False (documented where???). Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); @@ -7260,6 +7259,23 @@ package body Exp_Ch4 is end; end if; + -- Normally we complete expansion of exponentiation (e.g. converting + -- to multplications) right here, but there is one exception to this. + -- If we have a signed integer type and the overflow checking mode + -- is MINIMIZED or ELIMINATED and overflow checking is activated, then + -- we don't yet want to expand, since that will intefere with handling + -- of extended precision intermediate value. In this situation we just + -- apply the arithmetic overflow check, and then the overflow check + -- circuit will re-expand the exponentiation node in CHECKED mode. + + if Is_Signed_Integer_Type (Rtyp) + and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated + and then Do_Overflow_Check (N) + then + Apply_Arithmetic_Overflow_Check (N); + return; + end if; + -- Test for case of known right argument if Compile_Time_Known_Value (Exp) then @@ -10157,7 +10173,7 @@ package body Exp_Ch4 is then -- To prevent Gigi from generating illegal code, we generate a -- Program_Error node, but we give it the target type of the - -- conversion. + -- conversion (is this requirement documented somewhere ???) declare PE : constant Node_Id := Make_Raise_Program_Error (Loc, diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb index 3474e1b5f415..f8d2132ec1c6 100644 --- a/gcc/ada/s-bignum.adb +++ b/gcc/ada/s-bignum.adb @@ -81,7 +81,7 @@ package body System.Bignums is function Compare (X, Y : Digit_Vector; X_Neg, Y_Neg : Boolean) return Compare_Result - with Pre => X'First = 1 and then X'Last = 1; + with Pre => X'First = 1 and then Y'First = 1; -- Compare (X with sign X_Neg) with (Y with sign Y_Neg), and return the -- result of the signed comparison. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 483e7055f035..017318c80272 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7541,16 +7541,38 @@ package body Sem_Ch3 is -- subtype must be statically compatible with the parent -- discriminant's subtype (3.7(15)). - if Present (Corresponding_Discriminant (Discrim)) - and then - not Subtypes_Statically_Compatible - (Etype (Discrim), - Etype (Corresponding_Discriminant (Discrim))) - then - Error_Msg_N - ("subtype must be compatible with parent discriminant", - Discrim); - end if; + -- However, if the record contains an array constrained by + -- the discriminant but with some different bound, the compiler + -- attemps to create a smaller range for the discriminant type. + -- (See exp_ch3.Adjust_Discriminants). In this case, where + -- the discriminant type is a scalar type, the check must use + -- the original discriminant type in the parent declaration. + + declare + Corr_Disc : constant Entity_Id := + Corresponding_Discriminant (Discrim); + Disc_Type : constant Entity_Id := Etype (Discrim); + Corr_Type : Entity_Id; + + begin + if Present (Corr_Disc) then + if Is_Scalar_Type (Disc_Type) then + Corr_Type := + Entity (Discriminant_Type (Parent (Corr_Disc))); + else + Corr_Type := Etype (Corr_Disc); + end if; + + if not + Subtypes_Statically_Compatible (Disc_Type, Corr_Type) + then + Error_Msg_N + ("subtype must be compatible " + & "with parent discriminant", + Discrim); + end if; + end if; + end; Next_Discriminant (Discrim); end loop;