From: Javier Miranda <[email protected]>
Add support for ELIMINATED and MINIMIZED overflow checking modes
on types with the Unsigned_Base_Range aspect (modes available
under switch -gnato).
gcc/ada/ChangeLog:
* checks.ads (Convert_From_Bignum): Add a new formal and update
documentation.
(Convert_To_Bignum): Update documentation.
* checks.adb (Is_Signed_Integer_Arithmetic_Op): Renamed as
Is_Overflow_Arithmetic_Op, and replace calls to function
Is_Signed_Integer_Type by calls to Has_Overflow_Operations.
(Apply_Arithmetic_Overflow_Minimized_Eliminated): Add support
for types with the Unsigned_Base_Range aspect.
(Apply_Divide_Checks): Replace calls to Is_Signed_Integer_Type
by calls to Has_Overflow_Operations.
(Compute_Range_For_Arithmetic_Op): Adjust comment.
(Convert_To_Bignum): Add support for types with the Unsigned_
Base_Range aspect.
(Convert_From_Bignum): Add support for result type with the
Unsigned_Base_Range aspect.
(Minimize_Eliminate_Overflows): Add support for types with the
Unsigned_Base_Range aspect.
* exp_ch4.adb (Minimized_Eliminated_Overflow_Check): Replace
call to Is_Signed_Integer_Type by call to Has_Overflow_Operations.
(Expand_Compare_Minimize_Eliminate_Overflow): Add support for types
with the Unsigned_Base_Range aspect.
(Expand_Membership_Minimize_Eliminate_Overflow): Ditto.
(Expand_N_Op_Expon): Ditto.
(Expand_Exponentiation): New subprogram.
* rtsfind.ads (RE_Id): Add RE_LLU_To_Bignum, RE_LLU_From_Bignum.
* libgnat/s-bignum.ads (LLU_To_Bignum): New subprogram.
(LLU_From_Bignum): New subprogram.
* libgnat/s-bignum.adb (LLU_To_Bignum): New subprogram.
(LLU_From_Bignum): New subprogram.
* libgnat/s-genbig.ads (From_Bignum): New overloaded functions
for Long_Long_Long_Unsigned and Long_Long_Unsigned types.
(To_Bignum): Ditto.
* libgnat/s-genbig.adb (From_Bignum): New overloaded functions
for Long_Long_Long_Unsigned and Long_Long_Unsigned types.
(To_Bignum): Ditto.
* libgnat/s-expuns.ads (Exp_Unsigned): Fix documentation.
* libgnat/s-expllu.ads (Exp_Long_Long_Unsigned): Ditto.
* libgnat/s-explllu.ads (Exp_Long_Long_Long_Unsigned): Add missing
documentation.
Tested on x86_64-pc-linux-gnu (before the recent bootstrap breakage), committed
on master.
---
gcc/ada/checks.adb | 318 ++++++++++++++++++++-------------
gcc/ada/checks.ads | 13 +-
gcc/ada/exp_ch4.adb | 327 +++++++++++++++++++++++++++-------
gcc/ada/libgnat/s-bignum.adb | 6 +
gcc/ada/libgnat/s-bignum.ads | 13 ++
gcc/ada/libgnat/s-explllu.ads | 6 +
gcc/ada/libgnat/s-expllu.ads | 2 -
gcc/ada/libgnat/s-expuns.ads | 2 -
gcc/ada/libgnat/s-genbig.adb | 20 +++
gcc/ada/libgnat/s-genbig.ads | 21 +++
gcc/ada/rtsfind.ads | 4 +
11 files changed, 537 insertions(+), 195 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a346772001f..5dc63d529ce 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -326,11 +326,12 @@ package body Checks is
-- Called by Apply_{Length,Range}_Checks to rewrite the tree with the
-- Constraint_Error node.
- function Is_Signed_Integer_Arithmetic_Op (N : Node_Id) return Boolean;
- -- Returns True if node N is for an arithmetic operation with signed
- -- integer operands. This includes unary and binary operators (including
- -- comparison operators), and also if and case expression nodes which
- -- yield a value of a signed integer type.
+ function Is_Overflow_Arithmetic_Op (N : Node_Id) return Boolean;
+ -- Returns True if node N is for an arithmetic operation with operands
+ -- that have overflow operations. This includes unary and binary operators
+ -- (including comparison operators), and also if and case expression nodes
+ -- which yield a value of a signed integer type or a modular type that has
+ -- the Unsigned_Base_Range aspect.
-- These are the kinds of nodes for which special handling applies in
-- MINIMIZED or ELIMINATED overflow checking mode.
@@ -759,7 +760,7 @@ package body Checks is
-- overflow checking mode set to MINIMIZED or ELIMINATED).
if Overflow_Check_Mode = Strict
- or else not Is_Signed_Integer_Arithmetic_Op (N)
+ or else not Is_Overflow_Arithmetic_Op (N)
then
Apply_Arithmetic_Overflow_Strict (N);
@@ -847,7 +848,7 @@ package body Checks is
-- sure not to generate the arithmetic overflow check in these cases
-- (Exp_Ch4 would have a hard time removing them once generated).
- if Is_Signed_Integer_Type (Typ)
+ if Has_Overflow_Operations (Typ)
and then Nkind (Parent (N)) = N_Type_Conversion
then
Conversion_Optimization : declare
@@ -1128,13 +1129,15 @@ package body Checks is
----------------------------------------------------
procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id) is
- pragma Assert (Is_Signed_Integer_Arithmetic_Op (Op));
+ pragma Assert (Is_Overflow_Arithmetic_Op (Op));
Loc : constant Source_Ptr := Sloc (Op);
P : constant Node_Id := Parent (Op);
- LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
- -- Operands and results are of this type when we convert
+ LL_Type : Entity_Id;
+ -- Operands and results are of this type when we perform convertion:
+ -- Long_Long_Integer or Long_Long_Unsigned (when the type of the
+ -- result has the Unsigned_Base_Range aspect).
Result_Type : constant Entity_Id := Etype (Op);
-- Original result type
@@ -1156,7 +1159,7 @@ package body Checks is
-- this node will be processed during the downwards recursion that
-- is part of the processing in Minimize_Eliminate_Overflows).
- if Is_Signed_Integer_Arithmetic_Op (P)
+ if Is_Overflow_Arithmetic_Op (P)
or else Nkind (P) in N_Membership_Test
or else Nkind (P) in N_Op_Compare
@@ -1176,7 +1179,7 @@ package body Checks is
-- Similarly, if these expressions are nested, we should go on.
if Nkind (P) in N_If_Expression | N_Case_Expression
- and then not Is_Signed_Integer_Arithmetic_Op (Parent (P))
+ and then not Is_Overflow_Arithmetic_Op (Parent (P))
then
null;
elsif Nkind (P) in N_If_Expression | N_Case_Expression
@@ -1197,6 +1200,14 @@ package body Checks is
Minimize_Eliminate_Overflows (Op, Lo, Hi, Top_Level => True);
+ -- Initialize type of operands and results when we convert
+
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Result_Type)) then
+ LL_Type := Base_Type (Standard_Long_Long_Unsigned);
+ else
+ LL_Type := Base_Type (Standard_Long_Long_Integer);
+ end if;
+
-- That call may but does not necessarily change the result type of Op.
-- It is the job of this routine to undo such changes, so that at the
-- top level, we have the proper type. This "undoing" is a point at
@@ -1248,7 +1259,7 @@ package body Checks is
Rtype : Entity_Id;
begin
- RHS := Convert_From_Bignum (Op);
+ RHS := Convert_From_Bignum (Op, Result_Type);
if Nkind (P) /= N_Type_Conversion then
Convert_To_And_Rewrite (Result_Type, RHS);
@@ -1260,7 +1271,7 @@ package body Checks is
-- looked at later ???
else
- Rtype := LLIB;
+ Rtype := LL_Type;
end if;
Insert_Before
@@ -1279,13 +1290,14 @@ package body Checks is
Analyze_And_Resolve (Op);
end;
- -- Here we know the result is Long_Long_Integer'Base, or that it has
- -- been rewritten because the parent operation is a conversion. See
- -- Apply_Arithmetic_Overflow_Strict.Conversion_Optimization.
+ -- Here we know the result is Long_Long_[Integer|Unsigned]'Base,
+ -- or that it has been rewritten because the parent operation is
+ -- a conversion.
+ -- See Apply_Arithmetic_Overflow_Strict.Conversion_Optimization.
else
- pragma Assert
- (Etype (Op) = LLIB or else Nkind (Parent (Op)) = N_Type_Conversion);
+ pragma Assert (Etype (Op) = LL_Type
+ or else Nkind (Parent (Op)) = N_Type_Conversion);
-- All we need to do here is to convert the result to the proper
-- result type. As explained above for the Bignum case, we can
@@ -1813,7 +1825,7 @@ package body Checks is
-- ensure that any needed overflow/division checks are properly applied.
if Mode in Minimized_Or_Eliminated
- and then Is_Signed_Integer_Type (Typ)
+ and then Has_Overflow_Operations (Typ)
then
Apply_Arithmetic_Overflow_Minimized_Eliminated (N);
return;
@@ -4727,8 +4739,8 @@ package body Checks is
-- 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, return immediately
- -- and avoid computing giant bounds.
+ -- definitely won't fit in Long_Long_[Integer|Unsigned], return
+ -- 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.
@@ -4954,18 +4966,27 @@ package body Checks is
-- Convert_From_Bignum --
-------------------------
- function Convert_From_Bignum (N : Node_Id) return Node_Id is
- Loc : constant Source_Ptr := Sloc (N);
+ function Convert_From_Bignum
+ (N : Node_Id;
+ Result_Type : Entity_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Func_Id : Entity_Id;
begin
pragma Assert (Is_RTE (Etype (N), RE_Bignum));
-- Construct call From Bignum
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Result_Type)) then
+ Func_Id := RTE (RE_LLU_From_Bignum);
+ else
+ Func_Id := RTE (RE_From_Bignum);
+ end if;
+
return
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_From_Bignum), Loc),
+ Name => New_Occurrence_Of (Func_Id, Loc),
Parameter_Associations => New_List (Relocate_Node (N)));
end Convert_From_Bignum;
@@ -4974,25 +4995,40 @@ package body Checks is
-----------------------
function Convert_To_Bignum (N : Node_Id) return Node_Id is
- Loc : constant Source_Ptr := Sloc (N);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ LL_Type : Entity_Id;
+ Func_Id : Entity_Id;
begin
-- Nothing to do if Bignum already except call Relocate_Node
- if Is_RTE (Etype (N), RE_Bignum) then
+ if Is_RTE (Typ, RE_Bignum) then
return Relocate_Node (N);
- -- Otherwise construct call to To_Bignum, converting the operand to the
- -- required Long_Long_Integer form.
+ -- Otherwise construct call to To_Bignum, converting the operand to
+ -- the required Long_Long_[Integer|Unsigned] form.
else
- pragma Assert (Is_Signed_Integer_Type (Etype (N)));
+ pragma Assert (Has_Overflow_Operations (Typ)
+ or else Base_Type (Typ) = Base_Type (Standard_Long_Long_Unsigned));
+
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Typ))
+ or else Base_Type (Typ) = Base_Type (Standard_Long_Long_Unsigned)
+ then
+ LL_Type := Base_Type (RTE (RE_Long_Long_Unsigned));
+ Func_Id := RTE (RE_LLU_To_Bignum);
+ else
+ LL_Type := Base_Type (Standard_Long_Long_Integer);
+ Func_Id := RTE (RE_To_Bignum);
+ end if;
+
return
Make_Function_Call (Loc,
Name =>
- New_Occurrence_Of (RTE (RE_To_Bignum), Loc),
+ New_Occurrence_Of (Func_Id, Loc),
Parameter_Associations => New_List (
- Convert_To (Standard_Long_Long_Integer, Relocate_Node (N))));
+ Convert_To (LL_Type, Relocate_Node (N))));
end if;
end Convert_To_Bignum;
@@ -8363,11 +8399,11 @@ package body Checks is
end;
end Insert_Valid_Check;
- -------------------------------------
- -- Is_Signed_Integer_Arithmetic_Op --
- -------------------------------------
+ -------------------------------
+ -- Is_Overflow_Arithmetic_Op --
+ -------------------------------
- function Is_Signed_Integer_Arithmetic_Op (N : Node_Id) return Boolean is
+ function Is_Overflow_Arithmetic_Op (N : Node_Id) return Boolean is
begin
case Nkind (N) is
when N_Op_Abs
@@ -8381,20 +8417,20 @@ package body Checks is
| N_Op_Rem
| N_Op_Subtract
=>
- return Is_Signed_Integer_Type (Etype (N));
+ return Has_Overflow_Operations (Etype (N));
when N_Op_Compare =>
- return Is_Signed_Integer_Type (Etype (Left_Opnd (N)));
+ return Has_Overflow_Operations (Etype (Left_Opnd (N)));
when N_Case_Expression
| N_If_Expression
=>
- return Is_Signed_Integer_Type (Etype (N));
+ return Has_Overflow_Operations (Etype (N));
when others =>
return False;
end case;
- end Is_Signed_Integer_Arithmetic_Op;
+ end Is_Overflow_Arithmetic_Op;
----------------------------------
-- Install_Null_Excluding_Check --
@@ -8952,9 +8988,9 @@ package body Checks is
-- This is a recursive routine that is called at the top of an expression
-- tree to properly process overflow checking for a whole subtree by making
-- recursive calls to process operands. This processing may involve the use
- -- of bignum or long long integer arithmetic, which will change the types
- -- of operands and results. That's why we can't do this bottom up (since
- -- it would interfere with semantic analysis).
+ -- of bignum or long long [integer|unsigned] arithmetic, which will change
+ -- the types of operands and results. That's why we can't do this bottom up
+ -- (since it would interfere with semantic analysis).
-- What happens is that if MINIMIZED/ELIMINATED mode is in effect then
-- the operator expansion routines, as well as the expansion routines for
@@ -8985,8 +9021,9 @@ package body Checks is
Top_Level : Boolean)
is
Rtyp : constant Entity_Id := Etype (N);
- pragma Assert (Is_Signed_Integer_Type (Rtyp));
- -- Result type, must be a signed integer type
+ pragma Assert (Has_Overflow_Operations (Rtyp));
+ -- Result type, must be a signed type or a modular type that has the
+ -- Unsigned_Base_Range aspect.
Check_Mode : constant Overflow_Mode_Type := Overflow_Check_Mode;
pragma Assert (Check_Mode in Minimized_Or_Eliminated);
@@ -9000,12 +9037,14 @@ package body Checks is
Lhi : Uint := No_Uint; -- initialize to prevent warning
-- Ranges of values for left operand (operator case)
- LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
- -- Operands and results are of this type when we convert
+ LL_Type : Entity_Id;
+ -- Operands and results are of this type when we perform convertion:
+ -- Long_Long_Integer or Long_Long_Unsigned (when the type of the
+ -- result has the Unsigned_Base_Range aspect).
- LLLo : constant Uint := Intval (Type_Low_Bound (LLIB));
- LLHi : constant Uint := Intval (Type_High_Bound (LLIB));
- -- Bounds of Long_Long_Integer
+ LLLo : Uint;
+ LLHi : Uint;
+ -- Bounds of LL_Type
Binary : constant Boolean := Nkind (N) in N_Binary_Op;
-- Indicates binary operator case
@@ -9019,10 +9058,11 @@ package body Checks is
-- doing the operation in Bignum mode (or in the case of a case or if
-- expression, converting all the dependent expressions to Bignum).
- Long_Long_Integer_Operands : Boolean;
+ Long_Long_Operands : Boolean;
-- Set True if one or more operands is already of type Long_Long_Integer
- -- which means that if the result is known to be in the result type
- -- range, then we must convert such operands back to the result type.
+ -- or Long_Long_Unsigned (which means that if the result is known to be
+ -- in the result type range). Then we must convert such operands back to
+ -- the result type.
procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False);
-- This is called when we have modified the node and we therefore need
@@ -9158,9 +9198,20 @@ package body Checks is
Lo := No_Uint;
Hi := No_Uint;
- -- Case where we do not have a signed integer arithmetic operation
+ -- Initialize type of operands and results when we perform conversion
- if not Is_Signed_Integer_Arithmetic_Op (N) then
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Rtyp)) then
+ LL_Type := Base_Type (Standard_Long_Long_Unsigned);
+ else
+ LL_Type := Base_Type (Standard_Long_Long_Integer);
+ end if;
+
+ LLLo := Intval (Type_Low_Bound (LL_Type));
+ LLHi := Intval (Type_High_Bound (LL_Type));
+
+ -- Case where we do not have an overflow arithmetic operation
+
+ if not Is_Overflow_Arithmetic_Op (N) then
-- Use the normal Determine_Range routine to get the range. We
-- don't require operands to be valid, invalid values may result in
@@ -9205,8 +9256,8 @@ package body Checks is
if No (Rlo) then
Bignum_Operands := True;
else
- Long_Long_Integer_Operands :=
- Etype (Then_DE) = LLIB or else Etype (Else_DE) = LLIB;
+ Long_Long_Operands :=
+ Etype (Then_DE) = LL_Type or else Etype (Else_DE) = LL_Type;
Min (Lo, Rlo);
Max (Hi, Rhi);
@@ -9228,29 +9279,29 @@ package body Checks is
Reanalyze (RTE (RE_Bignum), Suppress => True);
- -- 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 reexpand to
- -- complete the expansion of the if expression (but we do not
- -- need to reanalyze).
+ -- If we have no Long_Long_[Integer|Unsigned] 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|Unsigned] 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
+ elsif not Long_Long_Operands then
Set_Do_Overflow_Check (N, False);
Reexpand;
- -- Otherwise convert us to long long integer mode. Note that we
- -- don't need any further overflow checking at this level.
+ -- Otherwise convert us to long long [integer|unsigned] mode. Note
+ -- that we don't need any further overflow checking at this level.
else
- Convert_To_And_Rewrite (LLIB, Then_DE);
- Convert_To_And_Rewrite (LLIB, Else_DE);
- Set_Etype (N, LLIB);
+ Convert_To_And_Rewrite (LL_Type, Then_DE);
+ Convert_To_And_Rewrite (LL_Type, Else_DE);
+ Set_Etype (N, LL_Type);
-- Now reanalyze with overflow checks off
Set_Do_Overflow_Check (N, False);
- Reanalyze (LLIB, Suppress => True);
+ Reanalyze (LL_Type, Suppress => True);
end if;
end;
@@ -9260,7 +9311,7 @@ package body Checks is
elsif Nkind (N) = N_Case_Expression then
Bignum_Operands := False;
- Long_Long_Integer_Operands := False;
+ Long_Long_Operands := False;
declare
Alt : Node_Id;
@@ -9279,28 +9330,31 @@ package body Checks is
if No (Lo) then
Bignum_Operands := True;
- elsif Etype (Aexp) = LLIB then
- Long_Long_Integer_Operands := True;
+ elsif Etype (Aexp) = LL_Type then
+ Long_Long_Operands := True;
end if;
end;
Next (Alt);
end loop;
- -- If we have no bignum or long long integer operands, it means
- -- that none of our dependent expressions could raise overflow.
+ -- If we have no bignum or long long [integer|unsigned] operands,
+ -- it means 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 reexpand to get the needed
-- expansion for the case expression, but we do not need to
-- reanalyze, since nothing has changed.
- if not (Bignum_Operands or Long_Long_Integer_Operands) then
+ if not (Bignum_Operands or Long_Long_Operands) then
Set_Do_Overflow_Check (N, False);
Reexpand (Suppress => True);
-- Otherwise we are going to rebuild the case expression using
- -- either bignum or long long integer operands throughout.
+ -- either bignum or long long [integer|unsigned] operands
+ -- throughout.
else
declare
@@ -9316,8 +9370,8 @@ package body Checks is
New_Exp := Convert_To_Bignum (Expression (Alt));
Rtype := RTE (RE_Bignum);
else
- New_Exp := Convert_To (LLIB, Expression (Alt));
- Rtype := LLIB;
+ New_Exp := Convert_To (LL_Type, Expression (Alt));
+ Rtype := LL_Type;
end if;
Append_To (New_Alts,
@@ -9354,11 +9408,11 @@ package body Checks is
(Left_Opnd (N), Llo, Lhi, Top_Level => False);
end if;
- -- Record if we have Long_Long_Integer operands
+ -- Record if we have Long_Long_[Integer|Unsigned] operands
- Long_Long_Integer_Operands :=
- Etype (Right_Opnd (N)) = LLIB
- or else (Binary and then Etype (Left_Opnd (N)) = LLIB);
+ Long_Long_Operands :=
+ Etype (Right_Opnd (N)) = LL_Type
+ or else (Binary and then Etype (Left_Opnd (N)) = LL_Type);
-- If either operand is a bignum, then result will be a bignum and we
-- don't need to do any range analysis. As previously discussed we could
@@ -9380,15 +9434,19 @@ package body Checks is
end if;
-- Here for the case where we have not rewritten anything (no bignum
- -- operands or long long integer operands), and we know the result.
+ -- operands or Long_Long_[Integer|Unsigned] 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).
+ -- operands or Long_Long_[Integer|Unsigned] 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)
+ if not (Bignum_Operands or Long_Long_Operands)
and then In_Result_Range
then
Set_Do_Overflow_Check (N, False);
@@ -9396,22 +9454,24 @@ package body Checks is
return;
-- Here we know that we are not in the result range, and in the general
- -- case we will move into either the Bignum or Long_Long_Integer domain
- -- to compute the result. However, there is one exception. If we are
- -- at the top level, and we do not have Bignum or Long_Long_Integer
- -- operands, we will have to immediately convert the result back to
- -- the result type, so there is no point in Bignum/Long_Long_Integer
- -- fiddling.
+ -- case we will move into either the Long_Long_[Integer|Unsigned] or
+ -- Bignum domain to compute the result. However, there is one exception.
+ -- If we are at the top level, and we do not have Long_Long_[Integer|
+ -- Unsigned] or Bignum operands, we will have to immediately convert
+ -- the result back to the result type, so there is no point in
+ -- Long_Long_[Integer|Unsigned]/Bignum fiddling.
elsif Top_Level
- and then not (Bignum_Operands or Long_Long_Integer_Operands)
+ and then not (Bignum_Operands or Long_Long_Operands)
-- One further refinement. If we are at the top level, but our parent
- -- is a type conversion, then go into bignum or long long integer node
- -- since the result will be converted to that type directly without
- -- going through the result type, and we may avoid an overflow. This
- -- is the case for example of Long_Long_Integer (A ** 4), where A is
- -- of type Integer, and the result A ** 4 fits in Long_Long_Integer
+ -- is a type conversion, then go into bignum or long long [integer|
+ -- unsigned] node since the result will be converted to that type
+ -- directly without going through the result type, and we may avoid
+ -- an overflow.
+
+ -- This is the case for example of Long_Long_Integer (A ** 4), where A
+ -- is of type Integer, and the result A ** 4 fits in Long_Long_Integer
-- but does not fit in Integer.
and then Nkind (Parent (N)) /= N_Type_Conversion
@@ -9431,8 +9491,9 @@ package body Checks is
-- Cases 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,
- -- which in some cases can be indicated by Hi and Lo being No_Uint.
+ -- the computed bounds are outside the bounds of Long_Long_[Integer|
+ -- Unsigned], 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
@@ -9441,9 +9502,10 @@ package body Checks is
elsif No (Lo) or else Lo < LLLo or else Hi > LLHi then
- -- OK, we are definitely outside the range of Long_Long_Integer. The
- -- question is whether to move to Bignum mode, or stay in the domain
- -- of Long_Long_Integer, signalling that an overflow check is needed.
+ -- OK, we are definitely outside the range of Long_Long_[Integer|
+ -- Unsigned]. The question is whether to move to Bignum mode, or
+ -- stay in the domain of Long_Long_[Integer|Unsigned], signalling
+ -- that an overflow check is needed.
-- Obviously in MINIMIZED mode we stay with LLI, since we are not in
-- the Bignum business. In ELIMINATED mode, we will normally move
@@ -9461,9 +9523,10 @@ package body Checks is
Enable_Overflow_Check (N);
end if;
- -- The result now has to be in Long_Long_Integer mode, so adjust
- -- the possible range to reflect this. Note these calls also
- -- change No_Uint values from the top level case to LLI bounds.
+ -- The result now has to be in Long_Long_[Integer|Unsigned] mode,
+ -- so adjust the possible range to reflect this. Note these calls
+ -- also change No_Uint values from the top level case to LL_Type
+ -- bounds.
Max (Lo, LLLo);
Min (Hi, LLHi);
@@ -9542,39 +9605,42 @@ package body Checks is
end;
end if;
- -- Otherwise we are in range of Long_Long_Integer, so no overflow
- -- check is required, at least not yet.
+ -- Otherwise we are in range of Long_Long_[Integer|Unsigned], so no
+ -- overflow check is required, at least not yet.
else
Set_Do_Overflow_Check (N, False);
end if;
-- Here we are not in Bignum territory, but we may have long long
- -- integer operands that need special handling. First a special check:
- -- If an exponentiation operator exponent is of type Long_Long_Integer,
- -- it means we converted it to prevent overflow, but exponentiation
- -- requires a Natural right operand, so convert it back to Natural.
- -- This conversion may raise an exception which is fine.
+ -- [integer|unsigned] operands that need special handling.
- if Nkind (N) = N_Op_Expon and then Etype (Right_Opnd (N)) = LLIB then
+ -- First a special check: If an exponentiation operator exponent is of
+ -- type Long_Long_[Integer|Unsigned] it means we converted it to prevent
+ -- overflow, but exponentiation requires a Natural right operand, so
+ -- convert it back to Natural. This conversion may raise an exception
+ -- which is fine.
+
+ if Nkind (N) = N_Op_Expon and then Etype (Right_Opnd (N)) = LL_Type then
Convert_To_And_Rewrite (Standard_Natural, 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.
+ -- Here we will do the operation in Long_Long_[Integer|Unsigned]. We do
+ -- this even if we know an overflow check is required, better to do this
+ -- in long long [integer|unsigned] mode, since we are less likely to
+ -- overflow.
- -- Convert right or only operand to Long_Long_Integer, except that
- -- we do not touch the exponentiation right operand.
+ -- Convert right or only operand to Long_Long_[Integer|Unsigned], except
+ -- that we do not touch the exponentiation right operand.
if Nkind (N) /= N_Op_Expon then
- Convert_To_And_Rewrite (LLIB, Right_Opnd (N));
+ Convert_To_And_Rewrite (LL_Type, Right_Opnd (N));
end if;
- -- Convert left operand to Long_Long_Integer for binary case
+ -- Convert left operand to Long_Long_[Integer|Unsigned] for binary case
if Binary then
- Convert_To_And_Rewrite (LLIB, Left_Opnd (N));
+ Convert_To_And_Rewrite (LL_Type, Left_Opnd (N));
end if;
-- Reset node to unanalyzed
@@ -9603,9 +9669,9 @@ package body Checks is
Scope_Suppress.Overflow_Mode_Assertions := Strict;
if not Do_Overflow_Check (N) then
- Reanalyze (LLIB, Suppress => True);
+ Reanalyze (LL_Type, Suppress => True);
else
- Reanalyze (LLIB);
+ Reanalyze (LL_Type);
end if;
Scope_Suppress.Overflow_Mode_General := SG;
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 1c8542bb4b9..a469b9583e1 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -294,16 +294,21 @@ package Checks is
-- that compares discriminants of the expression with discriminants of the
-- type. Also used directly for membership tests (see Exp_Ch4.Expand_N_In).
- function Convert_From_Bignum (N : Node_Id) return Node_Id;
+ function Convert_From_Bignum
+ (N : Node_Id;
+ Result_Type : Entity_Id) return Node_Id;
-- Returns result of converting node N from Bignum. The returned value is
-- not analyzed, the caller takes responsibility for this. Node N must be
- -- a subexpression node of type Bignum. The result is Long_Long_Integer.
+ -- a subexpression node of type Bignum. The result is Long_Long_Unsigned
+ -- if Result_Type has aspect Unsigned_Base_Range; otherwise the result is
+ -- Long_Long_Integer.
function Convert_To_Bignum (N : Node_Id) return Node_Id;
-- Returns result of converting node N to Bignum. The returned value is not
-- analyzed, the caller takes responsibility for this. Node N must be a
- -- subexpression node of a signed integer type or Bignum type (if it is
- -- already a Bignum, the returned value is Relocate_Node (N)).
+ -- subexpression node of a Bignum type, a signed integer type, a long long
+ -- [integer | unsigned] type, or a type with the Unsigned_Base_Range aspect
+ -- (if it is already a Bignum, the returned value is Relocate_Node (N)).
procedure Determine_Range
(N : Node_Id;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 2ba18827f37..3c5c9266438 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -218,7 +218,7 @@ package body Exp_Ch4 is
-- Convert_To_Actual_Subtype if necessary).
function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean;
- -- For signed arithmetic operations when the current overflow mode is
+ -- For overflow arithmetic operations when the current overflow mode is
-- MINIMIZED or ELIMINATED, we must call Apply_Arithmetic_Overflow_Checks
-- as the first thing we do. We then return. We count on the recursive
-- apparatus for overflow checks to call us back with an equivalent
@@ -2127,9 +2127,6 @@ package body Exp_Ch4 is
Llo, Lhi : Uint;
Rlo, Rhi : Uint;
- LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
- -- Entity for Long_Long_Integer'Base
-
procedure Set_True;
procedure Set_False;
-- These procedures rewrite N with an occurrence of Standard_True or
@@ -2229,11 +2226,30 @@ package body Exp_Ch4 is
Ltype : constant Entity_Id := Etype (Left_Opnd (N));
Rtype : constant Entity_Id := Etype (Right_Opnd (N));
+ LL_IB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
+ -- Entity for Long_Long_Integer'Base
+
+ LL_UB : constant Entity_Id := Base_Type (Standard_Long_Long_Unsigned);
+ -- Entity for Long_Long_Unsigned'Base
+
+ LL_Type : Entity_Id;
+ -- Operands and results are of this type when we perform convertion:
+ -- Long_Long_Integer or Long_Long_Unsigned (when the type of the
+ -- result has the Unsigned_Base_Range aspect).
+
begin
+ -- Initialize type of operands and results when we convert
+
+ if Ltype = LL_UB or else Rtype = LL_UB then
+ LL_Type := LL_UB;
+ else
+ LL_Type := LL_IB;
+ end if;
+
-- If the two operands have the same signed integer type we are
-- all set, nothing more to do. This is the case where either
-- both operands were unchanged, or we rewrote both of them to
- -- be Long_Long_Integer.
+ -- be Long_Long_[Integer|Unsigned].
-- Note: Entity for the comparison may be wrong, but it's not worth
-- the effort to change it, since the back end does not use it.
@@ -2315,25 +2331,29 @@ package body Exp_Ch4 is
end;
-- No bignums involved, but types are different, so we must have
- -- rewritten one of the operands as a Long_Long_Integer but not
- -- the other one.
+ -- rewritten one of the operands as a Long_Long_[Integer|Unsigned]
+ -- type but not the other one.
- -- If left operand is Long_Long_Integer, convert right operand
- -- and we are done (with a comparison of two Long_Long_Integers).
+ -- If left operand is Long_Long_[Integer|Unsigned], convert right
+ -- operand and we are done (with a comparison of two Long_Long_
+ -- [Integers|Unsigneds]).
- elsif Ltype = LLIB then
- Convert_To_And_Rewrite (LLIB, Right_Opnd (N));
- Analyze_And_Resolve (Right_Opnd (N), LLIB, Suppress => All_Checks);
+ elsif Ltype = LL_Type then
+ Convert_To_And_Rewrite (LL_Type, Right_Opnd (N));
+ Analyze_And_Resolve
+ (Right_Opnd (N), LL_Type, Suppress => All_Checks);
return;
- -- If right operand is Long_Long_Integer, convert left operand
- -- and we are done (with a comparison of two Long_Long_Integers).
+ -- If right operand is Long_Long_[Integer|Unsigned], convert left
+ -- operand and we are done (with a comparison of two Long_Long_
+ -- [Integers|Unsigneds]).
-- This is the only remaining possibility
- else pragma Assert (Rtype = LLIB);
- Convert_To_And_Rewrite (LLIB, Left_Opnd (N));
- Analyze_And_Resolve (Left_Opnd (N), LLIB, Suppress => All_Checks);
+ else pragma Assert (Rtype = LL_Type);
+ Convert_To_And_Rewrite (LL_Type, Left_Opnd (N));
+ Analyze_And_Resolve
+ (Left_Opnd (N), LL_Type, Suppress => All_Checks);
return;
end if;
end;
@@ -3641,10 +3661,23 @@ package body Exp_Ch4 is
Lo, Hi : Uint;
-- Bounds in Minimize calls, not used currently
- LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
- -- Entity for Long_Long_Integer'Base
+ LL_Type : Entity_Id;
+ -- Entity for Long_Long_[Integer|Unsigned]'Base
+
+ From_Bignum_Id : Entity_Id;
+ -- Entity for RE_[LLU_]From_Bignum
begin
+ -- Initialize type of operands and results when we convert
+
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Etype (Lop))) then
+ LL_Type := Base_Type (Standard_Long_Long_Unsigned);
+ From_Bignum_Id := RTE (RE_LLU_From_Bignum);
+ else
+ LL_Type := Base_Type (Standard_Long_Long_Integer);
+ From_Bignum_Id := RTE (RE_From_Bignum);
+ end if;
+
Minimize_Eliminate_Overflows (Lop, Lo, Hi, Top_Level => False);
-- If right operand is a subtype name, and the subtype name has no
@@ -3776,21 +3809,22 @@ package body Exp_Ch4 is
null;
-- If types are not all the same, it means that we have rewritten
- -- at least one of them to be of type Long_Long_Integer, and we
- -- will convert the other operands to Long_Long_Integer.
+ -- at least one of them to be of type Long_Long_[Integer|Unsigned]
+ -- and we will convert the other operands to Long_Long_[Integer|
+ -- Unsigned].
else
- Convert_To_And_Rewrite (LLIB, Lop);
+ Convert_To_And_Rewrite (LL_Type, Lop);
Set_Analyzed (Lop, False);
- Analyze_And_Resolve (Lop, LLIB);
+ Analyze_And_Resolve (Lop, LL_Type);
-- For the right operand, avoid unnecessary recursion into
-- this routine, we know that overflow is not possible.
- Convert_To_And_Rewrite (LLIB, Low_Bound (Rop));
- Convert_To_And_Rewrite (LLIB, High_Bound (Rop));
+ Convert_To_And_Rewrite (LL_Type, Low_Bound (Rop));
+ Convert_To_And_Rewrite (LL_Type, High_Bound (Rop));
Set_Analyzed (Rop, False);
- Analyze_And_Resolve (Rop, LLIB, Suppress => Overflow_Check);
+ Analyze_And_Resolve (Rop, LL_Type, Suppress => Overflow_Check);
end if;
-- Now the three operands are of the same signed integer type,
@@ -3825,7 +3859,7 @@ package body Exp_Ch4 is
-- declare
-- M : Mark_Id := SS_Mark;
- -- Lnn : Long_Long_Integer'Base
+ -- Lnn : Long_Long_[Integer|Unsigned]'Base
-- Nnn : Bignum;
-- begin
@@ -3836,7 +3870,8 @@ package body Exp_Ch4 is
-- else
-- Lnn := From_Bignum (Nnn);
-- Bnn :=
- -- Lnn in LLIB (T'Base'First) .. LLIB (T'Base'Last)
+ -- Lnn in LL_Type (T'Base'First)
+ -- .. LL_Type (T'Base'Last)
-- and then T'Base (Lnn) in T;
-- end if;
@@ -3872,7 +3907,7 @@ package body Exp_Ch4 is
(Last (Declarations (Blk)),
Make_Object_Declaration (Loc,
Defining_Identifier => Lnn,
- Object_Definition => New_Occurrence_Of (LLIB, Loc)));
+ Object_Definition => New_Occurrence_Of (LL_Type, Loc)));
Insert_After
(Last (Declarations (Blk)),
@@ -3909,11 +3944,12 @@ package body Exp_Ch4 is
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Lnn, Loc),
Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_From_Bignum), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Nnn, Loc)))),
+ Convert_To (LL_Type,
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (From_Bignum_Id, Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Nnn, Loc))))),
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Bnn, Loc),
@@ -3925,14 +3961,14 @@ package body Exp_Ch4 is
Right_Opnd =>
Make_Range (Loc,
Low_Bound =>
- Convert_To (LLIB,
+ Convert_To (LL_Type,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (TB, Loc))),
High_Bound =>
- Convert_To (LLIB,
+ Convert_To (LL_Type,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix =>
@@ -3956,15 +3992,15 @@ package body Exp_Ch4 is
end;
-- Not bignum case, but types don't match (this means we rewrote the
- -- left operand to be Long_Long_Integer).
+ -- left operand to be Long_Long_[Integer|Unsigned]).
else
- pragma Assert (Base_Type (Etype (Lop)) = LLIB);
+ pragma Assert (Base_Type (Etype (Lop)) = LL_Type);
-- We rewrite the membership test as (where T is the type with
-- the predicate, i.e. the type of the right operand)
- -- Lop in LLIB (T'Base'First) .. LLIB (T'Base'Last)
+ -- Lop in LL_Type (T'Base'First) .. LL_Type (T'Base'Last)
-- and then T'Base (Lop) in T
declare
@@ -3991,13 +4027,13 @@ package body Exp_Ch4 is
Right_Opnd =>
Make_Range (Loc,
Low_Bound =>
- Convert_To (LLIB,
+ Convert_To (LL_Type,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (TB, Loc))),
High_Bound =>
- Convert_To (LLIB,
+ Convert_To (LL_Type,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix =>
@@ -8815,6 +8851,13 @@ package body Exp_Ch4 is
Bastyp : Entity_Id;
+ procedure Expand_Exponentiation;
+ -- Expand N into code that computes Left_Opnd(N) ** Right_Opnd(N) using
+ -- the standard logarithmic approach. This routine is used to expand in
+ -- line the exponentiation of unsigned base range operands with overflow
+ -- checks, because there is no suitable implementation of it in the
+ -- runtime library.
+
function Wrap_MA (Exp : Node_Id) return Node_Id;
-- Given an expression Exp, if the root type is Float or Long_Float,
-- then wrap the expression in a call of Bastyp'Machine, to stop any
@@ -8822,6 +8865,130 @@ package body Exp_Ch4 is
-- a static constant and B is a variable with the same value. For any
-- other type, the node Exp is returned unchanged.
+ ---------------------------
+ -- Expand_Exponentiation --
+ ---------------------------
+
+ procedure Expand_Exponentiation is
+ Loc : constant Source_Ptr := Sloc (N);
+ Decls : constant List_Id := New_List;
+ Exp : constant Entity_Id := Make_Temporary (Loc, 'E');
+ Factor : constant Entity_Id := Make_Temporary (Loc, 'F');
+ L : constant Node_Id := Left_Opnd (N);
+ L_Typ : constant Entity_Id := Etype (L);
+ Result : constant Entity_Id := Make_Temporary (Loc, 'R');
+ R : constant Node_Id := Right_Opnd (N);
+ R_Typ : constant Entity_Id := Etype (R);
+ Stmts : constant List_Id := New_List;
+ Then_List : constant List_Id := New_List;
+
+ begin
+ -- Generate:
+ -- do
+ -- declare
+ -- Result : Typ := 1;
+ -- Factor : L_Typ := Left_Opnd (N);
+ -- Exp : R_Typ := Right_Opnd (N);
+ -- begin
+ -- loop
+ -- if Exp rem 2 /= 0 then
+ -- Result := Result * Factor;
+ -- end if;
+ -- Exp := Exp / 2;
+ -- if Exp = 0 then
+ -- exit;
+ -- end if;
+ -- Factor := Factor * Factor;
+ -- end loop;
+ -- end;
+ -- in Result end
+
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Result,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression => Make_Integer_Literal (Loc, Uint_1)));
+
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Factor,
+ Object_Definition => New_Occurrence_Of (L_Typ, Loc),
+ Expression => New_Copy_Tree (L)));
+
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Exp,
+ Object_Definition => New_Occurrence_Of (R_Typ, Loc),
+ Expression => New_Copy_Tree (R)));
+
+ Append_To (Then_List,
+ Make_Loop_Statement (Loc,
+ Statements => New_List (
+
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ Make_Op_Rem (Loc,
+ Left_Opnd => New_Occurrence_Of (Exp, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_2)),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
+
+ Then_Statements => New_List (
+ Make_Assignment_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (Result, Loc),
+ Expression =>
+ Make_Op_Multiply (Loc,
+ Left_Opnd => New_Occurrence_Of (Result, Loc),
+ Right_Opnd => New_Occurrence_Of (Factor, Loc))))),
+
+ Make_Assignment_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (Exp, Loc),
+ Expression =>
+ Make_Op_Divide (Loc,
+ Left_Opnd => New_Occurrence_Of (Exp, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_2))),
+
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd => New_Occurrence_Of (Exp, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
+ Then_Statements =>
+ New_List (Make_Exit_Statement (Loc))),
+
+ Make_Assignment_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (Factor, Loc),
+ Expression =>
+ Make_Op_Multiply (Loc,
+ Left_Opnd => New_Occurrence_Of (Factor, Loc),
+ Right_Opnd => New_Occurrence_Of (Factor, Loc)))
+ ),
+ End_Label => Empty));
+
+ Append_To (Stmts,
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => New_Occurrence_Of (Exp, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
+
+ Then_Statements => Then_List));
+
+ Rewrite (N,
+ Make_Expression_With_Actions (Loc,
+ Actions => New_List (
+ Make_Block_Statement (Loc,
+ Declarations => Decls,
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Stmts))),
+ Expression => New_Occurrence_Of (Result, Loc)));
+ end Expand_Exponentiation;
+
-------------
-- Wrap_MA --
-------------
@@ -9128,10 +9295,11 @@ package body Exp_Ch4 is
-- Fall through if exponentiation must be done using a runtime routine
- -- First deal with modular case
-
- if Has_Modular_Operations (Rtyp) then
+ -- First deal with modular case.
+ if Has_Modular_Operations (Rtyp)
+ and then not Has_Unsigned_Base_Range_Aspect (Base_Type (Typ))
+ then
-- Nonbinary modular case, we call the special exponentiation
-- routine for the nonbinary case, converting the argument to
-- Long_Long_Integer and passing the modulus value. Then the
@@ -9191,32 +9359,69 @@ package body Exp_Ch4 is
-- checks are required, and one when they are not required, since there
-- is a real gain in omitting checks on many machines.
- elsif Has_Overflow_Operations (Rtyp) then
+ elsif Has_Overflow_Operations (Rtyp)
+ or else Has_Unsigned_Base_Range_Aspect (Base_Type (Typ))
+ then
if Esize (Rtyp) <= Standard_Integer_Size then
- Etyp := Standard_Integer;
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)) then
+ Etyp := RTE (RE_Unsigned);
- if Ovflo then
- Rent := RE_Exp_Integer;
+ if Ovflo then
+ Expand_Exponentiation;
+ Analyze_And_Resolve (N, Typ);
+ return;
+ else
+ Rent := RE_Exp_Unsigned;
+ end if;
else
- Rent := RE_Exn_Integer;
+ Etyp := Standard_Integer;
+
+ if Ovflo then
+ Rent := RE_Exp_Integer;
+ else
+ Rent := RE_Exn_Integer;
+ end if;
end if;
elsif Esize (Rtyp) <= Standard_Long_Long_Integer_Size then
- Etyp := Standard_Long_Long_Integer;
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)) then
+ Etyp := RTE (RE_Long_Long_Unsigned);
- if Ovflo then
- Rent := RE_Exp_Long_Long_Integer;
+ if Ovflo then
+ Expand_Exponentiation;
+ Analyze_And_Resolve (N, Typ);
+ return;
+ else
+ Rent := RE_Exp_Long_Long_Unsigned;
+ end if;
else
- Rent := RE_Exn_Long_Long_Integer;
+ Etyp := Standard_Long_Long_Integer;
+
+ if Ovflo then
+ Rent := RE_Exp_Long_Long_Integer;
+ else
+ Rent := RE_Exn_Long_Long_Integer;
+ end if;
end if;
-
else
- Etyp := Standard_Long_Long_Long_Integer;
+ if Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)) then
+ Etyp := RTE (RE_Long_Long_Long_Unsigned);
- if Ovflo then
- Rent := RE_Exp_Long_Long_Long_Integer;
+ if Ovflo then
+ Expand_Exponentiation;
+ Analyze_And_Resolve (N, Typ);
+ return;
+ else
+ Rent := RE_Exp_Long_Long_Long_Unsigned;
+ end if;
else
- Rent := RE_Exn_Long_Long_Long_Integer;
+ Etyp := Standard_Long_Long_Long_Integer;
+
+ if Ovflo then
+ Rent := RE_Exp_Long_Long_Long_Integer;
+ else
+ Rent := RE_Exn_Long_Long_Long_Integer;
+ end if;
end if;
end if;
@@ -14147,11 +14352,11 @@ package body Exp_Ch4 is
function Minimized_Eliminated_Overflow_Check (N : Node_Id) return Boolean is
begin
- -- The MINIMIZED mode operates in Long_Long_Integer so we cannot use it
- -- if the type of the expression is already larger.
+ -- The MINIMIZED mode operates in Long_Long_[Integer|Unsigned] so we
+ -- cannot use it if the type of the expression is already larger.
return
- Is_Signed_Integer_Type (Etype (N))
+ Has_Overflow_Operations (Etype (N))
and then Overflow_Check_Mode in Minimized_Or_Eliminated
and then not (Overflow_Check_Mode = Minimized
and then
diff --git a/gcc/ada/libgnat/s-bignum.adb b/gcc/ada/libgnat/s-bignum.adb
index a57ed4b129e..1651a102a22 100644
--- a/gcc/ada/libgnat/s-bignum.adb
+++ b/gcc/ada/libgnat/s-bignum.adb
@@ -145,4 +145,10 @@ package body System.Bignums is
function From_Bignum (X : Bignum) return Long_Long_Integer
renames Sec_Stack_Bignums.From_Bignum;
+ function LLU_To_Bignum (X : Long_Long_Unsigned) return Bignum
+ renames Sec_Stack_Bignums.To_Bignum;
+
+ function LLU_From_Bignum (X : Bignum) return Long_Long_Unsigned
+ renames Sec_Stack_Bignums.From_Bignum;
+
end System.Bignums;
diff --git a/gcc/ada/libgnat/s-bignum.ads b/gcc/ada/libgnat/s-bignum.ads
index a209bbdd26e..667e19eb1d5 100644
--- a/gcc/ada/libgnat/s-bignum.ads
+++ b/gcc/ada/libgnat/s-bignum.ads
@@ -37,11 +37,16 @@
-- because the rtsfind mechanism is not ready to handle instantiations.
with System.Shared_Bignums;
+with System.Unsigned_Types;
package System.Bignums is
pragma Preelaborate;
+ package SU renames System.Unsigned_Types;
+
subtype Bignum is System.Shared_Bignums.Bignum;
+ subtype Long_Long_Unsigned is SU.Long_Long_Unsigned;
+ subtype Long_Long_Long_Unsigned is SU.Long_Long_Long_Unsigned;
function Big_Add (X, Y : Bignum) return Bignum; -- "+"
function Big_Sub (X, Y : Bignum) return Bignum; -- "-"
@@ -77,6 +82,14 @@ package System.Bignums is
-- Convert Bignum to Long_Long_Integer. Constraint_Error raised with
-- appropriate message if value is out of range of Long_Long_Integer.
+ function LLU_To_Bignum (X : Long_Long_Unsigned) return Bignum;
+ -- Convert Long_Long_Unsigned to Bignum. No exception can be raised for any
+ -- input argument.
+
+ function LLU_From_Bignum (X : Bignum) return Long_Long_Unsigned;
+ -- Convert Bignum to Long_Long_Unsigned. Constraint_Error raised with
+ -- appropriate message if value is out of range of Long_Long_Unsigned.
+
private
pragma Inline (Big_Add);
diff --git a/gcc/ada/libgnat/s-explllu.ads b/gcc/ada/libgnat/s-explllu.ads
index 88aa9af9e2d..fb085f45548 100644
--- a/gcc/ada/libgnat/s-explllu.ads
+++ b/gcc/ada/libgnat/s-explllu.ads
@@ -45,5 +45,11 @@ is
function Exp_Long_Long_Long_Unsigned is
new Exponu (Long_Long_Long_Unsigned);
pragma Pure_Function (Exp_Long_Long_Long_Unsigned);
+ -- Return the power of ``Left`` by ``Right`` where ``Left`` is a
+ -- Long_Long_Long_Unsigned.
+ --
+ -- This function is implemented using the standard logarithmic approach:
+ -- ``Right`` gets shifted right testing successive low order bits, and
+ -- ``Left`` is raised to the next power of 2.
end System.Exp_LLLU;
diff --git a/gcc/ada/libgnat/s-expllu.ads b/gcc/ada/libgnat/s-expllu.ads
index 3e2b2a7cce0..855f7be6e22 100644
--- a/gcc/ada/libgnat/s-expllu.ads
+++ b/gcc/ada/libgnat/s-expllu.ads
@@ -50,7 +50,5 @@ is
-- This function is implemented using the standard logarithmic approach:
-- ``Right`` gets shifted right testing successive low order bits, and
-- ``Left`` is raised to the next power of 2.
- --
- -- In case of overflow, Constraint_Error is raised.
end System.Exp_LLU;
diff --git a/gcc/ada/libgnat/s-expuns.ads b/gcc/ada/libgnat/s-expuns.ads
index d1dcc25b2c3..f98ec22fa35 100644
--- a/gcc/ada/libgnat/s-expuns.ads
+++ b/gcc/ada/libgnat/s-expuns.ads
@@ -51,7 +51,5 @@ is
-- This function is implemented using the standard logarithmic approach:
-- ``Right`` gets shifted right testing successive low order bits, and
-- ``Left`` is raised to the next power of 2.
- --
- -- In case of overflow, Constraint_Error is raised.
end System.Exp_Uns;
diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb
index 2780305e042..9407a0cfd97 100644
--- a/gcc/ada/libgnat/s-genbig.adb
+++ b/gcc/ada/libgnat/s-genbig.adb
@@ -1132,6 +1132,16 @@ package body System.Generic_Bignums is
return Unsigned_64 (Unsigned_128'(From_Bignum (X)));
end From_Bignum;
+ function From_Bignum (X : Bignum) return Long_Long_Unsigned is
+ begin
+ return Long_Long_Unsigned (Unsigned_128'(From_Bignum (X)));
+ end From_Bignum;
+
+ function From_Bignum (X : Bignum) return Long_Long_Long_Unsigned is
+ begin
+ return Long_Long_Long_Unsigned (Unsigned_128'(From_Bignum (X)));
+ end From_Bignum;
+
-------------------------
-- Bignum_In_LLI_Range --
-------------------------
@@ -1298,6 +1308,16 @@ package body System.Generic_Bignums is
return To_Bignum (Unsigned_128 (X));
end To_Bignum;
+ function To_Bignum (X : Long_Long_Unsigned) return Big_Integer is
+ begin
+ return To_Bignum (Unsigned_128 (X));
+ end To_Bignum;
+
+ function To_Bignum (X : Long_Long_Long_Unsigned) return Big_Integer is
+ begin
+ return To_Bignum (Unsigned_128 (X));
+ end To_Bignum;
+
---------------
-- To_String --
---------------
diff --git a/gcc/ada/libgnat/s-genbig.ads b/gcc/ada/libgnat/s-genbig.ads
index 8b7a54a4af8..15cab3df77e 100644
--- a/gcc/ada/libgnat/s-genbig.ads
+++ b/gcc/ada/libgnat/s-genbig.ads
@@ -35,6 +35,7 @@
with Interfaces;
with System.Shared_Bignums;
+with System.Unsigned_Types;
generic
type Big_Integer is private;
@@ -53,7 +54,11 @@ generic
package System.Generic_Bignums is
pragma Preelaborate;
+ package SU renames System.Unsigned_Types;
+
subtype Bignum is Shared_Bignums.Bignum;
+ subtype Long_Long_Unsigned is SU.Long_Long_Unsigned;
+ subtype Long_Long_Long_Unsigned is SU.Long_Long_Long_Unsigned;
-- Note that this package never shares an allocated Big_Integer value, so
-- so for example for X + 0, a copy of X is returned, not X itself.
@@ -101,10 +106,18 @@ package System.Generic_Bignums is
-- Convert Long_Long_Integer to a big integer. No exception can be raised
-- for any input argument.
+ function To_Bignum (X : Long_Long_Unsigned) return Big_Integer;
+ -- Convert Long_Long_Unsigned to a big integer. No exception can be raised
+ -- for any input argument.
+
function To_Bignum (X : Long_Long_Long_Integer) return Big_Integer;
-- Convert Long_Long_Long_Integer to a big integer. No exception can be
-- raised.
+ function To_Bignum (X : Long_Long_Long_Unsigned) return Big_Integer;
+ -- Convert Long_Long_Long_Unsigned to a big integer. No exception can be
+ -- raised.
+
function To_Bignum (X : Interfaces.Unsigned_64) return Big_Integer;
-- Convert Unsigned_64 to a big integer. No exception can be raised for any
-- input argument.
@@ -117,10 +130,18 @@ package System.Generic_Bignums is
-- Convert Bignum to Long_Long_Integer. Constraint_Error raised with
-- appropriate message if value is out of range of Long_Long_Integer.
+ function From_Bignum (X : Bignum) return Long_Long_Unsigned;
+ -- Convert Bignum to Long_Long_Unsigned. Constraint_Error raised with
+ -- appropriate message if value is out of range of Long_Long_Unsigned.
+
function From_Bignum (X : Bignum) return Long_Long_Long_Integer;
-- Convert Bignum to Long_Long_Long_Integer. Constraint_Error raised with
-- appropriate message if value is out of range of Long_Long_Long_Integer.
+ function From_Bignum (X : Bignum) return Long_Long_Long_Unsigned;
+ -- Convert Bignum to Long_Long_Long_Unsigned. Constraint_Error raised with
+ -- appropriate message if value is out of range of Long_Long_Long_Unsigned.
+
function From_Bignum (X : Bignum) return Interfaces.Unsigned_64;
-- Convert Bignum to Unsigned_64. Constraint_Error raised with
-- appropriate message if value is out of range of Unsigned_64.
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index ee529e122ab..3e1756c68e9 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -839,6 +839,8 @@ package Rtsfind is
RE_Bignum_In_LLI_Range, -- System.Bignums
RE_To_Bignum, -- System.Bignums
RE_From_Bignum, -- System.Bignums
+ RE_LLU_To_Bignum, -- System.Bignums
+ RE_LLU_From_Bignum, -- System.Bignums
RE_Val_2, -- System.Bitfields
RE_Copy_Bitfield, -- System.Bitfields
@@ -2497,6 +2499,8 @@ package Rtsfind is
RE_Bignum_In_LLI_Range => System_Bignums,
RE_To_Bignum => System_Bignums,
RE_From_Bignum => System_Bignums,
+ RE_LLU_To_Bignum => System_Bignums,
+ RE_LLU_From_Bignum => System_Bignums,
RE_Val_2 => System_Bitfields,
RE_Copy_Bitfield => System_Bitfields,
--
2.51.0
