From fa57ac97e9e50108ba984a0a6bfe3d54d339f059 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 14 Aug 2007 10:41:44 +0200 Subject: [PATCH] exp_aggr.ads, [...] (Convert_Aggr_In_Allocator): Use Insert_Actions to place expanded aggregate code before allocator... 2007-08-14 Ed Schonberg Gary Dismukes * exp_aggr.ads, exp_aggr.adb (Convert_Aggr_In_Allocator): Use Insert_Actions to place expanded aggregate code before allocator, and ahead of declaration for temporary, to prevent access before elaboration when the allocator is an actual for an access parameter. (Is_Static_Dispatch_Table_Aggregate): Handle aggregates initializing the TSD and the table of interfaces. (Convert_To_Assignments): Augment the test for delaying aggregate expansion for limited return statements to include the case of extended returns, to prevent creation of an unwanted transient scope. (Is_Static_Dispatch_Table_Aggregate): New subprogram. (Expand_Array_Aggregate): Handle aggregates associated with statically allocated dispatch tables. (Expand_Record_Aggregate): Handle aggregates associated with statically allocated dispatch tables. (Gen_Ctrl_Actions_For_Aggr): Generate a finalization list for allocators of anonymous access type. From-SVN: r127429 --- gcc/ada/exp_aggr.adb | 153 ++++++++++++++++++++++++++++++++----------- gcc/ada/exp_aggr.ads | 14 ++-- 2 files changed, 125 insertions(+), 42 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6321dc55d74..f79f0e26be2 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -93,6 +93,10 @@ package body Exp_Aggr is -- N is an aggregate (record or array). Checks the presence of default -- initialization (<>) in any component (Ada 2005: AI-287) + function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean; + -- Returns true if N is an aggregate used to initialize the components + -- of an statically allocated dispatch table. + ------------------------------------------------------ -- Local subprograms for Record Aggregate Expansion -- ------------------------------------------------------ @@ -115,9 +119,10 @@ package body Exp_Aggr is -- aggregate procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id); - -- N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of - -- the aggregate. Transform the given aggregate into a sequence of - -- assignments component per component. + -- N is an N_Aggregate or an N_Extension_Aggregate. Typ is the type of the + -- aggregate (which can only be a record type, this procedure is only used + -- for record types). Transform the given aggregate into a sequence of + -- assignments performed component by component. function Build_Record_Aggr_Code (N : Node_Id; @@ -2059,11 +2064,14 @@ package body Exp_Aggr is if Controlled_Type (Typ) then - -- The current aggregate belongs to an allocator which acts as - -- the root of a coextension chain. + -- The current aggregate belongs to an allocator which creates + -- an object through an anonymous access type or acts as the root + -- of a coextension chain. if Present (Alloc) - and then Is_Coextension_Root (Alloc) + and then + (Is_Coextension_Root (Alloc) + or else Ekind (Etype (Alloc)) = E_Anonymous_Access_Type) then if No (Associated_Final_Chain (Etype (Alloc))) then Build_Final_List (Alloc, Etype (Alloc)); @@ -2116,7 +2124,7 @@ package body Exp_Aggr is -- aggregate to its coextension chain. if Present (Alloc) - and then Is_Coextension (Alloc) + and then Is_Dynamic_Coextension (Alloc) then if No (Coextensions (Alloc)) then Set_Coextensions (Alloc, New_Elmt_List); @@ -3024,7 +3032,11 @@ package body Exp_Aggr is -- Convert_Aggr_In_Allocator -- ------------------------------- - procedure Convert_Aggr_In_Allocator (Decl, Aggr : Node_Id) is + procedure Convert_Aggr_In_Allocator + (Alloc : Node_Id; + Decl : Node_Id; + Aggr : Node_Id) + is Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); Temp : constant Entity_Id := Defining_Identifier (Decl); @@ -3045,6 +3057,14 @@ package body Exp_Aggr is -- the access discriminant is itself placed on the stack. Otherwise, -- some other finalization list is used (see exp_ch4.adb). + -- Decl has been inserted in the code ahead of the allocator, using + -- Insert_Actions. We use Insert_Actions below as well, to ensure that + -- subsequent insertions are done in the proper order. Using (for + -- example) Insert_Actions_After to place the expanded aggregate + -- immediately after Decl may lead to out-of-order references if the + -- allocator has generated a finalization list, as when the designated + -- object is controlled and there is an open transient scope. + if Ekind (Access_Type) = E_Anonymous_Access_Type and then Nkind (Associated_Node_For_Itype (Access_Type)) = N_Discriminant_Specification @@ -3074,14 +3094,14 @@ package body Exp_Aggr is if Has_Task (Typ) then Build_Task_Allocate_Block_With_Init_Stmts (L, Aggr, Init_Stmts); - Insert_Actions_After (Decl, L); + Insert_Actions (Alloc, L); else - Insert_Actions_After (Decl, Init_Stmts); + Insert_Actions (Alloc, Init_Stmts); end if; end; else - Insert_Actions_After (Decl, + Insert_Actions (Alloc, Late_Expansion (Aggr, Typ, Occ, Flist, Associated_Final_Chain (Base_Type (Access_Type)))); @@ -3269,6 +3289,9 @@ package body Exp_Aggr is Parent_Node : Node_Id; begin + pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N)); + pragma Assert (Is_Record_Type (Typ)); + Parent_Node := Parent (N); Parent_Kind := Nkind (Parent_Node); @@ -3293,34 +3316,47 @@ package body Exp_Aggr is end; end if; - -- Just set the Delay flag in the following cases where the - -- transformation will be done top down from above: + -- Just set the Delay flag in the cases where the transformation + -- will be done top down from above. - -- - internal aggregate (transformed when expanding the parent) + if False - -- - allocators (see Convert_Aggr_In_Allocator) + -- Internal aggregate (transformed when expanding the parent) - -- - object decl (see Convert_Aggr_In_Object_Decl) + or else Parent_Kind = N_Aggregate + or else Parent_Kind = N_Extension_Aggregate + or else Parent_Kind = N_Component_Association - -- - safe assignments (see Convert_Aggr_Assignments) - -- so far only the assignments in the init procs are taken - -- into account + -- Allocator (see Convert_Aggr_In_Allocator) - -- - (Ada 2005) A limited type in a return statement, which will - -- be rewritten as an extended return and may have its own - -- finalization machinery. + or else Parent_Kind = N_Allocator - if Parent_Kind = N_Aggregate - or else Parent_Kind = N_Extension_Aggregate - or else Parent_Kind = N_Component_Association - or else Parent_Kind = N_Allocator - or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl) - or else (Parent_Kind = N_Assignment_Statement - and then Inside_Init_Proc) - or else - (Is_Limited_Record (Typ) - and then Present (Parent (Parent (N))) - and then Nkind (Parent (Parent (N))) = N_Return_Statement) + -- Object declaration (see Convert_Aggr_In_Object_Decl) + + or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl) + + -- Safe assignment (see Convert_Aggr_Assignments). So far only the + -- assignments in init procs are taken into account. + + or else (Parent_Kind = N_Assignment_Statement + and then Inside_Init_Proc) + + -- (Ada 2005) An inherently limited type in a return statement, + -- which will be handled in a build-in-place fashion, and may be + -- rewritten as an extended return and have its own finalization + -- machinery. In the case of a simple return, the aggregate needs + -- to be delayed until the scope for the return statement has been + -- created, so that any finalization chain will be associated with + -- that scope. For extended returns, we delay expansion to avoid the + -- creation of an unwanted transient scope that could result in + -- premature finalization of the return object (which is built in + -- in place within the caller's scope). + + or else + (Is_Inherently_Limited_Type (Typ) + and then + (Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement + or else Nkind (Parent_Node) = N_Simple_Return_Statement)) then Set_Expansion_Delayed (N); return; @@ -4710,10 +4746,14 @@ package body Exp_Aggr is return; end if; - -- If all aggregate components are compile-time known and - -- the aggregate has been flattened, nothing left to do. + -- If all aggregate components are compile-time known and the aggregate + -- has been flattened, nothing left to do. The same occurs if the + -- aggregate is used to initialize the components of an statically + -- allocated dispatch table. - if Compile_Time_Known_Aggregate (N) then + if Compile_Time_Known_Aggregate (N) + or else Is_Static_Dispatch_Table_Aggregate (N) + then Set_Expansion_Delayed (N, False); return; end if; @@ -5165,6 +5205,12 @@ package body Exp_Aggr is then Expand_Atomic_Aggregate (N, Typ); return; + + -- No special management required for aggregates used to initialize + -- statically allocated dispatch tables + + elsif Is_Static_Dispatch_Table_Aggregate (N) then + return; end if; -- Ada 2005 (AI-318-2): We need to convert to assignments if components @@ -5607,6 +5653,39 @@ package body Exp_Aggr is end if; end Is_Delayed_Aggregate; + ---------------------------------------- + -- Is_Static_Dispatch_Table_Aggregate -- + ---------------------------------------- + + function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean is + Typ : constant Entity_Id := Base_Type (Etype (N)); + + begin + return Static_Dispatch_Tables + and then VM_Target = No_VM + and then RTU_Loaded (Ada_Tags) + + -- Avoid circularity when rebuilding the compiler + + and then Cunit_Entity (Get_Source_Unit (N)) /= RTU_Entity (Ada_Tags) + and then (Typ = RTE (RE_Dispatch_Table_Wrapper) + or else + Typ = RTE (RE_Address_Array) + or else + Typ = RTE (RE_Type_Specific_Data) + or else + Typ = RTE (RE_Tag_Table) + or else + (RTE_Available (RE_Interface_Data) + and then Typ = RTE (RE_Interface_Data)) + or else + (RTE_Available (RE_Interfaces_Array) + and then Typ = RTE (RE_Interfaces_Array)) + or else + (RTE_Available (RE_Interface_Data_Element) + and then Typ = RTE (RE_Interface_Data_Element))); + end Is_Static_Dispatch_Table_Aggregate; + -------------------- -- Late_Expansion -- -------------------- @@ -6131,7 +6210,7 @@ package body Exp_Aggr is if No (Component_Associations (N)) then - -- Verify that all components are static integers. + -- Verify that all components are static integers Expr := First (Expressions (N)); while Present (Expr) loop diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 4a265119a90..cb393287ea5 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -40,11 +40,15 @@ package Exp_Aggr is -- an N_Aggregate or N_Extension_Aggregate with Expansion_Delayed -- This procedure performs in-place aggregate assignment. - procedure Convert_Aggr_In_Allocator (Decl, Aggr : Node_Id); - -- Decl is an access N_Object_Declaration (produced during - -- allocator expansion), Aggr is the initial expression aggregate - -- of an allocator. This procedure perform in-place aggregate - -- assignment in the newly allocated object. + procedure Convert_Aggr_In_Allocator + (Alloc : Node_Id; + Decl : Node_Id; + Aggr : Node_Id); + -- Alloc is the allocator whose expression is the aggregate Aggr. + -- Decl is an N_Object_Declaration created during allocator expansion. + -- This procedure perform in-place aggregate assignment into the + -- temporary declared in Decl, and the allocator becomes an access to + -- that temporary. procedure Convert_Aggr_In_Assignment (N : Node_Id); -- If the right-hand side of an assignment is an aggregate, expand the -- 2.30.2