diff options
| author | Tristan Gingold <tgingold@free.fr> | 2022-12-22 10:19:43 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2022-12-23 08:53:09 +0100 |
| commit | 91266a811cd8cd5dcd70345ea6acbb899389453c (patch) | |
| tree | bccc893934a3fbebf43d6034fb314104c91ecd49 | |
| parent | f05bbd02f16d3368e9c171a7f42a08f26219262d (diff) | |
| download | ghdl-91266a811cd8cd5dcd70345ea6acbb899389453c.tar.gz ghdl-91266a811cd8cd5dcd70345ea6acbb899389453c.tar.bz2 ghdl-91266a811cd8cd5dcd70345ea6acbb899389453c.zip | |
vhdl-sem_inst: add instantiate_component_declaration.
For #2264
| -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. |