Skip to content

R
riscv-gcc-1
Commit 8113b0c7 by Eric Botcazou Committed by Pierre-Marie de Rodat
Options

[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.

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.

From-SVN: r273692
parent c936411f
Showing with 129 additions and 197 deletions
gcc/ada/ChangeLog
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* 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.
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* sprint.ads: Fix pasto in comment.
2019-07-22 Javier Miranda <miranda@adacore.com>
......
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
......@@ -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))));
-- Indicate that the result of the conversion may require a
-- range check (see below);
Set_Etype (N, Base_Type (Entity (Pref)));
Set_Analyzed (N);
Rewrite (N, OK_Convert_To (Entity (Pref), First (Exprs)));
-- 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);
Apply_Type_Conversion_Checks (N);
-- Verify that the conversion is possible
-- 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.
Generate_Range_Check (Expr, Equiv_T, CE_Overflow_Check_Failed);
Apply_Scalar_Range_Check
(Expression (N), Etype (N), Fixed_Int => True);
-- and verify that the result is in range
Generate_Range_Check (N, Etype (N), CE_Range_Check_Failed);
end;
end if;
Set_Analyzed (N);
Expand (N);
-----------
-- Floor --
......
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,32 +11928,22 @@ 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
if Is_Fixed_Point_Type (Target_Type) then
Expand_Convert_Fixed_To_Fixed (N);
Real_Range_Check;
elsif Is_Integer_Type (Etype (N)) then
elsif Is_Integer_Type (Target_Type) 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.
Set_Etype (N, Base_Type (Target_Type));
Discrete_Range_Check;
else
pragma Assert (Is_Floating_Point_Type (Etype (N)));
pragma Assert (Is_Floating_Point_Type (Target_Type));
Expand_Convert_Fixed_To_Float (N);
Real_Range_Check;
end if;
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.
-- a type conversion at this stage and Do_Range_Check is set.
if Nkind (N) = N_Type_Conversion then
-- 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
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))
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
Set_Do_Range_Check (Expr, False);
-- Reset overflow flag, since the range check will include
-- dealing with possible overflow, and generate the check.
-- 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.
Set_Do_Overflow_Check (N, False);
-- This code is not active yet, because we are only dealing
-- with discrete types so far ???
-- 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 Nkind (Expr) in N_Has_Treat_Fixed_As_Integer
and then Treat_Fixed_As_Integer (Expr)
if Is_Descendant_Of_Address (Etype (Expression (N)))
or else Is_Descendant_Of_Address (Target_Type)
then
Ftyp := Base_Type (Etype (Expr));
if Esize (Ftyp) >= Esize (Standard_Integer) then
Ityp := Standard_Long_Long_Integer;
Set_Do_Range_Check (Expression (N), False);
else
Ityp := Standard_Integer;
end if;
Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
Discrete_Range_Check;
end if;
-- 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.
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)
elsif Is_Floating_Point_Type (Target_Type)
or else (Is_Fixed_Point_Type (Target_Type)
and then Conversion_OK (N))
then
Generate_Range_Check
(Expr, Target_Type, CE_Range_Check_Failed);
end if;
end if;
end;
Real_Range_Check;
end if;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment