diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/simul/simul-vhdl_simul.adb | 45 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 87 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_stmts.ads | 5 |
3 files changed, 75 insertions, 62 deletions
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index cc4c8b4f9..9242e938c 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -2397,37 +2397,6 @@ package body Simul.Vhdl_Simul is end case; end Connect; - function Execute_Assoc_Conversion (Inst : Synth_Instance_Acc; - Func : Node; - Val : Memtyp; - Res_Typ : Type_Acc) return Memtyp - is - Res : Valtyp; - begin - case Get_Kind (Func) is - when Iir_Kind_Function_Call => - Res := Exec_Resolution_Call (Inst, Get_Implementation (Func), - Create_Value_Memtyp (Val)); - when Iir_Kind_Type_Conversion => - declare - Conv_Typ : constant Type_Acc := - Get_Subtype_Object (Inst, Get_Type (Func)); - begin - Res := Synth.Vhdl_Expr.Synth_Type_Conversion - (Inst, Create_Value_Memtyp (Val), Conv_Typ, Func); - end; - when others => - Vhdl.Errors.Error_Kind ("execute_assoc_conversion", Func); - end case; - Res := Synth.Vhdl_Expr.Synth_Subtype_Conversion - (Inst, Res, Res_Typ, False, Func); - if Res = No_Valtyp then - Grt.Errors.Fatal_Error; - end if; - Convert_Type_Width (Res.Typ); - return Synth.Vhdl_Expr.Get_Value_Memtyp (Res); - end Execute_Assoc_Conversion; - procedure Create_Shadow_Signal (Sig : Memory_Ptr; Val : Memory_Ptr; Typ : Type_Acc) @@ -2490,6 +2459,7 @@ package body Simul.Vhdl_Simul is Val : Memtyp; Dst : Memtyp; + Dst_Val : Valtyp; Expr_Marker, Inst_Marker : Mark_Type; begin @@ -2506,9 +2476,16 @@ package body Simul.Vhdl_Simul is Exec_Read_Signal (Conv.Src_Sig, Val, Read_Signal_Driving_Value); end case; - Dst := Execute_Assoc_Conversion - (Conv.Inst, Conv.Func, Val, Conv.Dst_Typ); - pragma Assert (Dst.Typ.Wkind = Wkind_Sim); + Dst_Val := Create_Value_Memory (Val, Current_Pool); + Dst_Val := Synth_Association_Conversion + (Conv.Inst, Conv.Func, Dst_Val, Conv.Dst_Typ); + pragma Assert (Dst_Val.Typ.Wkind = Wkind_Sim); + + if Dst_Val = No_Valtyp then + Grt.Errors.Fatal_Error; + end if; + Convert_Type_Width (Dst_Val.Typ); + Dst := Synth.Vhdl_Expr.Get_Value_Memtyp (Dst_Val); case Conv.Mode is when Convert_In => diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index bd260d6da..22c2698d7 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -1971,6 +1971,7 @@ package body Synth.Vhdl_Stmts is Val : Valtyp; Info : Target_Info; Actual_Inst : Synth_Instance_Acc; + Conv : Node; begin -- Actual and formal. Actual_Inst := Caller_Inst; @@ -1980,14 +1981,17 @@ package body Synth.Vhdl_Stmts is -- Missing association or open association: use default value. Actual := Get_Default_Value (Inter); Actual_Inst := Subprg_Inst; + Conv := Null_Node; elsif Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then -- Normal case: formal and actual. pragma Assert (Get_Whole_Association_Flag (Assoc)); Actual := Get_Actual (Assoc); + Conv := Get_Actual_Conversion (Assoc); else -- Just an expression. Actual := Assoc; + Conv := Null_Node; end if; -- Special case for protected type as the slot describes @@ -1998,17 +2002,8 @@ package body Synth.Vhdl_Stmts is Inter_Typ := Get_Subtype_Object (Subprg_Inst, Inter_Type); end if; - if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then - -- Actual is a reference. - Info := Synth_Target (Caller_Inst, Actual); - if Assoc /= Null_Node - and then Get_Actual_Conversion (Assoc) /= Null_Node - then - -- TODO - raise Internal_Error; - end if; - else - -- For constants and in variables. + if Get_Kind (Inter) = Iir_Kind_Interface_Constant_Declaration then + -- Constants: simply synth the expression Val := Synth_Expression_With_Type (Actual_Inst, Actual, Inter_Typ); if Val = No_Valtyp then return Val; @@ -2026,6 +2021,9 @@ package body Synth.Vhdl_Stmts is then Set_Instance_Const (Subprg_Inst, False); end if; + else + -- Actual is a reference. + Info := Synth_Target (Caller_Inst, Actual); end if; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is @@ -2038,25 +2036,28 @@ package body Synth.Vhdl_Stmts is -- For the copy back: keep info of formal. Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info)); end if; - Val := Synth_Read (Caller_Inst, Info, Assoc); - if not Flags.Flag_Simulation - and then not Is_Static (Val.Val) + if Get_Mode (Inter) /= Iir_Out_Mode + or else Inter_Typ.Kind = Type_File then - Set_Instance_Const (Subprg_Inst, False); - end if; - if Get_Mode (Inter) /= Iir_Out_Mode then + Val := Synth_Read (Caller_Inst, Info, Assoc); + if Conv /= Null_Node then + Val := Synth_Association_Conversion + (Caller_Inst, Conv, Val, Inter_Typ); + end if; + if not Flags.Flag_Simulation + and then not Is_Static (Val.Val) + then + Set_Instance_Const (Subprg_Inst, False); + end if; -- Always passed by value Val := Synth_Subtype_Conversion (Subprg_Inst, Val, Inter_Typ, True, Assoc); else -- Use default value - -- FIXME: also for wires ? - if Val.Val.Kind = Value_Memory then - if Is_Bounded_Type (Inter_Typ) then - Write_Value_Default (Val.Val.Mem, Inter_Typ); - else - Write_Value_Default (Val.Val.Mem, Val.Typ); - end if; + if Is_Bounded_Type (Inter_Typ) then + Val := Create_Value_Default (Inter_Typ); + else + Val := Create_Value_Default (Info.Targ_Type); end if; end if; Val.Typ := Unshare (Val.Typ, Instance_Pool); @@ -2353,6 +2354,31 @@ package body Synth.Vhdl_Stmts is end loop; end Synth_Subprogram_Association_Wires; + function Synth_Association_Conversion (Inst : Synth_Instance_Acc; + Func : Node; + Val : Valtyp; + Res_Typ : Type_Acc) return Valtyp + is + Res : Valtyp; + begin + case Get_Kind (Func) is + when Iir_Kind_Function_Call => + Res := Exec_Resolution_Call (Inst, Get_Implementation (Func), Val); + when Iir_Kind_Type_Conversion => + declare + Conv_Typ : constant Type_Acc := + Get_Subtype_Object (Inst, Get_Type (Func)); + begin + Res := Synth_Type_Conversion (Inst, Val, Conv_Typ, Func); + end; + when others => + Vhdl.Errors.Error_Kind ("synth_association_conversion", Func); + end case; + Res := Synth.Vhdl_Expr.Synth_Subtype_Conversion + (Inst, Res, Res_Typ, False, Func); + return Res; + end Synth_Association_Conversion; + procedure Synth_Subprogram_Back_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; @@ -2366,6 +2392,7 @@ package body Synth.Vhdl_Stmts is Formal : Node; Val : Valtyp; Targ : Valtyp; + Conv : Node; W : Wire_Id; D : Destroy_Type; begin @@ -2380,17 +2407,21 @@ package body Synth.Vhdl_Stmts is and then Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then + Targ := Get_Value (Caller_Inst, Assoc); Formal := Get_Formal (Assoc); + Conv := Get_Formal_Conversion (Assoc); + if Formal = Null_Node then Val := Get_Value (Subprg_Inst, Inter); else Val := Synth_Expression (Subprg_Inst, Formal); end if; - if Get_Formal_Conversion (Assoc) /= Null_Node then - -- TODO - raise Internal_Error; + + if Conv /= Null_Node then + Val := Synth_Association_Conversion + (Caller_Inst, Conv, Val, Targ.Typ); end if; - Targ := Get_Value (Caller_Inst, Assoc); + if Targ.Val.Kind = Value_Dyn_Alias then Synth_Assignment_Memory (Caller_Inst, Targ.Val.D_Obj, diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index 6afd115d3..c07dc7224 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -147,6 +147,11 @@ package Synth.Vhdl_Stmts is Inter_Chain : Node; Assoc_Chain : Node); + function Synth_Association_Conversion (Inst : Synth_Instance_Acc; + Func : Node; + Val : Valtyp; + Res_Typ : Type_Acc) return Valtyp; + -- For simulation. function Exec_Resolution_Call (Syn_Inst : Synth_Instance_Acc; Func : Node; |