diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/Makefile.rtl | 1 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 42 | ||||
| -rw-r--r-- | gcc/ada/exp_ch13.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 57 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 177 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 290 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.ads | 24 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/gen_il-fields.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/gen_il-gen-gen_entities.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-finmas.adb | 326 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-finmas.ads | 130 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-finpri.adb | 171 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-finpri.ads | 100 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-spsufi.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-spsufi.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-stposu.adb | 103 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-stposu.ads | 109 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 4 |
25 files changed, 736 insertions, 954 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index ad3e638..9c5bce9 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -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) \ diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c45c124..71c560d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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_Designated_Type --- Defined in variables which represent anonymous finalization masters. --- Contains the designated type which is being serviced by the master. - --- Anonymous_Masters +-- Anonymous_Collections -- Defined in packages, subprograms, and subprogram bodies. Contains a --- list of anonymous finalization masters declared within the related --- unit. The list acts as a mapping between a master and a designated --- type. +-- 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_Master [root type only] +-- Finalization_Collection [root type only] -- Defined in access-to-controlled or access-to-class-wide types. The --- field contains the entity of the finalization master which handles --- dynamically allocated controlled objects referenced by the access --- type. Empty for access-to-subprogram types. Empty for access types --- whose designated type does not need finalization actions. +-- 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 diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index cf56c6b..6399524 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f8d41b1..f998937 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 505c4b3..7916a04 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 928307a..1ed8325 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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; diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 79e4120..e95a052 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -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 diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index f4a0a85..50d5359 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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; diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 9a4797d..73a822b 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 533127f..efc9ef0 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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)) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4cb5979..dd4eff1 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index f53b565..594aeb6 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -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, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 50bcec8..f5b1b43 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -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), diff --git a/gcc/ada/libgnat/s-finmas.adb b/gcc/ada/libgnat/s-finmas.adb deleted file mode 100644 index f0e0816..0000000 --- a/gcc/ada/libgnat/s-finmas.adb +++ /dev/null @@ -1,326 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2015-2024, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -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; diff --git a/gcc/ada/libgnat/s-finmas.ads b/gcc/ada/libgnat/s-finmas.ads deleted file mode 100644 index 8518049..0000000 --- a/gcc/ada/libgnat/s-finmas.ads +++ /dev/null @@ -1,130 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S -- --- -- --- S p e c -- --- -- --- Copyright (C) 2011-2024, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -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; diff --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb index 05bf2a6..2abc9f4 100644 --- a/gcc/ada/libgnat/s-finpri.adb +++ b/gcc/ada/libgnat/s-finpri.adb @@ -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 -- ------------------------------------- diff --git a/gcc/ada/libgnat/s-finpri.ads b/gcc/ada/libgnat/s-finpri.ads index 7a47443..0632a72 100644 --- a/gcc/ada/libgnat/s-finpri.ads +++ b/gcc/ada/libgnat/s-finpri.ads @@ -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; diff --git a/gcc/ada/libgnat/s-spsufi.adb b/gcc/ada/libgnat/s-spsufi.adb index a59548b..dd7a6e7 100644 --- a/gcc/ada/libgnat/s-spsufi.adb +++ b/gcc/ada/libgnat/s-spsufi.adb @@ -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 diff --git a/gcc/ada/libgnat/s-spsufi.ads b/gcc/ada/libgnat/s-spsufi.ads index 097fb18..ade2c9a 100644 --- a/gcc/ada/libgnat/s-spsufi.ads +++ b/gcc/ada/libgnat/s-spsufi.ads @@ -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 diff --git a/gcc/ada/libgnat/s-stposu.adb b/gcc/ada/libgnat/s-stposu.adb index 7bd90cc..ebbd3e4 100644 --- a/gcc/ada/libgnat/s-stposu.adb +++ b/gcc/ada/libgnat/s-stposu.adb @@ -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; ------------------------- diff --git a/gcc/ada/libgnat/s-stposu.ads b/gcc/ada/libgnat/s-stposu.ads index 823f5e5..f3b908d 100644 --- a/gcc/ada/libgnat/s-stposu.ads +++ b/gcc/ada/libgnat/s-stposu.ads @@ -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) diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 8261482..266bdb4 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ad9e931..1d95b12 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fb43b04..446a0b8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5791725..6350524 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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); |