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;
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;
-- 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);
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);
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 (<Fin_Mas_Id>);
+
+ 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;
------------------------------
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
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
projects / gcc.git / commitdiff