This patch implements extended overflow checking modes with the exonentiation operator.
The following is a test program: 1. with Text_IO; use Text_IO; 2. procedure Overflowm4 is 3. function r1 (a, b : Integer) return Boolean is 4. begin 5. return a ** 2 - b ** 2 <= Integer'Last; 6. end; 7. function r2 (a, b : Integer) return Boolean is 8. begin 9. return a ** 10 - b ** 10 in Integer; 10. end; 11. begin 12. begin 13. Put_Line 14. ("r1 returns " & 15. Boolean'Image (r1 (Integer'Last, Integer'Last))); 16. exception 17. when Constraint_Error => 18. Put_Line ("r1 raises exception"); 19. end; 20. 21. begin 22. Put_Line 23. ("r2 returns " & 24. Boolean'Image (r2 (Integer'Last, Integer'Last))); 25. exception 26. when Constraint_Error => 27. Put_Line ("r2 raises exception"); 28. end; 29. end Overflowm4; In CHECKED mode (-gnato1) we get: r1 raises exception r2 raises exception since the first exponentiation in both r1 and r2 result in values outside the bounds of Integer'Base. In MINIMIZED mode (-gnato2) we get: r1 returns TRUE r2 raises exception since we can compute the exponentiation results in r1 in Long_Long_Integer mode, but that's not true for r2. In ELIMINATE mode (-gnato3) we get: r1 returns TRUE r2 returns TRUE Because now we use Bignum arithmetic for the exponentiation operations in r2. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-01 Robert Dewar <de...@adacore.com> * 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.
Index: checks.adb =================================================================== --- checks.adb (revision 191918) +++ checks.adb (working copy) @@ -6548,7 +6548,7 @@ 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,8 +6564,80 @@ -- 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 when N_Op_Minus => @@ -6623,13 +6695,13 @@ 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 @@ 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 @@ 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; - -- Now analyze this new node with checks off (since we know that - -- we do not need an overflow check). + -- Reset node to unanalyzed + Set_Analyzed (N, False); + Set_Etype (N, Empty); + Set_Entity (N, Empty); + + -- Now analyze this new node + + -- 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; Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 191918) +++ exp_ch4.adb (working copy) @@ -3708,7 +3708,6 @@ (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 @@ 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 @@ 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 @@ 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 @@ 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, Index: s-bignum.adb =================================================================== --- s-bignum.adb (revision 191918) +++ s-bignum.adb (working copy) @@ -81,7 +81,7 @@ 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.