2004-10-26 Ed Schonberg <schonberg@gnat.com>

	* exp_aggr.adb (Safe_Component): An aggregate component that is an
	unchecked conversion is safe for in-place use if the expression of the
	conversion is safe.
	(Expand_Array_Aggregate): An aggregate that initializes an allocator may
	be expandable in place even if the aggregate does not come from source.
	(Convert_Array_Aggr_In_Allocator): New procedure to initialize the
	designated object of an allocator in place, rather than building it
	first on the stack. The previous scheme forces a full copy of the array,
	and may be altogether unsusable if the size of the array is too large
	for stack allocation.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@89649 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 84 insertions, 8 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 7bc0a762f52..d18a02edae7 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -144,6 +144,16 @@ package body Exp_Aggr is
    -- Local Subprograms for Array Aggregate Expansion --
    -----------------------------------------------------
 
+   procedure Convert_Array_Aggr_In_Allocator
+     (Decl   : Node_Id;
+      Aggr   : Node_Id;
+      Target : Node_Id);
+   --  If the aggregate appears within an allocator and can be expanded in
+   --  place, this routine generates the individual assignments to components
+   --  of the designated object. This is an optimization over the general
+   --  case, where a temporary is first created on the stack and then used to
+   --  construct the allocated object on the heap.
+
    procedure Convert_To_Positional
      (N                    : Node_Id;
       Max_Others_Replicate : Nat     := 5;
@@ -2348,7 +2358,10 @@ package body Exp_Aggr is
       Access_Type : constant Entity_Id := Etype (Temp);
 
    begin
-      if Has_Default_Init_Comps (Aggr) then
+      if Is_Array_Type (Typ) then
+         Convert_Array_Aggr_In_Allocator (Decl, Aggr, Occ);
+
+      elsif Has_Default_Init_Comps (Aggr) then
          declare
             L          : constant List_Id := New_List;
             Init_Stmts : List_Id;
@@ -2491,6 +2504,34 @@ package body Exp_Aggr is
       Initialize_Discriminants (N, Typ);
    end Convert_Aggr_In_Object_Decl;
 
+   -------------------------------------
+   -- Convert_array_Aggr_In_Allocator --
+   -------------------------------------
+
+   procedure Convert_Array_Aggr_In_Allocator
+     (Decl   : Node_Id;
+      Aggr   : Node_Id;
+      Target : Node_Id)
+   is
+      Aggr_Code : List_Id;
+      Typ       : constant Entity_Id := Etype (Aggr);
+      Ctyp      : constant Entity_Id := Component_Type (Typ);
+
+   begin
+      --  The target is an explicit dereference of the allocated object.
+      --  Generate component assignments to it, as for an aggregate that
+      --  appears on the right-hand side of an assignment statement.
+
+      Aggr_Code :=
+        Build_Array_Aggr_Code (Aggr,
+          Ctype       => Ctyp,
+          Index       => First_Index (Typ),
+          Into        => Target,
+          Scalar_Comp => Is_Scalar_Type (Ctyp));
+
+      Insert_Actions_After (Decl, Aggr_Code);
+   end Convert_Array_Aggr_In_Allocator;
+
    ----------------------------
    -- Convert_To_Assignments --
    ----------------------------
@@ -3451,7 +3492,10 @@ package body Exp_Aggr is
                            and then Check_Component (Right_Opnd (Comp)))
 
                  or else (Nkind (Comp) = N_Selected_Component
-                           and then Check_Component (Prefix (Comp)));
+                           and then Check_Component (Prefix (Comp)))
+
+                 or else (Nkind (Comp) = N_Unchecked_Type_Conversion
+                           and then Check_Component (Expression (Comp)));
             end Check_Component;
 
          --  Start of processing for Safe_Component
@@ -3511,7 +3555,17 @@ package body Exp_Aggr is
             end if;
 
             Aggr_In := First_Index (Etype (N));
-            Obj_In  := First_Index (Etype (Name (Parent (N))));
+            if Nkind (Parent (N)) = N_Assignment_Statement then
+               Obj_In  := First_Index (Etype (Name (Parent (N))));
+
+            else
+               --  Context is an allocator. Check bounds of aggregate
+               --  against given type in qualified expression.
+
+               pragma Assert (Nkind (Parent (Parent (N))) = N_Allocator);
+               Obj_In :=
+                 First_Index (Etype (Entity (Subtype_Mark (Parent (N)))));
+            end if;
 
             while Present (Aggr_In) loop
                Get_Index_Bounds (Aggr_In, Aggr_Lo, Aggr_Hi);
@@ -4000,6 +4054,11 @@ package body Exp_Aggr is
       --  create a temporary. The analysis for safety of on-line assignment
       --  is delicate, i.e. we don't know how to do it fully yet ???
 
+      --  For allocators we assign to the designated object in place if the
+      --  aggregate meets the same conditions as other in-place assignments.
+      --  In this case the aggregate may not come from source but was created
+      --  for default initialization, e.g. with Initialize_Scalars.
+
       if Requires_Transient_Scope (Typ) then
          Establish_Transient_Scope
            (N, Sec_Stack => Has_Controlled_Component (Typ));
@@ -4007,13 +4066,21 @@ package body Exp_Aggr is
 
       if Has_Default_Init_Comps (N) then
          Maybe_In_Place_OK := False;
+
+      elsif Is_Bit_Packed_Array (Typ)
+        or else Has_Controlled_Component (Typ)
+      then
+         Maybe_In_Place_OK := False;
+
       else
          Maybe_In_Place_OK :=
-           Comes_From_Source (N)
-             and then Nkind (Parent (N)) = N_Assignment_Statement
-             and then not Is_Bit_Packed_Array (Typ)
-             and then not Has_Controlled_Component (Typ)
-             and then In_Place_Assign_OK;
+          (Nkind (Parent (N)) = N_Assignment_Statement
+             and then Comes_From_Source (N)
+             and then In_Place_Assign_OK)
+
+          or else
+            (Nkind (Parent (Parent (N))) = N_Allocator
+              and then In_Place_Assign_OK);
       end if;
 
       if not Has_Default_Init_Comps (N)
@@ -4047,6 +4114,15 @@ package body Exp_Aggr is
          end if;
 
       elsif Maybe_In_Place_OK
+        and then Nkind (Parent (N)) = N_Qualified_Expression
+        and then Nkind (Parent (Parent (N))) = N_Allocator
+      then
+         Set_Expansion_Delayed (N);
+         return;
+
+      --  In the remaining cases  the aggregate is the RHS of an assignment.
+
+      elsif Maybe_In_Place_OK
         and then Is_Entity_Name (Name (Parent (N)))
       then
          Tmp := Entity (Name (Parent (N)));