From: Hristian Kirtchev Date: Tue, 30 Aug 2011 13:28:16 +0000 (+0000) Subject: exp_ch3.adb (Expand_Freeze_Array_Type): Correct the call to Build_Finalization_Master... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3647ca26874c7f8814049a5efca277354ef0e3e7;p=gcc.git exp_ch3.adb (Expand_Freeze_Array_Type): Correct the call to Build_Finalization_Master by supplying an insertion node... 2011-08-30 Hristian Kirtchev * exp_ch3.adb (Expand_Freeze_Array_Type): Correct the call to Build_Finalization_Master by supplying an insertion node and enclosing scope. In its old version, the call did not generate a finalization master. (Expand_Freeze_Record_Type): Add local variable Has_AACC. Add code to recognize anonymous access-to-controlled components. Rewrite the machinery which creates finalization masters to service anonymous access-to-controlled components of a record type. In its current state, only one heterogeneous master is necessary to handle multiple anonymous components. (Freeze_Type): Comment reformatting. * rtsfind.ads: Add RE_Set_Is_Heterogeneous to tables RE_Id and RE_Unit_Table. * s-stposu.adb (Allocate_Any_Controlled): Rewrite the machinery which associates TSS primitive Finalize_Address with either the master itself or with the internal hash table depending on the mode of operation of the master. From-SVN: r178301 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 33ee4765a68..901c4eec923 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2011-08-30 Hristian Kirtchev + + * exp_ch3.adb (Expand_Freeze_Array_Type): Correct the call to + Build_Finalization_Master by supplying an insertion node and enclosing + scope. In its old version, the call did not generate a finalization + master. + (Expand_Freeze_Record_Type): Add local variable Has_AACC. Add code to + recognize anonymous access-to-controlled components. Rewrite the + machinery which creates finalization masters to service anonymous + access-to-controlled components of a record type. In its current state, + only one heterogeneous master is necessary to handle multiple anonymous + components. + (Freeze_Type): Comment reformatting. + * rtsfind.ads: Add RE_Set_Is_Heterogeneous to tables RE_Id and + RE_Unit_Table. + * s-stposu.adb (Allocate_Any_Controlled): Rewrite the machinery which + associates TSS primitive Finalize_Address with either the master itself + or with the internal hash table depending on the mode of operation of + the master. + 2011-08-30 Javier Miranda * exp_ch3.adb (Make_Eq_If): If the etype of the _parent component is an diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index b1d9b9c9e64..4af2ab6a074 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5522,14 +5522,18 @@ package body Exp_Ch3 is then Build_Slice_Assignment (Typ); end if; + end if; - -- ??? Now that masters acts as heterogeneous lists, it might be - -- worthwhile to revisit the global master approach. + -- Create a finalization master to service the anonymous access + -- components of the array. - elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type - and then Needs_Finalization (Directly_Designated_Type (Comp_Typ)) + if Ekind (Comp_Typ) = E_Anonymous_Access_Type + and then Needs_Finalization (Designated_Type (Comp_Typ)) then - Build_Finalization_Master (Comp_Typ); + Build_Finalization_Master + (Typ => Comp_Typ, + Ins_Node => Parent (Typ), + Encl_Scope => Scope (Typ)); end if; end if; @@ -5943,6 +5947,7 @@ package body Exp_Ch3 is Type_Decl : constant Node_Id := Parent (Def_Id); Comp : Entity_Id; Comp_Typ : Entity_Id; + Has_AACC : Boolean; Predef_List : List_Id; Renamed_Eq : Node_Id := Empty; @@ -6011,8 +6016,9 @@ package body Exp_Ch3 is -- Update task and controlled component flags, because some of the -- component types may have been private at the point of the record - -- declaration. + -- declaration. Detect anonymous access-to-controlled components. + Has_AACC := False; Comp := First_Component (Def_Id); while Present (Comp) loop Comp_Typ := Etype (Comp); @@ -6029,6 +6035,14 @@ package body Exp_Ch3 is and then Is_Controlled (Comp_Typ))) then Set_Has_Controlled_Component (Def_Id); + + -- Non self-referential anonymous access-to-controlled component + + elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type + and then Needs_Finalization (Designated_Type (Comp_Typ)) + and then Designated_Type (Comp_Typ) /= Def_Id + then + Has_AACC := True; end if; Next_Component (Comp); @@ -6396,28 +6410,103 @@ package body Exp_Ch3 is end; end if; - -- Processing for components of anonymous access type that designate - -- a controlled type. + -- Create a heterogeneous finalization master to service the anonymous + -- access-to-controlled components of the record type. - Comp := First_Component (Def_Id); - while Present (Comp) loop - Comp_Typ := Etype (Comp); + if Has_AACC then + declare + Encl_Scope : constant Entity_Id := Scope (Def_Id); + Ins_Node : constant Node_Id := Parent (Def_Id); + Loc : constant Source_Ptr := Sloc (Def_Id); + Fin_Mas_Id : Entity_Id; + + Attributes_Set : Boolean := False; + Master_Built : Boolean := False; + -- Two flags which control the creation and initialization of a + -- common heterogeneous master. + + begin + Comp := First_Component (Def_Id); + while Present (Comp) loop + Comp_Typ := Etype (Comp); - if Ekind (Comp_Typ) = E_Anonymous_Access_Type - and then Needs_Finalization (Directly_Designated_Type (Comp_Typ)) + -- A non self-referential anonymous access-to-controlled + -- component. - -- Avoid self-references + if Ekind (Comp_Typ) = E_Anonymous_Access_Type + and then Needs_Finalization (Designated_Type (Comp_Typ)) + and then Designated_Type (Comp_Typ) /= Def_Id + then + if VM_Target = No_VM then - and then Directly_Designated_Type (Comp_Typ) /= Def_Id - then - Build_Finalization_Master - (Typ => Comp_Typ, - Ins_Node => Parent (Def_Id), - Encl_Scope => Scope (Def_Id)); - end if; + -- Build a homogeneous master for the first anonymous + -- access-to-controlled component. This master may be + -- converted into a heterogeneous collection if more + -- components are to follow. - Next_Component (Comp); - end loop; + if not Master_Built then + Master_Built := True; + + -- All anonymous access-to-controlled types allocate + -- on the global pool. + + Set_Associated_Storage_Pool (Comp_Typ, + Get_Global_Pool_For_Access_Type (Comp_Typ)); + + Build_Finalization_Master + (Typ => Comp_Typ, + Ins_Node => Ins_Node, + Encl_Scope => Encl_Scope); + + Fin_Mas_Id := Finalization_Master (Comp_Typ); + + -- Subsequent anonymous access-to-controlled components + -- reuse the already available master. + + else + -- All anonymous access-to-controlled types allocate + -- on the global pool. + + Set_Associated_Storage_Pool (Comp_Typ, + Get_Global_Pool_For_Access_Type (Comp_Typ)); + + -- Shared the master among multiple components + + Set_Finalization_Master (Comp_Typ, Fin_Mas_Id); + + -- Convert the master into a heterogeneous collection. + -- Generate: + -- + -- Set_Is_Heterogeneous (); + + if not Attributes_Set then + Attributes_Set := True; + + Insert_Action (Ins_Node, + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To + (RTE (RE_Set_Is_Heterogeneous), Loc), + Parameter_Associations => New_List ( + New_Reference_To (Fin_Mas_Id, Loc)))); + end if; + end if; + + -- Since .NET/JVM targets do not support heterogeneous + -- masters, each component must have its own master. + + else + Build_Finalization_Master + (Typ => Comp_Typ, + Ins_Node => Ins_Node, + Encl_Scope => Encl_Scope); + end if; + end if; + + Next_Component (Comp); + end loop; + end; + end if; end Expand_Freeze_Record_Type; ------------------------------ @@ -6738,8 +6827,8 @@ package body Exp_Ch3 is then null; - -- The machinery assumes that incomplete or private types are - -- always completed by a controlled full vies. + -- Assume that incomplete and private types are always completed + -- by a controlled full view. elsif Needs_Finalization (Desig_Type) or else diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index d262e86cae1..be2bda7e774 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -803,6 +803,7 @@ package Rtsfind is RE_Finalization_Master_Ptr, -- System.Finalization_Masters RE_Set_Base_Pool, -- System.Finalization_Masters RE_Set_Finalize_Address, -- System.Finalization_Masters + RE_Set_Is_Heterogeneous, -- System.Finalization_Masters RE_Root_Controlled, -- System.Finalization_Root RE_Root_Controlled_Ptr, -- System.Finalization_Root @@ -1991,6 +1992,7 @@ package Rtsfind is RE_Finalization_Master_Ptr => System_Finalization_Masters, RE_Set_Base_Pool => System_Finalization_Masters, RE_Set_Finalize_Address => System_Finalization_Masters, + RE_Set_Is_Heterogeneous => System_Finalization_Masters, RE_Root_Controlled => System_Finalization_Root, RE_Root_Controlled_Ptr => System_Finalization_Root, diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb index 2b4e7fc4044..2bbc9ef6c2c 100644 --- a/gcc/ada/s-stposu.adb +++ b/gcc/ada/s-stposu.adb @@ -269,25 +269,25 @@ package body System.Storage_Pools.Subpools is Addr := N_Addr + Header_And_Padding; - -- Subpool allocations use heterogeneous masters to manage various - -- controlled objects. Associate a Finalize_Address with the object. - -- This relation pair is deleted when the object is deallocated or - -- when the associated master is finalized. - - if Is_Subpool_Allocation then - pragma Assert (not Master.Is_Homogeneous); - - Set_Finalize_Address (Addr, Fin_Address); - Finalize_Address_Table_In_Use := True; - - -- Normal allocations chain objects on homogeneous collections - - else - pragma Assert (Master.Is_Homogeneous); + -- Homogeneous masters service the following: + -- + -- 1) Allocations on / Deallocations from regular pools + -- 2) Named access types + -- 3) Most cases of anonymous access types usage + if Master.Is_Homogeneous then if Finalize_Address (Master.all) = null then Set_Finalize_Address (Master.all, Fin_Address); end if; + + -- Heterogeneous masters service the following: + -- + -- 1) Allocations on / Deallocations from subpools + -- 2) Certain cases of anonymous access types usage + + else + Set_Finalize_Address (Addr, Fin_Address); + Finalize_Address_Table_In_Use := True; end if; -- Non-controlled allocation