From 84c54629c2fb6dae0e7d97a2c57e894899f2b944 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 2 Nov 2020 22:54:01 +0100 Subject: [PATCH] [Ada] Optimize generation of checks for fixed-point types gcc/ada/ * checks.ads (Determine_Range_To_Discrete): New procedure. * checks.adb (Apply_Scalar_Range_Check): Call it to determine a range for the expression when the target type is discrete. And also apply the tests for discrete types to fixed-point types when they are treated as integers. (Apply_Type_Conversion_Checks): Apply checks to conversions involving fixed-point types when they are treated as integers. (Determine_Range) : Factor out code into... (Determine_Range_To_Discrete): ...this new procedure and add support for fixed-point types when they are treated as integers. * einfo.ads (Type_High_Bound): Remove obsolete sentence. (Type_Low_Bound): Likewise. * exp_ch4.adb (Discrete_Range_Check): Remove obsolete code. (Real_Range_Check): Likewise. (Expand_N_Type_Conversion): In case of a no-op conversion, clear the Do_Range_Check flag on the operand before substituting it. Remove calls to Real_Range_Check and Discrete_Range_Check that are not guarded by the Do_Range_Check flag, and an assertion. * sem_res.adb (Resolve_Type_Conversion): Always apply range checks in GNATprove mode; in normal mode, use the updated type of the operand in the test against Universal_Fixed. Remove obsolete code setting the Do_Range_Check flag at the end. --- gcc/ada/checks.adb | 188 ++++++++++++++++++++++++++------------------ gcc/ada/checks.ads | 15 ++++ gcc/ada/einfo.ads | 6 +- gcc/ada/exp_ch4.adb | 35 +-------- gcc/ada/sem_res.adb | 17 ++-- 5 files changed, 139 insertions(+), 122 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 1914fc3024a..c7a33217064 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3258,23 +3258,16 @@ package body Checks is end if; -- Return if we know expression is definitely in the range of the target - -- type as determined by Determine_Range. Right now we only do this for - -- discrete types, and not fixed-point or floating-point types. - - -- The additional less-precise tests below catch these cases - - -- In GNATprove_Mode, also deal with the case of a conversion from - -- floating-point to integer. It is only possible because analysis - -- in GNATprove rules out the possibility of a NaN or infinite value. + -- type as determined by Determine_Range_To_Discrete. Right now we only + -- do this for discrete target types, i.e. neither for fixed-point nor + -- for floating-point types. But the additional less precise tests below + -- catch these cases. -- Note: skip this if we are given a source_typ, since the point of -- supplying a Source_Typ is to stop us looking at the expression. -- We could sharpen this test to be out parameters only ??? if Is_Discrete_Type (Target_Typ) - and then (Is_Discrete_Type (Etype (Expr)) - or else (GNATprove_Mode - and then Is_Floating_Point_Type (Etype (Expr)))) and then not Is_Unconstrained_Subscr_Ref and then No (Source_Typ) then @@ -3318,35 +3311,8 @@ package body Checks is -- Otherwise determine range of value - if Is_Discrete_Type (Etype (Expr)) then - Determine_Range - (Expr, OK, Lo, Hi, Assume_Valid => True); - - -- When converting a float to an integer type, determine the - -- range in real first, and then convert the bounds using - -- UR_To_Uint which correctly rounds away from zero when - -- half way between two integers, as required by normal - -- Ada 95 rounding semantics. It is only possible because - -- analysis in GNATprove rules out the possibility of a NaN - -- or infinite value. - - elsif GNATprove_Mode - and then Is_Floating_Point_Type (Etype (Expr)) - then - declare - Hir : Ureal; - Lor : Ureal; - - begin - Determine_Range_R - (Expr, OK, Lor, Hir, Assume_Valid => True); - - if OK then - Lo := UR_To_Uint (Lor); - Hi := UR_To_Uint (Hir); - end if; - end; - end if; + Determine_Range_To_Discrete + (Expr, OK, Lo, Hi, Fixed_Int, Assume_Valid => True); if OK then @@ -3389,10 +3355,12 @@ package body Checks is -- Check if we can determine at compile time whether Expr is in the -- range of the target type. Note that if S_Typ is within the bounds -- of Target_Typ then this must be the case. This check is meaningful - -- only if this is not a conversion between integer and real types. + -- only if this is not a conversion between integer and real types, + -- unless for a fixed-point type if Fixed_Int is set. if not Is_Unconstrained_Subscr_Ref - and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) + and then (Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ) + or else (Fixed_Int and then Is_Discrete_Type (Target_Typ))) and then (In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int) @@ -3705,12 +3673,15 @@ package body Checks is then Apply_Float_Conversion_Check (Expr, Target_Type); else - -- Conversions involving fixed-point types are expanded - -- separately, and do not need a Range_Check flag, except - -- in GNATprove_Mode, where the explicit constraint check - -- will not be generated. + -- Raw conversions involving fixed-point types are expanded + -- separately and do not need a Range_Check flag yet, except + -- in GNATprove_Mode where this expansion is not performed. + -- This does not apply to conversion where fixed-point types + -- are treated as integers, which are precisely generated by + -- this expansion. if GNATprove_Mode + or else Conv_OK or else (not Is_Fixed_Point_Type (Expr_Type) and then not Is_Fixed_Point_Type (Target_Type)) then @@ -5354,38 +5325,11 @@ package body Checks is end case; when N_Type_Conversion => + -- For a type conversion, we can try to refine the range using the + -- converted value. - -- For type conversion from one discrete type to another, we can - -- refine the range using the converted value. - - if Is_Discrete_Type (Etype (Expression (N))) then - Determine_Range (Expression (N), OK1, Lor, Hir, Assume_Valid); - - -- When converting a float to an integer type, determine the range - -- in real first, and then convert the bounds using UR_To_Uint - -- which correctly rounds away from zero when half way between two - -- integers, as required by normal Ada 95 rounding semantics. It - -- is only possible because analysis in GNATprove rules out the - -- possibility of a NaN or infinite value. - - elsif GNATprove_Mode - and then Is_Floating_Point_Type (Etype (Expression (N))) - then - declare - Lor_Real, Hir_Real : Ureal; - begin - Determine_Range_R (Expression (N), OK1, Lor_Real, Hir_Real, - Assume_Valid); - - if OK1 then - Lor := UR_To_Uint (Lor_Real); - Hir := UR_To_Uint (Hir_Real); - end if; - end; - - else - OK1 := False; - end if; + Determine_Range_To_Discrete + (Expression (N), OK1, Lor, Hir, Conversion_OK (N), Assume_Valid); -- Nothing special to do for all other expression kinds @@ -5905,6 +5849,96 @@ package body Checks is end if; end Determine_Range_R; + --------------------------------- + -- Determine_Range_To_Discrete -- + --------------------------------- + + procedure Determine_Range_To_Discrete + (N : Node_Id; + OK : out Boolean; + Lo : out Uint; + Hi : out Uint; + Fixed_Int : Boolean := False; + Assume_Valid : Boolean := False) + is + Typ : constant Entity_Id := Etype (N); + + begin + -- For a discrete type, simply defer to Determine_Range + + if Is_Discrete_Type (Typ) then + Determine_Range (N, OK, Lo, Hi, Assume_Valid); + + -- For a fixed point type treated as an integer, we can determine the + -- range using the Corresponding_Integer_Value of the bounds of the + -- type or base type. This is done by the calls to Expr_Value below. + + elsif Is_Fixed_Point_Type (Typ) and then Fixed_Int then + declare + Btyp, Ftyp : Entity_Id; + Bound : Node_Id; + + begin + if Assume_Valid then + Ftyp := Typ; + else + Ftyp := Underlying_Type (Base_Type (Typ)); + end if; + + Btyp := Base_Type (Ftyp); + + -- First the low bound + + Bound := Type_Low_Bound (Ftyp); + + if Compile_Time_Known_Value (Bound) then + Lo := Expr_Value (Bound); + else + Lo := Expr_Value (Type_Low_Bound (Btyp)); + end if; + + -- Then the high bound + + Bound := Type_High_Bound (Ftyp); + + if Compile_Time_Known_Value (Bound) then + Hi := Expr_Value (Bound); + else + Hi := Expr_Value (Type_High_Bound (Btyp)); + end if; + + OK := True; + end; + + -- For a floating-point type, we can determine the range in real first, + -- and then convert the bounds using UR_To_Uint, which correctly rounds + -- away from zero when half way between two integers, as required by + -- normal Ada 95 rounding semantics. But this is only possible because + -- GNATprove's analysis rules out the possibility of a NaN or infinite. + + elsif GNATprove_Mode and then Is_Floating_Point_Type (Typ) then + declare + Lo_Real, Hi_Real : Ureal; + + begin + Determine_Range_R (N, OK, Lo_Real, Hi_Real, Assume_Valid); + + if OK then + Lo := UR_To_Uint (Lo_Real); + Hi := UR_To_Uint (Hi_Real); + else + Lo := No_Uint; + Hi := No_Uint; + end if; + end; + + else + Lo := No_Uint; + Hi := No_Uint; + OK := False; + end if; + end Determine_Range_To_Discrete; + ------------------------------------ -- Discriminant_Checks_Suppressed -- ------------------------------------ diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index aca1b7eea60..d75c6022097 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -338,6 +338,21 @@ package Checks is -- For that to happen, the possibility of arguments of infinite or NaN -- value should be taken into account, which is not the case currently. + procedure Determine_Range_To_Discrete + (N : Node_Id; + OK : out Boolean; + Lo : out Uint; + Hi : out Uint; + Fixed_Int : Boolean := False; + Assume_Valid : Boolean := False); + -- Similar to Determine_Range, but attempts to return a discrete range even + -- if N is not of a discrete type by doing a conversion. The Fixed_Int flag + -- if set causes any fixed-point values to be treated as though they were + -- discrete values (i.e. the underlying integer value is used), in which + -- case no conversion is needed. At the current time, this is used only for + -- discrete types, for fixed-point types if Fixed_Int is set, and also for + -- floating-point types in GNATprove, see Determine_Range_R above. + procedure Install_Null_Excluding_Check (N : Node_Id); -- Determines whether an access node requires a run-time access check and -- if so inserts the appropriate run-time check. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 8368fb3e62f..a4b4f0fcf76 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4596,15 +4596,13 @@ package Einfo is -- Applies to scalar types. Returns the tree node (Node_Id) that contains -- the high bound of a scalar type. The returned value is literal for a -- base type, but may be an expression in the case of scalar type with --- dynamic bounds. Note that in the case of a fixed point type, the high --- bound is in units of small, and is an integer. +-- dynamic bounds. -- Type_Low_Bound (synthesized) -- Applies to scalar types. Returns the tree node (Node_Id) that contains -- the low bound of a scalar type. The returned value is literal for a -- base type, but may be an expression in the case of scalar type with --- dynamic bounds. Note that in the case of a fixed point type, the low --- bound is in units of small, and is an integer. +-- dynamic bounds. -- Underlying_Full_View (Node19) -- Defined in private subtypes that are the completion of other private diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 74b8f27eaea..efdc235aa00 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11465,11 +11465,6 @@ package body Exp_Ch4 is -- Start of processing for Discrete_Range_Check begin - -- Clear the Do_Range_Check flag on N if needed: this can occur when - -- e.g. a trivial type conversion is rewritten by its expression. - - Set_Do_Range_Check (N, False); - -- Nothing more to do if conversion was rewritten if Nkind (N) /= N_Type_Conversion then @@ -11478,12 +11473,6 @@ package body Exp_Ch4 is Expr := Expression (N); - -- Nothing to do if no range check flag set - - if not Do_Range_Check (Expr) then - return; - end if; - -- Clear the Do_Range_Check flag on Expr Set_Do_Range_Check (Expr, False); @@ -11756,11 +11745,6 @@ package body Exp_Ch4 is Tnn : Entity_Id; begin - -- Clear the Do_Range_Check flag on N if needed: this can occur when - -- e.g. a trivial type conversion is rewritten by its expression. - - Set_Do_Range_Check (N, False); - -- Nothing more to do if conversion was rewritten if Nkind (N) /= N_Type_Conversion then @@ -12032,20 +12016,16 @@ package body Exp_Ch4 is -- Nothing at all to do if conversion is to the identical type so remove -- the conversion completely, it is useless, except that it may carry -- an Assignment_OK attribute, which must be propagated to the operand - -- and the Do_Range_Check flag on Operand should be taken into account. + -- and the Do_Range_Check flag on the operand must be cleared, if any. if Operand_Type = Target_Type then if Assignment_OK (N) then Set_Assignment_OK (Operand); end if; - Rewrite (N, Relocate_Node (Operand)); - - if Do_Range_Check (Operand) then - pragma Assert (Is_Discrete_Type (Operand_Type)); + Set_Do_Range_Check (Operand, False); - Discrete_Range_Check; - end if; + Rewrite (N, Relocate_Node (Operand)); goto Done; end if; @@ -12468,16 +12448,11 @@ package body Exp_Ch4 is if Is_Fixed_Point_Type (Target_Type) then Expand_Convert_Fixed_To_Fixed (N); - Real_Range_Check; - elsif Is_Integer_Type (Target_Type) then Expand_Convert_Fixed_To_Integer (N); - Discrete_Range_Check; - else pragma Assert (Is_Floating_Point_Type (Target_Type)); Expand_Convert_Fixed_To_Float (N); - Real_Range_Check; end if; -- Case of conversions to a fixed-point type @@ -12492,11 +12467,9 @@ package body Exp_Ch4 is then if Is_Integer_Type (Operand_Type) then Expand_Convert_Integer_To_Fixed (N); - Real_Range_Check; else pragma Assert (Is_Floating_Point_Type (Operand_Type)); Expand_Convert_Float_To_Fixed (N); - Real_Range_Check; end if; -- Case of array conversions @@ -12656,8 +12629,6 @@ package body Exp_Ch4 is -- Here at end of processing <> - pragma Assert (not Do_Range_Check (N)); - -- Apply predicate check if required. Note that we can't just call -- Apply_Predicate_Check here, because the type looks right after -- the conversion and it would omit the check. The Comes_From_Source diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ba91a62f57d..8256b8385f5 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -11747,16 +11747,14 @@ package body Sem_Res is Simplify_Type_Conversion (N); -- If after evaluation we still have a type conversion, then we may need - -- to apply checks required for a subtype conversion. - - -- Skip these type conversion checks if universal fixed operands - -- are involved, since range checks are handled separately for - -- these cases (in the appropriate Expand routines in unit Exp_Fixd). + -- to apply checks required for a subtype conversion. But skip them if + -- universal fixed operands are involved, since range checks are handled + -- separately for these cases, after the expansion done by Exp_Fixd. if Nkind (N) = N_Type_Conversion and then not Is_Generic_Type (Root_Type (Target_Typ)) and then Target_Typ /= Universal_Fixed - and then Operand_Typ /= Universal_Fixed + and then Etype (Operand) /= Universal_Fixed then Apply_Type_Conversion_Checks (N); end if; @@ -11995,11 +11993,12 @@ package body Sem_Res is (N, Target_Typ, Static_Failure_Is_Error => True); end if; - -- If at this stage we have a fixed point to integer conversion, make - -- sure that the Do_Range_Check flag is set which is not always done - -- by exp_fixd.adb. + -- If at this stage we have a fixed to integer conversion, make sure the + -- Do_Range_Check flag is set, because such conversions in general need + -- a range check. We only need this if expansion is off, see above why. if Nkind (N) = N_Type_Conversion + and then not Expander_Active and then Is_Integer_Type (Target_Typ) and then Is_Fixed_Point_Type (Operand_Typ) and then not Range_Checks_Suppressed (Target_Typ) -- 2.30.2