OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Improve compile-time evaluation of value ranges

Browse Source 
2020-06-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.adb (Compute_Range_For_Arithmetic_Op): New procedure to
	compute a range for an arithmetical operation extracted from...
	(Minimize_Eliminate_Overflows): ...here.  Call it.
	(Determine_Range_Cache_O): New cache for Original_Node nodes.
	(Determine_Range): Call Compute_Range_For_Arithmetic_Op for all
	arithmetic expressions. Use Attribute_Id in lieu of Attribute_Name
	for attributes. Add handling for Range_Length alongside Length.
	Add specific handling for Alignment, Bit, First_Bit, Last_Bit,
	Max_Size_In_Storage_Elements, Position, Bit_Position,
	Component_Size, Object_Size, Size, Value_Size, Descriptor_Size.
	(Enable_Overflow_Check): Omit the check for Abs and Minus if the
	operand cannot be the largest negative number.
	(Selected_Length_Checks): Use Pos for Number_Dimensions.
	* exp_attr.adb (Expand_N_Attribute_Reference): Move compile-time
	handling of Bit_Position, Descriptor_Size, First_Bit, Last_Bit
	and Position to...
	* sem_attr.adb (Eval_Attribute): ...here.  Move up Alignment for
	objects and use Compile_Time_Known_Attribute in this case too.
This commit is contained in:
Eric Botcazou 2020-04-21 22:28:00 +02:00 committed by Pierre-Marie de Rodat
parent 78689aa295
commit 12be130c3f
3 changed files with 668 additions and 616 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

940
gcc/ada/checks.adb
View File

File diff suppressed because it is too large Load Diff

173
gcc/ada/exp_attr.adb
View File

@ -2549,34 +2549,11 @@ package body Exp_Attr is
-- Bit_Position --
------------------
-- We compute this if a component clause was present, otherwise we leave
-- the computation up to the back end, since we don't know what layout
-- will be chosen.
-- We leave the computation up to the back end, since we don't know what
-- layout will be chosen if no component clause was specified.
-- Note that the attribute can apply to a naked record component
-- in generated code (i.e. the prefix is an identifier that
-- references the component or discriminant entity).
when Attribute_Bit_Position => Bit_Position : declare
CE : Entity_Id;
begin
if Nkind (Pref) = N_Identifier then
CE := Entity (Pref);
else
CE := Entity (Selector_Name (Pref));
end if;
if Known_Static_Component_Bit_Offset (CE) then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Component_Bit_Offset (CE)));
Analyze_And_Resolve (N, Typ);
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end Bit_Position;
when Attribute_Bit_Position =>
Apply_Universal_Integer_Attribute_Checks (N);
------------------
-- Body_Version --
@ -3022,24 +2999,10 @@ package body Exp_Attr is
-- Descriptor_Size --
---------------------
-- Attribute Descriptor_Size is handled by the back end
when Attribute_Descriptor_Size =>
-- Attribute Descriptor_Size is handled by the back end when applied
-- to an unconstrained array type.
if Is_Array_Type (Ptyp)
and then not Is_Constrained (Ptyp)
then
Apply_Universal_Integer_Attribute_Checks (N);
-- For any other type, the descriptor size is 0 because there is no
-- actual descriptor, but the result is not formally static.
else
Rewrite (N, Make_Integer_Literal (Loc, 0));
Analyze (N);
Set_Is_Static_Expression (N, False);
end if;
Apply_Universal_Integer_Attribute_Checks (N);
---------------
-- Elab_Body --
@ -3482,42 +3445,11 @@ package body Exp_Attr is
-- First_Bit --
---------------
-- Compute this if component clause was present, otherwise we leave the
-- computation to be completed in the back-end, since we don't know what
-- layout will be chosen.
-- We leave the computation up to the back end, since we don't know what
-- layout will be chosen if no component clause was specified.
when Attribute_First_Bit => First_Bit_Attr : declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
-- In Ada 2005 (or later) if we have the non-default bit order, then
-- we return the original value as given in the component clause
-- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (First_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE) then
Rewrite (N,
Make_Integer_Literal (Loc,
Component_Bit_Offset (CE) mod System_Storage_Unit));
Analyze_And_Resolve (N, Typ);
-- Otherwise left to back end, just do universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end First_Bit_Attr;
when Attribute_First_Bit =>
Apply_Universal_Integer_Attribute_Checks (N);
--------------------------------
-- Fixed_Value, Integer_Value --
@ -4147,45 +4079,11 @@ package body Exp_Attr is
-- Last_Bit --
--------------
-- We compute this if a component clause was present, otherwise we leave
-- the computation up to the back end, since we don't know what layout
-- will be chosen.
-- We leave the computation up to the back end, since we don't know what
-- layout will be chosen if no component clause was specified.
when Attribute_Last_Bit => Last_Bit_Attr : declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
-- In Ada 2005 (or later) if we have the non-default bit order, then
-- we return the original value as given in the component clause
-- (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Last_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with default bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE)
and then Known_Static_Esize (CE)
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => (Component_Bit_Offset (CE) mod System_Storage_Unit)
+ Esize (CE) - 1));
Analyze_And_Resolve (N, Typ);
-- Otherwise leave to back end, just apply universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end Last_Bit_Attr;
when Attribute_Last_Bit =>
Apply_Universal_Integer_Attribute_Checks (N);
------------------
-- Leading_Part --
@ -5249,44 +5147,11 @@ package body Exp_Attr is
-- Position --
--------------
-- We compute this if a component clause was present, otherwise we leave
-- the computation up to the back end, since we don't know what layout
-- will be chosen.
-- We leave the computation up to the back end, since we don't know what
-- layout will be chosen if no component clause was specified.
when Attribute_Position => Position_Attr : declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
if Present (Component_Clause (CE)) then
-- In Ada 2005 (or later) if we have the non-default bit order,
-- then we return the original value as given in the component
-- clause (RM 2005 13.5.2(2/2)).
if Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Position (Component_Clause (CE)))));
-- Otherwise (Ada 83 or 95, or default bit order specified in
-- later Ada version), return the normalized value.
else
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Component_Bit_Offset (CE) / System_Storage_Unit));
end if;
Analyze_And_Resolve (N, Typ);
-- If back end is doing things, just apply universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end Position_Attr;
when Attribute_Position =>
Apply_Universal_Integer_Attribute_Checks (N);
----------
-- Pred --

