From a46fa6510d24f4edcfd13dace9f7a0b4d86b86be Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Sun, 18 Oct 2020 12:17:51 -0400 Subject: [PATCH] [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. --- gcc/ada/exp_util.adb | 62 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/freeze.adb | 46 -------------------------------- 2 files changed, 62 insertions(+), 46 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 6845d458be5..dd3aa49af7d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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 -- ---------------------------- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 8ccc54e6333..24f6c93c06d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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 -- ---------------------- -- 2.30.2