From: Ed Schonberg <schonberg@adacore.com>
Date: Sun, 18 Oct 2020 16:17:51 +0000 (-0400)
Subject: [Ada] Further optimization with uninitialized aggregates
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a46fa6510d24f4edcfd13dace9f7a0b4d86b86be;p=gcc.git

[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.
---

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 --
    ----------------------