@@ -596,7 +596,6 @@ GNATRTL_NONTASKING_OBJS= \
s-ficobl$(objext) \
s-filatt$(objext) \
s-fileio$(objext) \
- s-finmas$(objext) \
s-finpri$(objext) \
s-finroo$(objext) \
s-flocon$(objext) \
@@ -426,15 +426,14 @@ package Einfo is
-- definition clause with an (obsolescent) mod clause is converted
-- into an attribute definition clause for this purpose.
-
+-- Anonymous_Collections
-- Defined in packages, subprograms, and subprogram bodies. Contains a
+-- list of anonymous finalization collections declared in this unit.
+-- The list acts as a mapping between collections and designated types.
+
+-- Anonymous_Designated_Type
+-- Defined in entities that represent anonymous finalization collections.
+-- Contains the designated type that is being serviced by the collection.
-- Anonymous_Object
-- Present in protected and task type entities. Contains the entity of
@@ -1298,12 +1297,13 @@ package Einfo is
-- families. Returns first extra formal of the subprogram or entry.
-- Returns Empty if there are no extra formals.
+-- Finalization_Collection [root type only]
-- Defined in access-to-controlled or access-to-class-wide types. The
+-- field contains the entity of the finalization collection of a type,
+-- which is the set of objects created by allocators of the type, or
+-- of types derived from the type. Empty for access-to-object types
+-- whose designated type does not need finalization actions as well
+-- as for access-to-subprogram types.
-- Finalization_Master_Node
-- Defined in variables and constants that require finalization actions.
@@ -5139,8 +5139,8 @@ package Einfo is
-- Direct_Primitive_Operations $$$ type
-- Master_Id
-- Directly_Designated_Type
- -- Associated_Storage_Pool (base type only)
- -- Finalization_Master (base type only)
+ -- Associated_Storage_Pool (root type only)
+ -- Finalization_Collection (root type only)
-- Storage_Size_Variable (base type only)
-- Has_Pragma_Controlled (base type only)
-- Has_Storage_Size_Clause (base type only)
@@ -5173,7 +5173,7 @@ package Einfo is
-- E_Anonymous_Access_Type
-- Directly_Designated_Type
- -- Finalization_Master
+ -- Finalization_Collection
-- Storage_Size_Variable is this needed ???
-- Associated_Storage_Pool $$$
-- (plus type attributes)
@@ -5500,7 +5500,7 @@ package Einfo is
-- Overridden_Operation
-- Wrapped_Entity (non-generic case only)
-- Extra_Formals
- -- Anonymous_Masters (non-generic case only)
+ -- Anonymous_Collections (non-generic case only)
-- Corresponding_Equality (implicit /= only)
-- Thunk_Entity (thunk case only)
-- Corresponding_Procedure (generate C code only)
@@ -5585,7 +5585,7 @@ package Einfo is
-- Master_Id
-- Directly_Designated_Type
-- Associated_Storage_Pool (root type only)
- -- Finalization_Master (root type only)
+ -- Finalization_Collection (root type only)
-- Storage_Size_Variable (base type only)
-- (plus type attributes)
@@ -5764,7 +5764,7 @@ package Einfo is
-- Package_Instantiation
-- Current_Use_Clause
-- Finalizer (non-generic case only)
- -- Anonymous_Masters (non-generic case only)
+ -- Anonymous_Collections (non-generic case only)
-- Contract
-- SPARK_Pragma
-- SPARK_Aux_Pragma
@@ -5861,7 +5861,7 @@ package Einfo is
-- Overridden_Operation (never for init proc)
-- Wrapped_Entity (non-generic case only)
-- Extra_Formals
- -- Anonymous_Masters (non-generic case only)
+ -- Anonymous_Collections (non-generic case only)
-- Static_Initialization (init_proc only)
-- Thunk_Entity (thunk case only)
-- Corresponding_Function (generate C code only)
@@ -6085,7 +6085,7 @@ package Einfo is
-- Last_Entity
-- Scope_Depth_Value
-- Extra_Formals
- -- Anonymous_Masters
+ -- Anonymous_Collections
-- Contract
-- SPARK_Pragma
-- Contains_Ignored_Ghost_Code
@@ -322,7 +322,7 @@ package body Exp_Ch13 is
return;
end if;
- -- Use the base type to perform the check for finalization master
+ -- Use the base type to perform the check for finalization collection
Typ := Etype (Expr);
@@ -338,12 +338,11 @@ package body Exp_Ch13 is
Typ := Full_View (Typ);
end if;
- -- Do not create a custom Deallocate when freeing an object with
- -- suppressed finalization. In such cases the object is never attached
- -- to a master, so it does not need to be detached. Use a regular free
- -- statement instead.
+ -- Do not create a custom Deallocate when the object has not been
+ -- attached to a collection, since it does not need to be detached.
+ -- Use a regular free statement instead.
- if No (Finalization_Master (Typ)) then
+ if No (Finalization_Collection (Typ)) then
return;
end if;
@@ -6249,7 +6249,7 @@ package body Exp_Ch3 is
--
-- * Controlled case
--
- -- if BIPfinalizationmaster = null then
+ -- if BIPcollection = null then
-- Temp_Id := <Alloc_Expr>;
-- else
-- declare
@@ -6485,14 +6485,14 @@ package body Exp_Ch3 is
if Needs_Finalization (Ret_Typ) then
declare
- Decls : constant List_Id := New_List;
- Fin_Mas_Id : constant Entity_Id :=
- Build_In_Place_Formal (Func_Id, BIP_Finalization_Master);
- Orig_Expr : constant Node_Id := New_Copy_Tree (Alloc_Expr);
- Stmts : constant List_Id := New_List;
- Local_Id : Entity_Id;
- Pool_Id : Entity_Id;
- Ptr_Typ : Entity_Id;
+ Decls : constant List_Id := New_List;
+ Fin_Coll_Id : constant Entity_Id :=
+ Build_In_Place_Formal (Func_Id, BIP_Collection);
+ Orig_Expr : constant Node_Id := New_Copy_Tree (Alloc_Expr);
+ Stmts : constant List_Id := New_List;
+ Local_Id : Entity_Id;
+ Pool_Id : Entity_Id;
+ Ptr_Typ : Entity_Id;
begin
-- Generate:
@@ -6519,8 +6519,8 @@ package body Exp_Ch3 is
end if;
-- Create an access type which uses the storage pool of the
- -- caller's master. This additional type is necessary because
- -- the finalization master cannot be associated with the type
+ -- caller. This additional type is necessary because the
+ -- finalization collection cannot be associated with the type
-- of the temporary. Otherwise the secondary stack allocation
-- will fail.
@@ -6537,11 +6537,11 @@ package body Exp_Ch3 is
Subtype_Indication =>
New_Occurrence_Of (Ret_Typ, Loc))));
- -- Perform minor decoration in order to set the master and the
- -- storage pool attributes.
+ -- Perform minor decoration in order to set the collection and
+ -- the storage pool attributes.
Mutate_Ekind (Ptr_Typ, E_Access_Type);
- Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
+ Set_Finalization_Collection (Ptr_Typ, Fin_Coll_Id);
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
-- Create the temporary, generate:
@@ -6574,10 +6574,10 @@ package body Exp_Ch3 is
New_Occurrence_Of (Local_Id, Loc))));
-- Wrap the allocation in a block to make it conditioned by the
- -- presence of the caller's finalization master at run time.
+ -- presence of the caller's collection at run time.
-- Generate:
- -- if BIPfinalizationmaster = null then
+ -- if BIPcollection = null then
-- Temp_Id := <Orig_Expr>;
-- else
-- declare
@@ -6591,7 +6591,7 @@ package body Exp_Ch3 is
Make_If_Statement (Loc,
Condition =>
Make_Op_Eq (Loc,
- Left_Opnd => New_Occurrence_Of (Fin_Mas_Id, Loc),
+ Left_Opnd => New_Occurrence_Of (Fin_Coll_Id, Loc),
Right_Opnd => Make_Null (Loc)),
Then_Statements => New_List (
@@ -9608,22 +9608,22 @@ package body Exp_Ch3 is
then
null;
- -- Create a finalization master for an access-to-controlled type
- -- or an access-to-incomplete type. It is assumed that the full
- -- view will be controlled.
+ -- Create a finalization collection for an access-to-controlled
+ -- type or an access-to-incomplete type. It is assumed that the
+ -- full view will be controlled.
elsif Needs_Finalization (Desig_Type)
or else (Is_Incomplete_Type (Desig_Type)
and then No (Full_View (Desig_Type)))
then
- Build_Finalization_Master (Def_Id);
+ Build_Finalization_Collection (Def_Id);
- -- Create a finalization master when the designated type contains
- -- a private component. It is assumed that the full view will be
- -- controlled.
+ -- Also create a finalization collection when the designated type
+ -- contains a private component. It is assumed that the full view
+ -- will be controlled.
elsif Has_Private_Component (Desig_Type) then
- Build_Finalization_Master
+ Build_Finalization_Collection
(Typ => Def_Id,
For_Private => True,
Context_Scope => Scope (Def_Id),
@@ -12754,10 +12754,6 @@ package body Exp_Ch3 is
-- derived from a private view of the abstract type that doesn't have
-- a visible Input).
- -- Do not generate stream routines for type Finalization_Master because
- -- a master may never appear in types and therefore cannot be read or
- -- written.
-
return
(not Is_Limited_Type (Typ)
or else Is_Interface (Typ)
@@ -12774,8 +12770,7 @@ package body Exp_Ch3 is
and then not No_Run_Time_Mode
and then RTE_Available (RE_Tag)
and then No (Type_Without_Stream_Operation (Typ))
- and then RTE_Available (RE_Root_Stream_Type)
- and then not Is_RTE (Typ, RE_Finalization_Master);
+ and then RTE_Available (RE_Root_Stream_Type);
end Stream_Operation_OK;
end Exp_Ch3;
@@ -818,8 +818,8 @@ package body Exp_Ch4 is
-- Inherit the allocation-related attributes from the original
-- access type.
- Set_Finalization_Master
- (Def_Id, Finalization_Master (PtrT));
+ Set_Finalization_Collection
+ (Def_Id, Finalization_Collection (PtrT));
Set_Associated_Storage_Pool
(Def_Id, Associated_Storage_Pool (PtrT));
@@ -4315,13 +4315,14 @@ package body Exp_Ch4 is
Validate_Remote_Access_To_Class_Wide_Type (N);
-- Processing for anonymous access-to-controlled types. These access
- -- types receive a special finalization master which appears in the
+ -- types receive a special finalization collection which appears in the
-- declarations of the enclosing semantic unit. This expansion is done
-- now to ensure that any additional types generated by this routine or
-- Expand_Allocator_Expression inherit the proper type attributes.
if (Ekind (PtrT) = E_Anonymous_Access_Type
- or else (Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
+ or else (Is_Itype (PtrT)
+ and then No (Finalization_Collection (PtrT))))
and then Needs_Finalization (Dtyp)
then
-- Detect the allocation of an anonymous controlled object where the
@@ -4358,16 +4359,16 @@ package body Exp_Ch4 is
end if;
end if;
- -- The finalization master must be inserted and analyzed as part of
- -- the current semantic unit. Note that the master is updated when
- -- analysis changes current units. Note that this is a "root type
- -- only" attribute.
+ -- The finalization collection must be inserted and analyzed as part
+ -- of the current semantic unit. Note that the collection is updated
+ -- when analysis changes current units. Note that this is a root type
+ -- attribute.
if Present (Rel_Typ) then
- Set_Finalization_Master
- (Root_Type (PtrT), Finalization_Master (Rel_Typ));
+ Set_Finalization_Collection
+ (Root_Type (PtrT), Finalization_Collection (Rel_Typ));
else
- Build_Anonymous_Master (Root_Type (PtrT));
+ Build_Anonymous_Collection (Root_Type (PtrT));
end if;
end if;
@@ -4669,7 +4670,7 @@ package body Exp_Ch4 is
-- Even though this might be a simple allocation, create a custom
-- Allocate if the context requires it.
- if Present (Finalization_Master (PtrT)) then
+ if Present (Finalization_Collection (PtrT)) then
Build_Allocate_Deallocate_Proc
(N => N,
Is_Allocate => True);
@@ -128,12 +128,12 @@ package body Exp_Ch6 is
-- Suffixes for Build-In-Place extra formals
- BIP_Alloc_Suffix : constant String := "BIPalloc";
- BIP_Storage_Pool_Suffix : constant String := "BIPstoragepool";
- BIP_Finalization_Master_Suffix : constant String := "BIPfinalizationmaster";
- BIP_Task_Master_Suffix : constant String := "BIPtaskmaster";
- BIP_Activation_Chain_Suffix : constant String := "BIPactivationchain";
- BIP_Object_Access_Suffix : constant String := "BIPaccess";
+ BIP_Alloc_Suffix : constant String := "BIPalloc";
+ BIP_Storage_Pool_Suffix : constant String := "BIPstoragepool";
+ BIP_Collection_Suffix : constant String := "BIPcollection";
+ BIP_Task_Master_Suffix : constant String := "BIPtaskmaster";
+ BIP_Activation_Chain_Suffix : constant String := "BIPactivationchain";
+ BIP_Object_Access_Suffix : constant String := "BIPaccess";
-----------------------
-- Local Subprograms --
@@ -165,16 +165,16 @@ package body Exp_Ch6 is
-- (which must not be Unspecified in that case). If Pool_Exp is present,
-- then use it for BIP_Storage_Pool, otherwise pass "null".
- procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Function_Call : Node_Id;
- Function_Id : Entity_Id;
- Ptr_Typ : Entity_Id := Empty;
- Master_Exp : Node_Id := Empty);
+ procedure Add_Collection_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Ptr_Typ : Entity_Id := Empty;
+ Collection_Exp : Node_Id := Empty);
-- Ada 2005 (AI-318-02): If the result type of a build-in-place call needs
-- finalization actions, add an actual parameter which is a pointer to the
- -- finalization master of the caller. If Master_Exp is present, then that
- -- will be passed as the actual. Otherwise, if Ptr_Typ is left Empty, this
- -- will result in an automatic "null" value for the actual.
+ -- collection of the access type used by the caller. If Collection_Exp is
+ -- present, then that will be passed as the actual. Otherwise, if Ptr_Typ
+ -- is Empty, this will result in an automatic "null" value for the actual.
procedure Add_Task_Actuals_To_Build_In_Place_Call
(Function_Call : Node_Id;
@@ -484,15 +484,15 @@ package body Exp_Ch6 is
end if;
end Add_Unconstrained_Actuals_To_Build_In_Place_Call;
- -----------------------------------------------------------
- -- Add_Finalization_Master_Actual_To_Build_In_Place_Call --
- -----------------------------------------------------------
+ --------------------------------------------------
+ -- Add_Collection_Actual_To_Build_In_Place_Call --
+ --------------------------------------------------
- procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Function_Call : Node_Id;
- Function_Id : Entity_Id;
- Ptr_Typ : Entity_Id := Empty;
- Master_Exp : Node_Id := Empty)
+ procedure Add_Collection_Actual_To_Build_In_Place_Call
+ (Function_Call : Node_Id;
+ Function_Id : Entity_Id;
+ Ptr_Typ : Entity_Id := Empty;
+ Collection_Exp : Node_Id := Empty)
is
Loc : constant Source_Ptr := Sloc (Function_Call);
@@ -501,20 +501,20 @@ package body Exp_Ch6 is
Desig_Typ : Entity_Id;
begin
- if not Needs_BIP_Finalization_Master (Function_Id) then
+ if not Needs_BIP_Collection (Function_Id) then
return;
end if;
- Formal := Build_In_Place_Formal (Function_Id, BIP_Finalization_Master);
+ Formal := Build_In_Place_Formal (Function_Id, BIP_Collection);
- -- If there is a finalization master actual, such as the implicit
- -- finalization master of an enclosing build-in-place function,
+ -- If there is a finalization collection actual, such as the implicit
+ -- finalization collection of an enclosing build-in-place function,
-- then this must be added as an extra actual of the call.
- if Present (Master_Exp) then
- Actual := Master_Exp;
+ if Present (Collection_Exp) then
+ Actual := Collection_Exp;
- -- Case where the context does not require an actual master
+ -- Case where the context does not require an actual collection
elsif No (Ptr_Typ) then
Actual := Make_Null (Loc);
@@ -524,8 +524,8 @@ package body Exp_Ch6 is
-- Check for a library-level access type whose designated type has
-- suppressed finalization or the access type is subject to pragma
- -- No_Heap_Finalization. Such an access type lacks a master. Pass
- -- a null actual to callee in order to signal a missing master.
+ -- No_Heap_Finalization. Such an access type lacks a collection. Pass
+ -- a null actual to callee in order to signal a missing collection.
if Is_Library_Level_Entity (Ptr_Typ)
and then (Finalize_Storage_Only (Desig_Typ)
@@ -537,25 +537,25 @@ package body Exp_Ch6 is
elsif Needs_Finalization (Desig_Typ) then
- -- The general mechanism of creating finalization masters for
- -- anonymous access types is disabled by default, otherwise
- -- finalization masters will pop all over the place. Such types
- -- use context-specific masters.
+ -- The general mechanism of creating finalization collections
+ -- for anonymous access types is disabled by default, otherwise
+ -- finalization collections will pop all over the place. Instead
+ -- such types use context-specific collections.
if Ekind (Ptr_Typ) = E_Anonymous_Access_Type
- and then No (Finalization_Master (Ptr_Typ))
+ and then No (Finalization_Collection (Ptr_Typ))
then
- Build_Anonymous_Master (Ptr_Typ);
+ Build_Anonymous_Collection (Ptr_Typ);
end if;
- -- Access-to-controlled types should always have a master
+ -- Access-to-controlled types should always have a collection
- pragma Assert (Present (Finalization_Master (Ptr_Typ)));
+ pragma Assert (Present (Finalization_Collection (Ptr_Typ)));
Actual :=
Make_Attribute_Reference (Loc,
Prefix =>
- New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc),
+ New_Occurrence_Of (Finalization_Collection (Ptr_Typ), Loc),
Attribute_Name => Name_Unrestricted_Access);
-- Tagged types
@@ -571,7 +571,7 @@ package body Exp_Ch6 is
-- the end of the function's actuals.
Add_Extra_Actual_To_Call (Function_Call, Formal, Actual);
- end Add_Finalization_Master_Actual_To_Build_In_Place_Call;
+ end Add_Collection_Actual_To_Build_In_Place_Call;
------------------------------
-- Add_Extra_Actual_To_Call --
@@ -851,8 +851,8 @@ package body Exp_Ch6 is
when BIP_Storage_Pool =>
return BIP_Storage_Pool_Suffix;
- when BIP_Finalization_Master =>
- return BIP_Finalization_Master_Suffix;
+ when BIP_Collection =>
+ return BIP_Collection_Suffix;
when BIP_Task_Master =>
return BIP_Task_Master_Suffix;
@@ -891,8 +891,8 @@ package body Exp_Ch6 is
elsif Has_Suffix (BIP_Storage_Pool_Suffix) then
return BIP_Storage_Pool;
- elsif Has_Suffix (BIP_Finalization_Master_Suffix) then
- return BIP_Finalization_Master;
+ elsif Has_Suffix (BIP_Collection_Suffix) then
+ return BIP_Collection;
elsif Has_Suffix (BIP_Task_Master_Suffix) then
return BIP_Task_Master;
@@ -3361,7 +3361,7 @@ package body Exp_Ch6 is
Analyze_And_Resolve (Actual, Standard_Integer);
Add_Extra_Actual_To_Call (N, Formal, Actual);
- -- BIPstoragepool, BIPfinalizationmaster, BIPactivationchain,
+ -- BIPstoragepool, BIPcollection, BIPactivationchain,
-- and BIPaccess.
elsif Is_Access_Type (Etype (Formal)) then
@@ -7973,7 +7973,7 @@ package body Exp_Ch6 is
begin
return Has_Suffix (BIP_Alloc_Suffix)
or else Has_Suffix (BIP_Storage_Pool_Suffix)
- or else Has_Suffix (BIP_Finalization_Master_Suffix)
+ or else Has_Suffix (BIP_Collection_Suffix)
or else Has_Suffix (BIP_Task_Master_Suffix)
or else Has_Suffix (BIP_Activation_Chain_Suffix)
or else Has_Suffix (BIP_Object_Access_Suffix);
@@ -8348,11 +8348,11 @@ package body Exp_Ch6 is
--
-- Even though the size of limited controlled type Lim_Ctrl is known,
-- allocating Obj at the caller side will chain Obj on Lim_Ctrl_Ptr's
- -- finalization master. The subsequent call to Make_Lim_Ctrl will fail
- -- during the initialization actions for Result, which implies that
+ -- finalization collection. The subsequent call to Make_Lim_Ctrl will
+ -- fail during the initialization actions for Result, which means that
-- Result (and Obj by extension) should not be finalized. However Obj
-- will be finalized when access type Lim_Ctrl_Ptr goes out of scope
- -- since it is already attached on the related finalization master.
+ -- since it is already attached on the its finalization collection.
if Needs_BIP_Alloc_Form (Function_Id) then
Temp_Init := Empty;
@@ -8373,9 +8373,9 @@ package body Exp_Ch6 is
-- No user-defined pool; pass an allocation parameter indicating that
-- the function should allocate its result on the heap. When there is
- -- a finalization master, a pool reference is required.
+ -- a finalization collection, a pool reference is required.
- elsif Needs_BIP_Finalization_Master (Function_Id) then
+ elsif Needs_BIP_Collection (Function_Id) then
Alloc_Form := Global_Heap;
Pool_Actual :=
Make_Attribute_Reference (Loc,
@@ -8515,7 +8515,7 @@ package body Exp_Ch6 is
Alloc_Form => Alloc_Form,
Pool_Exp => Pool_Actual);
- Add_Finalization_Master_Actual_To_Build_In_Place_Call
+ Add_Collection_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Ptr_Typ => Acc_Type);
Add_Task_Actuals_To_Build_In_Place_Call
@@ -8650,7 +8650,7 @@ package body Exp_Ch6 is
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
- Add_Finalization_Master_Actual_To_Build_In_Place_Call
+ Add_Collection_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id);
Add_Task_Actuals_To_Build_In_Place_Call
@@ -8677,7 +8677,7 @@ package body Exp_Ch6 is
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
- Add_Finalization_Master_Actual_To_Build_In_Place_Call
+ Add_Collection_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id);
Add_Task_Actuals_To_Build_In_Place_Call
@@ -8742,7 +8742,7 @@ package body Exp_Ch6 is
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Func_Id, Alloc_Form => Caller_Allocation);
- Add_Finalization_Master_Actual_To_Build_In_Place_Call
+ Add_Collection_Actual_To_Build_In_Place_Call
(Func_Call, Func_Id);
Add_Task_Actuals_To_Build_In_Place_Call
@@ -8833,16 +8833,16 @@ package body Exp_Ch6 is
Encl_Func : constant Entity_Id := Enclosing_Subprogram (Obj_Def_Id);
Result_Subt : constant Entity_Id := Etype (Function_Id);
- Call_Deref : Node_Id;
- Caller_Object : Node_Id;
- Def_Id : Entity_Id;
- Designated_Type : Entity_Id;
- Master_Actual : Node_Id := Empty;
- Pool_Actual : Node_Id;
- Ptr_Typ : Entity_Id;
- Ptr_Typ_Decl : Node_Id;
- Pass_Caller_Acc : Boolean := False;
- Res_Decl : Node_Id;
+ Call_Deref : Node_Id;
+ Caller_Object : Node_Id;
+ Collection_Actual : Node_Id := Empty;
+ Def_Id : Entity_Id;
+ Designated_Type : Entity_Id;
+ Pool_Actual : Node_Id;
+ Ptr_Typ : Entity_Id;
+ Ptr_Typ_Decl : Node_Id;
+ Pass_Caller_Acc : Boolean := False;
+ Res_Decl : Node_Id;
Definite : constant Boolean :=
Caller_Known_Size (Func_Call, Result_Subt)
@@ -9029,11 +9029,11 @@ package body Exp_Ch6 is
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
end if;
- if Needs_BIP_Finalization_Master (Encl_Func) then
- Master_Actual :=
+ if Needs_BIP_Collection (Encl_Func) then
+ Collection_Actual :=
New_Occurrence_Of
(Build_In_Place_Formal
- (Encl_Func, BIP_Finalization_Master), Loc);
+ (Encl_Func, BIP_Collection), Loc);
end if;
-- Retrieve the BIPacc formal from the enclosing function and convert
@@ -9071,20 +9071,20 @@ package body Exp_Ch6 is
elsif Is_Library_Level_Entity (Obj_Def_Id)
and then not Restriction_Active (No_Implicit_Heap_Allocations)
then
- -- Create a finalization master for the access result type to ensure
- -- that the heap allocation can properly chain the object and later
- -- finalize it when the library unit goes out of scope.
+ -- Create a finalization collection for the access result type to
+ -- ensure that the heap allocation can properly chain the object
+ -- and later finalize it when the library unit goes out of scope.
- if Needs_BIP_Finalization_Master (Func_Call) then
- Build_Finalization_Master
+ if Needs_BIP_Collection (Func_Call) then
+ Build_Finalization_Collection
(Typ => Ptr_Typ,
For_Lib_Level => True,
Insertion_Node => Ptr_Typ_Decl);
- Master_Actual :=
+ Collection_Actual :=
Make_Attribute_Reference (Loc,
Prefix =>
- New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc),
+ New_Occurrence_Of (Finalization_Collection (Ptr_Typ), Loc),
Attribute_Name => Name_Unrestricted_Access);
Pool_Actual :=
@@ -9117,12 +9117,12 @@ package body Exp_Ch6 is
Establish_Transient_Scope (Obj_Decl, Manage_Sec_Stack => True);
end if;
- -- Pass along any finalization master actual, which is needed in the
- -- case where the called function initializes a return object of an
- -- enclosing build-in-place function.
+ -- Pass along any finalization collection actual, which is needed in
+ -- the case where the called function initializes a return object of
+ -- an enclosing build-in-place function.
- Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Func_Call, Function_Id, Master_Exp => Master_Actual);
+ Add_Collection_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Collection_Exp => Collection_Actual);
if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
and then Needs_BIP_Task_Actuals (Function_Id)
@@ -9625,16 +9625,15 @@ package body Exp_Ch6 is
end if;
end Needs_BIP_Task_Actuals;
- -----------------------------------
- -- Needs_BIP_Finalization_Master --
- -----------------------------------
+ --------------------------
+ -- Needs_BIP_Collection --
+ --------------------------
- function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean
- is
+ function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
- -- A formal giving the finalization master is needed for build-in-place
+ -- A formal for the finalization collection is needed for build-in-place
-- functions whose result type needs finalization or is a tagged type.
-- Tagged primitive build-in-place functions need such a formal because
-- they can be called by a dispatching call, and extensions may require
@@ -9647,7 +9646,7 @@ package body Exp_Ch6 is
return not Restriction_Active (No_Finalization)
and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ))
and then not Has_Foreign_Convention (Typ);
- end Needs_BIP_Finalization_Master;
+ end Needs_BIP_Collection;
--------------------------
-- Needs_BIP_Alloc_Form --
@@ -9659,7 +9658,7 @@ package body Exp_Ch6 is
begin
-- See Make_Build_In_Place_Call_In_Allocator for the rationale
- if Needs_BIP_Finalization_Master (Func_Id) then
+ if Needs_BIP_Collection (Func_Id) then
return True;
end if;
@@ -76,9 +76,9 @@ package Exp_Ch6 is
-- is a pointer to the pool (of type Root_Storage_Pool_Ptr); otherwise
-- this is null. Also present if result type needs finalization.
- BIP_Finalization_Master,
- -- Present if result type needs finalization. Pointer to caller's
- -- finalization master.
+ BIP_Collection,
+ -- Present if result type needs finalization. Pointer to the collection
+ -- of the access type used by the caller.
BIP_Task_Master,
-- Present if result type contains tasks. Master associated with
@@ -287,7 +287,7 @@ package Exp_Ch6 is
-- Ada 2005 (AI-318-02): Return True if the function needs an implicit
-- BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
- function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
+ function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Return True if the result subtype of function
-- Func_Id might need finalization actions. This includes build-in-place
-- functions with tagged result types, since they can be invoked via
@@ -297,8 +297,8 @@ package body Exp_Ch7 is
Finalize_Case => TSS_Deep_Finalize,
Address_Case => TSS_Finalize_Address);
- function Allows_Finalization_Master (Typ : Entity_Id) return Boolean;
- -- Determine whether access type Typ may have a finalization master
+ function Allows_Finalization_Collection (Typ : Entity_Id) return Boolean;
+ -- Determine whether access type Typ may have a finalization collection
procedure Build_Array_Deep_Procs (Typ : Entity_Id);
-- Build the deep Initialize/Adjust/Finalize for a record Typ with
@@ -591,7 +591,7 @@ package body Exp_Ch7 is
-- cleanup code:
--
-- if BIPallocform > Secondary_Stack'Pos
- -- and then BIPfinalizationmaster /= null
+ -- and then BIPcollection /= null
-- then
-- declare
-- type Ptr_Typ is access Fun_Typ;
@@ -612,12 +612,12 @@ package body Exp_Ch7 is
(Func_Id : Entity_Id;
Obj_Addr : Node_Id) return Node_Id
is
- Alloc_Id : constant Entity_Id :=
+ Alloc_Id : constant Entity_Id :=
Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
- Decls : constant List_Id := New_List;
- Fin_Mas_Id : constant Entity_Id :=
- Build_In_Place_Formal (Func_Id, BIP_Finalization_Master);
- Func_Typ : constant Entity_Id := Etype (Func_Id);
+ Decls : constant List_Id := New_List;
+ Fin_Coll_Id : constant Entity_Id :=
+ Build_In_Place_Formal (Func_Id, BIP_Collection);
+ Func_Typ : constant Entity_Id := Etype (Func_Id);
Cond : Node_Id;
Free_Blk : Node_Id;
@@ -654,8 +654,7 @@ package body Exp_Ch7 is
Pool_Id := Empty;
end if;
- -- Create an access type which uses the storage pool of the
- -- caller's finalization master.
+ -- Create an access type which uses the storage pool of the caller
-- Generate:
-- type Ptr_Typ is access Func_Typ;
@@ -669,11 +668,11 @@ package body Exp_Ch7 is
Make_Access_To_Object_Definition (Loc,
Subtype_Indication => New_Occurrence_Of (Func_Typ, Loc))));
- -- Perform minor decoration in order to set the master and the
+ -- Perform minor decoration in order to set the collection and the
-- storage pool attributes.
Mutate_Ekind (Ptr_Typ, E_Access_Type);
- Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
+ Set_Finalization_Collection (Ptr_Typ, Fin_Coll_Id);
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
-- Create an explicit free statement. Note that the free uses the
@@ -705,7 +704,7 @@ package body Exp_Ch7 is
-- Generate:
-- if BIPallocform > Secondary_Stack'Pos
- -- and then BIPfinalizationmaster /= null
+ -- and then BIPcollection /= null
-- then
Cond :=
@@ -718,7 +717,7 @@ package body Exp_Ch7 is
UI_From_Int (BIP_Allocation_Form'Pos (Secondary_Stack)))),
Right_Opnd =>
Make_Op_Ne (Loc,
- Left_Opnd => New_Occurrence_Of (Fin_Mas_Id, Loc),
+ Left_Opnd => New_Occurrence_Of (Fin_Coll_Id, Loc),
Right_Opnd => Make_Null (Loc)));
-- Generate:
@@ -784,12 +783,12 @@ package body Exp_Ch7 is
-- If we are dealing with a return object of a build-in-place function
-- and its allocation has been done in the function, we additionally
- -- need to detach it from the caller's finalization master in order to
- -- prevent double finalization.
+ -- need to detach it from the caller's finalization collection in order
+ -- to prevent double finalization.
if Present (Func_Id)
and then Is_Build_In_Place_Function (Func_Id)
- and then Needs_BIP_Finalization_Master (Func_Id)
+ and then Needs_BIP_Collection (Func_Id)
then
declare
Ptr_Typ : constant Node_Id := Make_Temporary (Loc, 'P');
@@ -869,11 +868,11 @@ package body Exp_Ch7 is
(Master_Node_Ins, Master_Node_Attach, Suppress => All_Checks);
end Attach_Object_To_Master_Node;
- --------------------------------
- -- Allows_Finalization_Master --
- --------------------------------
+ ------------------------------------
+ -- Allows_Finalization_Collection --
+ ------------------------------------
- function Allows_Finalization_Master (Typ : Entity_Id) return Boolean is
+ function Allows_Finalization_Collection (Typ : Entity_Id) return Boolean is
function In_Deallocation_Instance (E : Entity_Id) return Boolean;
-- Determine whether entity E is inside a wrapper package created for
-- an instance of Ada.Unchecked_Deallocation.
@@ -909,11 +908,11 @@ package body Exp_Ch7 is
Ptr_Typ : constant Entity_Id :=
Root_Type_Of_Full_View (Base_Type (Typ));
- -- Start of processing for Allows_Finalization_Master
+ -- Start of processing for Allows_Finalization_Collection
begin
-- Certain run-time configurations and targets do not provide support
- -- for controlled types and therefore do not need masters.
+ -- for controlled types and therefore do not need collections.
if Restriction_Active (No_Finalization) then
return False;
@@ -946,8 +945,8 @@ package body Exp_Ch7 is
return False;
-- Do not consider a non-library access type when No_Nested_Finalization
- -- is in effect since finalization masters are controlled objects and if
- -- created will violate the restriction.
+ -- is in effect, because finalization collections are controlled objects
+ -- and, if created, will violate the restriction.
elsif Restriction_Active (No_Nested_Finalization)
and then not Is_Library_Level_Entity (Ptr_Typ)
@@ -961,68 +960,68 @@ package body Exp_Ch7 is
elsif No_Heap_Finalization (Ptr_Typ) then
return False;
- -- Do not create finalization masters in GNATprove mode because this
- -- causes unwanted extra expansion. A compilation in this mode must
+ -- Do not create finalization collections in GNATprove mode because this
+ -- causes unwanted extra expansion. Compilation in this mode must always
-- keep the tree as close as possible to the original sources.
elsif GNATprove_Mode then
return False;
- -- Otherwise the access type may use a finalization master
+ -- Otherwise the access type may use a finalization collection
else
return True;
end if;
- end Allows_Finalization_Master;
+ end Allows_Finalization_Collection;
- ----------------------------
- -- Build_Anonymous_Master --
- ----------------------------
+ --------------------------------
+ -- Build_Anonymous_Collection --
+ --------------------------------
- procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id) is
- function Create_Anonymous_Master
+ procedure Build_Anonymous_Collection (Ptr_Typ : Entity_Id) is
+ function Create_Anonymous_Collection
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id;
Unit_Decl : Node_Id) return Entity_Id;
- -- Create a new anonymous master for access type Ptr_Typ with designated
- -- type Desig_Typ. The declaration of the master and its initialization
- -- are inserted in the declarative part of unit Unit_Decl. Unit_Id is
- -- the entity of Unit_Decl.
+ -- Create a new anonymous collection for access type Ptr_Typ with
+ -- designated type Desig_Typ. The declaration of the collection and
+ -- its initialization are inserted in the declarative part of unit
+ -- Unit_Decl. Unit_Id is the entity of Unit_Decl.
- function Current_Anonymous_Master
+ function Current_Anonymous_Collection
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id) return Entity_Id;
- -- Find an anonymous master declared within unit Unit_Id which services
- -- designated type Desig_Typ. If there is no such master, return Empty.
+ -- Find an anonymous collection declared in unit Unit_Id which services
+ -- designated type Desig_Typ. If there is none, return Empty.
- -----------------------------
- -- Create_Anonymous_Master --
- -----------------------------
+ ---------------------------------
+ -- Create_Anonymous_Collection --
+ ---------------------------------
- function Create_Anonymous_Master
+ function Create_Anonymous_Collection
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id;
Unit_Decl : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (Unit_Id);
- All_FMs : Elist_Id;
+ All_FCs : Elist_Id;
Decls : List_Id;
- FM_Decl : Node_Id;
- FM_Id : Entity_Id;
+ FC_Decl : Node_Id;
+ FC_Id : Entity_Id;
Unit_Spec : Node_Id;
begin
-- Generate:
- -- <FM_Id> : Finalization_Master;
+ -- <FC_Id> : Finalization_Collection;
- FM_Id := Make_Temporary (Loc, 'A');
+ FC_Id := Make_Temporary (Loc, 'A');
- FM_Decl :=
+ FC_Decl :=
Make_Object_Declaration (Loc,
- Defining_Identifier => FM_Id,
+ Defining_Identifier => FC_Id,
Object_Definition =>
- New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+ New_Occurrence_Of (RTE (RE_Finalization_Collection), Loc));
-- Find the declarative list of the unit
@@ -1043,8 +1042,8 @@ package body Exp_Ch7 is
-- procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
- -- There is no suitable place to create the master as the subprogram
- -- is not in a declarative list.
+ -- There is no suitable place to create the collection because the
+ -- subprogram is not in a declarative list.
else
Decls := Declarations (Unit_Decl);
@@ -1055,89 +1054,89 @@ package body Exp_Ch7 is
end if;
end if;
- Prepend_To (Decls, FM_Decl);
+ Prepend_To (Decls, FC_Decl);
-- Use the scope of the unit when analyzing the declaration of the
- -- master and its initialization actions.
+ -- collection and its initialization actions.
Push_Scope (Unit_Id);
- Analyze (FM_Decl);
+ Analyze (FC_Decl);
Pop_Scope;
- -- Mark the master as servicing this specific designated type
+ -- Mark the collection as servicing this specific designated type
- Set_Anonymous_Designated_Type (FM_Id, Desig_Typ);
+ Set_Anonymous_Designated_Type (FC_Id, Desig_Typ);
- -- Include the anonymous master in the list of existing masters which
- -- appear in this unit. This effectively creates a mapping between a
- -- master and a designated type which in turn allows for the reuse of
- -- masters on a per-unit basis.
+ -- Include it in the list of existing anonymous collections which
+ -- appear in this unit. This effectively creates a mapping between
+ -- collections and designated types, which in turn allows for the
+ -- reuse of collections on a per-unit basis.
- All_FMs := Anonymous_Masters (Unit_Id);
+ All_FCs := Anonymous_Collections (Unit_Id);
- if No (All_FMs) then
- All_FMs := New_Elmt_List;
- Set_Anonymous_Masters (Unit_Id, All_FMs);
+ if No (All_FCs) then
+ All_FCs := New_Elmt_List;
+ Set_Anonymous_Collections (Unit_Id, All_FCs);
end if;
- Prepend_Elmt (FM_Id, All_FMs);
+ Prepend_Elmt (FC_Id, All_FCs);
- return FM_Id;
- end Create_Anonymous_Master;
+ return FC_Id;
+ end Create_Anonymous_Collection;
- ------------------------------
- -- Current_Anonymous_Master --
- ------------------------------
+ ----------------------------------
+ -- Current_Anonymous_Collection --
+ ----------------------------------
- function Current_Anonymous_Master
+ function Current_Anonymous_Collection
(Desig_Typ : Entity_Id;
Unit_Id : Entity_Id) return Entity_Id
is
- All_FMs : constant Elist_Id := Anonymous_Masters (Unit_Id);
- FM_Elmt : Elmt_Id;
- FM_Id : Entity_Id;
+ All_FCs : constant Elist_Id := Anonymous_Collections (Unit_Id);
+ FC_Elmt : Elmt_Id;
+ FC_Id : Entity_Id;
begin
- -- Inspect the list of anonymous masters declared within the unit
- -- looking for an existing master which services the same designated
+ -- Inspect the list of anonymous collections declared within the unit
+ -- looking for an existing collection which services the designated
-- type.
- if Present (All_FMs) then
- FM_Elmt := First_Elmt (All_FMs);
- while Present (FM_Elmt) loop
- FM_Id := Node (FM_Elmt);
+ if Present (All_FCs) then
+ FC_Elmt := First_Elmt (All_FCs);
+ while Present (FC_Elmt) loop
+ FC_Id := Node (FC_Elmt);
- -- The currect master services the same designated type. As a
- -- result the master can be reused and associated with another
- -- anonymous access-to-controlled type.
+ -- The current collection services the same designated type.
+ -- As a result, the collection can be reused and associated
+ -- with another anonymous access-to-controlled type.
- if Anonymous_Designated_Type (FM_Id) = Desig_Typ then
- return FM_Id;
+ if Anonymous_Designated_Type (FC_Id) = Desig_Typ then
+ return FC_Id;
end if;
- Next_Elmt (FM_Elmt);
+ Next_Elmt (FC_Elmt);
end loop;
end if;
return Empty;
- end Current_Anonymous_Master;
+ end Current_Anonymous_Collection;
-- Local variables
Desig_Typ : Entity_Id;
- FM_Id : Entity_Id;
+ FC_Id : Entity_Id;
Priv_View : Entity_Id;
Scop : Entity_Id;
Unit_Decl : Node_Id;
Unit_Id : Entity_Id;
- -- Start of processing for Build_Anonymous_Master
+ -- Start of processing for Build_Anonymous_Collection
begin
-- Nothing to do if the circumstances do not allow for a finalization
- -- master.
+ -- collection.
- if not Allows_Finalization_Master (Ptr_Typ) then
+ if not Allows_Finalization_Collection (Ptr_Typ) then
return;
end if;
@@ -1145,8 +1144,8 @@ package body Exp_Ch7 is
Unit_Id := Unique_Defining_Entity (Unit_Decl);
-- The compilation unit is a package instantiation. In this case the
- -- anonymous master is associated with the package spec as both the
- -- spec and body appear at the same level.
+ -- anonymous collection is associated with the package spec, as both
+ -- the spec and body appear at the same level.
if Nkind (Unit_Decl) = N_Package_Body
and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
@@ -1179,18 +1178,18 @@ package body Exp_Ch7 is
end if;
-- Determine whether the current semantic unit already has an anonymous
- -- master which services the designated type.
+ -- collection which services the designated type.
- FM_Id := Current_Anonymous_Master (Desig_Typ, Unit_Id);
+ FC_Id := Current_Anonymous_Collection (Desig_Typ, Unit_Id);
- -- If this is not the case, create a new master
+ -- If this is not the case, create a new collection
- if No (FM_Id) then
- FM_Id := Create_Anonymous_Master (Desig_Typ, Unit_Id, Unit_Decl);
+ if No (FC_Id) then
+ FC_Id := Create_Anonymous_Collection (Desig_Typ, Unit_Id, Unit_Decl);
end if;
- Set_Finalization_Master (Ptr_Typ, FM_Id);
- end Build_Anonymous_Master;
+ Set_Finalization_Collection (Ptr_Typ, FC_Id);
+ end Build_Anonymous_Collection;
----------------------------
-- Build_Array_Deep_Procs --
@@ -1517,11 +1516,11 @@ package body Exp_Ch7 is
Statements => Stmts);
end Build_Exception_Handler;
- -------------------------------
- -- Build_Finalization_Master --
- -------------------------------
+ -----------------------------------
+ -- Build_Finalization_Collection --
+ -----------------------------------
- procedure Build_Finalization_Master
+ procedure Build_Finalization_Collection
(Typ : Entity_Id;
For_Lib_Level : Boolean := False;
For_Private : Boolean := False;
@@ -1529,69 +1528,70 @@ package body Exp_Ch7 is
Insertion_Node : Node_Id := Empty)
is
Ptr_Typ : constant Entity_Id := Root_Type_Of_Full_View (Base_Type (Typ));
- -- A finalization master created for a named access type is associated
+ -- Finalization collections built for named access types are associated
-- with the full view (if applicable) as a consequence of freezing. The
-- full view criteria does not apply to anonymous access types because
-- those cannot have a private and a full view.
- -- Start of processing for Build_Finalization_Master
+ -- Start of processing for Build_Finalization_Collection
begin
-- Nothing to do if the circumstances do not allow for a finalization
- -- master.
+ -- collection.
- if not Allows_Finalization_Master (Typ) then
+ if not Allows_Finalization_Collection (Typ) then
return;
-- Various machinery such as freezing may have already created a
- -- finalization master.
+ -- finalization collection.
- elsif Present (Finalization_Master (Ptr_Typ)) then
+ elsif Present (Finalization_Collection (Ptr_Typ)) then
return;
end if;
declare
- Actions : constant List_Id := New_List;
- Loc : constant Source_Ptr := Sloc (Ptr_Typ);
- Fin_Mas_Id : Entity_Id;
- Pool_Id : Entity_Id;
+ Actions : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Ptr_Typ);
+
+ Fin_Coll_Id : Entity_Id;
+ Pool_Id : Entity_Id;
begin
- -- Source access types use fixed master names since the master is
+ -- Source access types use fixed names since the collection will be
-- inserted in the same source unit only once. The only exception to
-- this are instances using the same access type as generic actual.
if Comes_From_Source (Ptr_Typ) and then not Inside_A_Generic then
- Fin_Mas_Id :=
+ Fin_Coll_Id :=
Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Ptr_Typ), "FM"));
+ Chars => New_External_Name (Chars (Ptr_Typ), "FC"));
-- Internally generated access types use temporaries as their names
-- due to possible collision with identical names coming from other
-- packages.
else
- Fin_Mas_Id := Make_Temporary (Loc, 'F');
+ Fin_Coll_Id := Make_Temporary (Loc, 'F');
end if;
- Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
+ Set_Finalization_Collection (Ptr_Typ, Fin_Coll_Id);
-- Generate:
- -- <Ptr_Typ>FM : aliased Finalization_Master;
+ -- <Ptr_Typ>FC : aliased Finalization_Collection;
Append_To (Actions,
Make_Object_Declaration (Loc,
- Defining_Identifier => Fin_Mas_Id,
+ Defining_Identifier => Fin_Coll_Id,
Aliased_Present => True,
Object_Definition =>
- New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
+ New_Occurrence_Of (RTE (RE_Finalization_Collection), Loc)));
if Debug_Generated_Code then
- Set_Debug_Info_Needed (Fin_Mas_Id);
+ Set_Debug_Info_Needed (Fin_Coll_Id);
end if;
-- Set the associated pool and primitive Finalize_Address of the new
- -- finalization master.
+ -- finalization collection.
-- The access type has a user-defined storage pool, use it
@@ -1605,7 +1605,7 @@ package body Exp_Ch7 is
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
end if;
- -- A finalization master created for an access designating a type
+ -- A finalization collection created for an access designating a type
-- with private components is inserted before a context-dependent
-- node.
@@ -1632,17 +1632,17 @@ package body Exp_Ch7 is
Pop_Scope;
- -- The finalization master belongs to an access result type related
+ -- The finalization collection belongs to an access type related
-- to a build-in-place function call used to initialize a library
- -- level object. The master must be inserted in front of the access
- -- result type declaration denoted by Insertion_Node.
+ -- level object. The collection must be inserted in front of the
+ -- access type declaration denoted by Insertion_Node.
elsif For_Lib_Level then
pragma Assert (Present (Insertion_Node));
Insert_Actions (Insertion_Node, Actions);
- -- Otherwise the finalization master and its initialization become a
- -- part of the freeze node.
+ -- Otherwise the finalization collection and its initialization
+ -- become a part of the freeze node.
else
Append_Freeze_Actions (Ptr_Typ, Actions);
@@ -1650,16 +1650,16 @@ package body Exp_Ch7 is
Analyze_List (Actions);
- -- When the type the finalization master is being generated for was
- -- created to store a 'Old object, then mark it as such so its
+ -- When the type the finalization collection is being generated for
+ -- was created to store a 'Old object, then mark it as such so its
-- finalization can be delayed until after postconditions have been
-- checked.
if Stores_Attribute_Old_Prefix (Ptr_Typ) then
- Set_Stores_Attribute_Old_Prefix (Fin_Mas_Id);
+ Set_Stores_Attribute_Old_Prefix (Fin_Coll_Id);
end if;
end;
- end Build_Finalization_Master;
+ end Build_Finalization_Collection;
---------------------
-- Build_Finalizer --
@@ -2451,15 +2451,15 @@ package body Exp_Ch7 is
end if;
-- Inspect the freeze node of an access-to-controlled type and
- -- look for a delayed finalization master. This case arises when
- -- the freeze actions are inserted at a later time than the
+ -- look for a delayed finalization collection. This case arises
+ -- when the freeze actions are inserted at a later time than the
-- expansion of the context. Since Build_Finalizer is never called
- -- on a single construct twice, the master will be ultimately
+ -- on a single construct twice, the collection would be ultimately
-- left out and never finalized. This is also needed for freeze
-- actions of designated types themselves, since in some cases the
- -- finalization master is associated with a designated type's
+ -- finalization collection is associated with a designated type's
-- freeze node rather than that of the access type (see handling
- -- for freeze actions in Build_Finalization_Master).
+ -- for freeze actions in Build_Finalization_Collection).
elsif Nkind (Decl) = N_Freeze_Entity
and then Present (Actions (Decl))
@@ -2479,8 +2479,8 @@ package body Exp_Ch7 is
then
-- Freeze nodes are considered to be identical to packages
-- and blocks in terms of nesting. The difference is that
- -- a finalization master created inside the freeze node is
- -- at the same nesting level as the node itself.
+ -- a finalization collection created inside the freeze node
+ -- is at the same nesting level as the node itself.
Process_Declarations (Actions (Decl), Preprocess);
end if;
@@ -42,10 +42,10 @@ package Exp_Ch7 is
-- to a master node denoted by Master_Node. The code is inserted after
-- the object is initialized.
- procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id);
- -- Build a finalization master for an anonymous access-to-controlled type
- -- denoted by Ptr_Typ. The master is inserted in the declarations of the
- -- current unit.
+ procedure Build_Anonymous_Collection (Ptr_Typ : Entity_Id);
+ -- Build a finalization collection for an anonymous access-to-controlled
+ -- type denoted by Ptr_Typ. The collection is inserted in the declarations
+ -- of the current unit.
procedure Build_Controlling_Procs (Typ : Entity_Id);
-- Typ is a record, and array type having controlled components.
@@ -109,21 +109,21 @@ package Exp_Ch7 is
-- used when operating at the library level, when enabled the current
-- exception will be saved to a global location.
- procedure Build_Finalization_Master
+ procedure Build_Finalization_Collection
(Typ : Entity_Id;
For_Lib_Level : Boolean := False;
For_Private : Boolean := False;
Context_Scope : Entity_Id := Empty;
Insertion_Node : Node_Id := Empty);
- -- Build a finalization master for an access type. The designated type may
- -- not necessarily be controlled or need finalization actions depending on
- -- the context. Flag For_Lib_Level must be set when creating a master for a
- -- build-in-place function call access result type. Flag For_Private must
+ -- Build a finalization collection for an access type. The designated type
+ -- may not necessarily be controlled or need finalization actions depending
+ -- on the context. For_Lib_Level must be set when creating a collection for
+ -- a build-in-place function call access result type. Flag For_Private must
-- be set when the designated type contains a private component. Parameters
-- Context_Scope and Insertion_Node must be used in conjunction with flag
- -- For_Private. Context_Scope is the scope of the context where the
- -- finalization master must be analyzed. Insertion_Node is the insertion
- -- point before which the master is to be inserted.
+ -- For_Private. Context_Scope is the scope of the context where the newly
+ -- built collection must be analyzed. Insertion_Node is the insertion point
+ -- before which the collection is to be inserted.
procedure Build_Finalizer
(N : Node_Id;
@@ -937,11 +937,11 @@ package body Exp_Util is
and then not No_Heap_Finalization (Ptr_Typ);
-- The allocation/deallocation of a controlled object must be associated
- -- with an attachment to/detachment from a finalization master, but the
- -- implementation cannot guarantee this property for every anonymous
- -- access tyoe, see Build_Anonymous_Collection.
+ -- with an attachment to/detachment from a finalization collection, but
+ -- the implementation cannot guarantee this property for every anonymous
+ -- access type, see Build_Anonymous_Collection.
- if Needs_Fin and then No (Finalization_Master (Ptr_Typ)) then
+ if Needs_Fin and then No (Finalization_Collection (Ptr_Typ)) then
pragma Assert (Ekind (Ptr_Typ) = E_Anonymous_Access_Type);
Needs_Fin := False;
end if;
@@ -975,8 +975,8 @@ package body Exp_Util is
Alloc_Nod : Node_Id := Empty;
Alloc_Expr : Node_Id := Empty;
Fin_Addr_Id : Entity_Id;
- Fin_Mas_Act : Node_Id;
- Fin_Mas_Id : Entity_Id;
+ Fin_Coll_Act : Node_Id;
+ Fin_Coll_Id : Entity_Id;
Proc_To_Call : Entity_Id;
Subpool : Node_Id := Empty;
@@ -1035,21 +1035,21 @@ package body Exp_Util is
Append_To (Actuals, Make_Null (Loc));
end if;
- -- c) Finalization master
+ -- c) Finalization collection
if Needs_Fin then
- Fin_Mas_Id := Finalization_Master (Ptr_Typ);
- Fin_Mas_Act := New_Occurrence_Of (Fin_Mas_Id, Loc);
+ Fin_Coll_Id := Finalization_Collection (Ptr_Typ);
+ Fin_Coll_Act := New_Occurrence_Of (Fin_Coll_Id, Loc);
- -- Handle the case where the master is actually a pointer to a
- -- master. This case arises in build-in-place functions.
+ -- Handle the case where the collection is actually a pointer
+ -- to a collection. This arises in build-in-place functions.
- if Is_Access_Type (Etype (Fin_Mas_Id)) then
- Append_To (Actuals, Fin_Mas_Act);
+ if Is_Access_Type (Etype (Fin_Coll_Id)) then
+ Append_To (Actuals, Fin_Coll_Act);
else
Append_To (Actuals,
Make_Attribute_Reference (Loc,
- Prefix => Fin_Mas_Act,
+ Prefix => Fin_Coll_Act,
Attribute_Name => Name_Unrestricted_Access));
end if;
else
@@ -1293,6 +1293,7 @@ package body Exp_Util is
New_Occurrence_Of (RTE (RE_Storage_Count), Loc)));
Formal_Params : List_Id;
+
begin
if Use_Secondary_Stack_Pool then
-- Gigi expects a different profile in the Secondary_Stack_Pool
@@ -8751,7 +8752,7 @@ package body Exp_Util is
and then not Is_Aliased (Obj_Id, Decl)
-- Do not consider transient objects allocated on the heap since
- -- they are attached to a finalization master.
+ -- they are attached to a finalization collection.
and then not Is_Allocated (Obj_Id)
@@ -13063,15 +13064,15 @@ package body Exp_Util is
end if;
-- Inspect the freeze node of an access-to-controlled type and look
- -- for a delayed finalization master. This case arises when the
+ -- for a delayed finalization collection. This case arises when the
-- freeze actions are inserted at a later time than the expansion of
-- the context. Since Build_Finalizer is never called on a single
- -- construct twice, the master will be ultimately left out and never
- -- finalized. This is also needed for freeze actions of designated
- -- types themselves, since in some cases the finalization master is
- -- associated with a designated type's freeze node rather than that
- -- of the access type (see handling for freeze actions in
- -- Build_Finalization_Master).
+ -- construct twice, the collection would be ultimately left out and
+ -- never finalized. This is also needed for the freeze actions of
+ -- designated types themselves, since in some cases the finalization
+ -- collection is associated with a designated type's freeze node
+ -- rather than that of the access type (see handling for freeze
+ -- actions in Build_Finalization_Collection).
elsif Nkind (Decl) = N_Freeze_Entity
and then Present (Actions (Decl))
@@ -2616,11 +2616,11 @@ package body Freeze is
end loop;
end if;
- -- Historical note: We used to create a finalization master for an
- -- access type whose designated type is not controlled, but contains
+ -- Historical note: We used to create a finalization collection for
+ -- access types whose designated type is not controlled, but contains
-- private controlled compoments. This form of postprocessing is no
- -- longer needed because the finalization master is now created when
- -- the access type is frozen (see Exp_Ch3.Freeze_Type).
+ -- longer needed because the finalization collection is now created
+ -- when the access type is frozen (see Exp_Ch3.Freeze_Type).
Next_Entity (E);
end loop;
@@ -441,8 +441,8 @@ package Gen_IL.Fields is
Actual_Subtype,
Address_Taken,
Alignment,
+ Anonymous_Collections,
Anonymous_Designated_Type,
- Anonymous_Masters,
Anonymous_Object,
Associated_Entity,
Associated_Formal_Package,
@@ -537,7 +537,7 @@ package Gen_IL.Fields is
Extra_Constrained,
Extra_Formal,
Extra_Formals,
- Finalization_Master,
+ Finalization_Collection,
Finalization_Master_Node,
Finalize_Storage_Only,
Finalizer,
@@ -638,7 +638,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Ab (Access_Kind, Elementary_Kind,
(Sm (Associated_Storage_Pool, Node_Id, Root_Type_Only),
Sm (Directly_Designated_Type, Node_Id),
- Sm (Finalization_Master, Node_Id, Root_Type_Only),
+ Sm (Finalization_Collection, Node_Id, Root_Type_Only),
Sm (Has_Pragma_Controlled, Flag, Impl_Base_Type_Only),
Sm (Has_Storage_Size_Clause, Flag, Impl_Base_Type_Only),
Sm (Is_Access_Constant, Flag),
@@ -991,7 +991,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Cc (E_Function, Subprogram_Kind,
-- A function, created by a function declaration or a function body
-- that acts as its own declaration.
- (Sm (Anonymous_Masters, Elist_Id),
+ (Sm (Anonymous_Collections, Elist_Id),
Sm (Corresponding_Equality, Node_Id,
Pre => "not Comes_From_Source (N) and then Chars (N) = Name_Op_Ne"),
Sm (Corresponding_Procedure, Node_Id),
@@ -1040,7 +1040,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Cc (E_Procedure, Subprogram_Kind,
-- A procedure, created by a procedure declaration or a procedure
-- body that acts as its own declaration.
- (Sm (Anonymous_Masters, Elist_Id),
+ (Sm (Anonymous_Collections, Elist_Id),
Sm (Associated_Node_For_Itype, Node_Id),
Sm (Corresponding_Function, Node_Id),
Sm (DT_Position, Uint,
@@ -1249,7 +1249,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Cc (E_Package, Entity_Kind,
-- A package, created by a package declaration
(Sm (Abstract_States, Elist_Id),
- Sm (Anonymous_Masters, Elist_Id),
+ Sm (Anonymous_Collections, Elist_Id),
Sm (Associated_Formal_Package, Node_Id),
Sm (Body_Entity, Node_Id),
Sm (Body_Needed_For_Inlining, Flag),
@@ -1328,7 +1328,7 @@ begin -- Gen_IL.Gen.Gen_Entities
-- to represent the entity for the body. This entity serves almost no
-- function, since all semantic analysis uses the subprogram entity
-- for the declaration (E_Function or E_Procedure).
- (Sm (Anonymous_Masters, Elist_Id),
+ (Sm (Anonymous_Collections, Elist_Id),
Sm (Contract, Node_Id),
Sm (Extra_Formals, Node_Id),
Sm (First_Entity, Node_Id),
deleted file mode 100644
@@ -1,326 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-with Ada.Exceptions; use Ada.Exceptions;
-
-with System.Address_Image;
-with System.IO; use System.IO;
-with System.Soft_Links; use System.Soft_Links;
-with System.Storage_Elements; use System.Storage_Elements;
-
-package body System.Finalization_Masters is
-
- ---------------------------
- -- Add_Offset_To_Address --
- ---------------------------
-
- function Add_Offset_To_Address
- (Addr : System.Address;
- Offset : System.Storage_Elements.Storage_Offset) return System.Address
- is
- begin
- return System.Storage_Elements."+" (Addr, Offset);
- end Add_Offset_To_Address;
-
- ------------------------
- -- Attach_Unprotected --
- ------------------------
-
- procedure Attach_Unprotected
- (N : not null FM_Node_Ptr;
- Finalize_Address : not null Finalize_Address_Ptr;
- L : not null FM_Node_Ptr)
- is
- begin
- N.Finalize_Address := Finalize_Address;
- N.Prev := L;
- N.Next := L.Next;
-
- L.Next.Prev := N;
- L.Next := N;
- end Attach_Unprotected;
-
- ------------------------
- -- Detach_Unprotected --
- ------------------------
-
- procedure Detach_Unprotected (N : not null FM_Node_Ptr) is
- begin
- if N.Prev /= null and then N.Next /= null then
- N.Prev.Next := N.Next;
- N.Next.Prev := N.Prev;
- N.Prev := null;
- N.Next := null;
- end if;
- end Detach_Unprotected;
-
- --------------
- -- Finalize --
- --------------
-
- overriding procedure Finalize (Master : in out Finalization_Master) is
- Curr_Ptr : FM_Node_Ptr;
- Ex_Occur : Exception_Occurrence;
- Obj_Addr : Address;
- Raised : Boolean := False;
-
- function Is_Empty_List (L : not null FM_Node_Ptr) return Boolean;
- -- Determine whether a list contains only one element, the dummy head
-
- -------------------
- -- Is_Empty_List --
- -------------------
-
- function Is_Empty_List (L : not null FM_Node_Ptr) return Boolean is
- begin
- return L.Next = L and then L.Prev = L;
- end Is_Empty_List;
-
- -- Start of processing for Finalize
-
- begin
- Lock_Task.all;
-
- -- Synchronization:
- -- Read - allocation, finalization
- -- Write - finalization
-
- if Master.Finalization_Started then
- Unlock_Task.all;
-
- -- Double finalization may occur during the handling of stand alone
- -- libraries or the finalization of a pool with subpools. Due to the
- -- potential aliasing of masters in these two cases, do not process
- -- the same master twice.
-
- return;
- end if;
-
- -- Lock the master to prevent any allocations while the objects are
- -- being finalized. The master remains locked because either the master
- -- is explicitly deallocated or the associated access type is about to
- -- go out of scope.
-
- -- Synchronization:
- -- Read - allocation, finalization
- -- Write - finalization
-
- Master.Finalization_Started := True;
-
- while not Is_Empty_List (Master.Objects'Unchecked_Access) loop
- Curr_Ptr := Master.Objects.Next;
-
- -- Synchronization:
- -- Write - allocation, deallocation, finalization
-
- Detach_Unprotected (Curr_Ptr);
-
- -- Skip the list header in order to offer proper object layout for
- -- finalization.
-
- Obj_Addr := Curr_Ptr.all'Address + Header_Size;
-
- begin
- Curr_Ptr.Finalize_Address (Obj_Addr);
- exception
- when Fin_Occur : others =>
- if not Raised then
- Raised := True;
- Save_Occurrence (Ex_Occur, Fin_Occur);
- end if;
- end;
- end loop;
-
- Unlock_Task.all;
-
- -- If the finalization of a particular object failed or Finalize_Address
- -- was not set, reraise the exception now.
-
- if Raised then
- Reraise_Occurrence (Ex_Occur);
- end if;
- end Finalize;
-
- --------------------------
- -- Finalization_Started --
- --------------------------
-
- function Finalization_Started
- (Master : Finalization_Master) return Boolean
- is
- begin
- return Master.Finalization_Started;
- end Finalization_Started;
-
- -----------------
- -- Header_Size --
- -----------------
-
- function Header_Size return System.Storage_Elements.Storage_Count is
- begin
- return FM_Node'Size / Storage_Unit;
- end Header_Size;
-
- ----------------
- -- Initialize --
- ----------------
-
- overriding procedure Initialize (Master : in out Finalization_Master) is
- begin
- -- The dummy head must point to itself in both directions
-
- Master.Objects.Next := Master.Objects'Unchecked_Access;
- Master.Objects.Prev := Master.Objects'Unchecked_Access;
- end Initialize;
-
- -------------
- -- Objects --
- -------------
-
- function Objects (Master : Finalization_Master) return FM_Node_Ptr is
- begin
- return Master.Objects'Unrestricted_Access;
- end Objects;
-
- ------------------
- -- Print_Master --
- ------------------
-
- procedure Print_Master (Master : Finalization_Master) is
- Head : constant FM_Node_Ptr := Master.Objects'Unrestricted_Access;
- Head_Seen : Boolean := False;
- N_Ptr : FM_Node_Ptr;
-
- begin
- -- Output the basic contents of a master
-
- -- Master : 0x123456789
- -- Base_Pool: null <or> 0x123456789
- -- Fin_Start: TRUE <or> FALSE
-
- Put ("Master : ");
- Put_Line (Address_Image (Master'Address));
-
- Put ("Fin_Start: ");
- Put_Line (Master.Finalization_Started'Img);
-
- -- Output all chained elements. The format is the following:
-
- -- ^ <or> ? <or> null
- -- |Header: 0x123456789 (dummy head)
- -- | Fin_Addr: 0x0001F2580
- -- | Prev : 0x123456789
- -- | Next : 0x123456789
- -- V
-
- -- ^ - the current element points back to the correct element
- -- ? - the current element points back to an erroneous element
- -- n - the current element points back to null
-
- -- Header - the address of the list header
- -- Fin_Addr - the Finalize_Address routine
- -- Prev - the address of the list header which the current element
- -- points back to
- -- Next - the address of the list header which the current element
- -- points to
- -- (dummy head) - present if dummy head
-
- N_Ptr := Head;
- while N_Ptr /= null loop -- Should never be null
- Put_Line ("V");
-
- -- We see the head initially; we want to exit when we see the head a
- -- second time.
-
- if N_Ptr = Head then
- exit when Head_Seen;
-
- Head_Seen := True;
- end if;
-
- -- The current element is null. This should never happen since the
- -- list is circular.
-
- if N_Ptr.Prev = null then
- Put_Line ("null (ERROR)");
-
- -- The current element points back to the correct element
-
- elsif N_Ptr.Prev.Next = N_Ptr then
- Put_Line ("^");
-
- -- The current element points to an erroneous element
-
- else
- Put_Line ("? (ERROR)");
- end if;
-
- -- Output the header and fields
-
- Put ("|Header: ");
- Put (Address_Image (N_Ptr.all'Address));
-
- -- Detect the dummy head
-
- if N_Ptr = Head then
- Put_Line (" (dummy head)");
- else
- Put_Line ("");
- end if;
-
- Put ("| Fin_Addr: ");
- if N_Ptr.Finalize_Address = null then
- Put_Line ("null");
- else
- Put_Line (Address_Image (N_Ptr.Finalize_Address'Address));
- end if;
-
- Put ("| Prev : ");
-
- if N_Ptr.Prev = null then
- Put_Line ("null");
- else
- Put_Line (Address_Image (N_Ptr.Prev.all'Address));
- end if;
-
- Put ("| Next : ");
-
- if N_Ptr.Next = null then
- Put_Line ("null");
- else
- Put_Line (Address_Image (N_Ptr.Next.all'Address));
- end if;
-
- N_Ptr := N_Ptr.Next;
- end loop;
- end Print_Master;
-
-end System.Finalization_Masters;
deleted file mode 100644
@@ -1,130 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-with Ada.Finalization;
-with System.Storage_Elements;
-
-package System.Finalization_Masters is
- pragma Preelaborate;
-
- -- A reference to primitive Finalize_Address. The expander generates an
- -- implementation of this procedure for each controlled and class-wide
- -- type. Since controlled objects are simply viewed as addresses once
- -- allocated through a master, Finalize_Address provides a backward
- -- indirection from an address to a type-specific context.
-
- type Finalize_Address_Ptr is access procedure (Obj : System.Address);
-
- -- Heterogeneous collection type structure
-
- type FM_Node is private;
- type FM_Node_Ptr is access all FM_Node;
- pragma No_Strict_Aliasing (FM_Node_Ptr);
-
- -- Finalization master type structure. A unique master is associated with
- -- each access-to-controlled or access-to-class-wide type. Masters also act
- -- as components of subpools. By default, a master contains objects of the
- -- same designated type but it may also accommodate heterogeneous objects.
-
- type Finalization_Master is
- new Ada.Finalization.Limited_Controlled with private;
-
- -- A reference to a finalization master. Since this type may not be used
- -- to allocate objects, its storage size is zero.
-
- type Finalization_Master_Ptr is access all Finalization_Master;
- for Finalization_Master_Ptr'Storage_Size use 0;
-
- procedure Attach_Unprotected
- (N : not null FM_Node_Ptr;
- Finalize_Address : not null Finalize_Address_Ptr;
- L : not null FM_Node_Ptr);
- -- Prepend a node to a specific finalization master
-
- procedure Detach_Unprotected (N : not null FM_Node_Ptr);
- -- Remove a node from an arbitrary finalization master
-
- overriding procedure Finalize (Master : in out Finalization_Master);
- -- Lock the master to prevent allocations during finalization. Iterate over
- -- the list of allocated controlled objects, finalizing each one by calling
- -- its specific Finalize_Address. In the end, deallocate the dummy head.
-
- function Finalization_Started (Master : Finalization_Master) return Boolean;
- -- Return the finalization status of a master
-
- function Header_Size return System.Storage_Elements.Storage_Count;
- -- Return the size of type FM_Node as Storage_Count
-
- function Objects (Master : Finalization_Master) return FM_Node_Ptr;
- -- Return the header of the doubly-linked list of controlled objects
-
- procedure Print_Master (Master : Finalization_Master);
- -- Debug routine, outputs the contents of a master
-
-private
- -- Heterogeneous collection type structure
-
- type FM_Node is record
- Finalize_Address : Finalize_Address_Ptr := null;
-
- Prev : FM_Node_Ptr := null;
- Next : FM_Node_Ptr := null;
- end record;
-
- -- Finalization master type structure. A unique master is associated with
- -- each access-to-controlled or access-to-class-wide type. Masters also act
- -- as components of subpools. By default, a master contains objects of the
- -- same designated type but it may also accommodate heterogeneous objects.
-
- type Finalization_Master is
- new Ada.Finalization.Limited_Controlled with
- record
- Objects : aliased FM_Node;
- -- A doubly linked list which contains the headers of all controlled
- -- objects allocated in a [sub]pool.
-
- Finalization_Started : Boolean := False;
- -- A flag used to detect allocations which occur during the finalization
- -- of a master. The allocations must raise Program_Error. This scenario
- -- may arise in a multitask environment.
- end record;
-
- -- Since RTSfind cannot contain names of the form RE_"+", the following
- -- routine serves as a wrapper around System.Storage_Elements."+".
-
- function Add_Offset_To_Address
- (Addr : System.Address;
- Offset : System.Storage_Elements.Storage_Offset) return System.Address;
-
- overriding procedure Initialize (Master : in out Finalization_Master);
- -- Initialize the dummy head of a finalization master
-
-end System.Finalization_Masters;
@@ -35,6 +35,38 @@ with System.Soft_Links; use System.Soft_Links;
package body System.Finalization_Primitives is
+ use type System.Storage_Elements.Storage_Offset;
+
+ ---------------------------
+ -- Add_Offset_To_Address --
+ ---------------------------
+
+ function Add_Offset_To_Address
+ (Addr : System.Address;
+ Offset : System.Storage_Elements.Storage_Offset) return System.Address
+ is
+ begin
+ return System.Storage_Elements."+" (Addr, Offset);
+ end Add_Offset_To_Address;
+
+ -------------------------------
+ -- Attach_Node_To_Collection --
+ -------------------------------
+
+ procedure Attach_Node_To_Collection
+ (Node : not null Collection_Node_Ptr;
+ Finalize_Address : not null Finalize_Address_Ptr;
+ Collection : in out Finalization_Collection)
+ is
+ begin
+ Node.Finalize_Address := Finalize_Address;
+ Node.Prev := Collection.Head'Unchecked_Access;
+ Node.Next := Collection.Head.Next;
+
+ Collection.Head.Next.Prev := Node;
+ Collection.Head.Next := Node;
+ end Attach_Node_To_Collection;
+
-----------------------------
-- Attach_Object_To_Master --
-----------------------------
@@ -80,6 +112,120 @@ package body System.Finalization_Primitives is
Master.Head := Node;
end Chain_Node_To_Master;
+ ---------------------------------
+ -- Detach_Node_From_Collection --
+ ---------------------------------
+
+ procedure Detach_Node_From_Collection
+ (Node : not null Collection_Node_Ptr)
+ is
+ begin
+ if Node.Prev /= null and then Node.Next /= null then
+ Node.Prev.Next := Node.Next;
+ Node.Next.Prev := Node.Prev;
+ Node.Prev := null;
+ Node.Next := null;
+ end if;
+ end Detach_Node_From_Collection;
+
+ --------------------------
+ -- Finalization_Started --
+ --------------------------
+
+ function Finalization_Started
+ (Master : Finalization_Collection) return Boolean
+ is
+ begin
+ return Master.Finalization_Started;
+ end Finalization_Started;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ overriding procedure Finalize
+ (Collection : in out Finalization_Collection)
+ is
+ Curr_Ptr : Collection_Node_Ptr;
+ Exc_Occur : Exception_Occurrence;
+ Finalization_Exception_Raised : Boolean := False;
+ Obj_Addr : Address;
+
+ function Is_Empty_List (L : not null Collection_Node_Ptr) return Boolean;
+ -- Determine whether a list contains only one element, the dummy head
+
+ -------------------
+ -- Is_Empty_List --
+ -------------------
+
+ function Is_Empty_List (L : not null Collection_Node_Ptr) return Boolean
+ is
+ begin
+ return L.Next = L and then L.Prev = L;
+ end Is_Empty_List;
+
+ begin
+ Lock_Task.all;
+
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - finalization
+
+ if Collection.Finalization_Started then
+ Unlock_Task.all;
+
+ -- Double finalization may occur during the handling of stand alone
+ -- libraries or the finalization of a pool with subpools. Due to the
+ -- potential aliasing of masters in these two cases, do not process
+ -- the same master twice.
+
+ return;
+ end if;
+
+ -- Lock the master to prevent any allocations while the objects are
+ -- being finalized. The master remains locked because either the master
+ -- is explicitly deallocated or the associated access type is about to
+ -- go out of scope.
+
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - finalization
+
+ Collection.Finalization_Started := True;
+
+ while not Is_Empty_List (Collection.Head'Unchecked_Access) loop
+ Curr_Ptr := Collection.Head.Next;
+
+ -- Synchronization:
+ -- Write - allocation, deallocation, finalization
+
+ Detach_Node_From_Collection (Curr_Ptr);
+
+ -- Skip the list header in order to offer proper object layout for
+ -- finalization.
+
+ Obj_Addr := Curr_Ptr.all'Address + Header_Size;
+
+ begin
+ Curr_Ptr.Finalize_Address (Obj_Addr);
+ exception
+ when Fin_Occur : others =>
+ if not Finalization_Exception_Raised then
+ Finalization_Exception_Raised := True;
+ Save_Occurrence (Exc_Occur, Fin_Occur);
+ end if;
+ end;
+ end loop;
+
+ Unlock_Task.all;
+
+ -- If one of the finalization actions raised an exception, reraise it
+
+ if Finalization_Exception_Raised then
+ Reraise_Occurrence (Exc_Occur);
+ end if;
+ end Finalize;
+
---------------------
-- Finalize_Master --
---------------------
@@ -166,6 +312,31 @@ package body System.Finalization_Primitives is
end if;
end Finalize_Object;
+ -----------------
+ -- Header_Size --
+ -----------------
+
+ function Header_Size return System.Storage_Elements.Storage_Count is
+ begin
+ return Collection_Node'Size / Storage_Unit;
+ end Header_Size;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ overriding procedure Initialize
+ (Collection : in out Finalization_Collection)
+ is
+ begin
+ Collection.Finalization_Started := False;
+
+ -- The dummy head must point to itself in both directions
+
+ Collection.Head.Prev := Collection.Head'Unchecked_Access;
+ Collection.Head.Next := Collection.Head'Unchecked_Access;
+ end Initialize;
+
-------------------------------------
-- Suppress_Object_Finalize_At_End --
-------------------------------------
@@ -29,6 +29,10 @@
-- --
------------------------------------------------------------------------------
+with Ada.Finalization;
+
+with System.Storage_Elements;
+
-- This package encapsulates the types and operations used by the compiler
-- to support finalization of objects of Ada controlled types (types derived
-- from types Controlled and Limited_Controlled).
@@ -108,8 +112,77 @@ package System.Finalization_Primitives with Preelaborate is
-- is completed normally (it will still be finalized if an exception
-- is raised before the normal completion of the return statement).
+ --------------------------------------------------------------------------
+ -- Types and operations of finalization collections: A finalization
+ -- collection is used to manage a set of controlled objects associated
+ -- with an access type. Such collections are always associated with a
+ -- finalization master, either at the library-level or within a subprogram,
+ -- depending on where the access type is declared, and the collection
+ -- object itself is managed via a Master_Node attached to its finalization
+ -- master.
+
+ type Finalization_Collection is
+ new Ada.Finalization.Limited_Controlled with private;
+ -- Objects of this type encapsulate a set of zero or more controlled
+ -- objects associated with an access type. The compiler ensures that
+ -- each finalization collection is in turn associated with a finalization
+ -- master.
+
+ type Finalization_Collection_Ptr is access all Finalization_Collection;
+ for Finalization_Collection_Ptr'Storage_Size use 0;
+ -- A reference to a collection. Since this type may not be used to
+ -- allocate objects, its storage size is zero.
+
+ overriding procedure Initialize
+ (Collection : in out Finalization_Collection);
+ -- Initializes the dummy head of a collection
+
+ overriding procedure Finalize
+ (Collection : in out Finalization_Collection);
+ -- Finalizes each object that has been associated with a finalization
+ -- collection, in some arbitrary order. Calls to this procedure with
+ -- a collection that has already been finalized have no effect.
+
+ function Finalization_Started
+ (Master : Finalization_Collection) return Boolean;
+ -- Return the finalization status of a collection
+
+ type Collection_Node is private;
+ -- Each controlled object associated with a finalization collection has
+ -- an associated object of this type.
+
+ type Collection_Node_Ptr is access all Collection_Node;
+ for Collection_Node_Ptr'Storage_Size use 0;
+ pragma No_Strict_Aliasing (Collection_Node_Ptr);
+ -- A reference to a collection node. Since this type may not be used to
+ -- allocate objects, its storage size is zero.
+
+ procedure Attach_Node_To_Collection
+ (Node : not null Collection_Node_Ptr;
+ Finalize_Address : not null Finalize_Address_Ptr;
+ Collection : in out Finalization_Collection);
+ -- Associates a collection node with a finalization collection. The node
+ -- can be associated with at most one finalization collection.
+
+ procedure Detach_Node_From_Collection (Node : not null Collection_Node_Ptr);
+ -- Removes a collection node from its associated finalization collection.
+ -- Calls to the procedure with a Node that has already been detached have
+ -- no effects.
+
+ function Header_Size return System.Storage_Elements.Storage_Count;
+ -- Return the size of type Collection_Node as Storage_Count
+
private
+ -- Since RTSfind cannot contain names of the form RE_"+", the following
+ -- routine serves as a wrapper around System.Storage_Elements."+".
+
+ function Add_Offset_To_Address
+ (Addr : System.Address;
+ Offset : System.Storage_Elements.Storage_Offset) return System.Address;
+
+ -- Finalization masters:
+
-- Master node type structure
type Master_Node is record
@@ -137,4 +210,31 @@ private
pragma Inline (Finalize_Object);
pragma Inline (Suppress_Object_Finalize_At_End);
+ -- Finalization collections:
+
+ -- Collection node type structure
+
+ type Collection_Node is record
+ Finalize_Address : Finalize_Address_Ptr := null;
+
+ Prev : Collection_Node_Ptr := null;
+ Next : Collection_Node_Ptr := null;
+ -- Finalization_Collections are managed as a circular doubly-linked list
+ end record;
+
+ -- Finalization collection type structure
+
+ type Finalization_Collection is
+ new Ada.Finalization.Limited_Controlled with
+ record
+ Head : aliased Collection_Node;
+ -- The head of the circular doubly-linked list of Collection_Nodes
+
+ Finalization_Started : Boolean := False;
+ pragma Atomic (Finalization_Started);
+ -- A flag used to detect allocations which occur during the finalization
+ -- of a collection. The allocations must raise Program_Error. This may
+ -- arise in a multitask environment.
+ end record;
+
end System.Finalization_Primitives;
@@ -31,7 +31,7 @@
with Ada.Unchecked_Deallocation;
-with System.Finalization_Masters; use System.Finalization_Masters;
+with System.Finalization_Primitives; use System.Finalization_Primitives;
package body System.Storage_Pools.Subpools.Finalization is
@@ -53,9 +53,9 @@ package body System.Storage_Pools.Subpools.Finalization is
return;
end if;
- -- Clean up all controlled objects chained on the subpool's master
+ -- Clean up all controlled objects chained on the subpool's collection
- Finalize (Subpool.Master);
+ Finalize (Subpool.Collection);
-- Remove the subpool from its owner's list of subpools
@@ -38,7 +38,7 @@ package System.Storage_Pools.Subpools.Finalization is
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
-- This routine performs the following actions:
- -- 1) Finalize all objects chained on the subpool's master
+ -- 1) Finalize all objects chained on the subpool's collection
-- 2) Remove the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the subpool
-- 4) Call Deallocate_Subpool
@@ -33,18 +33,18 @@ with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with System.Address_Image;
-with System.Finalization_Masters; use System.Finalization_Masters;
-with System.IO; use System.IO;
-with System.Soft_Links; use System.Soft_Links;
-with System.Storage_Elements; use System.Storage_Elements;
+with System.Finalization_Primitives; use System.Finalization_Primitives;
+with System.IO; use System.IO;
+with System.Soft_Links; use System.Soft_Links;
+with System.Storage_Elements; use System.Storage_Elements;
with System.Storage_Pools.Subpools.Finalization;
use System.Storage_Pools.Subpools.Finalization;
package body System.Storage_Pools.Subpools is
- function Address_To_FM_Node_Ptr is
- new Ada.Unchecked_Conversion (Address, FM_Node_Ptr);
+ function To_Collection_Node_Ptr is
+ new Ada.Unchecked_Conversion (Address, Collection_Node_Ptr);
procedure Attach (N : not null SP_Node_Ptr; L : not null SP_Node_Ptr);
-- Attach a subpool node to a pool
@@ -61,12 +61,12 @@ package body System.Storage_Pools.Subpools is
Header_And_Padding : constant Storage_Offset :=
Header_Size_With_Padding (Alignment);
begin
- -- Expose the two hidden pointers by shifting the address from the
- -- start of the object to the FM_Node equivalent of the pointers.
+ -- Expose the collection node and its padding by shifting the address
+ -- from the start of the object to the beginning pf the padding.
Addr := Addr - Header_And_Padding;
- -- Update the size of the object to include the two pointers
+ -- Update the size to include the collection node and its padding
Storage_Size := Storage_Size + Header_And_Padding;
end Adjust_Controlled_Dereference;
@@ -99,35 +99,35 @@ package body System.Storage_Pools.Subpools is
-----------------------------
procedure Allocate_Any_Controlled
- (Pool : in out Root_Storage_Pool'Class;
- Context_Subpool : Subpool_Handle;
- Context_Master : Finalization_Masters.Finalization_Master_Ptr;
- Fin_Address : Finalization_Masters.Finalize_Address_Ptr;
- Addr : out System.Address;
- Storage_Size : System.Storage_Elements.Storage_Count;
- Alignment : System.Storage_Elements.Storage_Count;
- Is_Controlled : Boolean;
- On_Subpool : Boolean)
+ (Pool : in out Root_Storage_Pool'Class;
+ Context_Subpool : Subpool_Handle;
+ Context_Collection : Finalization_Primitives.Finalization_Collection_Ptr;
+ Fin_Address : Finalization_Primitives.Finalize_Address_Ptr;
+ Addr : out System.Address;
+ Storage_Size : System.Storage_Elements.Storage_Count;
+ Alignment : System.Storage_Elements.Storage_Count;
+ Is_Controlled : Boolean;
+ On_Subpool : Boolean)
is
Is_Subpool_Allocation : constant Boolean :=
Pool in Root_Storage_Pool_With_Subpools'Class;
- Master : Finalization_Master_Ptr := null;
+ Collection : Finalization_Collection_Ptr := null;
N_Addr : Address;
- N_Ptr : FM_Node_Ptr;
+ N_Ptr : Collection_Node_Ptr;
N_Size : Storage_Count;
Subpool : Subpool_Handle := null;
Lock_Taken : Boolean := False;
Header_And_Padding : Storage_Offset;
- -- This offset includes the size of a FM_Node plus any additional
+ -- This offset includes the size of a collection node plus an additional
-- padding due to a larger alignment.
begin
-- Step 1: Pool-related runtime checks
-- Allocation on a pool_with_subpools. In this scenario there is a
- -- master for each subpool. The master of the access type is ignored.
+ -- collection for each subpool. That of the access type is ignored.
if Is_Subpool_Allocation then
@@ -156,17 +156,17 @@ package body System.Storage_Pools.Subpools is
raise Program_Error with "incorrect owner of subpool";
end if;
- Master := Subpool.Master'Unchecked_Access;
+ Collection := Subpool.Collection'Unchecked_Access;
- -- Allocation on a simple pool. In this scenario there is a master for
- -- each access-to-controlled type. No context subpool should be present.
+ -- Allocation on a simple pool. In this scenario there is a collection
+ -- for each access-to-controlled type. No context subpool is allowed.
else
- -- If the master is missing, then the expansion of the access type
- -- failed to create one. This is a compiler bug.
+ -- If the collection is missing, then the expansion of the access
+ -- type has failed to create one. This is a compiler bug.
pragma Assert
- (Context_Master /= null, "missing master in pool allocation");
+ (Context_Collection /= null, "no collection in pool allocation");
-- If a subpool is present, then this is the result of erroneous
-- allocator expansion. This is not a serious error, but it should
@@ -186,10 +186,10 @@ package body System.Storage_Pools.Subpools is
with "pool of access type does not support subpools";
end if;
- Master := Context_Master;
+ Collection := Context_Collection;
end if;
- -- Step 2: Master, Finalize_Address-related runtime checks and size
+ -- Step 2: Collection, Finalize_Address-related runtime checks and size
-- calculations.
-- Allocation of a descendant from [Limited_]Controlled, a class-wide
@@ -205,9 +205,9 @@ package body System.Storage_Pools.Subpools is
Lock_Task.all;
-- Do not allow the allocation of controlled objects while the
- -- associated master is being finalized.
+ -- associated collection is being finalized.
- if Finalization_Started (Master.all) then
+ if Finalization_Started (Collection.all) then
raise Program_Error with "allocation after finalization started";
end if;
@@ -255,10 +255,9 @@ package body System.Storage_Pools.Subpools is
-- Note that we already did "Lock_Task.all;" in Step 2 above
- -- Map the allocated memory into a FM_Node record. This converts the
+ -- Map the allocated memory into a collection node. This converts the
-- top of the allocated bits into a list header. If there is padding
- -- due to larger alignment, the header is placed right next to the
- -- object:
+ -- due to larger alignment, the padding is placed at the beginning:
-- N_Addr N_Ptr
-- | |
@@ -272,14 +271,14 @@ package body System.Storage_Pools.Subpools is
-- +- Header_And_Padding --+
N_Ptr :=
- Address_To_FM_Node_Ptr (N_Addr + Header_And_Padding - Header_Size);
+ To_Collection_Node_Ptr (N_Addr + Header_And_Padding - Header_Size);
- -- Prepend the allocated object to the finalization master
+ -- Attach the allocated object to the finalization collection
-- Synchronization:
-- Write - allocation, deallocation, finalization
- Attach_Unprotected (N_Ptr, Fin_Address, Objects (Master.all));
+ Attach_Node_To_Collection (N_Ptr, Fin_Address, Collection.all);
-- Move the address from the hidden list header to the start of the
-- object. This operation effectively hides the list header.
@@ -343,11 +342,11 @@ package body System.Storage_Pools.Subpools is
Is_Controlled : Boolean)
is
N_Addr : Address;
- N_Ptr : FM_Node_Ptr;
+ N_Ptr : Collection_Node_Ptr;
N_Size : Storage_Count;
Header_And_Padding : Storage_Offset;
- -- This offset includes the size of a FM_Node plus any additional
+ -- This offset includes the size of a collection node plus an additional
-- padding due to a larger alignment.
begin
@@ -375,16 +374,16 @@ package body System.Storage_Pools.Subpools is
-- Convert the bits preceding the object into a list header
- N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size);
+ N_Ptr := To_Collection_Node_Ptr (Addr - Header_Size);
- -- Detach the object from the related finalization master. This
- -- action does not need to know the prior context used during
+ -- Detach the object from the related finalization collection.
+ -- This action does not need to know the context used during
-- allocation.
-- Synchronization:
-- Write - allocation, deallocation, finalization
- Detach_Unprotected (N_Ptr);
+ Detach_Node_From_Collection (N_Ptr);
-- Move the address from the object to the beginning of the list
-- header.
@@ -510,7 +509,7 @@ package body System.Storage_Pools.Subpools is
-- Perform the following actions:
- -- 1) Finalize all objects chained on the subpool's master
+ -- 1) Finalize all objects chained on the subpool's collection
-- 2) Remove the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the
-- subpool.
@@ -528,7 +527,7 @@ package body System.Storage_Pools.Subpools is
end;
end loop;
- -- If the finalization of a particular master failed, reraise the
+ -- If the finalization of a particular collection failed, reraise the
-- exception now.
if Raised then
@@ -705,9 +704,9 @@ package body System.Storage_Pools.Subpools is
-- Output the contents of a subpool
- -- Owner : 0x123456789
- -- Master: 0x123456789
- -- Node : 0x123456789
+ -- Owner : 0x123456789
+ -- Collection: 0x123456789
+ -- Node : 0x123456789
Put ("Owner : ");
if Subpool.Owner = null then
@@ -716,8 +715,8 @@ package body System.Storage_Pools.Subpools is
Put_Line (Address_Image (Subpool.Owner'Address));
end if;
- Put ("Master: ");
- Put_Line (Address_Image (Subpool.Master'Address));
+ Put ("Collection: ");
+ Put_Line (Address_Image (Subpool.Collection'Address));
Put ("Node : ");
if Subpool.Node = null then
@@ -731,8 +730,6 @@ package body System.Storage_Pools.Subpools is
else
Put_Line (Address_Image (Subpool.Node'Address));
end if;
-
- Print_Master (Subpool.Master);
end Print_Subpool;
-------------------------
@@ -34,7 +34,7 @@
------------------------------------------------------------------------------
with Ada.Finalization;
-with System.Finalization_Masters;
+with System.Finalization_Primitives;
with System.Storage_Elements;
package System.Storage_Pools.Subpools is
@@ -130,32 +130,8 @@ package System.Storage_Pools.Subpools is
(System.Storage_Elements.Storage_Count'Last);
private
- -- Model
- -- Pool_With_Subpools SP_Node SP_Node SP_Node
- -- +-->+--------------------+ +-----+ +-----+ +-----+
- -- | | Subpools -------->| ------->| ------->| ------->
- -- | +--------------------+ +-----+ +-----+ +-----+
- -- | |Finalization_Started|<------ |<------- |<------- |<---
- -- | +--------------------+ +-----+ +-----+ +-----+
- -- +--- Controller.Encl_Pool| | nul | | + | | + |
- -- | +--------------------+ +-----+ +--|--+ +--:--+
- -- | : : Dummy | ^ :
- -- | : : | | :
- -- | Root_Subpool V |
- -- | +-------------+ |
- -- +-------------------------------- Owner | |
- -- FM_Node FM_Node +-------------+ |
- -- +-----+ +-----+<-- Master.Objects| |
- -- <------ |<------ | +-------------+ |
- -- +-----+ +-----+ | Node -------+
- -- | ------>| -----> +-------------+
- -- +-----+ +-----+ : :
- -- |ctrl | Dummy : :
- -- | obj |
- -- +-----+
- --
- -- SP_Nodes are created on the heap. FM_Nodes and associated objects are
- -- created on the pool_with_subpools.
+ -- SP_Nodes are created on the heap, while collection nodes and associated
+ -- objects are created on the pool_with_subpools.
type Any_Storage_Pool_With_Subpools_Ptr
is access all Root_Storage_Pool_With_Subpools'Class;
@@ -205,7 +181,7 @@ private
Finalization_Started : Boolean := False;
pragma Atomic (Finalization_Started);
- -- A flag which prevents the creation of new subpools while the master
+ -- A flag which prevents the creation of new subpools while the parent
-- pool is being finalized. The flag needs to be atomic because it is
-- accessed without Lock_Task / Unlock_Task.
@@ -219,32 +195,35 @@ private
-- contains links to all controlled objects allocated on a particular
-- subpool.
- -- Pool_With_Subpools SP_Node SP_Node SP_Node
- -- +-->+----------------+ +-----+ +-----+ +-----+
- -- | | Subpools ------>| ------->| ------->| ------->
- -- | +----------------+ +-----+ +-----+ +-----+
- -- | : :<------ |<------- |<------- |
- -- | : : +-----+ +-----+ +-----+
- -- | |null | | + | | + |
- -- | +-----+ +--|--+ +--:--+
- -- | | ^ :
- -- | Root_Subpool V |
- -- | +-------------+ |
- -- +---------------------------- Owner | |
- -- +-------------+ |
- -- .......... Master | |
- -- +-------------+ |
- -- | Node -------+
- -- +-------------+
- -- : End-user :
- -- : components :
+ -- Pool_With_Subpools SP_Node SP_Node SP_Node
+ -- +-->+--------------------+ +-----+ +-----+ +-----+
+ -- | | Subpools -------->| ------->| ------->| ------->
+ -- | +--------------------+ +-----+ +-----+ +-----+
+ -- | |Finalization_Started|<------ |<------- |<------- |<---
+ -- | +--------------------+ +-----+ +-----+ +-----+
+ -- +--- Controller.Encl_Pool| | nul | | + | | + |
+ -- | +--------------------+ +-----+ +--|--+ +--:--+
+ -- | : : Dummy | ^ :
+ -- | : : | | :
+ -- | Root_Subpool V |
+ -- | +-------------+ |
+ -- +-------------------------------- Owner | |
+ -- Collection nodes +-------------+ |
+ -- +-----+ +-----+<-- | Collection |
+ -- <------ |<------ | +-------------+ |
+ -- +-----+ +-----+ | Node -------+
+ -- | ------>| -----> +-------------+
+ -- +-----+ +-----+ : :
+ -- |ctrl | Dummy : :
+ -- | obj |
+ -- +-----+
type Root_Subpool is abstract tagged limited record
Owner : Any_Storage_Pool_With_Subpools_Ptr := null;
- -- A reference to the master pool_with_subpools
+ -- A reference to the parent pool_with_subpools
- Master : aliased System.Finalization_Masters.Finalization_Master;
- -- A heterogeneous collection of controlled objects
+ Collection : aliased Finalization_Primitives.Finalization_Collection;
+ -- A collection of controlled objects
Node : SP_Node_Ptr := null;
-- A link to the doubly linked list node which contains the subpool.
@@ -257,21 +236,21 @@ private
Alignment : System.Storage_Elements.Storage_Count);
-- Given the memory attributes of a heap-allocated object that is known to
-- be controlled, adjust the address and size of the object to include the
- -- two hidden pointers inserted by the finalization machinery.
+ -- collection node inserted by the finalization machinery and its padding.
-- ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed
-- to Allocate_Any.
procedure Allocate_Any_Controlled
- (Pool : in out Root_Storage_Pool'Class;
- Context_Subpool : Subpool_Handle;
- Context_Master : Finalization_Masters.Finalization_Master_Ptr;
- Fin_Address : Finalization_Masters.Finalize_Address_Ptr;
- Addr : out System.Address;
- Storage_Size : System.Storage_Elements.Storage_Count;
- Alignment : System.Storage_Elements.Storage_Count;
- Is_Controlled : Boolean;
- On_Subpool : Boolean);
+ (Pool : in out Root_Storage_Pool'Class;
+ Context_Subpool : Subpool_Handle;
+ Context_Collection : Finalization_Primitives.Finalization_Collection_Ptr;
+ Fin_Address : Finalization_Primitives.Finalize_Address_Ptr;
+ Addr : out System.Address;
+ Storage_Size : System.Storage_Elements.Storage_Count;
+ Alignment : System.Storage_Elements.Storage_Count;
+ Is_Controlled : Boolean;
+ On_Subpool : Boolean);
-- Compiler interface. This version of Allocate handles all possible cases,
-- either on a pool or a pool_with_subpools, regardless of the controlled
-- status of the allocated object. Parameter usage:
@@ -283,9 +262,9 @@ private
-- subpool handle is present at the point of allocation, the actual
-- would be null.
--
- -- * Context_Master - The finalization master associated with the access
- -- type. If the access type's designated type is not controlled, the
- -- actual would be null.
+ -- * Context_Collection - The finalization collection associated with the
+ -- access type. If the access type's designated type is not controlled,
+ -- the actual would be null.
--
-- * Fin_Address - TSS routine Finalize_Address of the designated type.
-- If the designated type is not controlled, the actual would be null.
@@ -335,8 +314,8 @@ private
procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
-- Iterate over all subpools of Pool, detach them one by one and finalize
- -- their masters. This action first detaches a controlled object from a
- -- particular master, then invokes its Finalize_Address primitive.
+ -- their collections. This action first detaches a controlled object from a
+ -- particular collection, then invokes its Finalize_Address primitive.
function Header_Size_With_Padding
(Alignment : System.Storage_Elements.Storage_Count)
@@ -254,7 +254,6 @@ package Rtsfind is
System_Fat_LFlt,
System_Fat_LLF,
System_Fat_SFlt,
- System_Finalization_Masters,
System_Finalization_Primitives,
System_Finalization_Root,
System_Fore_Decimal_32,
@@ -918,16 +917,15 @@ package Rtsfind is
RE_Attr_Long_Long_Float, -- System.Fat_LLF
- RE_Add_Offset_To_Address, -- System.Finalization_Masters
- RE_Finalization_Master, -- System.Finalization_Masters
- RE_Finalization_Master_Ptr, -- System.Finalization_Masters
-
+ RE_Add_Offset_To_Address, -- System.Finalization_Primitives
RE_Attach_Object_To_Master, -- System.Finalization_Primitives
RE_Attach_Object_To_Node, -- System.Finalization_Primitives
RE_Chain_Node_To_Master, -- System.Finalization_Primitives
+ RE_Finalization_Collection, -- System.Finalization_Primitives
+ RE_Finalization_Collection_Ptr, -- System.Finalization_Primitives
+ RE_Finalization_Scope_Master, -- System.Finalization_Primitives
RE_Finalize_Master, -- System.Finalization_Primitives
RE_Finalize_Object, -- System.Finalization_Primitives
- RE_Finalization_Scope_Master, -- System.Finalization_Primitives
RE_Master_Node, -- System.Finalization_Primitives
RE_Suppress_Object_Finalize_At_End, -- System.Finalization_Primitives
@@ -2568,16 +2566,15 @@ package Rtsfind is
RE_Attr_Long_Long_Float => System_Fat_LLF,
- RE_Add_Offset_To_Address => System_Finalization_Masters,
- RE_Finalization_Master => System_Finalization_Masters,
- RE_Finalization_Master_Ptr => System_Finalization_Masters,
-
+ RE_Add_Offset_To_Address => System_Finalization_Primitives,
RE_Attach_Object_To_Master => System_Finalization_Primitives,
RE_Attach_Object_To_Node => System_Finalization_Primitives,
RE_Chain_Node_To_Master => System_Finalization_Primitives,
+ RE_Finalization_Collection => System_Finalization_Primitives,
+ RE_Finalization_Collection_Ptr => System_Finalization_Primitives,
+ RE_Finalization_Scope_Master => System_Finalization_Primitives,
RE_Finalize_Master => System_Finalization_Primitives,
RE_Finalize_Object => System_Finalization_Primitives,
- RE_Finalization_Scope_Master => System_Finalization_Primitives,
RE_Master_Node => System_Finalization_Primitives,
RE_Suppress_Object_Finalize_At_End => System_Finalization_Primitives,
@@ -1461,7 +1461,7 @@ package body Sem_Ch3 is
Set_Has_Timing_Event (T, False);
Set_Has_Controlled_Component (T, False);
- -- Initialize field Finalization_Master explicitly to Empty, to avoid
+ -- Initialize field Finalization_Collection explicitly to Empty to avoid
-- problems where an incomplete view of this entity has been previously
-- established by a limited with and an overlaid version of this field
-- (Stored_Constraint) was initialized for the incomplete view.
@@ -1469,10 +1469,10 @@ package body Sem_Ch3 is
-- This reset is performed in most cases except where the access type
-- has been created for the purposes of allocating or deallocating a
-- build-in-place object. Such access types have explicitly set pools
- -- and finalization masters.
+ -- and finalization collections.
if No (Associated_Storage_Pool (T)) then
- Set_Finalization_Master (T, Empty);
+ Set_Finalization_Collection (T, Empty);
end if;
-- Ada 2005 (AI-231): Propagate the null-excluding and access-constant
@@ -9302,24 +9302,24 @@ package body Sem_Ch6 is
end if;
-- In the case of functions whose result type needs finalization,
- -- add an extra formal which represents the finalization master.
+ -- add an extra formal which represents the caller's collection.
- if Needs_BIP_Finalization_Master (Ref_E)
+ if Needs_BIP_Collection (Ref_E)
or else
(Present (Parent_Subp)
and then Has_BIP_Extra_Formal (Parent_Subp,
- Kind => BIP_Finalization_Master,
+ Kind => BIP_Collection,
Must_Be_Frozen => False))
or else
(Present (Alias_Subp)
and then Has_BIP_Extra_Formal (Alias_Subp,
- Kind => BIP_Finalization_Master,
+ Kind => BIP_Collection,
Must_Be_Frozen => False))
then
Discard :=
Add_Extra_Formal
- (E, RTE (RE_Finalization_Master_Ptr),
- E, BIP_Formal_Suffix (BIP_Finalization_Master));
+ (E, RTE (RE_Finalization_Collection_Ptr),
+ E, BIP_Formal_Suffix (BIP_Collection));
end if;
-- When the result type contains tasks, add two extra formals: the
@@ -31047,8 +31047,8 @@ package body Sem_Util is
-- When a type associated with an indirect temporary gets
-- created for a 'Old attribute reference we need to mark
-- the type as such. This allows, for example, finalization
- -- masters associated with them to be finalized in the correct
- -- order after postcondition checks.
+ -- collections associated with them to be finalized in the
+ -- correct order after postcondition checks.
if Attribute_Name (Parent (Attr_Prefix)) = Name_Old then
Set_Stores_Attribute_Old_Prefix (Access_Type_Id);
From: Eric Botcazou <ebotcazou@adacore.com> This change replaces finalization masters with finalization collections in most cases, that is to say, when they implement a list of objects created by allocators of a given access type; indeed the moniker is overloaded in the front-end, e.g. Sem_Util.Is_Master determines if a node "constitutes a finalization master" but is not affected by the change. This is mostly a renaming at this stage, toward something more in keeping with the terminology used in the RM 7.6.1 clause and no functional changes: although it gets rid of the rest of the System.Finalization_Masters unit, the functionalities are reimplemented in the System.Finalization_Primitives unit in terms of collections with only minor adjustments. gcc/ada/ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Remove s-finmas$(objext). * einfo.ads (Anonymous_Masters): Rename into Anonymous_Collections. (Finalization_Master): Rename into Finalization_Collection. * gen_il-fields.ads (Opt_Field_Enum): Replace Anonymous_Masters with Anonymous_Collections; and Finalization_Master with Finalization_Collection. * gen_il-gen-gen_entities.adb (Access_Kind): Likewise. (E_Function): Likewise. (E_Procedure): Likewise. (E_Package): Likewise. (E_Subprogram_Body): Likewise. * exp_ch3.adb (Build_Heap_Or_Pool_Allocator): Adjust to renamings. (Freeze_Type): Likewise. (Stream_Operation_OK): Remove obsolete test. * exp_ch4.adb (Expand_Allocator_Expression): Adjust to renamings. (Expand_N_Allocator): Likewise. * exp_ch6.ads (BIP_Formal_Kind): Replace BIP_Finalization_Master with BIP_Collection. (Needs_BIP_Finalization_Master): Rename into... (Needs_BIP_Collection): ...this. * exp_ch6.adb (BIP_Finalization_Master_Suffix): Delete. (BIP_Collection_Suffix): New constant string. (Add_Finalization_Master_Actual_To_Build_In_Place_Call): Rename to (Add_Collection_Actual_To_Build_In_Place_Call): ...this and adjust. (BIP_Formal_Suffix): Replace BIP_Finalization_Master alternative with BIP_Collection alternative. (BIP_Suffix_Kind): Replace test on BIP_Finalization_Master_Suffix with test on BIP_Collection_Suffix. (Is_Build_In_Place_Entity): Likewise. (Make_Build_In_Place_Call_In_Allocator): Call Needs_BIP_Collection and Add_Collection_Actual_To_Build_In_Place_Call. (Make_Build_In_Place_Call_In_Anonymous_Context): Likewise. (Make_Build_In_Place_Call_In_Assignment): Likewise. (Make_Build_In_Place_Call_In_Object_Declaration): Likewise. (Needs_BIP_Finalization_Master): Rename into... (Needs_BIP_Collection): ...this. (Needs_BIP_Alloc_Form): Call Needs_BIP_Collection. * exp_ch7.ads (Build_Anonymous_Master): Rename into... (Build_Anonymous_Collection): ...this. (Build_Finalization_Master): Rename into... (Build_Finalization_Collection): ...this. * exp_ch7.adb (Allows_Finalization_Master): Rename into... (Allows_Finalization_Collection): ...this. (Build_BIP_Cleanup_Stmts): Adjust to renamings. (Build_Anonymous_Master): Rename into... (Build_Anonymous_Collection): ...this. Adjust to renamings. (Build_Finalization_Master): Rename into... (Build_Finalization_Collection): ...this. Adjust to renamings. (Build_Finalizer): Adjust comment to renamings. * exp_ch13.adb (Expand_N_Free_Statement): Adjust to renamings. * exp_util.adb (Build_Allocate_Deallocate_Proc): Likewise. (Requires_Cleanup_Actions): Adjust comment to renamings. * freeze.adb (Freeze_All): Likewise. * rtsfind.ads (RTU_Id): Remove System_Finalization_Masters. (RE_Id): Remove RE_Finalization_Master & RE_Finalization_Master_Ptr add RE_Finalization_Collection & RE_Finalization_Collection_Ptr. Adjust RE_Add_Offset_To_Address and RE_Finalization_Scope_Master. (RE_Unit_Table): Remove entries for RE_Finalization_Master & RE_Finalization_Master_Ptr, add ones for RE_Finalization_Collection & RE_Finalization_Collection_Ptr. Also adjust those of RE_Add_Offset_To_Address and RE_Finalization_Scope_Master. * sem_ch3.adb (Access_Type_Declaration): Adjust to renamings. * sem_ch6.adb (Create_Extra_Formals): Likewise. * sem_util.adb (Designated_Subtype_Mark): Likewise. * libgnat/s-finpri.ads: Add clauses for Ada.Finalization and System.Storage_Elements. (Finalization_Collection): New limited controlled type. (Finalization_Collection_Ptr): Likewise. (Initialize): New overriding procedure. (Finalize): Likewise. (Finalization_Started): Likewise. (Collection_Node): New type. (Collection_Node_Ptr): Likewise. (Attach_Node_To_Collection): New procedure. (Detach_Node_From_Collection): Likewise. (Header_Size): New function. (Add_Offset_To_Address): Likewise. * libgnat/s-finpri.adb (Add_Offset_To_Address): New function. (Attach_Node_To_Collection): New procedure. (Detach_Node_From_Collection): Likewise. (Finalization_Started): Likewise. (Finalize): New overriding procedure. (Header_Size): New function. (Initialize): New overriding procedure. * libgnat/s-spsufi.ads (Finalize_And_Deallocate): Adjust comment. * libgnat/s-spsufi.adb: Remove clause for Finalization_Masters and add clause for Finalization_Primitives. (Finalize_And_Deallocate): Finalize the Collection component. * libgnat/s-stposu.ads: Remove clause for Finalization_Masters and add clause for Finalization_Primitives. (Root_Subpool): Replace Master component with Collection. (Allocate_Any_Controlled): Replace Context_Master parameter with Context_Collection parameter. * libgnat/s-stposu.adb: Remove clauses for Finalization_Masters and add clauses for Finalization_Primitives. (Address_To_FM_Node_Ptr): Delete. (To_Collection_Node_Ptr): New instance of Ada.Unchecked_Conversion. (Adjust_Controlled_Dereference): Adjust comment to renamings. (Allocate_Any_Controlled): Replace Context_Master parameter with Context_Collection parameter. Adjust to renamings. (Deallocate_Any_Controlled): Adjust to renamings. (Print_Subpool): Likewise. * libgnat/s-finmas.ads: Delete. * libgnat/s-finmas.adb: Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/Makefile.rtl | 1 - gcc/ada/einfo.ads | 42 ++-- gcc/ada/exp_ch13.adb | 11 +- gcc/ada/exp_ch3.adb | 57 +++-- gcc/ada/exp_ch4.adb | 25 ++- gcc/ada/exp_ch6.adb | 177 ++++++++------- gcc/ada/exp_ch6.ads | 8 +- gcc/ada/exp_ch7.adb | 290 ++++++++++++------------- gcc/ada/exp_ch7.ads | 24 +- gcc/ada/exp_util.adb | 45 ++-- gcc/ada/freeze.adb | 8 +- gcc/ada/gen_il-fields.ads | 4 +- gcc/ada/gen_il-gen-gen_entities.adb | 10 +- gcc/ada/libgnat/s-finmas.adb | 326 ---------------------------- gcc/ada/libgnat/s-finmas.ads | 130 ----------- gcc/ada/libgnat/s-finpri.adb | 171 +++++++++++++++ gcc/ada/libgnat/s-finpri.ads | 100 +++++++++ gcc/ada/libgnat/s-spsufi.adb | 6 +- gcc/ada/libgnat/s-spsufi.ads | 2 +- gcc/ada/libgnat/s-stposu.adb | 103 +++++---- gcc/ada/libgnat/s-stposu.ads | 109 ++++------ gcc/ada/rtsfind.ads | 19 +- gcc/ada/sem_ch3.adb | 6 +- gcc/ada/sem_ch6.adb | 12 +- gcc/ada/sem_util.adb | 4 +- 25 files changed, 736 insertions(+), 954 deletions(-) delete mode 100644 gcc/ada/libgnat/s-finmas.adb delete mode 100644 gcc/ada/libgnat/s-finmas.ads