From 6f639c98660e3f370f7a9aa9ee2a31078cbf86a1 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 27 Oct 2004 15:01:17 +0200 Subject: [PATCH] exp_aggr.adb (Safe_Component): An aggregate component that is an unchecked conversion is safe for in-place use... 2004-10-26 Ed Schonberg * 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. From-SVN: r89649 --- gcc/ada/exp_aggr.adb | 92 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 84 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7bc0a762f523..d18a02edae72 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) @@ -4046,6 +4113,15 @@ package body Exp_Aggr is Set_Etype (Tmp, Typ); 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