171
gcc/ada/sem_attr.adb
View File

@ -7750,13 +7750,24 @@ package body Sem_Attr is
or else (Is_Entity_Name (P)
and then Ekind (Entity (P)) = E_Enumeration_Literal)
then
-- For Alignment, give alignment of object if available, otherwise we
-- cannot fold Alignment.
if Id = Attribute_Alignment then
if Is_Entity_Name (P) and then Known_Alignment (Entity (P)) then
Compile_Time_Known_Attribute (N, Alignment (Entity (P)));
else
Check_Expressions;
end if;
return;
-- For Component_Size, the prefix is an array object, and we apply
-- the attribute to the type of the object. This is allowed for both
-- unconstrained and constrained arrays, since the bounds have no
-- influence on the value of this attribute.
if Id = Attribute_Component_Size then
elsif Id = Attribute_Component_Size then
P_Entity := Etype (P);
-- For Enum_Rep, evaluation depends on the nature of the prefix and
@ -7818,13 +7829,126 @@ package body Sem_Attr is
return;
end if;
-- For First and Last, the prefix is an array object, and we apply
-- the attribute to the type of the array, but we need a constrained
-- type for this, so we use the actual subtype if available.
-- For Bit_Position, give Component_Bit_Offset of object if available
-- otherwise we cannot fold Bit_Position. Note that the attribute can
-- be applied to a naked record component in generated code, in which
-- case the prefix is an identifier that references the component or
-- discriminant entity.
elsif Id = Attribute_First or else
Id = Attribute_Last or else
Id = Attribute_Length
elsif Id = Attribute_Bit_Position then
declare
CE : Entity_Id;
begin
if Is_Entity_Name (P) then
CE := Entity (P);
else
CE := Entity (Selector_Name (P));
end if;
if Known_Static_Component_Bit_Offset (CE) then
Compile_Time_Known_Attribute
(N, Component_Bit_Offset (Entity (P)));
else
Check_Expressions;
end if;
return;
end;
-- For Position, in Ada 2005 (or later) if we have the non-default
-- bit order, we return the original value as given in the component
-- clause (RM 2005 13.5.2(3/2)). Otherwise (Ada 83/95, or later with
-- default bit order) return the value if it is known statically.
elsif Id = Attribute_Position then
declare
CE : constant Entity_Id := Entity (Selector_Name (P));
begin
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Compile_Time_Known_Attribute
(N, Expr_Value (Position (Component_Clause (CE))));
elsif Known_Static_Component_Bit_Offset (CE) then
Compile_Time_Known_Attribute
(N, Component_Bit_Offset (CE) / System_Storage_Unit);
else
Check_Expressions;
end if;
return;
end;
-- For First_Bit, in Ada 2005 (or later) if we have the non-default
-- bit order, we return the original value as given in the component
-- clause (RM 2005 13.5.2(3/2)). Otherwise (Ada 83/95, or later with
-- default bit order) return the value if it is known statically.
elsif Id = Attribute_First_Bit then
declare
CE : constant Entity_Id := Entity (Selector_Name (P));
begin
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Compile_Time_Known_Attribute
(N, Expr_Value (First_Bit (Component_Clause (CE))));
elsif Known_Static_Component_Bit_Offset (CE) then
Compile_Time_Known_Attribute
(N, Component_Bit_Offset (CE) mod System_Storage_Unit);
else
Check_Expressions;
end if;
return;
end;
-- For Last_Bit, in Ada 2005 (or later) if we have the non-default
-- bit order, we return the original value as given in the component
-- clause (RM 2005 13.5.2(3/2)). Otherwise (Ada 83/95, or later with
-- default bit order) return the value if it is known statically.
elsif Id = Attribute_Last_Bit then
declare
CE : constant Entity_Id := Entity (Selector_Name (P));
begin
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then Reverse_Bit_Order (Scope (CE))
then
Compile_Time_Known_Attribute
(N, Expr_Value (Last_Bit (Component_Clause (CE))));
elsif Known_Static_Component_Bit_Offset (CE)
and then Known_Static_Esize (CE)
then
Compile_Time_Known_Attribute
(N, (Component_Bit_Offset (CE) mod System_Storage_Unit)
+ Esize (CE) - 1);
else
Check_Expressions;
end if;
return;
end;
-- For First, Last and Length, the prefix is an array object, and we
-- apply the attribute to its type, but we need a constrained type
-- for this, so we use the actual subtype if available.
elsif Id = Attribute_First
or else Id = Attribute_Last
or else Id = Attribute_Length
then
declare
AS : constant Entity_Id := Get_Actual_Subtype_If_Available (P);
@ -7846,30 +7970,14 @@ package body Sem_Attr is
elsif Id = Attribute_Size then
if Is_Entity_Name (P)
and then Known_Esize (Entity (P))
and then Known_Static_Esize (Entity (P))
then
Compile_Time_Known_Attribute (N, Esize (Entity (P)));
return;
else
Check_Expressions;
return;
end if;
-- For Alignment, give size of object if available, otherwise we
-- cannot fold Alignment.
elsif Id = Attribute_Alignment then
if Is_Entity_Name (P)
and then Known_Alignment (Entity (P))
then
Fold_Uint (N, Alignment (Entity (P)), Static);
return;
else
Check_Expressions;
return;
end if;
return;
-- For Lock_Free, we apply the attribute to the type of the object.
-- This is allowed since we have already verified that the type is a
@ -7995,11 +8103,11 @@ package body Sem_Attr is
-- Definite must be folded if the prefix is not a generic type, that
-- is to say if we are within an instantiation. Same processing applies
-- to the GNAT attributes Atomic_Always_Lock_Free, Has_Discriminants,
-- Lock_Free, Type_Class, Has_Tagged_Value, and Unconstrained_Array.
-- to selected GNAT attributes.
elsif (Id = Attribute_Atomic_Always_Lock_Free or else
Id = Attribute_Definite or else
Id = Attribute_Descriptor_Size or else
Id = Attribute_Has_Access_Values or else
Id = Attribute_Has_Discriminants or else
Id = Attribute_Has_Tagged_Values or else
@ -8110,7 +8218,7 @@ package body Sem_Attr is
-- since we can't do anything with unconstrained arrays. In addition,
-- only the First, Last and Length attributes are possibly static.
-- Atomic_Always_Lock_Free, Definite, Has_Access_Values,
-- Atomic_Always_Lock_Free, Definite, Descriptor_Size, Has_Access_Values
-- Has_Discriminants, Has_Tagged_Values, Lock_Free, Type_Class, and
-- Unconstrained_Array are again exceptions, because they apply as well
-- to unconstrained types.
@ -8122,6 +8230,7 @@ package body Sem_Attr is
elsif Id = Attribute_Atomic_Always_Lock_Free or else
Id = Attribute_Definite or else
Id = Attribute_Descriptor_Size or else
Id = Attribute_Has_Access_Values or else
Id = Attribute_Has_Discriminants or else
Id = Attribute_Has_Tagged_Values or else
@ -8490,8 +8599,12 @@ package body Sem_Attr is
-- Descriptor_Size --
---------------------
-- Descriptor_Size is nonnull only for unconstrained array types
when Attribute_Descriptor_Size =>
null;
if not Is_Array_Type (P_Type) or else Is_Constrained (P_Type) then
Fold_Uint (N, Uint_0, Static);
end if;
------------
-- Digits --