From 57ae790f79b9710229ec9c791bc0e05775f8e71b Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Fri, 22 May 2015 12:32:55 +0000 Subject: [PATCH] 2015-05-22 Hristian Kirtchev * einfo.adb Node36 is now used as Anonymous_Master. Flag253 is now unused. (Anonymous_Master): New routine. (Has_Anonymous_Master): Removed. (Set_Anonymous_Master): New routine. (Set_Has_Anonymous_Master): Removed. (Write_Entity_Flags): Remove the output for Has_Anonymous_Maser. (Write_Field36_Name): Add output for Anonymous_Master. * einfo.ads Add new attribute Anonymous_Master along with occurrences in nodes. Remove attribute Has_Anonymous_Master along with occurrences in nodes. (Anonymous_Master): New routine along with pragma Inline. (Has_Anonymous_Master): Removed along with pragma Inline. (Set_Anonymous_Master): New routine along with pragma Inline. (Set_Has_Anonymous_Master): Removed along with pragma Inline. * exp_ch4.adb (Create_Anonymous_Master): New routine. (Current_Anonymous_Master): Reimplemented. From-SVN: r223550 --- gcc/ada/ChangeLog | 20 ++++ gcc/ada/einfo.adb | 38 +++---- gcc/ada/einfo.ads | 28 +++-- gcc/ada/exp_ch4.adb | 242 +++++++++++++++++++++----------------------- 4 files changed, 170 insertions(+), 158 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b803fcd7990..e9160b3d9d4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2015-05-22 Hristian Kirtchev + + * einfo.adb Node36 is now used as Anonymous_Master. Flag253 + is now unused. + (Anonymous_Master): New routine. + (Has_Anonymous_Master): Removed. + (Set_Anonymous_Master): New routine. + (Set_Has_Anonymous_Master): Removed. + (Write_Entity_Flags): Remove the output for Has_Anonymous_Maser. + (Write_Field36_Name): Add output for Anonymous_Master. + * einfo.ads Add new attribute Anonymous_Master along with + occurrences in nodes. Remove attribute Has_Anonymous_Master along + with occurrences in nodes. + (Anonymous_Master): New routine along with pragma Inline. + (Has_Anonymous_Master): Removed along with pragma Inline. + (Set_Anonymous_Master): New routine along with pragma Inline. + (Set_Has_Anonymous_Master): Removed along with pragma Inline. + * exp_ch4.adb (Create_Anonymous_Master): New routine. + (Current_Anonymous_Master): Reimplemented. + 2015-05-22 Bob Duff * freeze.adb (Freeze_Profile): Suppress warning if imported diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 02433567e3c..1d8f4f43425 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -264,7 +264,8 @@ package body Einfo is -- Import_Pragma Node35 - -- (unused) Node36 + -- Anonymous_Master Node36 + -- (unused) Node38 -- (unused) Node39 -- (unused) Node40 @@ -556,7 +557,6 @@ package body Einfo is -- Has_Implicit_Dereference Flag251 -- Is_Processed_Transient Flag252 - -- Has_Anonymous_Master Flag253 -- Is_Implementation_Defined Flag254 -- Is_Predicate_Function Flag255 -- Is_Predicate_Function_M Flag256 @@ -594,6 +594,7 @@ package body Einfo is -- Has_Volatile_Full_Access Flag285 -- Needs_Typedef Flag286 + -- (unused) Flag253 -- (unused) Flag287 -- (unused) Flag288 -- (unused) Flag289 @@ -753,6 +754,12 @@ package body Einfo is return Uint14 (Id); end Alignment; + function Anonymous_Master (Id : E) return E is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure)); + return Node36 (Id); + end Anonymous_Master; + function Associated_Entity (Id : E) return E is begin return Node37 (Id); @@ -1375,13 +1382,6 @@ package body Einfo is return Flag79 (Id); end Has_All_Calls_Remote; - function Has_Anonymous_Master (Id : E) return B is - begin - pragma Assert - (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure)); - return Flag253 (Id); - end Has_Anonymous_Master; - function Has_Atomic_Components (Id : E) return B is begin return Flag86 (Implementation_Base_Type (Id)); @@ -3576,6 +3576,12 @@ package body Einfo is Set_Elist16 (Id, V); end Set_Access_Disp_Table; + procedure Set_Anonymous_Master (Id : E; V : E) is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure)); + Set_Node36 (Id, V); + end Set_Anonymous_Master; + procedure Set_Associated_Entity (Id : E; V : E) is begin Set_Node37 (Id, V); @@ -4246,13 +4252,6 @@ package body Einfo is Set_Flag79 (Id, V); end Set_Has_All_Calls_Remote; - procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is - begin - pragma Assert - (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure)); - Set_Flag253 (Id, V); - end Set_Has_Anonymous_Master; - procedure Set_Has_Atomic_Components (Id : E; V : B := True) is begin pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id)); @@ -8634,7 +8633,6 @@ package body Einfo is W ("Has_Aliased_Components", Flag135 (Id)); W ("Has_Alignment_Clause", Flag46 (Id)); W ("Has_All_Calls_Remote", Flag79 (Id)); - W ("Has_Anonymous_Master", Flag253 (Id)); W ("Has_Atomic_Components", Flag86 (Id)); W ("Has_Biased_Representation", Flag139 (Id)); W ("Has_Completion", Flag26 (Id)); @@ -10121,6 +10119,12 @@ package body Einfo is procedure Write_Field36_Name (Id : Entity_Id) is begin case Ekind (Id) is + when E_Function | + E_Operator | + E_Package | + E_Procedure => + Write_Str ("Anonymous_Master"); + when others => Write_Str ("Field36??"); end case; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 58f35215ef1..1fe9d7d8b5e 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -436,6 +436,12 @@ package Einfo is -- definition clause with an (obsolescent) mod clause is converted -- into an attribute definition clause for this purpose. +-- Anonymous_Master (Node36) +-- Defined in the entities of non-generic subprogram and package units. +-- Contains the entity of a special heterogeneous finalization master +-- that services most anonymous access-to-controlled allocations that +-- occur within the unit. + -- Associated_Entity (Node37) -- Defined in all entities. This field is similar to Associated_Node, but -- applied to entities. The attribute links an entity from the generic @@ -1423,13 +1429,6 @@ package Einfo is -- entities, so the flag Is_Remote_Call_Interface will always be set if -- this flag is set. --- Has_Anonymous_Master (Flag253) --- Defined in units (top-level functions and procedures, library-level --- packages). Set if the associated unit contains a heterogeneous --- finalization master. The master's name is of the form AM and it --- services anonymous access-to-controlled types with an undetermined --- lifetime. - -- Has_Atomic_Components (Flag86) [implementation base type only] -- Defined in all types and objects. Set only for an array type or -- an array object if a valid pragma Atomic_Components applies to the @@ -5833,6 +5832,7 @@ package Einfo is -- Linker_Section_Pragma (Node33) -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) + -- Anonymous_Master (Node36) (non-generic case only) -- Body_Needed_For_SAL (Flag40) -- Contains_Ignored_Ghost_Code (Flag279) -- Default_Expressions_Processed (Flag108) @@ -5840,7 +5840,6 @@ package Einfo is -- Delay_Subprogram_Descriptors (Flag50) -- Discard_Names (Flag88) -- Elaboration_Entity_Required (Flag174) - -- Has_Anonymous_Master (Flag253) -- Has_Completion (Flag26) -- Has_Controlling_Result (Flag98) -- Has_Expanded_Contract (Flag240) (non-generic case only) @@ -6050,6 +6049,7 @@ package Einfo is -- SPARK_Pragma (Node32) -- SPARK_Aux_Pragma (Node33) -- Contract (Node34) + -- Anonymous_Master (Node36) (non-generic case only) -- Delay_Subprogram_Descriptors (Flag50) -- Body_Needed_For_SAL (Flag40) -- Contains_Ignored_Ghost_Code (Flag279) @@ -6058,7 +6058,6 @@ package Einfo is -- Elaborate_Body_Desirable (Flag210) (non-generic case only) -- From_Limited_With (Flag159) -- Has_All_Calls_Remote (Flag79) - -- Has_Anonymous_Master (Flag253) -- Has_Completion (Flag26) -- Has_Forward_Instantiation (Flag175) -- Has_Master_Entity (Flag21) @@ -6089,7 +6088,6 @@ package Einfo is -- Contract (Node34) -- Contains_Ignored_Ghost_Code (Flag279) -- Delay_Subprogram_Descriptors (Flag50) - -- Has_Anonymous_Master (Flag253) -- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Pragma_Inherited (Flag265) -- Scope_Depth (synth) @@ -6139,6 +6137,7 @@ package Einfo is -- Linker_Section_Pragma (Node33) -- Contract (Node34) -- Import_Pragma (Node35) (non-generic case only) + -- Anonymous_Master (Node36) (non-generic case only) -- Body_Needed_For_SAL (Flag40) -- Contains_Ignored_Ghost_Code (Flag279) -- Delay_Cleanups (Flag114) @@ -6148,7 +6147,6 @@ package Einfo is -- Delay_Cleanups (Flag114) -- Delay_Subprogram_Descriptors (Flag50) -- Discard_Names (Flag88) - -- Has_Anonymous_Master (Flag253) -- Has_Completion (Flag26) -- Has_Expanded_Contract (Flag240) (non-generic case only) -- Has_Invariants (Flag232) @@ -6647,6 +6645,7 @@ package Einfo is function Address_Taken (Id : E) return B; function Alias (Id : E) return E; function Alignment (Id : E) return U; + function Anonymous_Master (Id : E) return E; function Associated_Entity (Id : E) return E; function Associated_Formal_Package (Id : E) return E; function Associated_Node_For_Itype (Id : E) return N; @@ -6750,7 +6749,6 @@ package Einfo is function Has_Aliased_Components (Id : E) return B; function Has_Alignment_Clause (Id : E) return B; function Has_All_Calls_Remote (Id : E) return B; - function Has_Anonymous_Master (Id : E) return B; function Has_Atomic_Components (Id : E) return B; function Has_Biased_Representation (Id : E) return B; function Has_Completion (Id : E) return B; @@ -7301,6 +7299,7 @@ package Einfo is procedure Set_Address_Taken (Id : E; V : B := True); procedure Set_Alias (Id : E; V : E); procedure Set_Alignment (Id : E; V : U); + procedure Set_Anonymous_Master (Id : E; V : E); procedure Set_Associated_Entity (Id : E; V : E); procedure Set_Associated_Formal_Package (Id : E; V : E); procedure Set_Associated_Node_For_Itype (Id : E; V : N); @@ -7403,7 +7402,6 @@ package Einfo is procedure Set_Has_Aliased_Components (Id : E; V : B := True); procedure Set_Has_Alignment_Clause (Id : E; V : B := True); procedure Set_Has_All_Calls_Remote (Id : E; V : B := True); - procedure Set_Has_Anonymous_Master (Id : E; V : B := True); procedure Set_Has_Atomic_Components (Id : E; V : B := True); procedure Set_Has_Biased_Representation (Id : E; V : B := True); procedure Set_Has_Completion (Id : E; V : B := True); @@ -8076,6 +8074,7 @@ package Einfo is pragma Inline (Address_Taken); pragma Inline (Alias); pragma Inline (Alignment); + pragma Inline (Anonymous_Master); pragma Inline (Associated_Entity); pragma Inline (Associated_Formal_Package); pragma Inline (Associated_Node_For_Itype); @@ -8176,7 +8175,6 @@ package Einfo is pragma Inline (Has_Aliased_Components); pragma Inline (Has_Alignment_Clause); pragma Inline (Has_All_Calls_Remote); - pragma Inline (Has_Anonymous_Master); pragma Inline (Has_Atomic_Components); pragma Inline (Has_Biased_Representation); pragma Inline (Has_Completion); @@ -8577,6 +8575,7 @@ package Einfo is pragma Inline (Set_Address_Taken); pragma Inline (Set_Alias); pragma Inline (Set_Alignment); + pragma Inline (Set_Anonymous_Master); pragma Inline (Set_Associated_Entity); pragma Inline (Set_Associated_Formal_Package); pragma Inline (Set_Associated_Node_For_Itype); @@ -8675,7 +8674,6 @@ package Einfo is pragma Inline (Set_Has_Aliased_Components); pragma Inline (Set_Has_Alignment_Clause); pragma Inline (Set_Has_All_Calls_Remote); - pragma Inline (Set_Has_Anonymous_Master); pragma Inline (Set_Has_Atomic_Components); pragma Inline (Set_Has_Biased_Representation); pragma Inline (Set_Has_Completion); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index a2b938d311f..e5b47531e31 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -415,174 +415,164 @@ package body Exp_Ch4 is ------------------------------ function Current_Anonymous_Master return Entity_Id is - Decls : List_Id; - Loc : Source_Ptr; - Subp_Body : Node_Id; - Unit_Decl : Node_Id; - Unit_Id : Entity_Id; + function Create_Anonymous_Master + (Unit_Id : Entity_Id; + Decls : List_Id) return Entity_Id; + -- Create a new anonymous finalization master for a unit denoted by + -- Unit_Id. The declaration of the master along with any specialized + -- initialization is inserted at the top of declarative list Decls. + -- Return the entity of the anonymous master. - begin - Unit_Id := Cunit_Entity (Current_Sem_Unit); + ----------------------------- + -- Create_Anonymous_Master -- + ----------------------------- - -- Find the entity of the current unit + function Create_Anonymous_Master + (Unit_Id : Entity_Id; + Decls : List_Id) return Entity_Id + is + First_Decl : Node_Id := Empty; + -- The first declaration of list Decls. This variable is used when + -- inserting various actions. - if Ekind (Unit_Id) = E_Subprogram_Body then + procedure Insert_And_Analyze (Action : Node_Id); + -- Insert arbitrary node Action in declarative list Decl and analyze + -- it. - -- When processing subprogram bodies, the proper scope is always that - -- of the spec. + ------------------------ + -- Insert_And_Analyze -- + ------------------------ - Subp_Body := Unit_Id; - while Present (Subp_Body) - and then Nkind (Subp_Body) /= N_Subprogram_Body - loop - Subp_Body := Parent (Subp_Body); - end loop; + procedure Insert_And_Analyze (Action : Node_Id) is + begin + -- The list is already populated, the actions are inserted at the + -- top of the list, preserving their order. - Unit_Id := Corresponding_Spec (Subp_Body); - end if; + if Present (First_Decl) then + Insert_Before_And_Analyze (First_Decl, Action); - Loc := Sloc (Unit_Id); - Unit_Decl := Unit (Cunit (Current_Sem_Unit)); + -- Otherwise append to the declarations to preserve order - -- Find the declarations list of the current unit + else + Append_To (Decls, Action); + Analyze (Action); + end if; + end Insert_And_Analyze; - if Nkind (Unit_Decl) = N_Package_Declaration then - Unit_Decl := Specification (Unit_Decl); - Decls := Visible_Declarations (Unit_Decl); + -- Local variables - if No (Decls) then - Decls := New_List (Make_Null_Statement (Loc)); - Set_Visible_Declarations (Unit_Decl, Decls); + Loc : constant Source_Ptr := Sloc (Unit_Id); + FM_Id : Entity_Id; - elsif Is_Empty_List (Decls) then - Append_To (Decls, Make_Null_Statement (Loc)); - end if; + -- Start of processing for Create_Anonymous_Master - else - Decls := Declarations (Unit_Decl); - - if No (Decls) then - Decls := New_List (Make_Null_Statement (Loc)); - Set_Declarations (Unit_Decl, Decls); - - elsif Is_Empty_List (Decls) then - Append_To (Decls, Make_Null_Statement (Loc)); + begin + if Present (Decls) then + First_Decl := First (Decls); end if; - end if; - - -- The current unit has an existing anonymous master, traverse its - -- declarations and locate the entity. - - if Has_Anonymous_Master (Unit_Id) then - declare - Decl : Node_Id; - Fin_Mas_Id : Entity_Id; - begin - Decl := First (Decls); - while Present (Decl) loop - - -- Look for the first variable in the declarations whole type - -- is Finalization_Master. - - if Nkind (Decl) = N_Object_Declaration then - Fin_Mas_Id := Defining_Identifier (Decl); - - if Ekind (Fin_Mas_Id) = E_Variable - and then Etype (Fin_Mas_Id) = RTE (RE_Finalization_Master) - then - return Fin_Mas_Id; - end if; - end if; + -- Since the anonymous master and all its initialization actions are + -- inserted at top level, use the scope of the unit when analyzing. - Next (Decl); - end loop; + Push_Scope (Unit_Id); - -- The master was not found even though the unit was labeled as - -- having one. + -- Create the anonymous master - raise Program_Error; - end; + FM_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Unit_Id), "AM")); + Set_Anonymous_Master (Unit_Id, FM_Id); - -- Create a new anonymous master + -- Generate: + -- : Finalization_Master; - else - declare - First_Decl : constant Node_Id := First (Decls); - Action : Node_Id; - Fin_Mas_Id : Entity_Id; + Insert_And_Analyze + (Make_Object_Declaration (Loc, + Defining_Identifier => FM_Id, + Object_Definition => + New_Occurrence_Of (RTE (RE_Finalization_Master), Loc))); - begin - -- Since the master and its associated initialization is inserted - -- at top level, use the scope of the unit when analyzing. + -- Do not set the base pool and mode of operation on .NET/JVM since + -- those targets do not support pools and all VM masters defaulted to + -- heterogeneous. - Push_Scope (Unit_Id); + if VM_Target = No_VM then - -- Create the finalization master + -- Generate: + -- Set_Base_Pool + -- (, Global_Pool_Object'Unrestricted_Access); - Fin_Mas_Id := - Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Unit_Id), "AM")); + Insert_And_Analyze + (Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (FM_Id, Loc), + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc), + Attribute_Name => Name_Unrestricted_Access)))); -- Generate: - -- : Finalization_Master; + -- Set_Is_Heterogeneous (); - Action := - Make_Object_Declaration (Loc, - Defining_Identifier => Fin_Mas_Id, - Object_Definition => - New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)); - - Insert_Before_And_Analyze (First_Decl, Action); + Insert_And_Analyze + (Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (FM_Id, Loc)))); + end if; - -- Mark the unit to prevent the generation of multiple masters + Pop_Scope; - Set_Has_Anonymous_Master (Unit_Id); + return FM_Id; + end Create_Anonymous_Master; - -- Do not set the base pool and mode of operation on .NET/JVM - -- since those targets do not support pools and all VM masters - -- are heterogeneous by default. + -- Local declarations - if VM_Target = No_VM then + Unit_Decl : constant Node_Id := Unit (Cunit (Current_Sem_Unit)); + Unit_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl); + Decls : List_Id; + FM_Id : Entity_Id; + Unit_Spec : Node_Id; - -- Generate: - -- Set_Base_Pool - -- (, Global_Pool_Object'Unrestricted_Access); + -- Start of processing for Current_Anonymous_Master - Action := - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc), + begin + FM_Id := Anonymous_Master (Unit_Id); - Parameter_Associations => New_List ( - New_Occurrence_Of (Fin_Mas_Id, Loc), - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc), - Attribute_Name => Name_Unrestricted_Access))); + -- Create a new anonymous master when allocating an object of anonymous + -- access-to-controlled type for the first time. - Insert_Before_And_Analyze (First_Decl, Action); + if No (FM_Id) then - -- Generate: - -- Set_Is_Heterogeneous (); + -- Find the declarative list of the current unit - Action := - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Fin_Mas_Id, Loc))); + if Nkind (Unit_Decl) = N_Package_Declaration then + Unit_Spec := Specification (Unit_Decl); + Decls := Visible_Declarations (Unit_Spec); - Insert_Before_And_Analyze (First_Decl, Action); + if No (Decls) then + Decls := New_List; + Set_Visible_Declarations (Unit_Spec, Decls); end if; - -- Restore the original state of the scope stack + -- Package or subprogram body - Pop_Scope; + else + Decls := Declarations (Unit_Decl); - return Fin_Mas_Id; - end; + if No (Decls) then + Decls := New_List; + Set_Declarations (Unit_Decl, Decls); + end if; + end if; + + FM_Id := Create_Anonymous_Master (Unit_Id, Decls); end if; + + return FM_Id; end Current_Anonymous_Master; -------------------------------- -- 2.30.2