diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-12-18 21:09:43 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-12-18 21:09:43 +0100 |
commit | 0e76825a8170af3be3ee0f5a89c209262828d254 (patch) | |
tree | bd960ef3fbf1f0f81edc071652faa6b35ae791a8 /src/vhdl/vhdl-sem_inst.adb | |
parent | c0095f3f0c37a2db4d56dc289854252e2e6e67d4 (diff) | |
download | ghdl-0e76825a8170af3be3ee0f5a89c209262828d254.tar.gz ghdl-0e76825a8170af3be3ee0f5a89c209262828d254.tar.bz2 ghdl-0e76825a8170af3be3ee0f5a89c209262828d254.zip |
vhdl: add Get/Set_Associated_package. For #2264
Diffstat (limited to 'src/vhdl/vhdl-sem_inst.adb')
-rw-r--r-- | src/vhdl/vhdl-sem_inst.adb | 57 |
1 files changed, 44 insertions, 13 deletions
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb index db34e5f39..4b0ca0279 100644 --- a/src/vhdl/vhdl-sem_inst.adb +++ b/src/vhdl/vhdl-sem_inst.adb @@ -684,7 +684,8 @@ package body Vhdl.Sem_Inst is -- As the scope generic interfaces extends beyond the immediate scope (see -- LRM08 12.2 Scope of declarations), they must be instantiated. - function Instantiate_Generic_Chain (Inst : Iir; Inters : Iir) return Iir + function Instantiate_Generic_Chain + (Inst : Iir; Inters : Iir; In_Interface : Boolean) return Iir is Inter : Iir; First : Iir; @@ -722,11 +723,17 @@ package body Vhdl.Sem_Inst is when Iir_Kind_Interface_Package_Declaration => Set_Uninstantiated_Package_Decl (Res, Get_Uninstantiated_Package_Decl (Inter)); - Set_Generic_Chain - (Res, - Instantiate_Generic_Chain (Res, Get_Generic_Chain (Inter))); - Set_Declaration_Chain - (Res, Instantiate_Iir_Chain (Get_Declaration_Chain (Inter))); + if In_Interface then + -- Only set generics and declarations when instantiating + -- for an uninstantiated unit. + Set_Generic_Chain + (Res, + Instantiate_Generic_Chain + (Res, Get_Generic_Chain (Inter), True)); + Set_Declaration_Chain + (Res, + Instantiate_Iir_Chain (Get_Declaration_Chain (Inter))); + end if; when Iir_Kind_Interface_Type_Declaration => Set_Type (Res, Get_Type (Inter)); when Iir_Kinds_Interface_Subprogram_Declaration => @@ -780,6 +787,23 @@ package body Vhdl.Sem_Inst is -- pragma Assert (Get_Instance (N) = Null_Iir); Set_Instance (N, Inst); + if Kind = Iir_Kind_Interface_Package_Declaration then + -- For interface package, this is not symetric. + -- The nodes to set instance on are in the interface package, + -- while the instances are in the associated package. + declare + Pkg_Actual : constant Iir := Get_Associated_Package (Inst); + begin + Set_Instance_On_Chain (Get_Generic_Chain (N), + Get_Generic_Chain (Pkg_Actual)); + Set_Instance_On_Chain (Get_Declaration_Chain (N), + Get_Declaration_Chain (Pkg_Actual)); + Set_Instance_On_Chain (Get_Attribute_Value_Chain (N), + Get_Attribute_Value_Chain (Pkg_Actual)); + end; + return; + end if; + for I in Fields'Range loop F := Fields (I); @@ -928,6 +952,7 @@ package body Vhdl.Sem_Inst is -- In ASSOC (which is the association for interface INTER), adjust -- references to the instance. + -- INTER is the interface of the uninstantiated unit. procedure Instantiate_Generic_Map (Assoc : Iir; Inter: Iir) is Assoc_Formal : Iir; @@ -987,19 +1012,22 @@ package body Vhdl.Sem_Inst is end if; end; when Iir_Kind_Interface_Package_Declaration => + -- INTER is an instantiation, without generic nor declaration + -- chains. pragma Assert (Get_Kind (Assoc) = Iir_Kind_Association_Element_Package); declare Sub_Inst : constant Iir := Get_Named_Entity (Get_Actual (Assoc)); - Sub_Pkg : constant Iir := Get_Origin (Assoc_Formal); + Pkg_Inter : constant Iir := Get_Origin (Assoc_Formal); begin -- Replace references of interface package to references -- to the actual package. - Set_Instance (Sub_Pkg, Sub_Inst); - Set_Instance_On_Chain (Get_Generic_Chain (Sub_Pkg), + Set_Instance (Pkg_Inter, Sub_Inst); + Set_Associated_Package (Assoc_Formal, Sub_Inst); + Set_Instance_On_Chain (Get_Generic_Chain (Pkg_Inter), Get_Generic_Chain (Sub_Inst)); - Set_Instance_On_Chain (Get_Declaration_Chain (Sub_Pkg), + Set_Instance_On_Chain (Get_Declaration_Chain (Pkg_Inter), Get_Declaration_Chain (Sub_Inst)); end; when Iir_Kind_Interface_Type_Declaration => @@ -1085,7 +1113,8 @@ package body Vhdl.Sem_Inst is -- Manually instantiate the package declaration. Set_Generic_Chain - (Inst, Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Subprg))); + (Inst, + Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Subprg), True)); Instantiate_Generic_Map_Chain (Inst, Subprg); if Get_Kind (Subprg) = Iir_Kind_Function_Instantiation_Declaration then Set_Return_Type (Inst, Instantiate_Iir (Subprg, True)); @@ -1121,7 +1150,8 @@ package body Vhdl.Sem_Inst is -- Manually instantiate the package declaration. Set_Generic_Chain - (Inter, Instantiate_Generic_Chain (Inter, Get_Generic_Chain (Header))); + (Inter, + Instantiate_Generic_Chain (Inter, Get_Generic_Chain (Header), True)); Instantiate_Generic_Map_Chain (Inter, Pkg); Set_Declaration_Chain (Inter, Instantiate_Iir_Chain (Get_Declaration_Chain (Pkg))); @@ -1158,7 +1188,8 @@ package body Vhdl.Sem_Inst is -- Manually instantiate the package declaration. Set_Generic_Chain - (Inst, Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Header))); + (Inst, + Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Header), False)); Instantiate_Generic_Map_Chain (Inst, Pkg); Set_Declaration_Chain (Inst, Instantiate_Iir_Chain (Get_Declaration_Chain (Pkg))); |