This set of changes aimed at optimizing the generation of range and
overflow checks for fixed-point types contains two parts:
1. a cleanup to the generation of range checks for type conversions
involving fixed-point types, which is now more clearly deferred
entirely to after the expansion of the conversions by Exp_Fixd.
2. a generic improvement to the range computation engine so as to
take into account the underlying integer ranges of fixed point.
The main effect is to get rid of useless overflow checks in some large
integer types generated for multiplication operations by Exp_Fixd.
Tested on x86_64-pc-linux-gnu, committed on trunk
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) <N_Type_Conversion>: 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.diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
--- 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
--- 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
--- 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
--- 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
<<Done>>
- 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
--- 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)
