[Ada] Further optimization with uninitialized aggregates

gcc/ada/

	* freeze.adb (Is_Uninitialized_Aggregate): Move...
	* exp_util.adb (Is_Uninitialized_Aggregate): ... here.
	(Expand_Subtype_From_Expr): If the expression is an
	uninitialized aggregate, capture subtype for declared object and
	remove expression to suppress further superfluous expansion.
This commit is contained in:
Ed Schonberg 2020-10-18 12:17:51 -04:00 committed by Pierre-Marie de Rodat
parent 55fae09dcb
commit a46fa6510d
2 changed files with 62 additions and 46 deletions

View File

@ -169,6 +169,16 @@ package body Exp_Util is
-- Determine whether pragma Default_Initial_Condition denoted by Prag has
-- an assertion expression that should be verified at run time.
function Is_Uninitialized_Aggregate
(Exp : Node_Id;
T : Entity_Id) return Boolean;
-- Determine whether an array aggregate used in an object declaration
-- is uninitialized, when the aggregate is declared with a box and
-- the component type has no default value. Such an aggregate can be
-- optimized away to prevent the copying of uninitialized data, and
-- the bounds of the aggregate can be propagated directly to the
-- object declaration.
function Make_CW_Equivalent_Type
(T : Entity_Id;
E : Node_Id) return Entity_Id;
@ -5346,6 +5356,17 @@ package body Exp_Util is
elsif Is_Build_In_Place_Function_Call (Exp) then
null;
-- If the exprewsion is an uninitialized aggregate, no need to build
-- a subtype from the expression. because this may require the use
-- of dynamic memory to create the object.
elsif Is_Uninitialized_Aggregate (Exp, Exp_Typ) then
Rewrite (Subtype_Indic, New_Occurrence_Of (Etype (Exp), Sloc (N)));
if Nkind (N) = N_Object_Declaration then
Set_Expression (N, Empty);
Set_No_Initialization (N);
end if;
else
Remove_Side_Effects (Exp);
Rewrite (Subtype_Indic,
@ -8794,6 +8815,47 @@ package body Exp_Util is
and then Etype (Expression (Expr)) = RTE (RE_Tag);
end Is_Tag_To_Class_Wide_Conversion;
--------------------------------
-- Is_Uninitialized_Aggregate --
--------------------------------
function Is_Uninitialized_Aggregate
(Exp : Node_Id;
T : Entity_Id) return Boolean
is
Comp : Node_Id;
Comp_Type : Entity_Id;
Typ : Entity_Id;
begin
if Nkind (Exp) /= N_Aggregate then
return False;
end if;
Preanalyze_And_Resolve (Exp, T);
Typ := Etype (Exp);
if No (Typ)
or else Ekind (Typ) /= E_Array_Subtype
or else Present (Expressions (Exp))
or else No (Component_Associations (Exp))
then
return False;
else
Comp_Type := Component_Type (Typ);
Comp := First (Component_Associations (Exp));
if not Box_Present (Comp)
or else Present (Next (Comp))
then
return False;
end if;
return Is_Scalar_Type (Comp_Type)
and then No (Default_Aspect_Component_Value (Typ));
end if;
end Is_Uninitialized_Aggregate;
----------------------------
-- Is_Untagged_Derivation --
----------------------------

View File

@ -182,12 +182,6 @@ package body Freeze is
-- the designated type. Otherwise freezing the access type does not freeze
-- the designated type.
function Is_Uninitialized_Aggregate (N : Node_Id) return Boolean;
-- Determine whether an array aggregate used in an object declaration
-- is uninitialized, when the aggregate is declared with a box and
-- the component type has no default value. Such an aggregate can be
-- optimized away and prevent the copying of uninitialized data.
procedure Process_Default_Expressions
(E : Entity_Id;
After : in out Node_Id);
@ -727,12 +721,6 @@ package body Freeze is
if Present (Init)
and then not Is_Limited_View (Typ)
then
if Is_Uninitialized_Aggregate (Init) then
Init := Empty;
Set_No_Initialization (Decl);
return;
end if;
-- Capture initialization value at point of declaration, and make
-- explicit assignment legal, because object may be a constant.
@ -9153,40 +9141,6 @@ package body Freeze is
end if;
end Freeze_Subprogram;
--------------------------------
-- Is_Uninitialized_Aggregate --
--------------------------------
function Is_Uninitialized_Aggregate (N : Node_Id) return Boolean is
Aggr : constant Node_Id := Original_Node (N);
Typ : constant Entity_Id := Etype (Aggr);
Comp : Node_Id;
Comp_Type : Entity_Id;
begin
if Nkind (Aggr) /= N_Aggregate
or else No (Typ)
or else Ekind (Typ) /= E_Array_Type
or else Present (Expressions (Aggr))
or else No (Component_Associations (Aggr))
then
return False;
else
Comp_Type := Component_Type (Typ);
Comp := First (Component_Associations (Aggr));
if not Box_Present (Comp)
or else Present (Next (Comp))
then
return False;
end if;
return Is_Scalar_Type (Comp_Type)
and then No (Default_Aspect_Component_Value (Typ))
and then No (Default_Aspect_Value (Comp_Type));
end if;
end Is_Uninitialized_Aggregate;
----------------------
-- Is_Fully_Defined --
----------------------