diff options
| -rw-r--r-- | src/synth/synth-decls.adb | 85 | ||||
| -rw-r--r-- | src/synth/synth-decls.ads | 8 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 46 |
3 files changed, 91 insertions, 48 deletions
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index fe764f50b..f83ec1bbd 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -570,10 +570,10 @@ package body Synth.Decls is Get_Value (Syn_Inst, Universal_Real_Type_Definition)); end Synth_Convertible_Declarations; - procedure Synth_Package_Declaration - (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; + Pkg : Node) + return Synth_Instance_Acc is - pragma Assert (not Is_Uninstantiated_Package (Pkg)); Syn_Inst : Synth_Instance_Acc; Val : Value_Acc; begin @@ -586,6 +586,21 @@ package body Synth.Decls is -- Local package: check elaboration order. Create_Object (Parent_Inst, Pkg, Val); end if; + return Syn_Inst; + end Create_Package_Instance; + + procedure Synth_Package_Declaration + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + Syn_Inst : Synth_Instance_Acc; + begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + + Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg); + Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); if Pkg = Vhdl.Std_Package.Standard_Package then Synth_Convertible_Declarations (Syn_Inst); @@ -597,15 +612,79 @@ package body Synth.Decls is is Val : Value_Acc; begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then Val := Get_Package_Object (Parent_Inst, Pkg); else Val := Get_Value (Parent_Inst, Pkg); end if; + Synth_Declarations (Get_Value_Instance (Val.Instance), Get_Declaration_Chain (Bod)); end Synth_Package_Body; + procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; + Syn_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node) + is + Inter : Node; + Inter_Type : Type_Acc; + Assoc : Node; + Assoc_Inter : Node; + Actual : Node; + Val : Value_Acc; + begin + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Is_Valid (Assoc) loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + + Synth_Declaration_Type (Sub_Inst, Inter); + Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter)); + + pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode); + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_Open => + Actual := Get_Default_Value (Inter); + Val := Synth_Expression_With_Type + (Sub_Inst, Actual, Inter_Type); + when Iir_Kind_Association_Element_By_Expression => + Actual := Get_Actual (Assoc); + Val := Synth_Expression_With_Type + (Syn_Inst, Actual, Inter_Type); + when others => + raise Internal_Error; + end case; + + Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); + + pragma Assert (Is_Static (Val)); + + Create_Object (Sub_Inst, Inter, Val); + + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Synth_Generics_Association; + + procedure Synth_Package_Instantiation + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + Sub_Inst : Synth_Instance_Acc; + begin + Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg); + + Synth_Generics_Association + (Sub_Inst, Parent_Inst, + Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg)); + + Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); + end Synth_Package_Instantiation; + procedure Synth_Variable (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean) is diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index 7fd104280..66e961cf6 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -55,4 +55,12 @@ package Synth.Decls is (Parent_Inst : Synth_Instance_Acc; Pkg : Node); procedure Synth_Package_Body (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node); + + procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; + Syn_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node); + + procedure Synth_Package_Instantiation + (Parent_Inst : Synth_Instance_Acc; Pkg : Node); end Synth.Decls; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index fae1a5a65..18c23b8bb 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -751,50 +751,6 @@ package body Synth.Insts is end loop; end Synth_Instantiate_Module; - procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node) - is - Inter : Node; - Inter_Type : Type_Acc; - Assoc : Node; - Assoc_Inter : Node; - Actual : Node; - Val : Value_Acc; - begin - Assoc := Assoc_Chain; - Assoc_Inter := Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - - Synth_Declaration_Type (Sub_Inst, Inter); - Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter)); - - pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode); - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_Open => - Actual := Get_Default_Value (Inter); - Val := Synth_Expression_With_Type - (Sub_Inst, Actual, Inter_Type); - when Iir_Kind_Association_Element_By_Expression => - Actual := Get_Actual (Assoc); - Val := Synth_Expression_With_Type - (Syn_Inst, Actual, Inter_Type); - when others => - raise Internal_Error; - end case; - - Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); - - pragma Assert (Is_Static (Val)); - - Create_Object (Sub_Inst, Inter, Val); - - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - end Synth_Generics_Association; - -- Return the type of EXPR without evaluating it. -- FIXME: how dubious is it ? function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) @@ -1199,7 +1155,7 @@ package body Synth.Insts is end if; end; when Iir_Kind_Package_Instantiation_Declaration => - null; + Synth_Package_Instantiation (Parent_Inst, Dep_Unit); when Iir_Kind_Package_Body => null; when Iir_Kind_Architecture_Body => |