Skip to content

R
riscv-gcc-1
Commit ec2dd67a by Robert Dewar Committed by Arnaud Charlet
Options

checks.adb (Apply_Arithmetic_Overflow_Check): Avoid intermediate overflow if… 

checks.adb (Apply_Arithmetic_Overflow_Check): Avoid intermediate overflow if result converted to wider integer type.

2008-05-20  Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* checks.adb (Apply_Arithmetic_Overflow_Check): Avoid intermediate
	overflow if result converted to wider integer type.
	(Apply_Type_Conversion_Checks): Don't emit checks on conversions to
	discriminated types when discriminant checks are suppressed.

From-SVN: r135616
parent 57f56c63
Showing with 133 additions and 24 deletions
gcc/ada/checks.adb
......@@ -765,17 +765,120 @@ package body Checks is
-- Apply_Arithmetic_Overflow_Check --
-------------------------------------
-- This routine is called only if the type is an integer type, and
-- a software arithmetic overflow check must be performed for op
-- (add, subtract, multiply). The check is performed only if
-- Software_Overflow_Checking is enabled and Do_Overflow_Check
-- is set. In this case we expand the operation into a more complex
-- sequence of tests that ensures that overflow is properly caught.
-- This routine is called only if the type is an integer type, and a
-- software arithmetic overflow check may be needed for op (add, subtract,
-- or multiply). This check is performed only if Software_Overflow_Checking
-- is enabled and Do_Overflow_Check is set. In this case we expand the
-- operation into a more complex sequence of tests that ensures that
-- overflow is properly caught.
procedure Apply_Arithmetic_Overflow_Check (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Rtyp : constant Entity_Id := Root_Type (Typ);
Typ : Entity_Id := Etype (N);
Rtyp : Entity_Id := Root_Type (Typ);
begin
-- An interesting special case. If the arithmetic operation appears as
-- the operand of a type conversion:
-- type1 (x op y)
-- and all the following conditions apply:
-- arithmetic operation is for a signed integer type
-- target type type1 is a static integer subtype
-- range of x and y are both included in the range of type1
-- range of x op y is included in the range of type1
-- size of type1 is at least twice the result size of op
-- then we don't do an overflow check in any case, instead we transform
-- the operation so that we end up with:
-- type1 (type1 (x) op type1 (y))
-- This avoids intermediate overflow before the conversion. It is
-- explicitly permitted by RM 3.5.4(24):
-- For the execution of a predefined operation of a signed integer
-- type, the implementation need not raise Constraint_Error if the
-- result is outside the base range of the type, so long as the
-- correct result is produced.
-- It's hard to imagine that any programmer counts on the exception
-- being raised in this case, and in any case it's wrong coding to
-- have this expectation, given the RM permission. Furthermore, other
-- Ada compilers do allow such out of range results.
-- Note that we do this transformation even if overflow checking is
-- off, since this is precisely about giving the "right" result and
-- avoiding the need for an overflow check.
if Is_Signed_Integer_Type (Typ)
and then Nkind (Parent (N)) = N_Type_Conversion
then
declare
Target_Type : constant Entity_Id :=
Base_Type (Entity (Subtype_Mark (Parent (N))));
Llo, Lhi : Uint;
Rlo, Rhi : Uint;
LOK, ROK : Boolean;
Vlo : Uint;
Vhi : Uint;
VOK : Boolean;
Tlo : Uint;
Thi : Uint;
begin
if Is_Integer_Type (Target_Type)
and then RM_Size (Root_Type (Target_Type)) >= 2 * RM_Size (Rtyp)
then
Tlo := Expr_Value (Type_Low_Bound (Target_Type));
Thi := Expr_Value (Type_High_Bound (Target_Type));
Determine_Range (Left_Opnd (N), LOK, Llo, Lhi);
Determine_Range (Right_Opnd (N), ROK, Rlo, Rhi);
if (LOK and ROK)
and then Tlo <= Llo and then Lhi <= Thi
and then Tlo <= Rlo and then Rhi <= Thi
then
Determine_Range (N, VOK, Vlo, Vhi);
if VOK and then Tlo <= Vlo and then Vhi <= Thi then
Rewrite (Left_Opnd (N),
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
Expression => Relocate_Node (Left_Opnd (N))));
Rewrite (Right_Opnd (N),
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
Expression => Relocate_Node (Right_Opnd (N))));
Set_Etype (N, Target_Type);
Typ := Target_Type;
Rtyp := Root_Type (Typ);
Analyze_And_Resolve (Left_Opnd (N), Target_Type);
Analyze_And_Resolve (Right_Opnd (N), Target_Type);
-- Given that the target type is twice the size of the
-- source type, overflow is now impossible, so we can
-- safely kill the overflow check and return.
Set_Do_Overflow_Check (N, False);
return;
end if;
end if;
end if;
end;
end if;
-- Now see if an overflow check is required
declare
Siz : constant Int := UI_To_Int (Esize (Rtyp));
Dsiz : constant Int := Siz * 2;
Opnod : Node_Id;
......@@ -784,20 +887,22 @@ package body Checks is
Cent : RE_Id;
begin
-- Skip this if overflow checks are done in back end, or the overflow
-- flag is not set anyway, or we are not doing code expansion.
-- Skip check if back end does overflow checks, or the overflow flag
-- is not set anyway, or we are not doing code expansion.
-- Special case CLI target, where arithmetic overflow checks can be
-- performed for integer and long_integer
if Backend_Overflow_Checks_On_Target
or else (VM_Target = CLI_Target and then Siz >= Standard_Integer_Size)
or else not Do_Overflow_Check (N)
or else not Expander_Active
or else
(VM_Target = CLI_Target and then Siz >= Standard_Integer_Size)
then
return;
end if;
-- Otherwise, we generate the full general code for front end overflow
-- Otherwise, generate the full general code for front end overflow
-- detection, which works by doing arithmetic in a larger type:
-- x op y
......@@ -810,7 +915,7 @@ package body Checks is
-- an integer type of sufficient length to hold the largest possible
-- result.
-- In the case where check type exceeds the size of Long_Long_Integer,
-- If the size of check type exceeds the size of Long_Long_Integer,
-- we use a different approach, expanding to:
-- typ (xxx_With_Ovflo_Check (Integer_64 (x), Integer (y)))
......@@ -851,9 +956,9 @@ package body Checks is
return;
end if;
-- If we fall through, we have the case where we do the arithmetic in
-- the next higher type and get the check by conversion. In these cases
-- Ctyp is set to the type to be used as the check type.
-- If we fall through, we have the case where we do the arithmetic
-- in the next higher type and get the check by conversion. In these
-- cases Ctyp is set to the type to be used as the check type.
Opnod := Relocate_Node (N);
......@@ -871,10 +976,11 @@ package body Checks is
Set_Analyzed (Opnd, True);
Set_Right_Opnd (Opnod, Opnd);
-- The type of the operation changes to the base type of the check type,
-- and we reset the overflow check indication, since clearly no overflow
-- is possible now that we are using a double length type. We also set
-- the Analyzed flag to avoid a recursive attempt to expand the node.
-- The type of the operation changes to the base type of the check
-- type, and we reset the overflow check indication, since clearly no
-- overflow is possible now that we are using a double length type.
-- We also set the Analyzed flag to avoid a recursive attempt to
-- expand the node.
Set_Etype (Opnod, Base_Type (Ctyp));
Set_Do_Overflow_Check (Opnod, False);
......@@ -886,13 +992,14 @@ package body Checks is
Analyze (Opnd);
Set_Etype (Opnd, Typ);
-- In the discrete type case, we directly generate the range check for
-- the outer operand. This range check will implement the required
-- overflow check.
-- In the discrete type case, we directly generate the range check
-- for the outer operand. This range check will implement the
-- required overflow check.
if Is_Discrete_Type (Typ) then
Rewrite (N, Opnd);
Generate_Range_Check (Expression (N), Typ, CE_Overflow_Check_Failed);
Generate_Range_Check
(Expression (N), Typ, CE_Overflow_Check_Failed);
-- For other types, we enable overflow checking on the conversion,
-- after setting the node as analyzed to prevent recursive attempts
......@@ -907,6 +1014,7 @@ package body Checks is
exception
when RE_Not_Available =>
return;
end;
end Apply_Arithmetic_Overflow_Check;
----------------------------
......@@ -2231,6 +2339,7 @@ package body Checks is
end;
elsif Comes_From_Source (N)
and then not Discriminant_Checks_Suppressed (Target_Type)
and then Is_Record_Type (Target_Type)
and then Is_Derived_Type (Target_Type)
and then not Is_Tagged_Type (Target_Type)
......
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