From 787d1d010ba53f2572aa11a78407e846ee4061dc Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 30 Jun 2016 06:14:11 +0200 Subject: Initial support of direct recursive instantiation. Fix issue #2. --- src/vhdl/translate/trans-chap5.adb | 276 +++++++++++++++++++++---------------- 1 file changed, 160 insertions(+), 116 deletions(-) (limited to 'src/vhdl/translate/trans-chap5.adb') diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index a0c90ba6f..c115b84b4 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -30,6 +30,17 @@ with Trans.Foreach_Non_Composite; package body Trans.Chap5 is use Trans.Helpers; + procedure Save_Map_Env (Env : out Map_Env; Scope_Ptr : Var_Scope_Acc) is + begin + Env := (Scope_Ptr => Scope_Ptr, + Scope => Scope_Ptr.all); + end Save_Map_Env; + + procedure Set_Map_Env (Env : Map_Env) is + begin + Env.Scope_Ptr.all := Env.Scope; + end Set_Map_Env; + procedure Translate_Attribute_Specification (Spec : Iir_Attribute_Specification) is @@ -330,7 +341,10 @@ package body Trans.Chap5 is Update_Data_Record => Connect_Update_Data_Record, Finish_Data_Record => Connect_Finish_Data_Composite); - procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; By_Copy : Boolean) + procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; + By_Copy : Boolean; + Formal_Env : Map_Env; + Actual_Env : Map_Env) is Formal : constant Iir := Get_Formal (Assoc); Actual : constant Iir := Get_Actual (Assoc); @@ -341,6 +355,7 @@ package body Trans.Chap5 is Formal_Val : Mnode; Actual_Sig : Mnode; Actual_Val : Mnode; + Actual_En : O_Enode; Data : Connect_Data; Mode : Connect_Mode; begin @@ -384,13 +399,11 @@ package body Trans.Chap5 is raise Internal_Error; end case; - -- translate actual (abort if not a signal). - Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); - Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); - if By_Copy then - Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); + Set_Map_Env (Actual_Env); Chap6.Translate_Signal_Name (Actual, Actual_Sig, Actual_Val); + Set_Map_Env (Formal_Env); + Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); -- Copy pointer to the values. if Get_Info (Formal_Type).Type_Mode in Type_Mode_Arrays then @@ -401,15 +414,18 @@ package body Trans.Chap5 is New_Assign_Stmt (M2Lp (Formal_Val), M2Addr (Actual_Val)); end if; else - Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Set_Map_Env (Actual_Env); Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); + Set_Map_Env (Formal_Env); + Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); end if; else + Set_Map_Env (Actual_Env); + Actual_En := Chap7.Translate_Expression (Actual, Formal_Type); + Set_Map_Env (Formal_Env); + Actual_Sig := E2M (Actual_En, Get_Info (Formal_Type), Mode_Value); Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); - Actual_Sig := - E2M (Chap7.Translate_Expression (Actual, Formal_Type), - Get_Info (Formal_Type), Mode_Value); Mode := Connect_Value; -- raise Internal_Error; end if; @@ -431,7 +447,9 @@ package body Trans.Chap5 is else if Get_In_Conversion (Assoc) /= Null_Iir then Chap4.Elab_In_Conversion (Assoc, Actual_Sig); + Set_Map_Env (Formal_Env); Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Set_Map_Env (Actual_Env); Data := (Actual_Sig => Actual_Sig, Actual_Type => Formal_Type, Mode => Connect_Effective, @@ -441,11 +459,13 @@ package body Trans.Chap5 is if Get_Out_Conversion (Assoc) /= Null_Iir then -- flow: FORMAL to ACTUAL Chap4.Elab_Out_Conversion (Assoc, Formal_Sig); + Set_Map_Env (Actual_Env); Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); Data := (Actual_Sig => Actual_Sig, Actual_Type => Actual_Type, Mode => Connect_Source, By_Copy => False); + Set_Map_Env (Formal_Env); Connect (Formal_Sig, Actual_Type, Data); end if; end if; @@ -453,102 +473,7 @@ package body Trans.Chap5 is Close_Temp; end Elab_Port_Map_Aspect_Assoc; - procedure Elab_Generic_Map_Aspect (Mapping : Iir) - is - Assoc : Iir; - Formal : Iir; - begin - -- Elab generics, and associate. - Assoc := Get_Generic_Map_Aspect_Chain (Mapping); - while Assoc /= Null_Iir loop - Open_Temp; - Formal := Strip_Denoting_Name (Get_Formal (Assoc)); - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - declare - Targ : Mnode; - begin - if Get_Whole_Association_Flag (Assoc) then - Chap4.Elab_Object_Storage (Formal); - Targ := Chap6.Translate_Name (Formal, Mode_Value); - Chap4.Elab_Object_Init - (Targ, Formal, Get_Actual (Assoc)); - else - Targ := Chap6.Translate_Name (Formal, Mode_Value); - Chap7.Translate_Assign - (Targ, Get_Actual (Assoc), Get_Type (Formal)); - end if; - end; - when Iir_Kind_Association_Element_Open => - declare - Value : constant Iir := Get_Default_Value (Formal); - begin - Chap4.Elab_Object_Value (Formal, Value); - Chap9.Destroy_Types (Value); - end; - when Iir_Kind_Association_Element_By_Individual => - -- Create the object. - declare - Formal_Type : constant Iir := Get_Type (Formal); - Obj_Info : constant Object_Info_Acc := Get_Info (Formal); - Obj_Type : constant Iir := Get_Actual_Type (Assoc); - Formal_Node : Mnode; - Type_Info : Type_Info_Acc; - Bounds : Mnode; - begin - Chap3.Elab_Object_Subtype (Formal_Type); - Type_Info := Get_Info (Formal_Type); - Formal_Node := Get_Var - (Obj_Info.Object_Var, Type_Info, Mode_Value); - Stabilize (Formal_Node); - if Obj_Type = Null_Iir then - Chap4.Allocate_Complex_Object - (Formal_Type, Alloc_System, Formal_Node); - else - Chap3.Create_Array_Subtype (Obj_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Obj_Type); - Chap3.Translate_Object_Allocation - (Formal_Node, Alloc_System, Formal_Type, Bounds); - end if; - end; - when Iir_Kind_Association_Element_Package => - pragma Assert (Get_Kind (Formal) = - Iir_Kind_Interface_Package_Declaration); - declare - Uninst_Pkg : constant Iir := Get_Named_Entity - (Get_Uninstantiated_Package_Name (Formal)); - Uninst_Info : constant Ortho_Info_Acc := - Get_Info (Uninst_Pkg); - Formal_Info : constant Ortho_Info_Acc := - Get_Info (Formal); - Actual : constant Iir := Get_Named_Entity - (Get_Actual (Assoc)); - Actual_Info : constant Ortho_Info_Acc := - Get_Info (Actual); - begin - New_Assign_Stmt - (Get_Var (Formal_Info.Package_Instance_Spec_Var), - New_Address - (Get_Instance_Ref - (Actual_Info.Package_Instance_Spec_Scope), - Uninst_Info.Package_Spec_Ptr_Type)); - New_Assign_Stmt - (Get_Var (Formal_Info.Package_Instance_Body_Var), - New_Address - (Get_Instance_Ref - (Actual_Info.Package_Instance_Body_Scope), - Uninst_Info.Package_Body_Ptr_Type)); - end; - when others => - Error_Kind ("elab_generic_map_aspect(1)", Assoc); - end case; - Close_Temp; - Assoc := Get_Chain (Assoc); - end loop; - end Elab_Generic_Map_Aspect; - - function Alloc_Bounds (Atype : Iir; Alloc : Allocation_Kind) - return Mnode + function Alloc_Bounds (Atype : Iir; Alloc : Allocation_Kind) return Mnode is Tinfo : constant Type_Info_Acc := Get_Info (Atype); Var : O_Dnode; @@ -663,9 +588,7 @@ package body Trans.Chap5 is Open_Temp; case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_By_Expression => - if not Get_Whole_Association_Flag (Assoc) then - return; - end if; + pragma Assert (Get_Whole_Association_Flag (Assoc)); Bounds := Get_Unconstrained_Port_Bounds (Assoc); when Iir_Kind_Association_Element_Open => declare @@ -697,10 +620,14 @@ package body Trans.Chap5 is Close_Temp; end Elab_Unconstrained_Port_Bounds; - procedure Elab_Port_Map_Aspect (Mapping : Iir; Block_Parent : Iir) + procedure Elab_Port_Map_Aspect + (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is + Actual_Env : Map_Env; Assoc : Iir; begin + Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); + -- Ports. Assoc := Get_Port_Map_Aspect_Chain (Mapping); while Assoc /= Null_Iir loop @@ -710,6 +637,7 @@ package body Trans.Chap5 is Fb_Type : constant Iir := Get_Type (Formal_Base); Fbt_Info : constant Type_Info_Acc := Get_Info (Fb_Type); begin + Set_Map_Env (Formal_Env); -- Set bounds of unconstrained ports. if Fbt_Info.Type_Mode = Type_Mode_Fat_Array then Open_Temp; @@ -739,20 +667,23 @@ package body Trans.Chap5 is if Get_Whole_Association_Flag (Assoc) then if Get_Collapse_Signal_Flag (Assoc) then -- For collapsed association, copy signals. - Elab_Port_Map_Aspect_Assoc (Assoc, True); + Elab_Port_Map_Aspect_Assoc + (Assoc, True, Formal_Env, Actual_Env); else -- Create non-collapsed signals. Chap4.Elab_Signal_Declaration_Object (Formal, Block_Parent, False); -- And associate. - Elab_Port_Map_Aspect_Assoc (Assoc, False); + Elab_Port_Map_Aspect_Assoc + (Assoc, False, Formal_Env, Actual_Env); end if; else -- By sub-element. -- Either the whole signal is collapsed or it was already -- created. -- And associate. - Elab_Port_Map_Aspect_Assoc (Assoc, False); + Elab_Port_Map_Aspect_Assoc + (Assoc, False, Formal_Env, Actual_Env); end if; when Iir_Kind_Association_Element_Open | Iir_Kind_Association_Element_By_Individual => @@ -765,14 +696,127 @@ package body Trans.Chap5 is end; Assoc := Get_Chain (Assoc); end loop; + Set_Map_Env (Actual_Env); end Elab_Port_Map_Aspect; - procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir) is + procedure Elab_Generic_Map_Aspect (Mapping : Iir; Formal_Env : Map_Env) + is + Actual_Env : Map_Env; + Assoc : Iir; + Formal : Iir; + begin + Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); + + -- Elab generics, and associate. + Assoc := Get_Generic_Map_Aspect_Chain (Mapping); + while Assoc /= Null_Iir loop + Open_Temp; + Formal := Strip_Denoting_Name (Get_Formal (Assoc)); + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + declare + Targ : Mnode; + begin + if Get_Whole_Association_Flag (Assoc) then + Set_Map_Env (Formal_Env); + Chap4.Elab_Object_Storage (Formal); + Targ := Chap6.Translate_Name (Formal, Mode_Value); + Set_Map_Env (Actual_Env); + Chap4.Elab_Object_Init + (Targ, Formal, Get_Actual (Assoc)); + else + Set_Map_Env (Formal_Env); + Targ := Chap6.Translate_Name (Formal, Mode_Value); + Set_Map_Env (Actual_Env); + Chap7.Translate_Assign + (Targ, Get_Actual (Assoc), Get_Type (Formal)); + end if; + end; + when Iir_Kind_Association_Element_Open => + declare + Value : constant Iir := Get_Default_Value (Formal); + begin + Set_Map_Env (Formal_Env); + Chap4.Elab_Object_Value (Formal, Value); + Chap9.Destroy_Types (Value); + Set_Map_Env (Actual_Env); + end; + when Iir_Kind_Association_Element_By_Individual => + -- Create the object. + declare + Formal_Type : constant Iir := Get_Type (Formal); + Obj_Info : constant Object_Info_Acc := Get_Info (Formal); + Obj_Type : constant Iir := Get_Actual_Type (Assoc); + Formal_Node : Mnode; + Type_Info : Type_Info_Acc; + Bounds : Mnode; + begin + Set_Map_Env (Formal_Env); + Chap3.Elab_Object_Subtype (Formal_Type); + Type_Info := Get_Info (Formal_Type); + Formal_Node := Get_Var + (Obj_Info.Object_Var, Type_Info, Mode_Value); + Stabilize (Formal_Node); + if Obj_Type = Null_Iir then + Chap4.Allocate_Complex_Object + (Formal_Type, Alloc_System, Formal_Node); + else + Chap3.Create_Array_Subtype (Obj_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Obj_Type); + Chap3.Translate_Object_Allocation + (Formal_Node, Alloc_System, Formal_Type, Bounds); + end if; + Set_Map_Env (Actual_Env); + end; + when Iir_Kind_Association_Element_Package => + pragma Assert (Get_Kind (Formal) = + Iir_Kind_Interface_Package_Declaration); + declare + Uninst_Pkg : constant Iir := Get_Named_Entity + (Get_Uninstantiated_Package_Name (Formal)); + Uninst_Info : constant Ortho_Info_Acc := + Get_Info (Uninst_Pkg); + Formal_Info : constant Ortho_Info_Acc := + Get_Info (Formal); + Actual : constant Iir := Get_Named_Entity + (Get_Actual (Assoc)); + Actual_Info : constant Ortho_Info_Acc := + Get_Info (Actual); + begin + New_Assign_Stmt + (Get_Var (Formal_Info.Package_Instance_Spec_Var), + New_Address + (Get_Instance_Ref + (Actual_Info.Package_Instance_Spec_Scope), + Uninst_Info.Package_Spec_Ptr_Type)); + New_Assign_Stmt + (Get_Var (Formal_Info.Package_Instance_Body_Var), + New_Address + (Get_Instance_Ref + (Actual_Info.Package_Instance_Body_Scope), + Uninst_Info.Package_Body_Ptr_Type)); + end; + when others => + Error_Kind ("elab_generic_map_aspect(1)", Assoc); + end case; + Close_Temp; + Assoc := Get_Chain (Assoc); + end loop; + end Elab_Generic_Map_Aspect; + + procedure Elab_Map_Aspect + (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is begin + -- The use of FORMAL_ENV (and then later ACTUAL_ENV) is rather fragile + -- as in some cases both the formal and the actual are referenced in the + -- same time (like Check_Array_Match). But the env are different only + -- in case of direct recursive instantation (rare). To stay on the safe + -- side, FORMAL_ENV must be active/set. + -- The generic map must be done before the elaboration of -- the ports, since a port subtype may depend on a generic. - Elab_Generic_Map_Aspect (Mapping); + Elab_Generic_Map_Aspect (Mapping, Formal_Env); - Elab_Port_Map_Aspect (Mapping, Block_Parent); + Elab_Port_Map_Aspect (Mapping, Block_Parent, Formal_Env); end Elab_Map_Aspect; end Trans.Chap5; -- cgit v1.2.3