diff options
author | Tristan Gingold <tgingold@free.fr> | 2021-08-28 10:14:15 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2021-08-28 13:22:29 +0200 |
commit | 7f05e691acbf37a5ec8b2cbd30c023368db86505 (patch) | |
tree | 1673431d70b546ed0f3d778f11345b879ef0ef72 /src | |
parent | b8b61eb99f0fdd3a04a3c5be53c0892f17c921e9 (diff) | |
download | ghdl-7f05e691acbf37a5ec8b2cbd30c023368db86505.tar.gz ghdl-7f05e691acbf37a5ec8b2cbd30c023368db86505.tar.bz2 ghdl-7f05e691acbf37a5ec8b2cbd30c023368db86505.zip |
vhdl: handle foreign units in libraries and configuration
Diffstat (limited to 'src')
-rw-r--r-- | src/libraries.adb | 9 | ||||
-rw-r--r-- | src/vhdl/vhdl-configuration.adb | 53 | ||||
-rw-r--r-- | src/vhdl/vhdl-configuration.ads | 7 |
3 files changed, 45 insertions, 24 deletions
diff --git a/src/libraries.adb b/src/libraries.adb index 0c79d77d9..70c9d4178 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -1114,7 +1114,14 @@ package body Libraries is while Design_Unit /= Null_Iir loop Next_Design_Unit := Get_Hash_Chain (Design_Unit); Design_File := Get_Design_File (Design_Unit); - Library_Unit := Get_Library_Unit (Design_Unit); + case Get_Kind (Design_Unit) is + when Iir_Kind_Foreign_Module => + Library_Unit := Design_Unit; + when Iir_Kind_Design_Unit => + Library_Unit := Get_Library_Unit (Design_Unit); + when others => + raise Internal_Error; + end case; if Get_Identifier (Design_Unit) = Unit_Id and then Get_Library (Design_File) = Work_Library and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index ad086cd3d..4c3ae299f 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -1022,29 +1022,36 @@ package body Vhdl.Configuration is end if; end if; - if Get_Kind (Design) = Iir_Kind_Design_Unit then - Unit := Get_Library_Unit (Design); - case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is - when Iir_Kind_Architecture_Body => - Status := Walk_Concurrent_Statements_Chain - (Get_Concurrent_Statement_Chain (Unit), - Mark_Instantiation_Cb'Access); - pragma Assert (Status = Walk_Continue); - when Iir_Kind_Configuration_Declaration => - -- Just ignored. - null; - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Entity_Declaration - | Iir_Kinds_Verification_Unit - | Iir_Kind_Context_Declaration => - null; - end case; - else - -- TODO: also traverse foreign units - null; - end if; + case Get_Kind (Design) is + when Iir_Kind_Design_Unit => + Unit := Get_Library_Unit (Design); + case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is + when Iir_Kind_Architecture_Body => + Status := Walk_Concurrent_Statements_Chain + (Get_Concurrent_Statement_Chain (Unit), + Mark_Instantiation_Cb'Access); + pragma Assert (Status = Walk_Continue); + when Iir_Kind_Configuration_Declaration => + -- Just ignored. + null; + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Entity_Declaration + | Iir_Kinds_Verification_Unit + | Iir_Kind_Context_Declaration => + null; + end case; + + when Iir_Kind_Foreign_Module => + if Mark_Foreign_Module = null then + raise Internal_Error; + end if; + Mark_Foreign_Module.all (Get_Foreign_Node (Design)); + + when others => + raise Internal_Error; + end case; return Walk_Continue; end Mark_Units_Cb; diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index 1abff5057..d272d23e9 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -62,6 +62,13 @@ package Vhdl.Configuration is -- LOC is used to report errors. function Find_Top_Entity (From : Iir; Loc : Location_Type) return Iir; + -- Hook for Find_Top_Entity to deal with foreign units. + -- When called for a foreign module N, the procedure must walk N to find + -- all the module instantiations. For each instantiation, it must look + -- for the definition in the VHDL scope table and set the Elab flag. + type Mark_Instantiated_Units_Access is access procedure (N : Int32); + Mark_Foreign_Module : Mark_Instantiated_Units_Access; + -- Add an override for generic ID. procedure Add_Generic_Override (Id : Name_Id; Value : String); |