diff options
Diffstat (limited to 'src/synth/synth-vhdl_stmts.adb')
| -rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 488 |
1 files changed, 283 insertions, 205 deletions
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 6fa2e9227..f351c34f3 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -142,6 +142,7 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Indexed_Name => declare + El_Typ : Type_Acc; Voff : Net; Off : Value_Offsets; Err : Boolean; @@ -150,7 +151,8 @@ package body Synth.Vhdl_Stmts is (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Strip_Const (Dest_Base); - Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off, Err); + Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, + El_Typ, Voff, Off, Err); if Err then Dest_Base := No_Valtyp; @@ -179,7 +181,7 @@ package body Synth.Vhdl_Stmts is end if; end if; - Dest_Typ := Get_Array_Element (Dest_Typ); + Dest_Typ := El_Typ; end; when Iir_Kind_Selected_Element => @@ -190,10 +192,7 @@ package body Synth.Vhdl_Stmts is Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); - Dest_Off.Net_Off := - Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff; - Dest_Off.Mem_Off := - Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff; + Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; end; @@ -261,8 +260,6 @@ package body Synth.Vhdl_Stmts is end case; end Synth_Assignment_Prefix; - type Target_Info_Array is array (Natural range <>) of Target_Info; - function Synth_Aggregate_Target_Type (Syn_Inst : Synth_Instance_Acc; Target : Node) return Type_Acc is @@ -295,7 +292,7 @@ package body Synth.Vhdl_Stmts is pragma Assert (Get_Kind (Choice) = Iir_Kind_Choice_By_None); El := Get_Associated_Expr (Choice); El_Typ := Elab.Vhdl_Expr.Exec_Type_Of_Object (Syn_Inst, El); - Bnd := Get_Array_Bound (El_Typ, 1); + Bnd := Get_Array_Bound (El_Typ); Len := Len + Bnd.Len; Choice := Get_Chain (Choice); end loop; @@ -323,7 +320,7 @@ package body Synth.Vhdl_Stmts is -- Compute the type. case Base_Typ.Kind is when Type_Unbounded_Vector => - Res := Create_Vector_Type (Bnd, Base_Typ.Uvec_El); + Res := Create_Vector_Type (Bnd, Base_Typ.Uarr_El); when others => raise Internal_Error; end case; @@ -344,6 +341,7 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration + | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Dereference => @@ -417,14 +415,14 @@ package body Synth.Vhdl_Stmts is end case; end Aggregate_Extract; - procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; - Target : Node; - Target_Typ : Type_Acc; - Val : Valtyp; - Loc : Node) + procedure Assign_Aggregate (Inst : Synth_Instance_Acc; + Target : Node; + Target_Typ : Type_Acc; + Val : Valtyp; + Loc : Node) is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ, 1); + Ctxt : constant Context_Acc := Get_Build (Inst); + Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ); Choice : Node; Assoc : Node; Pos : Uns32; @@ -436,23 +434,96 @@ package body Synth.Vhdl_Stmts is Assoc := Get_Associated_Expr (Choice); case Get_Kind (Choice) is when Iir_Kind_Choice_By_None => - Targ_Info := Synth_Target (Syn_Inst, Assoc); + Targ_Info := Synth_Target (Inst, Assoc); if Get_Element_Type_Flag (Choice) then Pos := Pos - 1; else - Pos := Pos - Get_Array_Bound (Targ_Info.Targ_Type, 1).Len; + Pos := Pos - Get_Array_Bound (Targ_Info.Targ_Type).Len; end if; - Synth_Assignment - (Syn_Inst, Targ_Info, - Aggregate_Extract (Ctxt, Val, Pos, - Targ_Info.Targ_Type, Assoc), - Loc); + Assign (Inst, Targ_Info, + Aggregate_Extract (Ctxt, Val, Pos, + Targ_Info.Targ_Type, Assoc), + Loc); when others => - Error_Kind ("synth_assignment_aggregate", Choice); + Error_Kind ("assign_aggregate", Choice); end case; Choice := Get_Chain (Choice); end loop; - end Synth_Assignment_Aggregate; + end Assign_Aggregate; + + procedure Synth_Assignment_Aggregate is + new Assign_Aggregate (Assign => Synth_Assignment); + + procedure Synth_Assignment_Simple (Syn_Inst : Synth_Instance_Acc; + Targ : Valtyp; + Off : Value_Offsets; + Val : Valtyp; + Loc : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + W : Wire_Id; + V : Valtyp; + begin + if Targ = No_Valtyp then + -- There was an error. + return; + end if; + + if Targ.Val.Kind = Value_Alias then + Synth_Assignment_Simple (Syn_Inst, (Targ.Val.A_Typ, Targ.Val.A_Obj), + Off + Targ.Val.A_Off, Val, Loc); + return; + end if; + + V := Val; + + if Targ.Val.Kind = Value_Wire then + W := Get_Value_Wire (Targ.Val); + if Is_Static (V.Val) + and then V.Typ.Sz = Targ.Typ.Sz + then + pragma Assert (Off = No_Value_Offsets); + Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); + else + if V.Typ.W = 0 then + -- Forget about null wires. + return; + end if; + Phi_Assign_Net (Ctxt, W, Get_Net (Ctxt, V), Off.Net_Off); + end if; + else + if not Is_Static (V.Val) then + -- Maybe the error message is too cryptic ? + Error_Msg_Synth + (+Loc, "cannot assign a net to a static value"); + else + Copy_Memory (Targ.Val.Mem + Off.Mem_Off, Get_Memory (V), V.Typ.Sz); + end if; + end if; + end Synth_Assignment_Simple; + + procedure Synth_Assignment_Memory (Syn_Inst : Synth_Instance_Acc; + Targ_Base : Value_Acc; + Targ_Poff : Uns32; + Targ_Ptyp : Type_Acc; + Targ_Voff : Net; + Targ_Eoff : Uns32; + Val : Valtyp; + Loc : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + W : constant Wire_Id := Get_Value_Wire (Targ_Base); + N : Net; + begin + -- Get the whole memory. + N := Get_Current_Assign_Value (Ctxt, W, Targ_Poff, Targ_Ptyp.W); + -- Insert the new value. + N := Build_Dyn_Insert + (Ctxt, N, Get_Net (Ctxt, Val), Targ_Voff, Targ_Eoff); + Set_Location (N, Loc); + -- Write. + Phi_Assign_Net (Ctxt, W, N, Targ_Poff); + end Synth_Assignment_Memory; procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Target_Info; @@ -461,7 +532,6 @@ package body Synth.Vhdl_Stmts is is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); V : Valtyp; - W : Wire_Id; begin V := Synth_Subtype_Conversion (Ctxt, Val, Target.Targ_Type, False, Loc); pragma Unreferenced (Val); @@ -475,52 +545,13 @@ package body Synth.Vhdl_Stmts is Synth_Assignment_Aggregate (Syn_Inst, Target.Aggr, Target.Targ_Type, V, Loc); when Target_Simple => - if V.Typ.Sz = 0 then - -- If there is nothing to assign (like a null slice), - -- return now. - return; - end if; - - if Target.Obj.Val.Kind = Value_Wire then - W := Get_Value_Wire (Target.Obj.Val); - if Is_Static (V.Val) - and then V.Typ.Sz = Target.Obj.Typ.Sz - then - pragma Assert (Target.Off = (0, 0)); - Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); - else - if V.Typ.W = 0 then - -- Forget about null wires. - return; - end if; - Phi_Assign_Net - (Ctxt, W, Get_Net (Ctxt, V), Target.Off.Net_Off); - end if; - else - if not Is_Static (V.Val) then - -- Maybe the error message is too cryptic ? - Error_Msg_Synth - (+Loc, "cannot assign a net to a static value"); - else - Strip_Const (V); - Copy_Memory (Target.Obj.Val.Mem + Target.Off.Mem_Off, - V.Val.Mem, V.Typ.Sz); - end if; - end if; + Synth_Assignment_Simple (Syn_Inst, Target.Obj, Target.Off, V, Loc); when Target_Memory => - declare - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - W : constant Wire_Id := Get_Value_Wire (Target.Mem_Obj.Val); - N : Net; - begin - N := Get_Current_Assign_Value - (Ctxt, W, - Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ.W); - N := Build_Dyn_Insert (Ctxt, N, Get_Net (Ctxt, V), - Target.Mem_Dyn.Voff, Target.Mem_Doff); - Set_Location (N, Loc); - Phi_Assign_Net (Ctxt, W, N, Target.Mem_Dyn.Pfx_Off.Net_Off); - end; + Synth_Assignment_Memory + (Syn_Inst, Target.Mem_Obj.Val, + Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ, + Target.Mem_Dyn.Voff, Target.Mem_Doff, + V, Loc); end case; end Synth_Assignment; @@ -851,8 +882,8 @@ package body Synth.Vhdl_Stmts is when Type_Discrete => return False; when Type_Vector => - if V.Typ.Vec_El = Logic_Type then - for I in 1 .. Size_Type (V.Typ.Vbound.Len) loop + if V.Typ.Arr_El = Logic_Type then + for I in 1 .. Size_Type (V.Typ.Abound.Len) loop if Ignore_Choice_Logic (Read_U8 (V.Val.Mem + (I - 1)), Loc) then return True; @@ -1578,16 +1609,6 @@ package body Synth.Vhdl_Stmts is end if; end Synth_Label; - function Is_Copyback_Interface (Inter : Node) return Boolean is - begin - case Iir_Parameter_Modes (Get_Mode (Inter)) is - when Iir_In_Mode => - return False; - when Iir_Out_Mode | Iir_Inout_Mode => - return Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration; - end case; - end Is_Copyback_Interface; - type Association_Iterator_Kind is (Association_Function, Association_Operator); @@ -1623,36 +1644,6 @@ package body Synth.Vhdl_Stmts is Right => Right); end Association_Iterator_Build; - function Count_Associations (Init : Association_Iterator_Init) - return Natural - is - Assoc : Node; - Assoc_Inter : Node; - Inter : Node; - Nbr_Inout : Natural; - begin - case Init.Kind is - when Association_Function => - Nbr_Inout := 0; - - Assoc := Init.Assoc_Chain; - Assoc_Inter := Init.Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - - if Is_Copyback_Interface (Inter) then - Nbr_Inout := Nbr_Inout + 1; - end if; - - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - - return Nbr_Inout; - when Association_Operator => - return 0; - end case; - end Count_Associations; - type Association_Iterator (Kind : Association_Iterator_Kind := Association_Function) is record @@ -1729,7 +1720,9 @@ package body Synth.Vhdl_Stmts is Formal := Get_Formal (Assoc); pragma Assert (Formal /= Null_Node); Formal := Get_Interface_Of_Formal (Formal); - if Formal = Inter then + -- Compare by identifier, as INTER can be the generic + -- interface, while FORMAL is the instantiated one. + if Get_Identifier (Formal) = Get_Identifier (Inter) then -- Found. -- Optimize in case assocs are in order. if Assoc = Iterator.First_Named_Assoc then @@ -1750,26 +1743,42 @@ package body Synth.Vhdl_Stmts is end case; end Association_Iterate_Next; - procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; - Caller_Inst : Synth_Instance_Acc; - Init : Association_Iterator_Init; - Infos : out Target_Info_Array) + function Info_To_Valtyp (Info : Target_Info) return Valtyp is + begin + case Info.Kind is + when Target_Simple => + if Info.Off = No_Value_Offsets then + return Info.Obj; + else + return Create_Value_Alias (Info.Obj, Info.Off, Info.Targ_Type); + end if; + when Target_Aggregate => + raise Internal_Error; + when Target_Memory => + return Create_Value_Dyn_Alias (Info.Mem_Obj.Val, + Info.Mem_Dyn.Pfx_Off.Net_Off, + Info.Mem_Dyn.Pfx_Typ, + Info.Mem_Dyn.Voff, + Info.Mem_Doff, + Info.Targ_Type); + end case; + end Info_To_Valtyp; + + procedure Synth_Subprogram_Associations (Subprg_Inst : Synth_Instance_Acc; + Caller_Inst : Synth_Instance_Acc; + Init : Association_Iterator_Init) is - pragma Assert (Infos'First = 1); Ctxt : constant Context_Acc := Get_Build (Caller_Inst); Inter : Node; Inter_Type : Type_Acc; Assoc : Node; Actual : Node; Val : Valtyp; - Nbr_Inout : Natural; Iterator : Association_Iterator; Info : Target_Info; begin Set_Instance_Const (Subprg_Inst, True); - Nbr_Inout := 0; - -- Process in INTER order. Association_Iterate_Init (Iterator, Init); loop @@ -1778,8 +1787,9 @@ package body Synth.Vhdl_Stmts is Inter_Type := Get_Subtype_Object (Subprg_Inst, Get_Type (Inter)); - case Iir_Parameter_Modes (Get_Mode (Inter)) is - when Iir_In_Mode => + case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is + when Iir_Kind_Interface_Constant_Declaration => + pragma Assert (Get_Mode (Inter) = Iir_In_Mode); if Assoc = Null_Node or else Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then @@ -1797,40 +1807,38 @@ package body Synth.Vhdl_Stmts is Val := Synth_Expression_With_Type (Caller_Inst, Actual, Inter_Type); end if; - when Iir_Out_Mode | Iir_Inout_Mode => + when Iir_Kind_Interface_Variable_Declaration => + -- Always pass by value. Actual := Get_Actual (Assoc); Info := Synth_Target (Caller_Inst, Actual); - - case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) - is - when Iir_Kind_Interface_Constant_Declaration => - raise Internal_Error; - when Iir_Kind_Interface_Variable_Declaration => - -- Always pass by value. - Nbr_Inout := Nbr_Inout + 1; - Infos (Nbr_Inout) := Info; - if Info.Kind /= Target_Memory - and then Is_Static (Info.Obj.Val) - then - Val := Create_Value_Memory (Info.Targ_Type); - Copy_Memory (Val.Val.Mem, - Info.Obj.Val.Mem + Info.Off.Mem_Off, - Info.Targ_Type.Sz); - else - Val := Synth_Read (Caller_Inst, Info, Assoc); - end if; - when Iir_Kind_Interface_Signal_Declaration => - -- Always pass by reference (use an alias). - if Info.Kind = Target_Memory then - raise Internal_Error; - end if; - Val := Create_Value_Alias - (Info.Obj, Info.Off, Info.Targ_Type); - when Iir_Kind_Interface_File_Declaration => - Val := Info.Obj; - when Iir_Kind_Interface_Quantity_Declaration => - raise Internal_Error; - end case; + if Is_Copyback_Parameter (Inter) then + Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info)); + end if; + if Info.Kind /= Target_Memory + and then Is_Static (Info.Obj.Val) + then + Val := Create_Value_Memory (Info.Targ_Type); + Copy_Memory (Val.Val.Mem, + Info.Obj.Val.Mem + Info.Off.Mem_Off, + Info.Targ_Type.Sz); + else + Val := Synth_Read (Caller_Inst, Info, Assoc); + end if; + when Iir_Kind_Interface_Signal_Declaration => + -- Always pass by reference (use an alias). + Actual := Get_Actual (Assoc); + Info := Synth_Target (Caller_Inst, Actual); + if Info.Kind = Target_Memory then + raise Internal_Error; + end if; + Val := Create_Value_Alias + (Info.Obj, Info.Off, Info.Targ_Type); + when Iir_Kind_Interface_File_Declaration => + Actual := Get_Actual (Assoc); + Info := Synth_Target (Caller_Inst, Actual); + Val := Info.Obj; + when Iir_Kind_Interface_Quantity_Declaration => + raise Internal_Error; end case; if Val = No_Valtyp then @@ -1842,9 +1850,14 @@ package body Synth.Vhdl_Stmts is case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration => - -- Always passed by value - Val := Synth_Subtype_Conversion - (Ctxt, Val, Inter_Type, True, Assoc); + if Get_Mode (Inter) /= Iir_Out_Mode then + -- Always passed by value + Val := Synth_Subtype_Conversion + (Ctxt, Val, Inter_Type, True, Assoc); + else + -- Use default value ? + null; + end if; when Iir_Kind_Interface_Signal_Declaration => -- LRM08 4.2.2.3 Signal parameters -- If an actual signal is associated with a signal parameter @@ -1905,7 +1918,7 @@ package body Synth.Vhdl_Stmts is case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration => - -- Pass by reference. + -- Pass by copy. Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_Variable_Declaration => -- Arguments are passed by copy. @@ -1925,19 +1938,17 @@ package body Synth.Vhdl_Stmts is raise Internal_Error; end case; end loop; - end Synth_Subprogram_Association; + end Synth_Subprogram_Associations; procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node) is - Infos : Target_Info_Array (1 .. 0); Init : Association_Iterator_Init; begin Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain); - Synth_Subprogram_Association (Subprg_Inst, Caller_Inst, Init, Infos); - pragma Unreferenced (Infos); + Synth_Subprogram_Associations (Subprg_Inst, Caller_Inst, Init); end Synth_Subprogram_Association; -- Create wires for out and inout interface variables. @@ -1975,31 +1986,39 @@ package body Synth.Vhdl_Stmts is procedure Synth_Subprogram_Back_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Inter_Chain : Node; + Assoc_Chain : Node) is - pragma Assert (Infos'First = 1); Inter : Node; Assoc : Node; Assoc_Inter : Node; Val : Valtyp; - Nbr_Inout : Natural; + Targ : Valtyp; W : Wire_Id; + D : Destroy_Type; begin - Nbr_Inout := 0; - pragma Assert (Init.Kind = Association_Function); - Assoc := Init.Assoc_Chain; - Assoc_Inter := Init.Inter_Chain; + Destroy_Init (D, Caller_Inst); + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); - if Is_Copyback_Interface (Inter) then + if Is_Copyback_Parameter (Inter) then if not Get_Whole_Association_Flag (Assoc) then raise Internal_Error; end if; - Nbr_Inout := Nbr_Inout + 1; + Targ := Get_Value (Caller_Inst, Assoc); Val := Get_Value (Subprg_Inst, Inter); - Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc); + if Targ.Val.Kind = Value_Dyn_Alias then + Synth_Assignment_Memory + (Caller_Inst, Targ.Val.D_Obj, + Targ.Val.D_Poff, Targ.Val.D_Ptyp, + Get_Value_Dyn_Alias_Voff (Targ.Val), Targ.Val.D_Eoff, + Val, Assoc); + else + Synth_Assignment_Simple + (Caller_Inst, Targ, No_Value_Offsets, Val, Assoc); + end if; -- Free wire used for out/inout interface variables. if Val.Val.Kind = Value_Wire then @@ -2007,11 +2026,13 @@ package body Synth.Vhdl_Stmts is Phi_Discard_Wires (W, No_Wire_Id); Free_Wire (W); end if; + + Destroy_Object (D, Assoc); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; - pragma Assert (Nbr_Inout = Infos'Last); + Destroy_Finish (D); end Synth_Subprogram_Back_Association; function Build_Control_Signal (Syn_Inst : Synth_Instance_Acc; @@ -2029,8 +2050,7 @@ package body Synth.Vhdl_Stmts is function Synth_Dynamic_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Sub_Inst : Synth_Instance_Acc; Call : Node; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Init : Association_Iterator_Init) return Valtyp is Imp : constant Node := Get_Implementation (Call); @@ -2106,7 +2126,8 @@ package body Synth.Vhdl_Stmts is end if; else Res := No_Valtyp; - Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); end if; end if; @@ -2114,7 +2135,6 @@ package body Synth.Vhdl_Stmts is Vhdl_Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - pragma Unreferenced (Infos); -- Propagate assignments. -- Wires that have been created for this subprogram will be destroyed. @@ -2141,8 +2161,7 @@ package body Synth.Vhdl_Stmts is Sub_Inst : Synth_Instance_Acc; Call : Node; Bod : Node; - Init : Association_Iterator_Init; - Infos : Target_Info_Array) + Init : Association_Iterator_Init) return Valtyp is Imp : constant Node := Get_Implementation (Call); @@ -2184,17 +2203,31 @@ package body Synth.Vhdl_Stmts is end if; else Res := No_Valtyp; - Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); end if; end if; Vhdl_Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - pragma Unreferenced (Infos); return Res; end Synth_Static_Subprogram_Call; + function Synth_Subprogram_Call_Instance (Inst : Synth_Instance_Acc; + Imp : Node; + Bod : Node) + return Synth_Instance_Acc + is + Res : Synth_Instance_Acc; + Up_Inst : Synth_Instance_Acc; + begin + Up_Inst := Get_Instance_By_Scope (Inst, Get_Parent_Scope (Imp)); + Res := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node); + Set_Caller_Instance (Res, Inst); + return Res; + end Synth_Subprogram_Call_Instance; + function Synth_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Call : Node; Init : Association_Iterator_Init) @@ -2204,23 +2237,18 @@ 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); - Nbr_Inout : constant Natural := Count_Associations (Init); - Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; Res : Valtyp; Sub_Inst : Synth_Instance_Acc; - Up_Inst : Synth_Instance_Acc; begin Areapools.Mark (Area_Mark, Instance_Pool.all); - Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp)); - Sub_Inst := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node); - Set_Caller_Instance (Sub_Inst, Syn_Inst); + Sub_Inst := Synth_Subprogram_Call_Instance (Syn_Inst, Imp, Bod); if Ctxt /= null then Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; - Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init); if Is_Error (Sub_Inst) then Res := No_Valtyp; @@ -2233,10 +2261,10 @@ package body Synth.Vhdl_Stmts is if Get_Instance_Const (Sub_Inst) then Res := Synth_Static_Subprogram_Call - (Syn_Inst, Sub_Inst, Call, Bod, Init, Infos); + (Syn_Inst, Sub_Inst, Call, Bod, Init); else Res := Synth_Dynamic_Subprogram_Call - (Syn_Inst, Sub_Inst, Call, Init, Infos); + (Syn_Inst, Sub_Inst, Call, Init); end if; end if; @@ -2300,8 +2328,6 @@ package body Synth.Vhdl_Stmts is Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Init : constant Association_Iterator_Init := Association_Iterator_Build (Inter_Chain, Assoc_Chain); - Nbr_Inout : constant Natural := Count_Associations (Init); - Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; Sub_Inst : Synth_Instance_Acc; begin @@ -2312,11 +2338,12 @@ package body Synth.Vhdl_Stmts is Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); end if; - Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Associations (Sub_Inst, Syn_Inst, Init); Synth.Vhdl_Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call); - Synth_Subprogram_Back_Association (Sub_Inst, Syn_Inst, Init, Infos); + Synth_Subprogram_Back_Association + (Sub_Inst, Syn_Inst, Init.Inter_Chain, Init.Assoc_Chain); Free_Instance (Sub_Inst); Areapools.Release (Area_Mark, Instance_Pool.all); @@ -2678,11 +2705,14 @@ package body Synth.Vhdl_Stmts is is Iterator : constant Node := Get_Parameter_Specification (Stmt); It_Type : constant Node := Get_Declaration_Type (Iterator); + D : Destroy_Type; begin - Destroy_Object (Inst, Iterator); + Destroy_Init (D, Inst); + Destroy_Object (D, Iterator); if It_Type /= Null_Node then - Destroy_Object (Inst, It_Type); + Destroy_Object (D, It_Type); end if; + Destroy_Finish (D); end Finish_For_Loop_Statement; procedure Synth_Dynamic_For_Loop_Statement @@ -2950,7 +2980,7 @@ package body Synth.Vhdl_Stmts is Put_Err ("): "); if Rep = No_Valtyp then - Put_Line_Err ("assertion failure"); + Put_Line_Err ("Assertion violation"); else Put_Line_Err (Value_To_String (Rep)); end if; @@ -2961,10 +2991,53 @@ package body Synth.Vhdl_Stmts is end if; end Synth_Static_Report; - procedure Synth_Static_Report_Statement (C : Seq_Context; Stmt : Node) is + procedure Execute_Report_Statement (Inst : Synth_Instance_Acc; + Stmt : Node) is begin - Synth_Static_Report (C.Inst, Stmt); - end Synth_Static_Report_Statement; + Synth_Static_Report (Inst, Stmt); + end Execute_Report_Statement; + + -- Return True if EXPR can be evaluated with static values. + -- Does not need to be fully accurate, used for report/assert messages. + function Is_Static_Expr (Inst : Synth_Instance_Acc; + Expr : Node) return Boolean is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Dyadic_Operator => + return Is_Static_Expr (Inst, Get_Left (Expr)) + and then Is_Static_Expr (Inst, Get_Right (Expr)); + when Iir_Kind_Image_Attribute => + return Is_Static_Expr (Inst, Get_Parameter (Expr)); + when Iir_Kind_Instance_Name_Attribute + | Iir_Kinds_Literal + | Iir_Kind_Enumeration_Literal => + return True; + when Iir_Kind_Length_Array_Attribute => + -- Attributes on types can be evaluated. + return True; + when Iir_Kind_Simple_Name => + return Is_Static_Expr (Inst, Get_Named_Entity (Expr)); + when others => + Error_Kind ("is_static_expr", Expr); + return False; + end case; + end Is_Static_Expr; + + procedure Synth_Dynamic_Report_Statement (Inst : Synth_Instance_Acc; + Stmt : Node; + Is_Cond : Boolean) + is + Rep_Expr : constant Node := Get_Report_Expression (Stmt); + Sev_Expr : constant Node := Get_Severity_Expression (Stmt); + begin + if not Is_Cond + and then Is_Static_Expr (Inst, Rep_Expr) + and then (Sev_Expr = Null_Node + or else Is_Static_Expr (Inst, Sev_Expr)) + then + Synth_Static_Report (Inst, Stmt); + end if; + end Synth_Dynamic_Report_Statement; procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc; Stmt : Node) @@ -3083,7 +3156,12 @@ package body Synth.Vhdl_Stmts is Synth_Procedure_Call (C.Inst, Stmt); when Iir_Kind_Report_Statement => if not Is_Dyn then - Synth_Static_Report_Statement (C, Stmt); + Execute_Report_Statement (C.Inst, Stmt); + else + -- Not executed. + -- Depends on the execution path: the report statement may + -- be conditionally executed. + Synth_Dynamic_Report_Statement (C.Inst, Stmt, True); end if; when Iir_Kind_Assertion_Statement => if not Is_Dyn then |