diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/synth/synth-vhdl_insts.adb | 7 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_assocs.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.adb | 59 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.ads | 18 |
5 files changed, 90 insertions, 9 deletions
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index 46f2983a2..3e7e59f6c 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -1058,6 +1058,7 @@ package body Synth.Vhdl_Insts is Arch : Node; Config : Node) is + Generic_Chain : constant Node := Get_Generic_Chain (Ent); Inst_Obj : Inst_Object; Inst : Instance; Enc : Name_Encoding; @@ -1070,6 +1071,10 @@ package body Synth.Vhdl_Insts is Enc := Name_Parameters; end if; + -- Interning needs access to the actual types of interface types. + Set_Interface_Associated + (Generic_Chain, Get_Generic_Map_Aspect_Chain (Stmt)); + -- Search if corresponding module has already been used. -- If not create a new module -- * create a name from the generics and the library @@ -1083,6 +1088,8 @@ package body Synth.Vhdl_Insts is pragma Assert (Is_Expr_Pool_Empty); + Clear_Interface_Associated (Generic_Chain); + -- Do the instantiation. Inst := New_Instance (Get_Instance_Module (Syn_Inst), diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 528b642a1..174f1456e 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -445,6 +445,12 @@ package body Vhdl.Sem is Sem_Association_Chain (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match); + + -- Clear associated type of interface type. + -- Should be part of Sem_Association_Chain, but needed only for + -- generics. + Clear_Interface_Associated (Inter_Chain); + Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain); if Match = Not_Compatible then return False; diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index a28ebe12e..f93eaaecf 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -2386,15 +2386,6 @@ package body Vhdl.Sem_Assocs is Has_Individual := False; Last_Assoc := Null_Iir; - -- Clear associated type of interface type. - Inter := Interface_Chain; - while Inter /= Null_Iir loop - if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then - Set_Associated_Type (Get_Type (Inter), Null_Iir); - end if; - Inter := Get_Chain (Inter); - end loop; - -- Loop on every assoc element, try to match it. Inter := Interface_Chain; Last_Individual := Null_Iir; diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 05c1dc0ee..6bd200cc3 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -691,6 +691,65 @@ package body Vhdl.Utils is end if; end Is_Copyback_Parameter; + procedure Set_Interface_Associated (Inter_Chain : Iir; Assoc_Chain : Iir) + is + Inter, Assoc_Inter, Assoc : Iir; + begin + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Assoc /= Null_Node loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is + when Iir_Kind_Interface_Type_Declaration => + declare + Tdef : constant Iir := Get_Interface_Type_Definition (Inter); + begin + pragma Assert (Get_Associated_Type (Tdef) = Null_Iir); + Set_Associated_Type (Tdef, Get_Actual_Type (Assoc)); + end; + -- TODO: subprograms ? + when Iir_Kind_Interface_Package_Declaration => + pragma Assert (Get_Associated_Package (Inter) = Null_Iir); + Set_Associated_Package + (Inter, Get_Named_Entity (Get_Actual (Assoc))); + when Iir_Kinds_Interface_Subprogram_Declaration => + pragma Assert (Get_Associated_Subprogram (Inter) = Null_Iir); + Set_Associated_Subprogram + (Inter, Get_Named_Entity (Get_Actual (Assoc))); + when Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Interface_Terminal_Declaration => + null; + end case; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Set_Interface_Associated; + + procedure Clear_Interface_Associated (Inter_Chain : Iir) + is + Inter : Iir; + begin + Inter := Inter_Chain; + while Inter /= Null_Node loop + case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is + when Iir_Kind_Interface_Type_Declaration => + declare + Tdef : constant Iir := Get_Interface_Type_Definition (Inter); + begin + Set_Associated_Type (Tdef, Null_Iir); + end; + -- TODO: subprograms ? + when Iir_Kind_Interface_Package_Declaration => + Set_Associated_Package (Inter, Null_Iir); + when Iir_Kinds_Interface_Subprogram_Declaration => + Set_Associated_Subprogram (Inter, Null_Iir); + when Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Interface_Terminal_Declaration => + null; + end case; + Inter := Get_Chain (Inter); + end loop; + end Clear_Interface_Associated; + function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir is El : Iir; diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads index 01425a157..8cce0eb14 100644 --- a/src/vhdl/vhdl-utils.ads +++ b/src/vhdl/vhdl-utils.ads @@ -94,6 +94,18 @@ package Vhdl.Utils is -- interface (initialized to the association chain and interface chain). -- The function Get_Association_Interface return the interface associated -- to ASSOC,and Next_Association_Interface updates ASSOC and INTER. + -- + -- Usage: + -- Assoc := Get_xxx_Association_Chain (X); + -- Assoc_Inter := Get_xxx_Declaration_Chain (Y); + -- while Assoc /= Null_Iir loop + -- Inter := Get_Association_Interface (Assoc, Assoc_Inter); + -- ... + -- Next_Association_Interface (Assoc, Assoc_Inter); + -- end loop; + -- + -- Note: This iterates over association, so unassociated interfaces are + -- not iterated. function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir; procedure Next_Association_Interface (Assoc : in out Iir; Inter : in out Iir); @@ -116,6 +128,12 @@ package Vhdl.Utils is -- variable). function Is_Copyback_Parameter (Inter : Iir) return Boolean; + -- Set/clear the Associated_XXX fields of type, package and subprogram + -- interfaces. + -- For set, check they were previously cleared. + procedure Set_Interface_Associated (Inter_Chain : Iir; Assoc_Chain : Iir); + procedure Clear_Interface_Associated (Inter_Chain : Iir); + -- Duplicate enumeration literal LIT. function Copy_Enumeration_Literal (Lit : Iir) return Iir; |