From cb1a979037ac59a80e09cdcc095871480757859d Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 25 Aug 2017 05:16:38 +0200 Subject: Handle protected function as association conversion function. Fix #400 --- src/vhdl/sem_assocs.adb | 2 ++ src/vhdl/sem_names.adb | 38 +++++++++++++++++++----------- src/vhdl/translate/trans-chap4.adb | 47 ++++++++++++++++++++++++++++++++++---- src/vhdl/translate/trans.ads | 2 ++ 4 files changed, 71 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 48856557c..2136466b3 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -1564,6 +1564,7 @@ package body Sem_Assocs is Assoc := Get_Parameter_Association_Chain (Func); Free_Iir (Assoc); Set_Parameter_Association_Chain (Func, Null_Iir); + Name_To_Method_Object (Func, Conv); return Func; when Iir_Kind_Type_Conversion => return Func; @@ -1600,6 +1601,7 @@ package body Sem_Assocs is Set_Type (Res, Get_Return_Type (Func)); Set_Expr_Staticness (Res, None); Mark_Subprogram_Used (Func); + Name_To_Method_Object (Res, Conv); when Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration => Res := Create_Iir (Iir_Kind_Type_Conversion); diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 0baf6c71d..ddf592cf6 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -1872,7 +1872,8 @@ package body Sem_Names is -- LRM93 §6.3 -- Selected Names. - procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean := False) + procedure Sem_Selected_Name + (Name: Iir; Keep_Alias : Boolean := False; Soft : Boolean := False) is Suffix : constant Name_Id := Get_Identifier (Name); Prefix_Name : constant Iir := Get_Prefix (Name); @@ -2023,7 +2024,11 @@ package body Sem_Names is end Error_Unit_Not_Found; begin -- Analyze prefix. - Sem_Name (Prefix_Name); + if Soft then + Sem_Name_Soft (Prefix_Name); + else + Sem_Name (Prefix_Name); + end if; Prefix := Get_Named_Entity (Prefix_Name); if Prefix = Error_Mark then Set_Named_Entity (Name, Prefix); @@ -2080,7 +2085,7 @@ package body Sem_Names is end loop; end if; end; - if Res = Null_Iir then + if Res = Null_Iir and then not Soft then Error_Msg_Sem (+Name, "no suffix %i for overloaded selected name", +Suffix); end if; @@ -2094,11 +2099,11 @@ package body Sem_Names is -- particularly for an architecture body. -- GHDL: FIXME: error message more explicit Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name); - if Res = Null_Iir then - Error_Unit_Not_Found (Prefix); - else + if Res /= Null_Iir then Sem.Add_Dependence (Res); Res := Get_Library_Unit (Res); + elsif not Soft then + Error_Unit_Not_Found (Prefix); end if; when Iir_Kind_Process_Statement | Iir_Kind_Procedure_Declaration @@ -2133,8 +2138,10 @@ package body Sem_Names is Res := Find_Declarations_In_List (Prefix, Name, Keep_Alias); if Res = Null_Iir then - Error_Msg_Sem - (+Name, "no declaration for %i in %n", (+Suffix, +Prefix)); + if not Soft then + Error_Msg_Sem + (+Name, "no declaration for %i in %n", (+Suffix, +Prefix)); + end if; else -- LRM93 §6.3 -- This form of expanded name is only allowed within the @@ -2144,6 +2151,7 @@ package body Sem_Names is Iir_Kind_Package_Declaration, Iir_Kind_Package_Instantiation_Declaration) and then not Get_Is_Within_Flag (Prefix) + and then not Soft then Error_Msg_Sem (+Prefix_Loc, @@ -2156,7 +2164,7 @@ package body Sem_Names is if Res = Null_Iir then Sem_As_Selected_Element (Prefix); end if; - if Res = Null_Iir then + if Res = Null_Iir and then not Soft then Error_Selected_Element (Get_Return_Type (Prefix)); end if; when Iir_Kinds_Object_Declaration @@ -2170,12 +2178,12 @@ package body Sem_Names is = Iir_Kind_Protected_Type_Declaration then Sem_As_Protected_Item (Prefix); - if Res = Null_Iir then + if Res = Null_Iir and then not Soft then Error_Protected_Item (Prefix); end if; else Sem_As_Selected_Element (Prefix); - if Res = Null_Iir then + if Res = Null_Iir and then not Soft then Error_Selected_Element (Get_Type (Prefix)); end if; end if; @@ -2185,8 +2193,10 @@ package body Sem_Names is | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Slice_Name | Iir_Kind_Procedure_Call_Statement => - Error_Msg_Sem - (+Prefix_Loc, "%n cannot be selected by name", +Prefix); + if not Soft then + Error_Msg_Sem + (+Prefix_Loc, "%n cannot be selected by name", +Prefix); + end if; when others => Error_Kind ("sem_selected_name(2)", Prefix); @@ -3732,6 +3742,8 @@ package body Sem_Names is | Iir_Kind_Operator_Symbol => -- String_Literal may be a operator_symbol. Sem_Simple_Name (Name, False, Soft => True); + when Iir_Kind_Selected_Name => + Sem_Selected_Name (Name, Keep_Alias => False, Soft => True); when others => Error_Kind ("sem_name_soft", Name); end case; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index b496be745..ba95730a1 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2634,6 +2634,8 @@ package body Trans.Chap4 is Res : Mnode; Imp : Iir; Func : Iir; + Obj : Iir; -- Method object for function conversion + Obj_Type : Iir; -- Valid only if OBJ is valid begin case Mode is when Conv_Mode_In => @@ -2661,6 +2663,15 @@ package body Trans.Chap4 is Out_Info := Get_Info (Out_Type); In_Info := Get_Info (In_Type); + if Get_Kind (Imp) = Iir_Kind_Function_Call then + Obj := Get_Method_Object (Imp); + if Is_Valid (Obj) then + Obj_Type := Get_Type (Obj); + end if; + else + Obj := Null_Iir; + end if; + -- Start record containing data for the conversion function. Start_Record_Type (El_List); @@ -2690,6 +2701,14 @@ package body Trans.Chap4 is Conv_Info.Instantiated_Field := O_Fnode_Null; end if; + if Obj /= Null_Iir then + New_Record_Field + (El_List, Conv_Info.Method_Object, Get_Identifier ("obj"), + Get_Info (Obj_Type).Ortho_Ptr_Type (Mode_Value)); + else + Conv_Info.Method_Object := O_Fnode_Null; + end if; + -- Add inputs, which is a pointer to the signal. New_Record_Field (El_List, Conv_Info.In_Sig_Field, Get_Identifier ("sig_in"), @@ -2816,8 +2835,17 @@ package body Trans.Chap4 is New_Association (Constr, M2E (Res)); end if; - Subprgs.Add_Subprg_Instance_Assoc - (Constr, Subprg_Info.Subprg_Instance); + if Obj /= Null_Iir then + -- Protected object. + New_Association + (Constr, + New_Value (New_Selected_Acc_Value + (New_Obj (Var_Data), + Conv_Info.Method_Object))); + else + Subprgs.Add_Subprg_Instance_Assoc + (Constr, Subprg_Info.Subprg_Instance); + end if; New_Association (Constr, R); @@ -2923,6 +2951,7 @@ package body Trans.Chap4 is procedure Elab_Conversion (Sig_In : Iir; Sig_Out : Iir; + Conv : Iir; Reg_Subprg : O_Dnode; Info : Assoc_Conv_Info; Dest_Sig : out Mnode) @@ -2969,11 +2998,19 @@ package body Trans.Chap4 is end if; New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (Var_Data), - Info.Instantiated_Field), + Info.Instantiated_Field), Inst_Addr); end; end if; + if Info.Method_Object /= O_Fnode_Null then + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Method_Object), + M2E (Chap6.Translate_Name + (Get_Method_Object (Conv), Mode_Value))); + end if; + -- Set input. Chap6.Translate_Signal_Name (Sig_In, Src_Sig, Src_Val); Src_Sig := Stabilize (Src_Sig, True); @@ -3048,7 +3085,7 @@ package body Trans.Chap4 is Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin Elab_Conversion - (Get_Actual (Assoc), Formal, + (Get_Actual (Assoc), Formal, Get_In_Conversion (Assoc), Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest); end Elab_In_Conversion; @@ -3060,7 +3097,7 @@ package body Trans.Chap4 is Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin Elab_Conversion - (Formal, Get_Actual (Assoc), + (Formal, Get_Actual (Assoc), Get_Out_Conversion (Assoc), Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest); end Elab_Out_Conversion; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 1d57e7ed0..f18795e61 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -1147,6 +1147,8 @@ package Trans is Instantiated_Entity : Iir; -- and its address. Instantiated_Field : O_Fnode; + -- The object if the subprogram is a method + Method_Object : O_Fnode; In_Sig_Field : O_Fnode; In_Val_Field : O_Fnode; Out_Sig_Field : O_Fnode; -- cgit v1.2.3