Improve access to parent for macro-expanded entities

For ghdl#2580
stefanlippuner · Jan 12, 2024 · fb25283 · fb25283
1 parent 430bfd4
commit fb25283
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 30 deletions.
diff --git a/src/simul/simul-vhdl_compile.adb b/src/simul/simul-vhdl_compile.adb
@@ -1361,6 +1361,7 @@ package body Simul.Vhdl_Compile is
       Sub_Inst : constant Synth_Instance_Acc :=
         Get_Sub_Instance (Inst, Stmt);
       Info : constant Block_Info_Acc := Get_Info (Stmt);
+      Hdr : constant Node := Get_Instantiated_Header (Stmt);
       Link : Memory_Ptr;
       Ptr : Memory_Ptr;
    begin
@@ -1392,6 +1393,21 @@ package body Simul.Vhdl_Compile is
          --  An entity (or a configuration).
          Ptr := Build_Elab_Instance (Sub_Inst);
          Link_Instance (Ptr, Get_Source_Scope (Sub_Inst), Link);
+
+         if Hdr /= Null_Node then
+            declare
+               Ent_Info : constant Block_Info_Acc := Get_Info (Hdr);
+               Orig_Mem : Memory_Ptr;
+            begin
+               --  Set the origin field.
+               if Ent_Info /= null then
+                  Orig_Mem := Add_Field_Offset
+                    (Ptr, Ent_Info.Block_Origin_Field);
+                  Write_Ptr (Orig_Mem, Base_Mem);
+               end if;
+            end;
+         end if;
+
          Link_Component (Link, Stmt, Ptr);
       end if;
 

diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
@@ -256,10 +256,11 @@ package body Trans.Chap1 is
       Clear_Scope (Arch_Info.Block_Scope);
    end Pop_Architecture_Scope;
 
-   procedure Push_Instantiated_Architecture_Scope
-     (Entity : Iir; Entity_Info : Block_Info_Acc)
+   procedure Push_Pop_Instantiated_Architecture_Scope
+     (Entity : Iir; Entity_Info : Block_Info_Acc; Is_Push : Boolean)
    is
       Parent : Iir;
+      P_Info : Block_Info_Acc;
    begin
       Parent := Get_Parent (Entity);
       loop
@@ -276,33 +277,30 @@ package body Trans.Chap1 is
       end loop;
 
       --  TODO: continue recursion.
-      Set_Scope_Via_Field_Ptr (Get_Info (Parent).Block_Scope,
-                               Entity_Info.Block_Origin_Field,
-                               Entity_Info.Block_Scope'Access);
-   end Push_Instantiated_Architecture_Scope;
-
-   procedure Pop_Instantiated_Architecture_Scope
-     (Entity : Iir)
-   is
-      Parent : Iir;
-   begin
-      Parent := Get_Parent (Entity);
-      loop
-         case Get_Kind (Parent) is
-            when Iir_Kind_Architecture_Body =>
-               exit;
-            when Iir_Kind_Block_Statement
-              | Iir_Kind_Component_Instantiation_Statement =>
-               Parent := Get_Parent (Parent);
-            when others =>
-               --  TODO
-               Error_Kind ("pop_instantiated_architecture_scope", Parent);
-         end case;
-      end loop;
+      P_Info := Get_Info (Parent);
+      if Is_Push then
+         Set_Scope_Via_Field_Ptr (P_Info.Block_Scope,
+                                  Entity_Info.Block_Origin_Field,
+                                  Entity_Info.Block_Scope'Access);
+      else
+         Clear_Scope (P_Info.Block_Scope);
+      end if;
 
-      --  TODO: continue recursion.
-      Clear_Scope (Get_Info (Parent).Block_Scope);
-   end Pop_Instantiated_Architecture_Scope;
+      if Get_Kind (Parent) = Iir_Kind_Architecture_Body then
+         declare
+            P_Ent : constant Iir := Get_Entity (Parent);
+            P_Ent_Info : constant Block_Info_Acc := Get_Info (P_Ent);
+         begin
+            if Is_Push then
+               Set_Scope_Via_Field (P_Ent_Info.Block_Scope,
+                                    P_Info.Block_Parent_Field,
+                                    P_Info.Block_Scope'Access);
+            else
+               Clear_Scope (P_Ent_Info.Block_Scope);
+            end if;
+         end;
+      end if;
+   end Push_Pop_Instantiated_Architecture_Scope;
 
    procedure Translate_Architecture_Body (Arch : Iir)
    is
@@ -400,14 +398,14 @@ package body Trans.Chap1 is
 
       if Entity_Info.Block_Origin_Field /= O_Fnode_Null then
          --  Set scope for origin and parents.
-         Push_Instantiated_Architecture_Scope (Entity, Entity_Info);
+         Push_Pop_Instantiated_Architecture_Scope (Entity, Entity_Info, True);
       end if;
 
       Chap9.Translate_Block_Subprograms (Arch, Arch);
 
       if Entity_Info.Block_Origin_Field /= O_Fnode_Null then
          --  Remove scope for origin and parents.
-         Pop_Instantiated_Architecture_Scope (Entity);
+         Push_Pop_Instantiated_Architecture_Scope (Entity, Entity_Info, False);
       end if;
 
       Clear_Scope (Entity_Info.Block_Scope);