[Ada] Narrow large arithmetic and comparison operations
2020-06-18 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * exp_ch4.adb (Narrow_Large_Operation): New procedure to try and narrow large arithmetic and comparison operations. (Expand_N_In): Call it. (Expand_N_Op_Abs): Likewise. (Expand_N_Op_Add): Likewise. (Expand_N_Op_Divide): Likewise. (Expand_N_Op_Eq): Likewise. (Expand_N_Op_Ge): Likewise. (Expand_N_Op_Gt): Likewise. (Expand_N_Op_Le): Likewise. (Expand_N_Op_Lt): Likewise. (Expand_N_Op_Minus): Likewise. (Expand_N_Op_Mod): Likewise. (Expand_N_Op_Multiply): Likewise. (Expand_N_Op_Ne): Likewise. (Expand_N_Op_Plus): Likewise. (Expand_N_Op_Rem): Likewise. (Expand_N_Op_Subtract): Likewise. (Expand_N_Type_Conversion): Use Convert_To procedure. * exp_ch9.adb (Is_Pure_Barrier) <N_Identifier>: Skip all numeric types. <N_Type_Conversion>: Use explicit criterion.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
4bfab79a72
commit
6c8e4f7e38
@ -224,6 +224,11 @@ package body Exp_Ch4 is
|
||||
-- skipped if the operation is done in Bignum mode but that's fine, since
|
||||
-- the Bignum call takes care of everything.
|
||||
|
||||
procedure Narrow_Large_Operation (N : Node_Id);
|
||||
-- Try to compute the result of a large operation in a narrower type than
|
||||
-- its nominal type. This is mainly aimed to get rid of operations done in
|
||||
-- Universal_Integer that can be generated for attributes.
|
||||
|
||||
procedure Optimize_Length_Comparison (N : Node_Id);
|
||||
-- Given an expression, if it is of the form X'Length op N (or the other
|
||||
-- way round), where N is known at compile time to be 0 or 1, or something
|
||||
@ -6545,6 +6550,12 @@ package body Exp_Ch4 is
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Ltyp = Universal_Integer and then Nkind (N) = N_In then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
-- For all other cases of an explicit range, nothing to be done
|
||||
|
||||
goto Leave;
|
||||
@ -7224,6 +7235,7 @@ package body Exp_Ch4 is
|
||||
procedure Expand_N_Op_Abs (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Expr : constant Node_Id := Right_Opnd (N);
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
|
||||
begin
|
||||
Unary_Op_Validity_Checks (N);
|
||||
@ -7235,9 +7247,19 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Abs then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Deal with software overflow checking
|
||||
|
||||
if Is_Signed_Integer_Type (Etype (N))
|
||||
if Is_Signed_Integer_Type (Typ)
|
||||
and then Do_Overflow_Check (N)
|
||||
then
|
||||
-- The only case to worry about is when the argument is equal to the
|
||||
@ -7297,6 +7319,16 @@ package body Exp_Ch4 is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Add then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Arithmetic overflow checks for signed integer/fixed point types
|
||||
|
||||
if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
|
||||
@ -7474,6 +7506,16 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Divide then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Convert x / 2 ** y to Shift_Right (x, y). Note that the fact that
|
||||
-- Is_Power_Of_2_For_Shift is set means that we know that our left
|
||||
-- operand is an unsigned integer, as required for this to work.
|
||||
@ -8437,6 +8479,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typl = Universal_Integer and then Nkind (N) = N_Op_Eq then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
-- Special optimization of length comparison
|
||||
|
||||
Optimize_Length_Comparison (N);
|
||||
@ -9053,6 +9101,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Ge then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
Optimize_Length_Comparison (N);
|
||||
end Expand_N_Op_Ge;
|
||||
|
||||
@ -9096,6 +9150,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Gt then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
Optimize_Length_Comparison (N);
|
||||
end Expand_N_Op_Gt;
|
||||
|
||||
@ -9139,6 +9199,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Le then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
Optimize_Length_Comparison (N);
|
||||
end Expand_N_Op_Le;
|
||||
|
||||
@ -9182,6 +9248,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Lt then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
Optimize_Length_Comparison (N);
|
||||
end Expand_N_Op_Lt;
|
||||
|
||||
@ -9203,8 +9275,18 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Minus then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if not Backend_Overflow_Checks_On_Target
|
||||
and then Is_Signed_Integer_Type (Etype (N))
|
||||
and then Is_Signed_Integer_Type (Typ)
|
||||
and then Do_Overflow_Check (N)
|
||||
then
|
||||
-- Software overflow checking expands -expr into (0 - expr)
|
||||
@ -9252,7 +9334,17 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Is_Integer_Type (Etype (N)) then
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Mod then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Is_Integer_Type (Typ) then
|
||||
Apply_Divide_Checks (N);
|
||||
|
||||
-- All done if we don't have a MOD any more, which can happen as a
|
||||
@ -9551,6 +9643,16 @@ package body Exp_Ch4 is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Multiply then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Convert x * 2 ** y to Shift_Left (x, y). Note that the fact that
|
||||
-- Is_Power_Of_2_For_Shift is set means that we know that our left
|
||||
-- operand is an integer, as required for this to work.
|
||||
@ -9734,6 +9836,12 @@ package body Exp_Ch4 is
|
||||
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer and then Nkind (N) = N_Op_Ne then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
|
||||
-- For all cases other than elementary types, we rewrite node as the
|
||||
-- negation of an equality operation, and reanalyze. The equality to be
|
||||
-- used is defined in the same scope and has the same signature. This
|
||||
@ -10016,6 +10124,8 @@ package body Exp_Ch4 is
|
||||
----------------------
|
||||
|
||||
procedure Expand_N_Op_Plus (N : Node_Id) is
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
|
||||
begin
|
||||
Unary_Op_Validity_Checks (N);
|
||||
|
||||
@ -10025,6 +10135,12 @@ package body Exp_Ch4 is
|
||||
Apply_Arithmetic_Overflow_Check (N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
end if;
|
||||
end Expand_N_Op_Plus;
|
||||
|
||||
---------------------
|
||||
@ -10058,6 +10174,16 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Rem then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Is_Integer_Type (Etype (N)) then
|
||||
Apply_Divide_Checks (N);
|
||||
|
||||
@ -10422,6 +10548,16 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Try to narrow the operation
|
||||
|
||||
if Typ = Universal_Integer then
|
||||
Narrow_Large_Operation (N);
|
||||
|
||||
if Nkind (N) /= N_Op_Subtract then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- N - 0 = N for integer types
|
||||
|
||||
if Is_Integer_Type (Typ)
|
||||
@ -11876,20 +12012,13 @@ package body Exp_Ch4 is
|
||||
L, R : Node_Id;
|
||||
|
||||
begin
|
||||
R :=
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc),
|
||||
Expression => Relocate_Node (Right_Opnd (Operand)));
|
||||
|
||||
Opnd := New_Op_Node (Nkind (Operand), Loc);
|
||||
|
||||
R := Convert_To (Standard_Integer, Right_Opnd (Operand));
|
||||
Set_Right_Opnd (Opnd, R);
|
||||
|
||||
if Nkind (Operand) in N_Binary_Op then
|
||||
L :=
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc),
|
||||
Expression => Relocate_Node (Left_Opnd (Operand)));
|
||||
|
||||
L := Convert_To (Standard_Integer, Left_Opnd (Operand));
|
||||
Set_Left_Opnd (Opnd, L);
|
||||
end if;
|
||||
|
||||
@ -13777,6 +13906,207 @@ package body Exp_Ch4 is
|
||||
and then Overflow_Check_Mode in Minimized_Or_Eliminated;
|
||||
end Minimized_Eliminated_Overflow_Check;
|
||||
|
||||
----------------------------
|
||||
-- Narrow_Large_Operation --
|
||||
----------------------------
|
||||
|
||||
procedure Narrow_Large_Operation (N : Node_Id) is
|
||||
Kind : constant Node_Kind := Nkind (N);
|
||||
In_Rng : constant Boolean := Kind = N_In;
|
||||
Binary : constant Boolean := Kind in N_Binary_Op or else In_Rng;
|
||||
Compar : constant Boolean := Kind in N_Op_Compare or else In_Rng;
|
||||
R : constant Node_Id := Right_Opnd (N);
|
||||
Typ : constant Entity_Id := Etype (R);
|
||||
|
||||
function Get_Size_For_Range (Lo, Hi : Uint) return Nat;
|
||||
-- Return the size of the smallest signed integer type covering Lo .. Hi
|
||||
|
||||
------------------------
|
||||
-- Get_Size_For_Range --
|
||||
------------------------
|
||||
|
||||
function Get_Size_For_Range (Lo, Hi : Uint) return Nat is
|
||||
B : Uint;
|
||||
S : Nat;
|
||||
|
||||
begin
|
||||
S := 1;
|
||||
B := Uint_1;
|
||||
|
||||
-- S = size, B = 2 ** (size - 1) (can accommodate -B .. +(B - 1))
|
||||
|
||||
while Lo < -B or else Hi < -B or else Lo >= B or else Hi >= B loop
|
||||
B := Uint_2 ** S;
|
||||
S := S + 1;
|
||||
end loop;
|
||||
|
||||
return S;
|
||||
end Get_Size_For_Range;
|
||||
|
||||
-- Local variables
|
||||
|
||||
L : Node_Id;
|
||||
Llo, Lhi : Uint;
|
||||
Rlo, Rhi : Uint;
|
||||
Lsiz, Rsiz : Nat;
|
||||
Nlo, Nhi : Uint;
|
||||
Nsiz : Nat;
|
||||
Ntyp : Entity_Id;
|
||||
Nop : Node_Id;
|
||||
OK : Boolean;
|
||||
|
||||
-- Start of processing for Narrow_Large_Operation
|
||||
|
||||
begin
|
||||
-- First, determine the range of the left operand, if any
|
||||
|
||||
if Binary then
|
||||
L := Left_Opnd (N);
|
||||
Determine_Range (L, OK, Llo, Lhi, Assume_Valid => True);
|
||||
if not OK then
|
||||
return;
|
||||
end if;
|
||||
|
||||
else
|
||||
L := Empty;
|
||||
Llo := Uint_0;
|
||||
Lhi := Uint_0;
|
||||
end if;
|
||||
|
||||
-- Second, determine the range of the right operand, which can itself
|
||||
-- be a range, in which case we take the lower bound of the low bound
|
||||
-- and the upper bound of the high bound.
|
||||
|
||||
if In_Rng then
|
||||
declare
|
||||
Zlo, Zhi : Uint;
|
||||
|
||||
begin
|
||||
Determine_Range
|
||||
(Low_Bound (R), OK, Rlo, Zhi, Assume_Valid => True);
|
||||
if not OK then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Determine_Range
|
||||
(High_Bound (R), OK, Zlo, Rhi, Assume_Valid => True);
|
||||
if not OK then
|
||||
return;
|
||||
end if;
|
||||
end;
|
||||
|
||||
else
|
||||
Determine_Range (R, OK, Rlo, Rhi, Assume_Valid => True);
|
||||
if not OK then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Then compute a size suitable for each range
|
||||
|
||||
if Binary then
|
||||
Lsiz := Get_Size_For_Range (Llo, Lhi);
|
||||
else
|
||||
Lsiz := 0;
|
||||
end if;
|
||||
|
||||
Rsiz := Get_Size_For_Range (Rlo, Rhi);
|
||||
|
||||
-- Now compute the size of the narrower type
|
||||
|
||||
if Compar then
|
||||
-- The type must be able to accomodate the operands
|
||||
|
||||
Nsiz := Nat'Max (Lsiz, Rsiz);
|
||||
|
||||
else
|
||||
-- The type must be able to accomodate the operand(s) and the result.
|
||||
|
||||
-- Note that Determine_Range typically does not report the bounds of
|
||||
-- the value as being larger than those of the base type, which means
|
||||
-- that it does not report overflow (see also Enable_Overflow_Check).
|
||||
|
||||
Determine_Range (N, OK, Nlo, Nhi, Assume_Valid => True);
|
||||
if not OK then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Therefore, if Nsiz is not lower than the size of the original type
|
||||
-- here, we cannot be sure that the operation does not overflow.
|
||||
|
||||
Nsiz := Get_Size_For_Range (Nlo, Nhi);
|
||||
Nsiz := Nat'Max (Nsiz, Lsiz);
|
||||
Nsiz := Nat'Max (Nsiz, Rsiz);
|
||||
end if;
|
||||
|
||||
-- If the size is not lower than the size of the original type, then
|
||||
-- there is no point in changing the type, except in the case where
|
||||
-- we can remove a conversion to the original type from an operand.
|
||||
|
||||
if Nsiz >= RM_Size (Typ)
|
||||
and then not (Binary
|
||||
and then Nkind (L) = N_Type_Conversion
|
||||
and then Entity (Subtype_Mark (L)) = Typ)
|
||||
and then not (Nkind (R) = N_Type_Conversion
|
||||
and then Entity (Subtype_Mark (R)) = Typ)
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Now pick the narrower type according to the size
|
||||
|
||||
if Nsiz <= RM_Size (Standard_Integer) then
|
||||
Ntyp := Standard_Integer;
|
||||
|
||||
elsif Nsiz <= RM_Size (Standard_Long_Long_Integer) then
|
||||
Ntyp := Standard_Long_Long_Integer;
|
||||
|
||||
else
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Finally rewrite the operation in the narrower type
|
||||
|
||||
Nop := New_Op_Node (Kind, Sloc (N));
|
||||
|
||||
if Binary then
|
||||
Set_Left_Opnd (Nop, Convert_To (Ntyp, L));
|
||||
end if;
|
||||
|
||||
if In_Rng then
|
||||
Set_Right_Opnd (Nop,
|
||||
Make_Range (Sloc (N),
|
||||
Convert_To (Ntyp, Low_Bound (R)),
|
||||
Convert_To (Ntyp, High_Bound (R))));
|
||||
else
|
||||
Set_Right_Opnd (Nop, Convert_To (Ntyp, R));
|
||||
end if;
|
||||
|
||||
Rewrite (N, Nop);
|
||||
|
||||
if Compar then
|
||||
-- Analyze it with the comparison type and checks suppressed since
|
||||
-- the conversions of the operands cannot overflow.
|
||||
|
||||
Analyze_And_Resolve
|
||||
(N, Etype (Original_Node (N)), Suppress => Overflow_Check);
|
||||
|
||||
else
|
||||
-- Analyze it with the narrower type and checks suppressed, but only
|
||||
-- when we are sure that the operation does not overflow, see above.
|
||||
|
||||
if Nsiz < RM_Size (Typ) then
|
||||
Analyze_And_Resolve (N, Ntyp, Suppress => Overflow_Check);
|
||||
else
|
||||
Analyze_And_Resolve (N, Ntyp);
|
||||
end if;
|
||||
|
||||
-- Put back a conversion to the original type
|
||||
|
||||
Convert_To_And_Rewrite (Typ, N);
|
||||
end if;
|
||||
end Narrow_Large_Operation;
|
||||
|
||||
--------------------------------
|
||||
-- Optimize_Length_Comparison --
|
||||
--------------------------------
|
||||
|
||||
@ -6185,7 +6185,7 @@ package body Exp_Ch9 is
|
||||
if No (Entity (N)) then
|
||||
return Abandon;
|
||||
|
||||
elsif Is_Universal_Numeric_Type (Entity (N)) then
|
||||
elsif Is_Numeric_Type (Entity (N)) then
|
||||
return Skip;
|
||||
end if;
|
||||
|
||||
@ -6283,11 +6283,13 @@ package body Exp_Ch9 is
|
||||
|
||||
when N_Type_Conversion =>
|
||||
|
||||
-- Conversions to Universal_Integer will not raise constraint
|
||||
-- errors.
|
||||
-- Conversions to Universal_Integer do not raise constraint
|
||||
-- errors. Likewise if the expression's type is statically
|
||||
-- compatible with the target's type.
|
||||
|
||||
if Cannot_Raise_Constraint_Error (N)
|
||||
or else Etype (N) = Universal_Integer
|
||||
if Etype (N) = Universal_Integer
|
||||
or else Subtypes_Statically_Compatible
|
||||
(Etype (Expression (N)), Etype (N))
|
||||
then
|
||||
return OK;
|
||||
end if;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user