Patchwork [Ada] Exponentiation works with extended overflow checks

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 1, 2012, 1:15 p.m.
Message ID <20121001131547.GA12012@adacore.com>
Download mbox | patch
Permalink /patch/188291/
State New
Headers show

Comments

Arnaud Charlet - Oct. 1, 2012, 1:15 p.m.
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  <dewar@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.

Patch

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.