diff options
Diffstat (limited to 'src/synth/synth-vhdl_stmts.adb')
| -rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 85 |
1 files changed, 75 insertions, 10 deletions
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 5b958681d..a10167cf3 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -41,6 +41,7 @@ with PSL.NFAs; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; +with Elab.Vhdl_Prot; with Elab.Vhdl_Types; use Elab.Vhdl_Types; with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; with Elab.Vhdl_Debug; @@ -347,8 +348,9 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Simple_Name | Iir_Kind_Selected_Element | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Variable_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name @@ -1872,7 +1874,8 @@ package body Synth.Vhdl_Stmts is is Marker : Mark_Type; Inter : Node; - Inter_Type : Type_Acc; + Inter_Type : Node; + Inter_Typ : Type_Acc; Assoc : Node; Actual : Node; Val : Valtyp; @@ -1889,7 +1892,12 @@ package body Synth.Vhdl_Stmts is Association_Iterate_Next (Iterator, Inter, Assoc); exit when Inter = Null_Node; - Inter_Type := Get_Subtype_Object (Subprg_Inst, Get_Type (Inter)); + Inter_Type := Get_Type (Inter); + if Get_Kind (Inter_Type) = Iir_Kind_Protected_Type_Declaration then + Inter_Typ := Protected_Type; + else + Inter_Typ := Get_Subtype_Object (Subprg_Inst, Inter_Type); + end if; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration => @@ -1899,7 +1907,7 @@ package body Synth.Vhdl_Stmts is then Actual := Get_Default_Value (Inter); Val := Synth_Expression_With_Type - (Subprg_Inst, Actual, Inter_Type); + (Subprg_Inst, Actual, Inter_Typ); else if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression @@ -1909,7 +1917,7 @@ package body Synth.Vhdl_Stmts is Actual := Assoc; end if; Val := Synth_Expression_With_Type - (Caller_Inst, Actual, Inter_Type); + (Caller_Inst, Actual, Inter_Typ); end if; when Iir_Kind_Interface_Variable_Declaration => -- Always pass by value. @@ -1961,7 +1969,7 @@ package body Synth.Vhdl_Stmts is if Get_Mode (Inter) /= Iir_Out_Mode then -- Always passed by value Val := Synth_Subtype_Conversion - (Subprg_Inst, Val, Inter_Type, True, Assoc); + (Subprg_Inst, Val, Inter_Typ, True, Assoc); Val := Unshare (Val, Instance_Pool); else -- Use default value ? @@ -1983,7 +1991,7 @@ package body Synth.Vhdl_Stmts is Iir_Kinds_Scalar_Type_And_Subtype_Definition then if Get_Mode (Inter) in Iir_In_Modes then - if not Is_Scalar_Subtype_Compatible (Val.Typ, Inter_Type) + if not Is_Scalar_Subtype_Compatible (Val.Typ, Inter_Typ) then Error_Msg_Synth (+Actual, @@ -1992,7 +2000,7 @@ package body Synth.Vhdl_Stmts is end if; end if; if Get_Mode (Inter) in Iir_Out_Modes then - if not Is_Scalar_Subtype_Compatible (Inter_Type, Val.Typ) + if not Is_Scalar_Subtype_Compatible (Inter_Typ, Val.Typ) then Error_Msg_Synth (+Actual, @@ -2005,7 +2013,7 @@ package body Synth.Vhdl_Stmts is -- This is equivalent to subtype conversion for non-scalar -- types. Val := Synth_Subtype_Conversion - (Subprg_Inst, Val, Inter_Type, True, Assoc); + (Subprg_Inst, Val, Inter_Typ, True, Assoc); Val := Unshare (Val, Instance_Pool); end if; if Val.Typ /= null then @@ -2340,6 +2348,47 @@ package body Synth.Vhdl_Stmts is return Res; end Synth_Subprogram_Call_Instance; + -- Like Get_Protected_Type_Body, but also works for instances, where + -- instantiated nodes have no bodies. + -- FIXME: maybe fix the issue directly in Sem_Inst ? + function Get_Protected_Type_Body_Origin (Spec : Node) return Node + is + Res : constant Node := Get_Protected_Type_Body (Spec); + Orig : Node; + begin + if Res /= Null_Node then + return Res; + else + Orig := Vhdl.Sem_Inst.Get_Origin (Spec); + return Get_Protected_Type_Body_Origin (Orig); + end if; + end Get_Protected_Type_Body_Origin; + pragma Unreferenced (Get_Protected_Type_Body_Origin); + + function Synth_Protected_Call_Instance (Inst : Synth_Instance_Acc; + Obj : Node; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc + is + pragma Unreferenced (Imp); + Obj_Info : Target_Info; + Idx : Protected_Index; + Obj_Inst : Synth_Instance_Acc; + Res : Synth_Instance_Acc; + begin + Obj_Info := Synth_Target (Inst, Obj); + pragma Assert (Obj_Info.Kind = Target_Simple); + pragma Assert (Obj_Info.Off = No_Value_Offsets); + -- Get instance_acc of the variable + Idx := Read_Protected (Obj_Info.Obj.Val.Mem); + Obj_Inst := Elab.Vhdl_Prot.Get (Idx); + + Res := Make_Elab_Instance (Obj_Inst, Bod, Config => Null_Node); + Set_Caller_Instance (Res, Inst); + return Res; + end Synth_Protected_Call_Instance; + function Synth_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Call : Node; Init : Association_Iterator_Init) @@ -2349,6 +2398,7 @@ package body Synth.Vhdl_Stmts is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp); + Obj : Node; Area_Mark : Areapools.Mark_Type; Ret_Typ : Type_Acc; Res : Valtyp; @@ -2356,7 +2406,22 @@ package body Synth.Vhdl_Stmts is begin Areapools.Mark (Area_Mark, Instance_Pool.all); - Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); + case Get_Kind (Call) is + when Iir_Kinds_Dyadic_Operator + | Iir_Kinds_Monadic_Operator => + Obj := Null_Node; + when Iir_Kind_Function_Call + | Iir_Kind_Procedure_Call => + Obj := Get_Method_Object (Call); + when others => + raise Internal_Error; + end case; + + if Obj /= Null_Node then + Sub_Inst := Synth_Protected_Call_Instance (Syn_Inst, Obj, Imp, Bod); + else + Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); + end if; if Ctxt /= null then Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; |