diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/vhdl-canon.adb | 12 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_inst.adb | 48 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_inst.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_stmts.adb | 81 | 
4 files changed, 139 insertions, 5 deletions
| diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index b07fb7d7c..95f531cf8 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -2321,18 +2321,22 @@ package body Vhdl.Canon is           when Iir_Kind_Component_Instantiation_Statement =>              declare                 Inst : Iir; +               Hdr : Iir;                 Assoc_Chain : Iir;              begin -               Inst := Get_Instantiated_Unit (Stmt); -               Inst := Get_Entity_From_Entity_Aspect (Inst); +               Hdr := Get_Instantiated_Header (Stmt); +               if True or Hdr = Null_Iir then +                  Inst := Get_Instantiated_Unit (Stmt); +                  Hdr := Get_Entity_From_Entity_Aspect (Inst); +               end if;                 Assoc_Chain := Canon_Association_Chain_And_Actuals -                 (Get_Generic_Chain (Inst), +                 (Get_Generic_Chain (Hdr),                    Get_Generic_Map_Aspect_Chain (Stmt),                    Stmt);                 Set_Generic_Map_Aspect_Chain (Stmt, Assoc_Chain);                 Assoc_Chain := Canon_Association_Chain_And_Actuals -                 (Get_Port_Chain (Inst), +                 (Get_Port_Chain (Hdr),                    Get_Port_Map_Aspect_Chain (Stmt),                    Stmt);                 Set_Port_Map_Aspect_Chain (Stmt, Assoc_Chain); diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb index 4b0ca0279..0a4f4387e 100644 --- a/src/vhdl/vhdl-sem_inst.adb +++ b/src/vhdl/vhdl-sem_inst.adb @@ -1300,6 +1300,54 @@ package body Vhdl.Sem_Inst is        return Res;     end Instantiate_Package_Body; +   function Instantiate_Component_Declaration (Comp : Iir; Map : Iir) +                                              return Iir +   is +      Prev_Instance_File : constant Source_File_Entry := Instance_File; +      Mark : constant Instance_Index_Type := Prev_Instance_Table.Last; +      Prev_Orig : Iir; +      Inst : Iir; +   begin +      --  Create the component/entity. +      Inst := Create_Iir (Get_Kind (Comp)); + +      --  Build and set the new location. +      Create_Relocation (Map, Comp); +      Set_Location (Inst, Relocate (Get_Location (Comp))); + +      --  Be sure Get_Origin_Priv can be called on existing nodes. +      Expand_Origin_Table; + +      --  For Parent: the instance of PKG is INST. +      Prev_Orig := Get_Origin (Comp); +      Set_Origin (Comp, Inst); + +      --  Instantiate generics +      Set_Generic_Chain +        (Inst, +         Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Comp), True)); + +      declare +         Assoc, Inter : Iir; +      begin +         Assoc := Get_Generic_Map_Aspect_Chain (Map); +         Inter := Get_Generic_Chain (Inst); +         while Is_Valid (Assoc) loop +            Instantiate_Generic_Map (Assoc, Inter); +            Next_Association_Interface (Assoc, Inter); +         end loop; +      end; + +      Set_Port_Chain +        (Inst, Instantiate_Iir_Chain (Get_Port_Chain (Comp))); + +      Set_Origin (Comp, Prev_Orig); + +      Instance_File := Prev_Instance_File; +      Restore_Origin (Mark); +      return Inst; +   end Instantiate_Component_Declaration; +     procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir);     procedure Substitute_On_Iir (N : Iir; E : Iir; Rep : Iir) is diff --git a/src/vhdl/vhdl-sem_inst.ads b/src/vhdl/vhdl-sem_inst.ads index c9585d0c7..dea437837 100644 --- a/src/vhdl/vhdl-sem_inst.ads +++ b/src/vhdl/vhdl-sem_inst.ads @@ -40,6 +40,9 @@ package Vhdl.Sem_Inst is     --  body.  INST has the form of a generic-mapped package.     function Instantiate_Package_Body (Inst : Iir) return Iir; +   function Instantiate_Component_Declaration (Comp : Iir; Map : Iir) +                                              return Iir; +     --  In CHAIN, substitute all references to E by REP.     procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir); diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index 74409ccab..c1c2431e1 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -25,6 +25,7 @@ with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;  with Vhdl.Sem_Names; use Vhdl.Sem_Names;  with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;  with Vhdl.Sem_Types; +with Vhdl.Sem_Inst;  with Vhdl.Sem_Psl;  with Std_Names;  with Vhdl.Evaluation; use Vhdl.Evaluation; @@ -1945,10 +1946,79 @@ package body Vhdl.Sem_Stmts is        end if;     end Sem_Instantiated_Unit; +   function Component_Need_Instance (Comp : Iir) return Boolean +   is +      Inter : Iir; +      Inter_Type, Type_Name : Iir; +      Has_Type_Gen : Boolean; +   begin +      Has_Type_Gen := False; +      Inter := Get_Generic_Chain (Comp); +      while Inter /= Null_Iir loop +         case Get_Kind (Inter) is +            when Iir_Kind_Interface_Package_Declaration +              | Iir_Kind_Interface_Type_Declaration => +               Has_Type_Gen := True; +            when others => +               null; +         end case; +         Inter := Get_Chain (Inter); +      end loop; + +      --  If neither interface package nor interface type, no need to check +      --  ports. +      if not Has_Type_Gen then +         return False; +      end if; + +      --  Check if a type from an interface package or a generic type is used. +      Inter := Get_Port_Chain (Comp); +      while Inter /= Null_Iir loop +         Inter_Type := Get_Subtype_Indication (Inter); +         if Inter_Type /= Null_Iir then +            --  Maybe to ad-hoc ? +            Type_Name := Get_Base_Name (Inter_Type); +            case Get_Kind (Type_Name) is +               when Iir_Kind_Interface_Package_Declaration +                 | Iir_Kind_Interface_Type_Declaration => +                  return True; +               when others => +                  null; +            end case; +         end if; +         Inter := Get_Chain (Inter); +      end loop; + +      return False; +   end Component_Need_Instance; + +   procedure Reassoc_Association_Chain (Chain : Iir) +   is +      Assoc : Iir; +      Formal : Iir; +      Ent : Iir; +   begin +      Assoc := Chain; +      while Assoc /= Null_Iir loop +         Formal := Get_Formal (Assoc); +         if Formal /= Null_Iir then +            if Get_Kind (Formal) = Iir_Kind_Simple_Name then +               Ent := Get_Named_Entity (Formal); +               Ent := Sem_Inst.Get_Origin (Ent); +               Set_Named_Entity (Formal, Ent); +            else +               raise Internal_Error; +            end if; +         end if; +         Assoc := Get_Chain (Assoc); +      end loop; +   end Reassoc_Association_Chain; +     procedure Sem_Component_Instantiation_Statement       (Stmt: Iir_Component_Instantiation_Statement; Is_Passive : Boolean)     is        Decl : Iir; +      Decl_Inst : Iir;        Entity_Unit : Iir_Design_Unit;        Bind : Iir_Binding_Indication;     begin @@ -1972,7 +2042,16 @@ package body Vhdl.Sem_Stmts is        --  The associations        Sem_Generic_Association_Chain (Decl, Stmt); -      Sem_Port_Association_Chain (Decl, Stmt); +      if Component_Need_Instance (Decl) then +         Decl_Inst := Sem_Inst.Instantiate_Component_Declaration (Decl, Stmt); +         Set_Instantiated_Header (Stmt, Decl_Inst); +         Sem_Port_Association_Chain (Decl_Inst, Stmt); +         --  Re-associate formals with the non-instantiated interfaces. +         Reassoc_Association_Chain (Get_Generic_Map_Aspect_Chain (Stmt)); +         Reassoc_Association_Chain (Get_Port_Map_Aspect_Chain (Stmt)); +      else +         Sem_Port_Association_Chain (Decl, Stmt); +      end if;        --  FIXME: add sources for signals, in order to detect multiple sources        --  to unresolved signals. | 
