From 7f05e691acbf37a5ec8b2cbd30c023368db86505 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 28 Aug 2021 10:14:15 +0200
Subject: vhdl: handle foreign units in libraries and configuration

---
 src/vhdl/vhdl-configuration.adb | 53 +++++++++++++++++++++++------------------
 src/vhdl/vhdl-configuration.ads |  7 ++++++
 2 files changed, 37 insertions(+), 23 deletions(-)

(limited to 'src/vhdl')

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);
 
-- 
cgit v1.2.3