diff --git a/src/simul/simul-vhdl_compile.adb b/src/simul/simul-vhdl_compile.adb index 68efde27ba..c8aeb85f8d 100644 --- 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 index d695051f0b..8978b3e1e6 100644 --- 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);