From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 35B3C3858410; Wed, 1 Dec 2021 10:27:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 35B3C3858410 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-5677] [Ada] Tidy up freezing code for instantiations X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 17fa48b12d42fe41c4cc8782645b30acfa764141 X-Git-Newrev: 49b8a94b8878438cb5a08704101aee6f7319bd8b Message-Id: <20211201102706.35B3C3858410@sourceware.org> Date: Wed, 1 Dec 2021 10:27:06 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 01 Dec 2021 10:27:06 -0000 https://gcc.gnu.org/g:49b8a94b8878438cb5a08704101aee6f7319bd8b commit r12-5677-g49b8a94b8878438cb5a08704101aee6f7319bd8b Author: Eric Botcazou Date: Mon Nov 15 16:04:25 2021 +0100 [Ada] Tidy up freezing code for instantiations gcc/ada/ * sem_ch12.adb (Freeze_Subprogram_Body): Rename into... (Freeze_Subprogram_Instance): ...this and change the name of the first parameter and local variables for the sake of consistency. (Insert_Freeze_Node_For_Instance): Use local variable Par_Inst. (Install_Body): Rename into... (Freeze_Package_Instance): ...this, remove first parameter and change the name of local variables for the sake of consistency. Do not deal with the special case of incomplete actual types here and do not insert the body. (Instantiate_Package_Body): Deal with the special case of incomplete actual types here and insert the body. Call Freeze_Package_Instance only if expansion is done. (Instantiate_Subprogram_Body): Minor consistency tweak. Diff: --- gcc/ada/sem_ch12.adb | 278 ++++++++++++++++++++++++++------------------------- 1 file changed, 144 insertions(+), 134 deletions(-) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index a37224a7b18..f779cc74ff7 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -613,14 +613,14 @@ package body Sem_Ch12 is -- packages, and the prefix of the formal type may be needed to resolve -- the ambiguity in the instance ??? - procedure Freeze_Subprogram_Body - (Inst_Node : Node_Id; + procedure Freeze_Subprogram_Instance + (N : Node_Id; Gen_Body : Node_Id; Pack_Id : Entity_Id); -- The generic body may appear textually after the instance, including -- in the proper body of a stub, or within a different package instance. -- Given that the instance can only be elaborated after the generic, we - -- place freeze_nodes for the instance and/or for packages that may enclose + -- place freeze nodes for the instance and/or for packages that may enclose -- the instance and the generic, so that the back-end can establish the -- proper order of elaboration. @@ -714,13 +714,15 @@ package body Sem_Ch12 is -- associated freeze node. Insert the freeze node before the first source -- body which follows immediately after N. If no such body is found, the -- freeze node is inserted at the end of the declarative region which - -- contains N. + -- contains N. This can also be invoked to insert the freeze node of a + -- package that encloses an instantiation, in which case N may denote an + -- arbitrary node. - procedure Install_Body - (Act_Body : Node_Id; - N : Node_Id; + procedure Freeze_Package_Instance + (N : Node_Id; Gen_Body : Node_Id; - Gen_Decl : Node_Id); + Gen_Decl : Node_Id; + Act_Id : Entity_Id); -- If the instantiation happens textually before the body of the generic, -- the instantiation of the body must be analyzed after the generic body, -- and not at the point of instantiation. Such early instantiations can @@ -9015,22 +9017,15 @@ package body Sem_Ch12 is end if; end Find_Actual_Type; - ---------------------------- - -- Freeze_Subprogram_Body -- - ---------------------------- + -------------------------------- + -- Freeze_Subprogram_Instance -- + -------------------------------- - procedure Freeze_Subprogram_Body - (Inst_Node : Node_Id; + procedure Freeze_Subprogram_Instance + (N : Node_Id; Gen_Body : Node_Id; Pack_Id : Entity_Id) is - Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node); - Par : constant Entity_Id := Scope (Gen_Unit); - Enc_G : Entity_Id; - Enc_G_F : Node_Id; - Enc_I : Node_Id; - F_Node : Node_Id; - function Enclosing_Package_Body (N : Node_Id) return Node_Id; -- Find innermost package body that encloses the given node, and which -- is not a compilation unit. Freeze nodes for the instance, or for its @@ -9086,7 +9081,16 @@ package body Sem_Ch12 is return Freeze_Node (Id); end Package_Freeze_Node; - -- Start of processing for Freeze_Subprogram_Body + -- Local variables + + Enc_G : constant Node_Id := Enclosing_Package_Body (Gen_Body); + Enc_N : constant Node_Id := Enclosing_Package_Body (N); + Par_Id : constant Entity_Id := Scope (Get_Generic_Entity (N)); + + Enc_G_F : Node_Id; + F_Node : Node_Id; + + -- Start of processing for Freeze_Subprogram_Instance begin -- If the instance and the generic body appear within the same unit, and @@ -9097,21 +9101,18 @@ package body Sem_Ch12 is -- packages. Otherwise, the freeze node is placed at the end of the -- current declarative part. - Enc_G := Enclosing_Package_Body (Gen_Body); - Enc_I := Enclosing_Package_Body (Inst_Node); Ensure_Freeze_Node (Pack_Id); F_Node := Freeze_Node (Pack_Id); - if Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then In_Same_Declarative_Part - (Parent (Freeze_Node (Par)), Inst_Node) + if Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), N) then -- The parent was a premature instantiation. Insert freeze node at -- the end the current declarative part. - if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par)) then - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par_Id)) then + Insert_Freeze_Node_For_Instance (N, F_Node); -- Handle the following case: -- @@ -9131,13 +9132,13 @@ package body Sem_Ch12 is -- after that of Parent_Inst. This relation is established by -- comparing the Slocs of Parent_Inst freeze node and Inst. - elsif In_Same_List (Get_Unit_Instantiation_Node (Par), Inst_Node) - and then Sloc (Freeze_Node (Par)) <= Sloc (Inst_Node) + elsif In_Same_List (Get_Unit_Instantiation_Node (Par_Id), N) + and then Sloc (Freeze_Node (Par_Id)) <= Sloc (N) then - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); else - Insert_After (Freeze_Node (Par), F_Node); + Insert_After (Freeze_Node (Par_Id), F_Node); end if; -- The body enclosing the instance should be frozen after the body that @@ -9147,26 +9148,27 @@ package body Sem_Ch12 is -- already, freeze the instance at the end of the current declarative -- part. - elsif Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then Present (Enc_I) + elsif Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then Present (Enc_N) then - if In_Same_Declarative_Part (Parent (Freeze_Node (Par)), Enc_I) then + if In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), Enc_N) + then -- The enclosing package may contain several instances. Rather -- than computing the earliest point at which to insert its freeze -- node, we place it at the end of the declarative part of the -- parent of the generic. Insert_Freeze_Node_For_Instance - (Freeze_Node (Par), Package_Freeze_Node (Enc_I)); + (Freeze_Node (Par_Id), Package_Freeze_Node (Enc_N)); end if; - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); elsif Present (Enc_G) - and then Present (Enc_I) - and then Enc_G /= Enc_I - and then Earlier (Inst_Node, Gen_Body) + and then Present (Enc_N) + and then Enc_G /= Enc_N + and then Earlier (N, Gen_Body) then -- Freeze package that encloses instance, and place node after the -- package that encloses generic. If enclosing package is already @@ -9181,15 +9183,15 @@ package body Sem_Ch12 is Enclosing_Body : Node_Id; begin - if Nkind (Enc_I) = N_Package_Body_Stub then - Enclosing_Body := Proper_Body (Unit (Library_Unit (Enc_I))); + if Nkind (Enc_N) = N_Package_Body_Stub then + Enclosing_Body := Proper_Body (Unit (Library_Unit (Enc_N))); else - Enclosing_Body := Enc_I; + Enclosing_Body := Enc_N; end if; if Parent (List_Containing (Enc_G)) /= Enclosing_Body then Insert_Freeze_Node_For_Instance - (Enc_G, Package_Freeze_Node (Enc_I)); + (Enc_G, Package_Freeze_Node (Enc_N)); end if; end; @@ -9201,15 +9203,15 @@ package body Sem_Ch12 is Insert_After (Enc_G, Enc_G_F); end if; - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); else -- If none of the above, insert freeze node at the end of the current -- declarative part. - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); end if; - end Freeze_Subprogram_Body; + end Freeze_Subprogram_Instance; ---------------- -- Get_Gen_Id -- @@ -9571,10 +9573,11 @@ package body Sem_Ch12 is (N : Node_Id; F_Node : Node_Id) is - Decl : Node_Id; - Decls : List_Id; - Inst : Entity_Id; - Par_N : Node_Id; + Decl : Node_Id; + Decls : List_Id; + Inst : Entity_Id; + Par_Inst : Node_Id; + Par_N : Node_Id; function Enclosing_Body (N : Node_Id) return Node_Id; -- Find enclosing package or subprogram body, if any. Freeze node may @@ -9640,8 +9643,8 @@ package body Sem_Ch12 is if not Is_List_Member (F_Node) then Decl := N; Decls := List_Containing (N); - Inst := Entity (F_Node); Par_N := Parent (Decls); + Inst := Entity (F_Node); -- When processing a subprogram instantiation, utilize the actual -- subprogram instantiation rather than its package wrapper as it @@ -9651,18 +9654,18 @@ package body Sem_Ch12 is Inst := Related_Instance (Inst); end if; + Par_Inst := Parent (Inst); + -- If this is a package instance, check whether the generic is -- declared in a previous instance and the current instance is -- not within the previous one. - if Present (Generic_Parent (Parent (Inst))) - and then Is_In_Main_Unit (N) + if Present (Generic_Parent (Par_Inst)) and then Is_In_Main_Unit (N) then declare Enclosing_N : constant Node_Id := Enclosing_Body (N); Par_I : constant Entity_Id := - Previous_Instance - (Generic_Parent (Parent (Inst))); + Previous_Instance (Generic_Parent (Par_Inst)); Scop : Entity_Id; begin @@ -9744,8 +9747,7 @@ package body Sem_Ch12 is if Nkind (Par_N) /= N_Package_Declaration and then Ekind (Inst) = E_Package and then Is_Generic_Instance (Inst) - and then - not In_Same_Source_Unit (Generic_Parent (Parent (Inst)), Inst) + and then not In_Same_Source_Unit (Generic_Parent (Par_Inst), Inst) then while Present (Decl) loop if (Nkind (Decl) in N_Unit_Body @@ -9769,15 +9771,15 @@ package body Sem_Ch12 is end if; end Insert_Freeze_Node_For_Instance; - ------------------ - -- Install_Body -- - ------------------ + ----------------------------- + -- Freeze_Package_Instance -- + ----------------------------- - procedure Install_Body - (Act_Body : Node_Id; - N : Node_Id; + procedure Freeze_Package_Instance + (N : Node_Id; Gen_Body : Node_Id; - Gen_Decl : Node_Id) + Gen_Decl : Node_Id; + Act_Id : Entity_Id) is function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean; -- Check if the generic definition and the instantiation come from @@ -9838,55 +9840,22 @@ package body Sem_Ch12 is return Res; end True_Sloc; - Act_Id : constant Entity_Id := Corresponding_Spec (Act_Body); + -- Local variables + + Gen_Id : constant Entity_Id := Get_Generic_Entity (N); + Par_Id : constant Entity_Id := Scope (Gen_Id); Act_Unit : constant Node_Id := Unit (Cunit (Get_Source_Unit (N))); - Gen_Id : constant Entity_Id := Corresponding_Spec (Gen_Body); - Par : constant Entity_Id := Scope (Gen_Id); Gen_Unit : constant Node_Id := Unit (Cunit (Get_Source_Unit (Gen_Decl))); Body_Unit : Node_Id; F_Node : Node_Id; Must_Delay : Boolean; - Orig_Body : Node_Id := Gen_Body; + Orig_Body : Node_Id; - -- Start of processing for Install_Body + -- Start of processing for Freeze_Package_Instance begin - -- Handle first the case of an instance with incomplete actual types. - -- The instance body cannot be placed after the declaration because - -- full views have not been seen yet. Any use of the non-limited views - -- in the instance body requires the presence of a regular with_clause - -- in the enclosing unit, and will fail if this with_clause is missing. - -- We place the instance body at the beginning of the enclosing body, - -- which is the unit being compiled. The freeze node for the instance - -- is then placed after the instance body. - - if not Is_Empty_Elmt_List (Incomplete_Actuals (Act_Id)) - and then Expander_Active - and then Ekind (Scope (Act_Id)) = E_Package - then - declare - Scop : constant Entity_Id := Scope (Act_Id); - Body_Id : constant Node_Id := - Corresponding_Body (Unit_Declaration_Node (Scop)); - - begin - Ensure_Freeze_Node (Act_Id); - F_Node := Freeze_Node (Act_Id); - if Present (Body_Id) then - Set_Is_Frozen (Act_Id, False); - Prepend (Act_Body, Declarations (Parent (Body_Id))); - if Is_List_Member (F_Node) then - Remove (F_Node); - end if; - - Insert_After (Act_Body, F_Node); - end if; - end; - return; - end if; - -- If the body is a subunit, the freeze point is the corresponding stub -- in the current compilation, not the subunit itself. @@ -9914,8 +9883,8 @@ package body Sem_Ch12 is and then (Nkind (Gen_Unit) in N_Generic_Package_Declaration | N_Package_Declaration or else (Gen_Unit = Body_Unit - and then True_Sloc (N, Act_Unit) < - Sloc (Orig_Body))) + and then + True_Sloc (N, Act_Unit) < Sloc (Orig_Body))) and then Is_In_Main_Unit (Original_Node (Gen_Unit)) and then In_Same_Scope (Gen_Id, Act_Id)); @@ -9929,9 +9898,8 @@ package body Sem_Ch12 is -- if no delay is needed, we place the freeze node at the end of the -- current declarative part. - if Expander_Active - and then (No (Freeze_Node (Act_Id)) - or else not Is_List_Member (Freeze_Node (Act_Id))) + if No (Freeze_Node (Act_Id)) + or else not Is_List_Member (Freeze_Node (Act_Id)) then Ensure_Freeze_Node (Act_Id); F_Node := Freeze_Node (Act_Id); @@ -9939,14 +9907,14 @@ package body Sem_Ch12 is if Must_Delay then Insert_After (Orig_Body, F_Node); - elsif Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then Scope (Act_Id) /= Par + elsif Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then Scope (Act_Id) /= Par_Id then -- Freeze instance of inner generic after instance of enclosing -- generic. - if In_Same_Declarative_Part (Parent (Freeze_Node (Par)), N) then + if In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), N) then -- Handle the following case: @@ -9971,13 +9939,14 @@ package body Sem_Ch12 is -- of a package declaration, and the inner instance is in -- the corresponding private part. - if Parent (List_Containing (Get_Unit_Instantiation_Node (Par))) + if Parent (List_Containing (Get_Unit_Instantiation_Node + (Par_Id))) = Parent (List_Containing (N)) - and then Sloc (Freeze_Node (Par)) <= Sloc (N) + and then Sloc (Freeze_Node (Par_Id)) <= Sloc (N) then Insert_Freeze_Node_For_Instance (N, F_Node); else - Insert_After (Freeze_Node (Par), F_Node); + Insert_After (Freeze_Node (Par_Id), F_Node); end if; -- Freeze package enclosing instance of inner generic after @@ -9985,7 +9954,7 @@ package body Sem_Ch12 is elsif Nkind (Parent (N)) in N_Package_Body | N_Subprogram_Body and then In_Same_Declarative_Part - (Parent (Freeze_Node (Par)), Parent (N)) + (Parent (Freeze_Node (Par_Id)), Parent (N)) then declare Enclosing : Entity_Id; @@ -10027,15 +9996,15 @@ package body Sem_Ch12 is -- the enclosing package, insert the freeze node after -- the body. - elsif In_Same_List (Freeze_Node (Par), Parent (N)) - and then Sloc (Freeze_Node (Par)) < Sloc (Parent (N)) + elsif In_Same_List (Freeze_Node (Par_Id), Parent (N)) + and then Sloc (Freeze_Node (Par_Id)) < Sloc (Parent (N)) then Insert_Freeze_Node_For_Instance (Parent (N), Freeze_Node (Enclosing)); else Insert_After - (Freeze_Node (Par), Freeze_Node (Enclosing)); + (Freeze_Node (Par_Id), Freeze_Node (Enclosing)); end if; end if; end; @@ -10048,11 +10017,7 @@ package body Sem_Ch12 is Insert_Freeze_Node_For_Instance (N, F_Node); end if; end if; - - Set_Is_Frozen (Act_Id); - Insert_Before (N, Act_Body); - Mark_Rewrite_Insertion (Act_Body); - end Install_Body; + end Freeze_Package_Instance; ----------------------------- -- Install_Formal_Packages -- @@ -12207,7 +12172,7 @@ package body Sem_Ch12 is -- for the elaboration subprogram). if Nkind (Defining_Unit_Name (Act_Spec)) = - N_Defining_Program_Unit_Name + N_Defining_Program_Unit_Name then Set_Scope (Defining_Entity (Inst_Node), Scope (Act_Decl_Id)); end if; @@ -12216,11 +12181,53 @@ package body Sem_Ch12 is -- Case where instantiation is not a library unit else - -- If this is an early instantiation, i.e. appears textually - -- before the corresponding body and must be elaborated first, - -- indicate that the body instance is to be delayed. + -- Handle the case of an instance with incomplete actual types. + -- The instance body cannot be placed just after the declaration + -- because full views have not been seen yet. Any use of the non- + -- limited views in the instance body requires the presence of a + -- regular with_clause in the enclosing unit. Therefore we place + -- the instance body at the beginning of the enclosing body, and + -- the freeze node for the instance is then placed after the body. + + if not Is_Empty_Elmt_List (Incomplete_Actuals (Act_Decl_Id)) + and then Ekind (Scope (Act_Decl_Id)) = E_Package + then + declare + Scop : constant Entity_Id := Scope (Act_Decl_Id); + Body_Id : constant Node_Id := + Corresponding_Body (Unit_Declaration_Node (Scop)); + + F_Node : Node_Id; + + begin + pragma Assert (Present (Body_Id)); - Install_Body (Act_Body, Inst_Node, Gen_Body, Gen_Decl); + Prepend (Act_Body, Declarations (Parent (Body_Id))); + + if Expander_Active then + Ensure_Freeze_Node (Act_Decl_Id); + F_Node := Freeze_Node (Act_Decl_Id); + Set_Is_Frozen (Act_Decl_Id, False); + if Is_List_Member (F_Node) then + Remove (F_Node); + end if; + + Insert_After (Act_Body, F_Node); + end if; + end; + + else + Insert_Before (Inst_Node, Act_Body); + Mark_Rewrite_Insertion (Act_Body); + + -- Insert the freeze node for the instance if need be + + if Expander_Active then + Freeze_Package_Instance + (Inst_Node, Gen_Body, Gen_Decl, Act_Decl_Id); + Set_Is_Frozen (Act_Decl_Id); + end if; + end if; -- If the instantiation appears within a generic child package -- enable visibility of current instance of enclosing generic @@ -12581,11 +12588,14 @@ package body Sem_Ch12 is else Insert_Before (Inst_Node, Pack_Body); Mark_Rewrite_Insertion (Pack_Body); - Analyze (Pack_Body); + + -- Insert the freeze node for the instance if need be if Expander_Active then - Freeze_Subprogram_Body (Inst_Node, Gen_Body, Pack_Id); + Freeze_Subprogram_Instance (Inst_Node, Gen_Body, Pack_Id); end if; + + Analyze (Pack_Body); end if; Inherit_Context (Gen_Body, Inst_Node);