# [Ada] Exponentiation works with extended overflow checks

## Commit Message

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

for exponentiation.
* exp_ch4.adb (Expand_N_Op_Expon): Changes for Minimize/Eliminate
overflow checks.
```

## Patch

```Index: checks.adb
===================================================================
@@ -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);

@@ -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;

===================================================================
@@ -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,
===================================================================