https://gcc.gnu.org/g:913d2dda428e883eea58adcab946f1ed03c9469b
commit r16-6633-g913d2dda428e883eea58adcab946f1ed03c9469b Author: Javier Miranda <[email protected]> Date: Wed Dec 3 19:37:53 2025 +0000 ada: Unsigned_Base_Range aspect (part 7) 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. Diff: --- 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 a346772001f2..5dc63d529ced 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 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; - if not Is_Signed_Integer_Arithmetic_Op (N) then + 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. + + -- 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)) = LLIB then + 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 1c8542bb4b9f..a469b9583e14 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 2ba18827f372..3c5c92664382 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; - end if; + 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 a57ed4b129e0..1651a102a22c 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 a209bbdd26e2..667e19eb1d5d 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 88aa9af9e2d4..fb085f45548c 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 3e2b2a7cce0b..855f7be6e229 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 d1dcc25b2c3c..f98ec22fa35f 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 2780305e042b..9407a0cfd975 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 8b7a54a4af88..15cab3df77e4 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 ee529e122ab4..3e1756c68e9e 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,
