This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Overhaul code implementing conversions involving fixed-point types
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Eric Botcazou <ebotcazou at adacore dot com>
- Date: Mon, 22 Jul 2019 10:02:20 -0400
- Subject: [Ada] Overhaul code implementing conversions involving fixed-point types
This ovehauls the code implementing conversions involving fixed-point
types in the front-end because it leaks the Do_Range_Check flag in
several places to the back-end, which is a violation of the documented
interface between front-end and back-end.
This also does a bit of housekeeping work throughout it in the process.
There should be essentially no functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* checks.adb (Apply_Type_Conversion_Checks): Do not set
Do_Range_Check flag on conversions from fixed-point types
either.
* exp_attr.adb: Add use and with clause for Expander.
(Expand_N_Attribute_Reference) <Fixed_Value, Integer_Value>: Set
the Conversion_OK flag and do not generate overflow/range checks
manually.
* exp_ch4.adb (Expand_N_Qualified_Expression): Remove
superfluous clearing of Do_Range_Check flag.
(Discrete_Range_Check): New procedure to generate a range check
for discrete types.
(Real_Range_Check): Remove redundant local variable and adjust.
Remove useless shortcut. Clear Do_Range_Check flag on all
paths.
(Expand_N_Type_Conversion): Remove redundant test on
Conversion_OK. Call Discrete_Range_Check to generate range
checks on discrete types. Remove obsolete code for
float-to-integer conversions. Add code to generate range checks
for conversions involving fixed-point types.
--- gcc/ada/checks.adb
+++ gcc/ada/checks.adb
@@ -3622,13 +3622,14 @@ package body Checks is
-- will not be generated.
if GNATprove_Mode
- or else not Is_Fixed_Point_Type (Expr_Type)
+ or else (not Is_Fixed_Point_Type (Expr_Type)
+ and then not Is_Fixed_Point_Type (Target_Type))
then
Apply_Scalar_Range_Check
(Expr, Target_Type, Fixed_Int => Conv_OK);
else
- Set_Do_Range_Check (Expression (N), False);
+ Set_Do_Range_Check (Expr, False);
end if;
-- If the target type has predicates, we need to indicate
--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -39,6 +39,7 @@ with Exp_Pakd; use Exp_Pakd;
with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
+with Expander; use Expander;
with Freeze; use Freeze;
with Gnatvsn; use Gnatvsn;
with Itypes; use Itypes;
@@ -3540,7 +3541,7 @@ package body Exp_Attr is
-- We transform
-- fixtype'Fixed_Value (integer-value)
- -- inttype'Fixed_Value (fixed-value)
+ -- inttype'Integer_Value (fixed-value)
-- into
@@ -3549,75 +3550,30 @@ package body Exp_Attr is
-- respectively.
- -- We do all the required analysis of the conversion here, because we do
- -- not want this to go through the fixed-point conversion circuits. Note
- -- that the back end always treats fixed-point as equivalent to the
- -- corresponding integer type anyway.
- -- However, in order to remove the handling of Do_Range_Check from the
- -- backend, we force the generation of a check on the result by
- -- setting the result type appropriately. Apply_Conversion_Checks
- -- will generate the required expansion.
+ -- We set Conversion_OK on the conversion because we do not want it
+ -- to go through the fixed-point conversion circuits.
when Attribute_Fixed_Value
| Attribute_Integer_Value
=>
- Rewrite (N,
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
- Expression => Relocate_Node (First (Exprs))));
+ Rewrite (N, OK_Convert_To (Entity (Pref), First (Exprs)));
- -- Indicate that the result of the conversion may require a
- -- range check (see below);
-
- Set_Etype (N, Base_Type (Entity (Pref)));
- Set_Analyzed (N);
-
- -- Note: it might appear that a properly analyzed unchecked
+ -- Note that it might appear that a properly analyzed unchecked
-- conversion would be just fine here, but that's not the case,
- -- since the full range checks performed by the following code
+ -- since the full range checks performed by the following calls
-- are critical.
- -- Given that Fixed-point conversions are not further expanded
- -- to prevent the involvement of real type operations we have to
- -- construct two checks explicitly: one on the operand, and one
- -- on the result. This used to be done in part in the back-end,
- -- but for other targets (E.g. LLVM) it is preferable to create
- -- the tests in full in the front-end.
-
- if Is_Fixed_Point_Type (Etype (N)) then
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Equiv_T : constant Entity_Id := Make_Temporary (Loc, 'T', N);
- Expr : constant Node_Id := Expression (N);
- Fst : constant Entity_Id := Root_Type (Etype (N));
- Decl : Node_Id;
- begin
- Decl :=
- Make_Full_Type_Declaration (Sloc (N),
- Defining_Identifier => Equiv_T,
- Type_Definition =>
- Make_Signed_Integer_Type_Definition (Loc,
- Low_Bound =>
- Make_Integer_Literal (Loc,
- Intval =>
- Corresponding_Integer_Value
- (Type_Low_Bound (Fst))),
- High_Bound =>
- Make_Integer_Literal (Loc,
- Intval =>
- Corresponding_Integer_Value
- (Type_High_Bound (Fst)))));
- Insert_Action (N, Decl);
-
- -- Verify that the conversion is possible
+ Apply_Type_Conversion_Checks (N);
- Generate_Range_Check (Expr, Equiv_T, CE_Overflow_Check_Failed);
+ -- Note that Apply_Type_Conversion_Checks only deals with the
+ -- overflow checks on conversions involving fixed-point types
+ -- so we must apply range checks manually on them and expand.
- -- and verify that the result is in range
+ Apply_Scalar_Range_Check
+ (Expression (N), Etype (N), Fixed_Int => True);
- Generate_Range_Check (N, Etype (N), CE_Range_Check_Failed);
- end;
- end if;
+ Set_Analyzed (N);
+ Expand (N);
-----------
-- Floor --
--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -10274,7 +10274,6 @@ package body Exp_Ch4 is
Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True);
if Do_Range_Check (Operand) then
- Set_Do_Range_Check (Operand, False);
Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed);
end if;
end Expand_N_Qualified_Expression;
@@ -10929,9 +10928,12 @@ package body Exp_Ch4 is
procedure Expand_N_Type_Conversion (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Operand : constant Node_Id := Expression (N);
- Target_Type : constant Entity_Id := Etype (N);
+ Target_Type : Entity_Id := Etype (N);
Operand_Type : Entity_Id := Etype (Operand);
+ procedure Discrete_Range_Check;
+ -- Handles generation of range check for discrete target value
+
procedure Handle_Changed_Representation;
-- This is called in the case of record and array type conversions to
-- see if there is a change of representation to be handled. Change of
@@ -10954,6 +10956,44 @@ package body Exp_Ch4 is
-- True iff Present (Effective_Extra_Accessibility (Id)) successfully
-- evaluates to True.
+ --------------------------
+ -- Discrete_Range_Check --
+ --------------------------
+
+ -- Case of conversions to a discrete type
+
+ procedure Discrete_Range_Check is
+ Expr : Node_Id;
+ Ityp : Entity_Id;
+
+ begin
+ -- Nothing to do if conversion was rewritten
+
+ if Nkind (N) /= N_Type_Conversion then
+ return;
+ end if;
+
+ Expr := Expression (N);
+
+ -- Before we do a range check, we have to deal with treating
+ -- a fixed-point operand as an integer. The way we do this
+ -- is simply to do an unchecked conversion to an appropriate
+ -- integer type large enough to hold the result.
+
+ if Is_Fixed_Point_Type (Etype (Expr)) then
+ if Esize (Base_Type (Etype (Expr))) > Esize (Standard_Integer) then
+ Ityp := Standard_Long_Long_Integer;
+ else
+ Ityp := Standard_Integer;
+ end if;
+
+ Set_Do_Range_Check (Expr, False);
+ Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
+ end if;
+
+ Generate_Range_Check (Expr, Target_Type, CE_Range_Check_Failed);
+ end Discrete_Range_Check;
+
-----------------------------------
-- Handle_Changed_Representation --
-----------------------------------
@@ -11169,7 +11209,6 @@ package body Exp_Ch4 is
Btyp : constant Entity_Id := Base_Type (Target_Type);
Lo : constant Node_Id := Type_Low_Bound (Target_Type);
Hi : constant Node_Id := Type_High_Bound (Target_Type);
- Xtyp : constant Entity_Id := Etype (Operand);
Conv : Node_Id;
Hi_Arg : Node_Id;
@@ -11193,6 +11232,12 @@ package body Exp_Ch4 is
and then
Hi = Type_High_Bound (Btyp))
then
+ -- Unset the range check flag on the current value of
+ -- Expression (N), since the captured Operand may have
+ -- been rewritten (such as for the case of a conversion
+ -- to a fixed-point type).
+
+ Set_Do_Range_Check (Expression (N), False);
return;
end if;
@@ -11202,6 +11247,7 @@ package body Exp_Ch4 is
if Is_Entity_Name (Operand)
and then Range_Checks_Suppressed (Entity (Operand))
then
+ Set_Do_Range_Check (Expression (N), False);
return;
end if;
@@ -11211,12 +11257,12 @@ package body Exp_Ch4 is
-- not trust it to be in range (might be infinite)
declare
- S_Lo : constant Node_Id := Type_Low_Bound (Xtyp);
- S_Hi : constant Node_Id := Type_High_Bound (Xtyp);
+ S_Lo : constant Node_Id := Type_Low_Bound (Operand_Type);
+ S_Hi : constant Node_Id := Type_High_Bound (Operand_Type);
begin
- if (not Is_Floating_Point_Type (Xtyp)
- or else Is_Constrained (Xtyp))
+ if (not Is_Floating_Point_Type (Operand_Type)
+ or else Is_Constrained (Operand_Type))
and then Compile_Time_Known_Value (S_Lo)
and then Compile_Time_Known_Value (S_Hi)
and then Compile_Time_Known_Value (Hi)
@@ -11229,7 +11275,7 @@ package body Exp_Ch4 is
S_Hiv : Ureal;
begin
- if Is_Real_Type (Xtyp) then
+ if Is_Real_Type (Operand_Type) then
S_Lov := Expr_Value_R (S_Lo);
S_Hiv := Expr_Value_R (S_Hi);
else
@@ -11241,30 +11287,17 @@ package body Exp_Ch4 is
and then S_Lov >= D_Lov
and then S_Hiv <= D_Hiv
then
- -- Unset the range check flag on the current value of
- -- Expression (N), since the captured Operand may have
- -- been rewritten (such as for the case of a conversion
- -- to a fixed-point type).
-
Set_Do_Range_Check (Expression (N), False);
-
return;
end if;
end;
end if;
end;
- -- For float to float conversions, we are done
-
- if Is_Floating_Point_Type (Xtyp)
- and then
- Is_Floating_Point_Type (Btyp)
- then
- return;
- end if;
-
-- Otherwise rewrite the conversion as described above
+ Set_Do_Range_Check (Expression (N), False);
+
Conv := Relocate_Node (N);
Rewrite (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
Set_Etype (Conv, Btyp);
@@ -11273,7 +11306,7 @@ package body Exp_Ch4 is
-- where it is never required, since we can never have overflow in
-- this case.
- if not Is_Integer_Type (Etype (Operand)) then
+ if not Is_Integer_Type (Operand_Type) then
Enable_Overflow_Check (Conv);
end if;
@@ -11895,31 +11928,21 @@ package body Exp_Ch4 is
then
Set_Rounded_Result (N);
Set_Etype (N, Etype (Parent (N)));
+ Target_Type := Etype (N);
end if;
- -- Otherwise do correct fixed-conversion, but skip these if the
- -- Conversion_OK flag is set, because from a semantic point of view
- -- these are simple integer conversions needing no further processing
- -- (the backend will simply treat them as integers).
-
- if not Conversion_OK (N) then
- if Is_Fixed_Point_Type (Etype (N)) then
- Expand_Convert_Fixed_To_Fixed (N);
- Real_Range_Check;
-
- elsif Is_Integer_Type (Etype (N)) then
- Expand_Convert_Fixed_To_Integer (N);
-
- -- The result of the conversion might need a range check, so do
- -- not assume that the result is in bounds.
+ if Is_Fixed_Point_Type (Target_Type) then
+ Expand_Convert_Fixed_To_Fixed (N);
+ Real_Range_Check;
- Set_Etype (N, Base_Type (Target_Type));
+ elsif Is_Integer_Type (Target_Type) then
+ Expand_Convert_Fixed_To_Integer (N);
+ Discrete_Range_Check;
- else
- pragma Assert (Is_Floating_Point_Type (Etype (N)));
- Expand_Convert_Fixed_To_Float (N);
- Real_Range_Check;
- end if;
+ 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
@@ -11941,42 +11964,6 @@ package body Exp_Ch4 is
Real_Range_Check;
end if;
- -- Case of float-to-integer conversions
-
- -- We also handle float-to-fixed conversions with Conversion_OK set
- -- since semantically the fixed-point target is treated as though it
- -- were an integer in such cases.
-
- elsif Is_Floating_Point_Type (Operand_Type)
- and then
- (Is_Integer_Type (Target_Type)
- or else
- (Is_Fixed_Point_Type (Target_Type) and then Conversion_OK (N)))
- then
- -- One more check here, gcc is still not able to do conversions of
- -- this type with proper overflow checking, and so gigi is doing an
- -- approximation of what is required by doing floating-point compares
- -- with the end-point. But that can lose precision in some cases, and
- -- give a wrong result. Converting the operand to Universal_Real is
- -- helpful, but still does not catch all cases with 64-bit integers
- -- on targets with only 64-bit floats.
-
- -- The above comment seems obsoleted by Apply_Float_Conversion_Check
- -- Can this code be removed ???
-
- if Do_Range_Check (Operand) then
- Rewrite (Operand,
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Universal_Real, Loc),
- Expression =>
- Relocate_Node (Operand)));
-
- Set_Etype (Operand, Universal_Real);
- Enable_Range_Check (Operand);
- Set_Do_Range_Check (Expression (Operand), False);
- end if;
-
-- Case of array conversions
-- Expansion of array conversions, add required length/range checks but
@@ -12059,11 +12046,6 @@ package body Exp_Ch4 is
Analyze_And_Resolve (N, Target_Type);
end if;
-
- -- Case of conversions to floating-point
-
- elsif Is_Floating_Point_Type (Target_Type) then
- Real_Range_Check;
end if;
-- At this stage, either the conversion node has been transformed into
@@ -12081,80 +12063,51 @@ package body Exp_Ch4 is
-- Check: are these rules stated in sinfo??? if so, why restate here???
-- The only remaining step is to generate a range check if we still have
- -- a type conversion at this stage and Do_Range_Check is set. For now we
- -- do this only for conversions of discrete types and for float-to-float
- -- conversions.
-
- if Nkind (N) = N_Type_Conversion then
+ -- a type conversion at this stage and Do_Range_Check is set.
- -- For now we only support floating-point cases where both source
- -- and target are floating-point types. Conversions where the source
- -- and target involve integer or fixed-point types are still TBD,
- -- though not clear whether those can even happen at this point, due
- -- to transformations above. ???
+ if Nkind (N) = N_Type_Conversion
+ and then Do_Range_Check (Expression (N))
+ then
+ -- Float-to-float conversions
- if Is_Floating_Point_Type (Etype (N))
+ if Is_Floating_Point_Type (Target_Type)
and then Is_Floating_Point_Type (Etype (Expression (N)))
then
- if Do_Range_Check (Expression (N))
- and then Is_Floating_Point_Type (Target_Type)
- then
- Generate_Range_Check
- (Expression (N), Target_Type, CE_Range_Check_Failed);
- end if;
-
- -- Discrete-to-discrete conversions
+ Generate_Range_Check
+ (Expression (N), Target_Type, CE_Range_Check_Failed);
- elsif Is_Discrete_Type (Etype (N)) then
- declare
- Expr : constant Node_Id := Expression (N);
- Ftyp : Entity_Id;
- Ityp : Entity_Id;
+ -- Discrete-to-discrete conversions or fixed-point-to-discrete
+ -- conversions when Conversion_OK is set.
- begin
- if Do_Range_Check (Expr)
- and then Is_Discrete_Type (Etype (Expr))
- then
- Set_Do_Range_Check (Expr, False);
-
- -- Before we do a range check, we have to deal with treating
- -- a fixed-point operand as an integer. The way we do this
- -- is simply to do an unchecked conversion to an appropriate
- -- integer type large enough to hold the result.
-
- -- This code is not active yet, because we are only dealing
- -- with discrete types so far ???
-
- if Nkind (Expr) in N_Has_Treat_Fixed_As_Integer
- and then Treat_Fixed_As_Integer (Expr)
- then
- Ftyp := Base_Type (Etype (Expr));
+ elsif Is_Discrete_Type (Target_Type)
+ and then (Is_Discrete_Type (Etype (Expression (N)))
+ or else (Is_Fixed_Point_Type (Etype (Expression (N)))
+ and then Conversion_OK (N)))
+ then
+ -- Reset overflow flag, since the range check will include
+ -- dealing with possible overflow, and generate the check.
- if Esize (Ftyp) >= Esize (Standard_Integer) then
- Ityp := Standard_Long_Long_Integer;
- else
- Ityp := Standard_Integer;
- end if;
+ Set_Do_Overflow_Check (N, False);
- Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
- end if;
+ -- If Address is either a source type or target type,
+ -- suppress range check to avoid typing anomalies when
+ -- it is a visible integer type.
- -- Reset overflow flag, since the range check will include
- -- dealing with possible overflow, and generate the check.
- -- If Address is either a source type or target type,
- -- suppress range check to avoid typing anomalies when
- -- it is a visible integer type.
+ if Is_Descendant_Of_Address (Etype (Expression (N)))
+ or else Is_Descendant_Of_Address (Target_Type)
+ then
+ Set_Do_Range_Check (Expression (N), False);
+ else
+ Discrete_Range_Check;
+ end if;
- Set_Do_Overflow_Check (N, False);
+ -- Conversions to floating- or fixed-point when Conversion_OK is set
- if not Is_Descendant_Of_Address (Etype (Expr))
- and then not Is_Descendant_Of_Address (Target_Type)
- then
- Generate_Range_Check
- (Expr, Target_Type, CE_Range_Check_Failed);
- end if;
- end if;
- end;
+ elsif Is_Floating_Point_Type (Target_Type)
+ or else (Is_Fixed_Point_Type (Target_Type)
+ and then Conversion_OK (N))
+ then
+ Real_Range_Check;
end if;
end if;