aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2021-08-28 10:14:15 +0200
committerTristan Gingold <tgingold@free.fr>2021-08-28 13:22:29 +0200
commit7f05e691acbf37a5ec8b2cbd30c023368db86505 (patch)
tree1673431d70b546ed0f3d778f11345b879ef0ef72 /src
parentb8b61eb99f0fdd3a04a3c5be53c0892f17c921e9 (diff)
downloadghdl-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.adb9
-rw-r--r--src/vhdl/vhdl-configuration.adb53
-rw-r--r--src/vhdl/vhdl-configuration.ads7
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);