aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2022-12-22 10:19:43 +0100
committerTristan Gingold <tgingold@free.fr>2022-12-23 08:53:09 +0100
commit91266a811cd8cd5dcd70345ea6acbb899389453c (patch)
treebccc893934a3fbebf43d6034fb314104c91ecd49
parentf05bbd02f16d3368e9c171a7f42a08f26219262d (diff)
downloadghdl-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.adb12
-rw-r--r--src/vhdl/vhdl-sem_inst.adb48
-rw-r--r--src/vhdl/vhdl-sem_inst.ads3
-rw-r--r--src/vhdl/vhdl-sem_stmts.adb81
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.