From d65a80fd559aca749b54eb6affd71d2d84f410f8 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Fri, 13 Jan 2017 09:34:48 +0000 Subject: atree.adb (Allocate_Initialize_Node): A newly created node is no longer marked as Ghost at this level. 2017-01-13 Hristian Kirtchev * atree.adb (Allocate_Initialize_Node): A newly created node is no longer marked as Ghost at this level. (Mark_New_Ghost_Node): New routine. (New_Copy): Mark the copy as Ghost. (New_Entity): Mark the entity as Ghost. (New_Node): Mark the node as Ghost. * einfo.adb (Is_Checked_Ghost_Entity): This attribute can now apply to unanalyzed entities. (Is_Ignored_Ghost_Entity): This attribute can now apply to unanalyzed entities. (Set_Is_Checked_Ghost_Entity): This attribute now applies to all entities as well as unanalyzed entities. (Set_Is_Ignored_Ghost_Entity): This attribute now applies to all entities as well as unanalyzed entities. * expander.adb Add with and use clauses for Ghost. (Expand): Install and revert the Ghost region associated with the node being expanded. * exp_ch3.adb (Expand_Freeze_Array_Type): Remove all Ghost-related code. (Expand_Freeze_Class_Wide_Type): Remoe all Ghost-related code. (Expand_Freeze_Enumeration_Type): Remove all Ghost-related code. (Expand_Freeze_Record_Type): Remove all Ghost-related code. (Freeze_Type): Install and revert the Ghost region associated with the type being frozen. * exp_ch5.adb Remove with and use clauses for Ghost. (Expand_N_Assignment_Statement): Remove all Ghost-related code. * exp_ch6.adb Remove with and use clauses for Ghost. (Expand_N_Procedure_Call_Statement): Remove all Ghost-relatd code. (Expand_N_Subprogram_Body): Remove all Ghost-related code. * exp_ch7.adb (Build_Invariant_Procedure_Body): Install and revert the Ghost region of the working type. (Build_Invariant_Procedure_Declaration): Install and revert the Ghost region of the working type. (Expand_N_Package_Body): Remove all Ghost-related code. * exp_ch8.adb Remove with and use clauses for Ghost. (Expand_N_Exception_Renaming_Declaration): Remove all Ghost-related code. (Expand_N_Object_Renaming_Declaration): Remove all Ghost-related code. (Expand_N_Package_Renaming_Declaration): Remove all Ghost-related code. (Expand_N_Subprogram_Renaming_Declaration): Remove all Ghost-related code. * exp_ch13.adb Remove with and use clauses for Ghost. (Expand_N_Freeze_Entity): Remove all Ghost-related code. * exp_disp.adb (Make_DT): Install and revert the Ghost region of the tagged type. Move the generation of various entities within the Ghost region of the type. * exp_prag.adb Remove with and use clauses for Ghost. (Expand_Pragma_Check): Remove all Ghost-related code. (Expand_Pragma_Contract_Cases): Remove all Ghost-related code. (Expand_Pragma_Initial_Condition): Remove all Ghost-related code. (Expand_Pragma_Loop_Variant): Remove all Ghost-related code. * exp_util.adb (Build_DIC_Procedure_Body): Install and revert the Ghost region of the working types. (Build_DIC_Procedure_Declaration): Install and revert the Ghost region of the working type. (Make_Invariant_Call): Install and revert the Ghost region of the associated type. (Make_Predicate_Call): Reimplemented. Install and revert the Ghost region of the associated type. * freeze.adb (Freeze_Entity): Install and revert the Ghost region of the entity being frozen. (New_Freeze_Node): Removed. * ghost.adb Remove with and use clauses for Opt. (Check_Ghost_Completion): Update the parameter profile and all references to formal parameters. (Ghost_Entity): Update the comment on usage. (Install_Ghost_Mode): New routines. (Is_Ghost_Assignment): New routine. (Is_Ghost_Declaration): New routine. (Is_Ghost_Pragma): New routine. (Is_Ghost_Procedure_Call): New routine. (Is_Ghost_Renaming): Removed. (Is_OK_Declaration): Reimplemented. (Is_OK_Pragma): Reimplemented. (Is_OK_Statement): Reimplemented. (Is_Subject_To_Ghost): Update the comment on usage. (Mark_And_Set_Ghost_Assignment): New routine. (Mark_And_Set_Ghost_Body): New routine. (Mark_And_Set_Ghost_Completion): New routine. (Mark_And_Set_Ghost_Declaration): New routine. (Mark_And_Set_Ghost_Instantiation): New routine. (Mark_And_Set_Ghost_Procedure_Call): New routine. (Mark_Full_View_As_Ghost): Removed. (Mark_Ghost_Declaration_Or_Body): New routine. (Mark_Ghost_Pragma): New routine. (Mark_Ghost_Renaming): New routine. (Mark_Pragma_As_Ghost): Removed. (Mark_Renaming_As_Ghost): Removed. (Propagate_Ignored_Ghost_Code): Update the comment on usage. (Prune_Node): Freeze nodes no longer need special pruning, they are processed by the general ignored Ghost code mechanism. (Restore_Ghost_Mode): New routine. (Set_Ghost_Mode): Reimplemented. (Set_Ghost_Mode_From_Entity): Removed. * ghost.ads Add with and use clauses for Ghost. (Check_Ghost_Completion): Update the parameter profile along with the comment on usage. (Install_Ghost_Mode): New routine. (Is_Ghost_Assignment): New routine. (Is_Ghost_Declaration): New routine. (Is_Ghost_Pragma): New routine. (Is_Ghost_Procedure_Call): New routine. (Mark_And_Set_Ghost_Assignment): New routine. (Mark_And_Set_Ghost_Body): New routine. (Mark_And_Set_Ghost_Completion): New routine. (Mark_And_Set_Ghost_Declaration): New routine. (Mark_And_Set_Ghost_Instantiation): New routine. (Mark_And_Set_Ghost_Procedure_Call): New routine. (Mark_Full_View_As_Ghost): Removed. (Mark_Ghost_Pragma): New routine. (Mark_Ghost_Renaming): New routine. (Mark_Pragma_As_Ghost): Removed. (Mark_Renaming_As_Ghost): Removed. (Restore_Ghost_Mode): New routine. (Set_Ghost_Mode): Redefined. (Set_Ghost_Mode_From_Entity): Removed. * sem.adb (Analyze): Install and revert the Ghost region of the node being analyzed. (Do_Analyze): Change the way a clean Ghost region is installed and reverted. * sem_ch3.adb (Analyze_Full_Type_Declaration): Remove all Ghost-related code. (Analyze_Incomplete_Type_Decl): Remove all Ghost-related code. (Analyze_Number_Declaration): Remove all Ghost-related code. (Analyze_Object_Declaration): Install and revert the Ghost region of a deferred object declaration's completion. (Array_Type_Declaration): Remove all Ghost-related code. (Build_Derived_Type): Update the comment on the propagation of Ghost attributes from a parent to a derived type. (Derive_Subprogram): Remove all Ghost-related code. (Make_Class_Wide_Type): Remove all Ghost-related code. (Make_Implicit_Base): Remove all Ghost-related code. (Process_Full_View): Install and revert the Ghost region of the partial view. There is no longer need to check the Ghost completion here. * sem_ch5.adb (Analyze_Assignment): Install and revert the Ghost region of the left hand side. * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Remove all Ghost-related code. (Analyze_Expression_Function): Remove all Ghost-related code. (Analyze_Generic_Subprogram_Body): Remove all Ghost-related code. (Analyze_Procedure_Call): Install and revert the Ghost region of the procedure being called. (Analyze_Subprogram_Body_Helper): Install and revert the Ghost region of the spec or body. (Analyze_Subprogram_Declaration): Remove all Ghost-related code. (Build_Subprogram_Declaration): Remove all Ghost-related code. (Find_Corresponding_Spec): Remove all Ghost-related code. (Process_Formals): Remove all Ghost-related code. * sem_ch7.adb (Analyze_Package_Body_Helper): Install and revert the Ghost region of the spec. (Analyze_Package_Declaration): Remove all Ghost-related code. * sem_ch8.adb (Analyze_Exception_Renaming): Mark a renaming as Ghost when it aliases a Ghost entity. (Analyze_Generic_Renaming): Mark a renaming as Ghost when it aliases a Ghost entity. (Analyze_Object_Renaming): Mark a renaming as Ghost when it aliases a Ghost entity. (Analyze_Package_Renaming): Mark a renaming as Ghost when it aliases a Ghost entity. (Analyze_Subprogram_Renaming): Mark a renaming as Ghost when it aliases a Ghost entity. * sem_ch11.adb Remove with and use clauses for Ghost. (Analyze_Exception_Declaration): Remove all Ghost-related code. * sem_ch12.adb (Analyze_Generic_Package_Declaration): Remove all Ghost-related code. (Analyze_Generic_Subprogram_Declaration): Remove all Ghost-related code. (Analyze_Package_Instantiation): Install and revert the Ghost region of the package instantiation. (Analyze_Subprogram_Instantiation): Install and revert the Ghost region of the subprogram instantiation. (Instantiate_Package_Body): Code clean up. Install and revert the Ghost region of the package body. (Instantiate_Subprogram_Body): Code clean up. Install and revert the Ghost region of the subprogram body. * sem_ch13.adb (Build_Predicate_Functions): Install and revert the Ghost region of the related type. (Build_Predicate_Function_Declaration): Code clean up. Install and rever the Ghost region of the related type. * sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part): Install and revert the Ghost region of the pragma. (Analyze_Initial_Condition_In_Decl_Part): Install and revert the Ghost region of the pragma. (Analyze_Pragma): Install and revert the Ghost region of various pragmas. Mark a pragma as Ghost when it is related to a Ghost entity or encloses a Ghost entity. (Analyze_Pre_Post_Condition): Install and revert the Ghost region of the pragma. (Analyze_Pre_Post_Condition_In_Decl_Part): Install and revert the Ghost region of the pragma. * sem_res.adb (Resolve): Remove all Ghost-related code. * sem_util.adb (Is_Declaration): Reimplemented. (Is_Declaration_Other_Than_Renaming): New routine. * sem_util.ads (Is_Declaration_Other_Than_Renaming): New routine. * sinfo.adb (Is_Checked_Ghost_Pragma): New routine. (Is_Ghost_Pragma): Removed. (Is_Ignored_Ghost_Pragma): New routine. (Set_Is_Checked_Ghost_Pragma): New routine. (Set_Is_Ghost_Pragma): Removed. (Set_Is_Ignored_Ghost_Pragma): New routine. * sinfo.ads: Update the documentation on Ghost mode and Ghost regions. New attributes Is_Checked_Ghost_Pragma and Is_Ignored_Ghost_Pragma along with usages in nodes. Remove attribute Is_Ghost_Pragma along with usages in nodes. (Is_Checked_Ghost_Pragma): New routine along with pragma Inline. (Is_Ghost_Pragma): Removed along with pragma Inline. (Is_Ignored_Ghost_Pragma): New routine along with pragma Inline. (Set_Is_Checked_Ghost_Pragma): New routine along with pragma Inline. (Set_Is_Ghost_Pragma): Removed along with pragma Inline. (Set_Is_Ignored_Ghost_Pragma): New routine along with pragma Inline. From-SVN: r244395 --- gcc/ada/exp_disp.adb | 111 ++++++++++++++++++++++++--------------------------- 1 file changed, 53 insertions(+), 58 deletions(-) (limited to 'gcc/ada/exp_disp.adb') diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 03c4558..034e199 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -4367,71 +4367,62 @@ package body Exp_Disp is -- Local variables - Elab_Code : constant List_Id := New_List; - Result : constant List_Id := New_List; - Tname : constant Name_Id := Chars (Typ); + Elab_Code : constant List_Id := New_List; + Result : constant List_Id := New_List; + Tname : constant Name_Id := Chars (Typ); + + -- The following name entries are used by Make_DT to generate a number + -- of entities related to a tagged type. These entities may be generated + -- in a scope other than that of the tagged type declaration, and if + -- the entities for two tagged types with the same name happen to be + -- generated in the same scope, we have to take care to use different + -- names. This is achieved by means of a unique serial number appended + -- to each generated entity name. + + Name_DT : constant Name_Id := + New_External_Name (Tname, 'T', Suffix_Index => -1); + Name_Exname : constant Name_Id := + New_External_Name (Tname, 'E', Suffix_Index => -1); + Name_HT_Link : constant Name_Id := + New_External_Name (Tname, 'H', Suffix_Index => -1); + Name_Predef_Prims : constant Name_Id := + New_External_Name (Tname, 'R', Suffix_Index => -1); + Name_SSD : constant Name_Id := + New_External_Name (Tname, 'S', Suffix_Index => -1); + Name_TSD : constant Name_Id := + New_External_Name (Tname, 'B', Suffix_Index => -1); + AI : Elmt_Id; AI_Tag_Elmt : Elmt_Id; AI_Tag_Comp : Elmt_Id; + DT : Entity_Id; DT_Aggr_List : List_Id; DT_Constr_List : List_Id; DT_Ptr : Entity_Id; + Exname : Entity_Id; + HT_Link : Entity_Id; ITable : Node_Id; I_Depth : Nat := 0; Iface_Table_Node : Node_Id; + Mode : Ghost_Mode_Type; Name_ITable : Name_Id; Nb_Predef_Prims : Nat := 0; Nb_Prim : Nat := 0; New_Node : Node_Id; Num_Ifaces : Nat := 0; Parent_Typ : Entity_Id; + Predef_Prims : Entity_Id; Prim : Entity_Id; Prim_Elmt : Elmt_Id; Prim_Ops_Aggr_List : List_Id; + SSD : Entity_Id; Suffix_Index : Int; Typ_Comps : Elist_Id; Typ_Ifaces : Elist_Id; + TSD : Entity_Id; TSD_Aggr_List : List_Id; TSD_Tags_List : List_Id; - Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; - - -- The following name entries are used by Make_DT to generate a number - -- of entities related to a tagged type. These entities may be generated - -- in a scope other than that of the tagged type declaration, and if - -- the entities for two tagged types with the same name happen to be - -- generated in the same scope, we have to take care to use different - -- names. This is achieved by means of a unique serial number appended - -- to each generated entity name. - - Name_DT : constant Name_Id := - New_External_Name (Tname, 'T', Suffix_Index => -1); - Name_Exname : constant Name_Id := - New_External_Name (Tname, 'E', Suffix_Index => -1); - Name_HT_Link : constant Name_Id := - New_External_Name (Tname, 'H', Suffix_Index => -1); - Name_Predef_Prims : constant Name_Id := - New_External_Name (Tname, 'R', Suffix_Index => -1); - Name_SSD : constant Name_Id := - New_External_Name (Tname, 'S', Suffix_Index => -1); - Name_TSD : constant Name_Id := - New_External_Name (Tname, 'B', Suffix_Index => -1); - - -- Entities built with above names - - DT : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_DT); - Exname : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_Exname); - HT_Link : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_HT_Link); - Predef_Prims : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_Predef_Prims); - SSD : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_SSD); - TSD : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_TSD); - -- Start of processing for Make_DT begin @@ -4441,7 +4432,7 @@ package body Exp_Disp is -- the mode now to ensure that any nodes generated during dispatch table -- creation are properly marked as Ghost. - Set_Ghost_Mode (Declaration_Node (Typ), Typ); + Set_Ghost_Mode (Typ, Mode); -- Handle cases in which there is no need to build the dispatch table @@ -4449,19 +4440,17 @@ package body Exp_Disp is or else No (Access_Disp_Table (Typ)) or else Is_CPP_Class (Typ) then - Ghost_Mode := Save_Ghost_Mode; - return Result; + goto Leave; elsif No_Run_Time_Mode then Error_Msg_CRT ("tagged types", Typ); - Ghost_Mode := Save_Ghost_Mode; - return Result; + goto Leave; elsif not RTE_Available (RE_Tag) then Append_To (Result, Make_Object_Declaration (Loc, - Defining_Identifier => Node (First_Elmt - (Access_Disp_Table (Typ))), + Defining_Identifier => + Node (First_Elmt (Access_Disp_Table (Typ))), Object_Definition => New_Occurrence_Of (RTE (RE_Tag), Loc), Constant_Present => True, Expression => @@ -4470,8 +4459,7 @@ package body Exp_Disp is Analyze_List (Result, Suppress => All_Checks); Error_Msg_CRT ("tagged types", Typ); - Ghost_Mode := Save_Ghost_Mode; - return Result; + goto Leave; end if; -- Ensure that the value of Max_Predef_Prims defined in a-tags is @@ -4481,18 +4469,23 @@ package body Exp_Disp is if RTE_Available (RE_Interface_Data) then if Max_Predef_Prims /= 15 then Error_Msg_N ("run-time library configuration error", Typ); - Ghost_Mode := Save_Ghost_Mode; - return Result; + goto Leave; end if; else if Max_Predef_Prims /= 9 then Error_Msg_N ("run-time library configuration error", Typ); Error_Msg_CRT ("tagged types", Typ); - Ghost_Mode := Save_Ghost_Mode; - return Result; + goto Leave; end if; end if; + DT := Make_Defining_Identifier (Loc, Name_DT); + Exname := Make_Defining_Identifier (Loc, Name_Exname); + HT_Link := Make_Defining_Identifier (Loc, Name_HT_Link); + Predef_Prims := Make_Defining_Identifier (Loc, Name_Predef_Prims); + SSD := Make_Defining_Identifier (Loc, Name_SSD); + TSD := Make_Defining_Identifier (Loc, Name_TSD); + -- Initialize Parent_Typ handling private types Parent_Typ := Etype (Typ); @@ -4695,7 +4688,7 @@ package body Exp_Disp is Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Node (Last (Result), New_Node); - goto Early_Exit_For_SCIL; + goto Leave_SCIL; -- Gnat2scil has its own implementation of dispatch tables, -- different than what is being implemented here. Generating @@ -4772,7 +4765,7 @@ package body Exp_Disp is Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Node (Last (Result), New_Node); - goto Early_Exit_For_SCIL; + goto Leave_SCIL; -- Gnat2scil has its own implementation of dispatch tables, -- different than what is being implemented here. Generating @@ -6238,13 +6231,15 @@ package body Exp_Disp is end; end if; - <> + <> -- Register the tagged type in the call graph nodes table Register_CG_Node (Typ); - Ghost_Mode := Save_Ghost_Mode; + <> + Restore_Ghost_Mode (Mode); + return Result; end Make_DT; -- cgit v1.1