From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 4EA603858434; Wed, 1 Dec 2021 10:27:11 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4EA603858434 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-5678] [Ada] Tidy up freezing code for instantiations (continued) X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 49b8a94b8878438cb5a08704101aee6f7319bd8b X-Git-Newrev: 70b29d02f460ecfeed4456677626d518444bcc3d Message-Id: <20211201102711.4EA603858434@sourceware.org> Date: Wed, 1 Dec 2021 10:27:11 +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:11 -0000 https://gcc.gnu.org/g:70b29d02f460ecfeed4456677626d518444bcc3d commit r12-5678-g70b29d02f460ecfeed4456677626d518444bcc3d Author: Eric Botcazou Date: Wed Nov 17 13:43:15 2021 +0100 [Ada] Tidy up freezing code for instantiations (continued) gcc/ada/ * sem_ch12.adb (Freeze_Package_Instance): Move up. Diff: --- gcc/ada/sem_ch12.adb | 766 +++++++++++++++++++++++++-------------------------- 1 file changed, 383 insertions(+), 383 deletions(-) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f779cc74ff7..f10967a01fc 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -613,6 +613,24 @@ 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_Package_Instance + (N : Node_Id; + Gen_Body : 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 + -- happen if the generic and the instance appear in a package declaration + -- because the generic body can only appear in the corresponding package + -- body. Early instantiations can also appear if generic, instance and + -- body are all in the declarative part of a subprogram or entry. Entities + -- of packages that are early instantiations are delayed, and their freeze + -- node appears after the generic body. This rather complex machinery is + -- needed when nested instantiations are present, because the source does + -- not carry any indication of where the corresponding instance bodies must + -- be installed and frozen. + procedure Freeze_Subprogram_Instance (N : Node_Id; Gen_Body : Node_Id; @@ -718,24 +736,6 @@ package body Sem_Ch12 is -- package that encloses an instantiation, in which case N may denote an -- arbitrary node. - procedure Freeze_Package_Instance - (N : Node_Id; - Gen_Body : 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 - -- happen if the generic and the instance appear in a package declaration - -- because the generic body can only appear in the corresponding package - -- body. Early instantiations can also appear if generic, instance and - -- body are all in the declarative part of a subprogram or entry. Entities - -- of packages that are early instantiations are delayed, and their freeze - -- node appears after the generic body. This rather complex machinery is - -- needed when nested instantiations are present, because the source does - -- not carry any indication of where the corresponding instance bodies must - -- be installed and frozen. - procedure Install_Formal_Packages (Par : Entity_Id); -- Install the visible part of any formal of the parent that is a formal -- package. Note that for the case of a formal package with a box, this @@ -9017,156 +9017,404 @@ package body Sem_Ch12 is end if; end Find_Actual_Type; - -------------------------------- - -- Freeze_Subprogram_Instance -- - -------------------------------- + ----------------------------- + -- Freeze_Package_Instance -- + ----------------------------- - procedure Freeze_Subprogram_Instance - (N : Node_Id; - Gen_Body : Node_Id; - Pack_Id : Entity_Id) - is - 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 - -- enclosing body, may be inserted after the enclosing_body of the - -- generic unit. Used to determine proper placement of freeze node for - -- both package and subprogram instances. + procedure Freeze_Package_Instance + (N : Node_Id; + Gen_Body : 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 + -- a common scope, in which case the instance must be frozen after + -- the generic body. - function Package_Freeze_Node (B : Node_Id) return Node_Id; - -- Find entity for given package body, and locate or create a freeze - -- node for it. + function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr; + -- If the instance is nested inside a generic unit, the Sloc of the + -- instance indicates the place of the original definition, not the + -- point of the current enclosing instance. Pending a better usage of + -- Slocs to indicate instantiation places, we determine the place of + -- origin of a node by finding the maximum sloc of any ancestor node. - ---------------------------- - -- Enclosing_Package_Body -- - ---------------------------- + -- Why is this not equivalent to Top_Level_Location ??? - function Enclosing_Package_Body (N : Node_Id) return Node_Id is - P : Node_Id; + ------------------- + -- In_Same_Scope -- + ------------------- + + function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean is + Act_Scop : Entity_Id := Scope (Act_Id); + Gen_Scop : Entity_Id := Scope (Gen_Id); begin - P := Parent (N); - while Present (P) - and then Nkind (Parent (P)) /= N_Compilation_Unit + while Act_Scop /= Standard_Standard + and then Gen_Scop /= Standard_Standard loop - if Nkind (P) = N_Package_Body then - if Nkind (Parent (P)) = N_Subunit then - return Corresponding_Stub (Parent (P)); - else - return P; - end if; + if Act_Scop = Gen_Scop then + return True; end if; - P := True_Parent (P); + Act_Scop := Scope (Act_Scop); + Gen_Scop := Scope (Gen_Scop); end loop; - return Empty; - end Enclosing_Package_Body; + return False; + end In_Same_Scope; - ------------------------- - -- Package_Freeze_Node -- - ------------------------- + --------------- + -- True_Sloc -- + --------------- - function Package_Freeze_Node (B : Node_Id) return Node_Id is - Id : Entity_Id; + function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr is + N1 : Node_Id; + Res : Source_Ptr; begin - if Nkind (B) = N_Package_Body then - Id := Corresponding_Spec (B); - else pragma Assert (Nkind (B) = N_Package_Body_Stub); - Id := Corresponding_Spec (Proper_Body (Unit (Library_Unit (B)))); - end if; + Res := Sloc (N); + N1 := N; + while Present (N1) and then N1 /= Act_Unit loop + if Sloc (N1) > Res then + Res := Sloc (N1); + end if; - Ensure_Freeze_Node (Id); - return Freeze_Node (Id); - end Package_Freeze_Node; + N1 := Parent (N1); + end loop; + + return Res; + end True_Sloc; -- 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)); + 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_Unit : constant Node_Id := + Unit (Cunit (Get_Source_Unit (Gen_Decl))); - Enc_G_F : Node_Id; - F_Node : Node_Id; + Body_Unit : Node_Id; + F_Node : Node_Id; + Must_Delay : Boolean; + Orig_Body : Node_Id; - -- Start of processing for Freeze_Subprogram_Instance + -- Start of processing for Freeze_Package_Instance begin - -- If the instance and the generic body appear within the same unit, and - -- the instance precedes the generic, the freeze node for the instance - -- must appear after that of the generic. If the generic is nested - -- within another instance I2, then current instance must be frozen - -- after I2. In both cases, the freeze nodes are those of enclosing - -- packages. Otherwise, the freeze node is placed at the end of the - -- current declarative part. - - Ensure_Freeze_Node (Pack_Id); - F_Node := Freeze_Node (Pack_Id); + -- If the body is a subunit, the freeze point is the corresponding stub + -- in the current compilation, not the subunit itself. - 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 Nkind (Parent (Gen_Body)) = N_Subunit then + Orig_Body := Corresponding_Stub (Parent (Gen_Body)); + else + Orig_Body := Gen_Body; + end if; - if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par_Id)) then - Insert_Freeze_Node_For_Instance (N, F_Node); + Body_Unit := Unit (Cunit (Get_Source_Unit (Orig_Body))); - -- Handle the following case: - -- - -- package Parent_Inst is new ... - -- freeze Parent_Inst [] - -- - -- procedure P ... -- this body freezes Parent_Inst - -- - -- procedure Inst is new ... - -- - -- In this particular scenario, the freeze node for Inst must be - -- inserted in the same manner as that of Parent_Inst - before the - -- next source body or at the end of the declarative list (body not - -- available). If body P did not exist and Parent_Inst was frozen - -- after Inst, either by a body following Inst or at the end of the - -- declarative region, the freeze node for Inst must be inserted - -- after that of Parent_Inst. This relation is established by - -- comparing the Slocs of Parent_Inst freeze node and Inst. + -- If the instantiation and the generic definition appear in the same + -- package declaration, this is an early instantiation. If they appear + -- in the same declarative part, it is an early instantiation only if + -- the generic body appears textually later, and the generic body is + -- also in the main unit. - 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 (N, F_Node); + -- If instance is nested within a subprogram, and the generic body + -- is not, the instance is delayed because the enclosing body is. If + -- instance and body are within the same scope, or the same subprogram + -- body, indicate explicitly that the instance is delayed. - else - Insert_After (Freeze_Node (Par_Id), F_Node); - end if; + Must_Delay := + (Gen_Unit = Act_Unit + 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 Is_In_Main_Unit (Original_Node (Gen_Unit)) + and then In_Same_Scope (Gen_Id, Act_Id)); - -- The body enclosing the instance should be frozen after the body that - -- includes the generic, because the body of the instance may make - -- references to entities therein. If the two are not in the same - -- declarative part, or if the one enclosing the instance is frozen - -- already, freeze the instance at the end of the current declarative - -- part. + -- If this is an early instantiation, the freeze node is placed after + -- the generic body. Otherwise, if the generic appears in an instance, + -- we cannot freeze the current instance until the outer one is frozen. + -- This is only relevant if the current instance is nested within some + -- inner scope not itself within the outer instance. If this scope is + -- a package body in the same declarative part as the outer instance, + -- then that body needs to be frozen after the outer instance. Finally, + -- if no delay is needed, we place the freeze node at the end of the + -- current declarative part. - elsif Is_Generic_Instance (Par_Id) - and then Present (Freeze_Node (Par_Id)) - and then Present (Enc_N) + if No (Freeze_Node (Act_Id)) + or else not Is_List_Member (Freeze_Node (Act_Id)) 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_Id), Package_Freeze_Node (Enc_N)); - end if; + Ensure_Freeze_Node (Act_Id); + F_Node := Freeze_Node (Act_Id); - Insert_Freeze_Node_For_Instance (N, F_Node); + if Must_Delay then + Insert_After (Orig_Body, F_Node); - elsif Present (Enc_G) - and then Present (Enc_N) + 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_Id)), N) then + + -- Handle the following case: + + -- package Parent_Inst is new ... + -- freeze Parent_Inst [] + + -- procedure P ... -- this body freezes Parent_Inst + + -- package Inst is new ... + + -- In this particular scenario, the freeze node for Inst must + -- be inserted in the same manner as that of Parent_Inst, + -- before the next source body or at the end of the declarative + -- list (body not available). If body P did not exist and + -- Parent_Inst was frozen after Inst, either by a body + -- following Inst or at the end of the declarative region, + -- the freeze node for Inst must be inserted after that of + -- Parent_Inst. This relation is established by comparing + -- the Slocs of Parent_Inst freeze node and Inst. + -- We examine the parents of the enclosing lists to handle + -- the case where the parent instance is in the visible part + -- of a package declaration, and the inner instance is in + -- the corresponding private part. + + if Parent (List_Containing (Get_Unit_Instantiation_Node + (Par_Id))) + = Parent (List_Containing (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_Id), F_Node); + end if; + + -- Freeze package enclosing instance of inner generic after + -- instance of enclosing generic. + + elsif Nkind (Parent (N)) in N_Package_Body | N_Subprogram_Body + and then In_Same_Declarative_Part + (Parent (Freeze_Node (Par_Id)), Parent (N)) + then + declare + Enclosing : Entity_Id; + + begin + Enclosing := Corresponding_Spec (Parent (N)); + + if No (Enclosing) then + Enclosing := Defining_Entity (Parent (N)); + end if; + + Insert_Freeze_Node_For_Instance (N, F_Node); + Ensure_Freeze_Node (Enclosing); + + if not Is_List_Member (Freeze_Node (Enclosing)) then + + -- The enclosing context is a subunit, insert the freeze + -- node after the stub. + + if Nkind (Parent (Parent (N))) = N_Subunit then + Insert_Freeze_Node_For_Instance + (Corresponding_Stub (Parent (Parent (N))), + Freeze_Node (Enclosing)); + + -- The enclosing context is a package with a stub body + -- which has already been replaced by the real body. + -- Insert the freeze node after the actual body. + + elsif Ekind (Enclosing) = E_Package + and then Present (Body_Entity (Enclosing)) + and then Was_Originally_Stub + (Parent (Body_Entity (Enclosing))) + then + Insert_Freeze_Node_For_Instance + (Parent (Body_Entity (Enclosing)), + Freeze_Node (Enclosing)); + + -- The parent instance has been frozen before the body of + -- the enclosing package, insert the freeze node after + -- the body. + + 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_Id), Freeze_Node (Enclosing)); + end if; + end if; + end; + + else + Insert_Freeze_Node_For_Instance (N, F_Node); + end if; + + else + Insert_Freeze_Node_For_Instance (N, F_Node); + end if; + end if; + end Freeze_Package_Instance; + + -------------------------------- + -- Freeze_Subprogram_Instance -- + -------------------------------- + + procedure Freeze_Subprogram_Instance + (N : Node_Id; + Gen_Body : Node_Id; + Pack_Id : Entity_Id) + is + 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 + -- enclosing body, may be inserted after the enclosing_body of the + -- generic unit. Used to determine proper placement of freeze node for + -- both package and subprogram instances. + + function Package_Freeze_Node (B : Node_Id) return Node_Id; + -- Find entity for given package body, and locate or create a freeze + -- node for it. + + ---------------------------- + -- Enclosing_Package_Body -- + ---------------------------- + + function Enclosing_Package_Body (N : Node_Id) return Node_Id is + P : Node_Id; + + begin + P := Parent (N); + while Present (P) + and then Nkind (Parent (P)) /= N_Compilation_Unit + loop + if Nkind (P) = N_Package_Body then + if Nkind (Parent (P)) = N_Subunit then + return Corresponding_Stub (Parent (P)); + else + return P; + end if; + end if; + + P := True_Parent (P); + end loop; + + return Empty; + end Enclosing_Package_Body; + + ------------------------- + -- Package_Freeze_Node -- + ------------------------- + + function Package_Freeze_Node (B : Node_Id) return Node_Id is + Id : Entity_Id; + + begin + if Nkind (B) = N_Package_Body then + Id := Corresponding_Spec (B); + else pragma Assert (Nkind (B) = N_Package_Body_Stub); + Id := Corresponding_Spec (Proper_Body (Unit (Library_Unit (B)))); + end if; + + Ensure_Freeze_Node (Id); + return Freeze_Node (Id); + end Package_Freeze_Node; + + -- 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 + -- the instance precedes the generic, the freeze node for the instance + -- must appear after that of the generic. If the generic is nested + -- within another instance I2, then current instance must be frozen + -- after I2. In both cases, the freeze nodes are those of enclosing + -- packages. Otherwise, the freeze node is placed at the end of the + -- current declarative part. + + Ensure_Freeze_Node (Pack_Id); + F_Node := Freeze_Node (Pack_Id); + + 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_Id)) then + Insert_Freeze_Node_For_Instance (N, F_Node); + + -- Handle the following case: + -- + -- package Parent_Inst is new ... + -- freeze Parent_Inst [] + -- + -- procedure P ... -- this body freezes Parent_Inst + -- + -- procedure Inst is new ... + -- + -- In this particular scenario, the freeze node for Inst must be + -- inserted in the same manner as that of Parent_Inst - before the + -- next source body or at the end of the declarative list (body not + -- available). If body P did not exist and Parent_Inst was frozen + -- after Inst, either by a body following Inst or at the end of the + -- declarative region, the freeze node for Inst must be inserted + -- 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_Id), 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_Id), F_Node); + end if; + + -- The body enclosing the instance should be frozen after the body that + -- includes the generic, because the body of the instance may make + -- references to entities therein. If the two are not in the same + -- declarative part, or if the one enclosing the instance is frozen + -- already, freeze the instance at the end of the current declarative + -- part. + + 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_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_Id), Package_Freeze_Node (Enc_N)); + end if; + + Insert_Freeze_Node_For_Instance (N, F_Node); + + elsif Present (Enc_G) + and then Present (Enc_N) and then Enc_G /= Enc_N and then Earlier (N, Gen_Body) then @@ -9771,254 +10019,6 @@ package body Sem_Ch12 is end if; end Insert_Freeze_Node_For_Instance; - ----------------------------- - -- Freeze_Package_Instance -- - ----------------------------- - - procedure Freeze_Package_Instance - (N : Node_Id; - Gen_Body : 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 - -- a common scope, in which case the instance must be frozen after - -- the generic body. - - function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr; - -- If the instance is nested inside a generic unit, the Sloc of the - -- instance indicates the place of the original definition, not the - -- point of the current enclosing instance. Pending a better usage of - -- Slocs to indicate instantiation places, we determine the place of - -- origin of a node by finding the maximum sloc of any ancestor node. - - -- Why is this not equivalent to Top_Level_Location ??? - - ------------------- - -- In_Same_Scope -- - ------------------- - - function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean is - Act_Scop : Entity_Id := Scope (Act_Id); - Gen_Scop : Entity_Id := Scope (Gen_Id); - - begin - while Act_Scop /= Standard_Standard - and then Gen_Scop /= Standard_Standard - loop - if Act_Scop = Gen_Scop then - return True; - end if; - - Act_Scop := Scope (Act_Scop); - Gen_Scop := Scope (Gen_Scop); - end loop; - - return False; - end In_Same_Scope; - - --------------- - -- True_Sloc -- - --------------- - - function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr is - N1 : Node_Id; - Res : Source_Ptr; - - begin - Res := Sloc (N); - N1 := N; - while Present (N1) and then N1 /= Act_Unit loop - if Sloc (N1) > Res then - Res := Sloc (N1); - end if; - - N1 := Parent (N1); - end loop; - - return Res; - end True_Sloc; - - -- 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_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; - - -- Start of processing for Freeze_Package_Instance - - begin - -- If the body is a subunit, the freeze point is the corresponding stub - -- in the current compilation, not the subunit itself. - - if Nkind (Parent (Gen_Body)) = N_Subunit then - Orig_Body := Corresponding_Stub (Parent (Gen_Body)); - else - Orig_Body := Gen_Body; - end if; - - Body_Unit := Unit (Cunit (Get_Source_Unit (Orig_Body))); - - -- If the instantiation and the generic definition appear in the same - -- package declaration, this is an early instantiation. If they appear - -- in the same declarative part, it is an early instantiation only if - -- the generic body appears textually later, and the generic body is - -- also in the main unit. - - -- If instance is nested within a subprogram, and the generic body - -- is not, the instance is delayed because the enclosing body is. If - -- instance and body are within the same scope, or the same subprogram - -- body, indicate explicitly that the instance is delayed. - - Must_Delay := - (Gen_Unit = Act_Unit - 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 Is_In_Main_Unit (Original_Node (Gen_Unit)) - and then In_Same_Scope (Gen_Id, Act_Id)); - - -- If this is an early instantiation, the freeze node is placed after - -- the generic body. Otherwise, if the generic appears in an instance, - -- we cannot freeze the current instance until the outer one is frozen. - -- This is only relevant if the current instance is nested within some - -- inner scope not itself within the outer instance. If this scope is - -- a package body in the same declarative part as the outer instance, - -- then that body needs to be frozen after the outer instance. Finally, - -- if no delay is needed, we place the freeze node at the end of the - -- current declarative part. - - 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); - - if Must_Delay then - Insert_After (Orig_Body, F_Node); - - 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_Id)), N) then - - -- Handle the following case: - - -- package Parent_Inst is new ... - -- freeze Parent_Inst [] - - -- procedure P ... -- this body freezes Parent_Inst - - -- package Inst is new ... - - -- In this particular scenario, the freeze node for Inst must - -- be inserted in the same manner as that of Parent_Inst, - -- before the next source body or at the end of the declarative - -- list (body not available). If body P did not exist and - -- Parent_Inst was frozen after Inst, either by a body - -- following Inst or at the end of the declarative region, - -- the freeze node for Inst must be inserted after that of - -- Parent_Inst. This relation is established by comparing - -- the Slocs of Parent_Inst freeze node and Inst. - -- We examine the parents of the enclosing lists to handle - -- the case where the parent instance is in the visible part - -- of a package declaration, and the inner instance is in - -- the corresponding private part. - - if Parent (List_Containing (Get_Unit_Instantiation_Node - (Par_Id))) - = Parent (List_Containing (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_Id), F_Node); - end if; - - -- Freeze package enclosing instance of inner generic after - -- instance of enclosing generic. - - elsif Nkind (Parent (N)) in N_Package_Body | N_Subprogram_Body - and then In_Same_Declarative_Part - (Parent (Freeze_Node (Par_Id)), Parent (N)) - then - declare - Enclosing : Entity_Id; - - begin - Enclosing := Corresponding_Spec (Parent (N)); - - if No (Enclosing) then - Enclosing := Defining_Entity (Parent (N)); - end if; - - Insert_Freeze_Node_For_Instance (N, F_Node); - Ensure_Freeze_Node (Enclosing); - - if not Is_List_Member (Freeze_Node (Enclosing)) then - - -- The enclosing context is a subunit, insert the freeze - -- node after the stub. - - if Nkind (Parent (Parent (N))) = N_Subunit then - Insert_Freeze_Node_For_Instance - (Corresponding_Stub (Parent (Parent (N))), - Freeze_Node (Enclosing)); - - -- The enclosing context is a package with a stub body - -- which has already been replaced by the real body. - -- Insert the freeze node after the actual body. - - elsif Ekind (Enclosing) = E_Package - and then Present (Body_Entity (Enclosing)) - and then Was_Originally_Stub - (Parent (Body_Entity (Enclosing))) - then - Insert_Freeze_Node_For_Instance - (Parent (Body_Entity (Enclosing)), - Freeze_Node (Enclosing)); - - -- The parent instance has been frozen before the body of - -- the enclosing package, insert the freeze node after - -- the body. - - 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_Id), Freeze_Node (Enclosing)); - end if; - end if; - end; - - else - Insert_Freeze_Node_For_Instance (N, F_Node); - end if; - - else - Insert_Freeze_Node_For_Instance (N, F_Node); - end if; - end if; - end Freeze_Package_Instance; - ----------------------------- -- Install_Formal_Packages -- -----------------------------