From d7f0f4d54961c65fbf5b98eb97d125c23de534f6 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 26 Aug 2020 18:18:17 +0200 Subject: synth: improve diagnostic for multiple assignment. Fix #1428 --- src/synth/synth-context.adb | 2 +- src/synth/synth-environment.adb | 184 ++++++++++++++++++++++++++++++++++++++-- src/synth/synth-environment.ads | 6 +- src/synth/synth-insts.adb | 4 +- src/synth/synth-stmts.adb | 14 +-- 5 files changed, 191 insertions(+), 19 deletions(-) (limited to 'src/synth') diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 0362a0a25..309fa1dd7 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -306,7 +306,7 @@ package body Synth.Context is if Kind = Wire_None then Wid := No_Wire_Id; else - Wid := Alloc_Wire (Kind, Obj); + Wid := Alloc_Wire (Kind, Otyp, Obj); end if; Val := Create_Value_Wire (Wid, Otyp); diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index 7f552f352..d1d07a66b 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -28,6 +28,7 @@ with Netlists.Folds; use Netlists.Folds; with Netlists.Inference; with Errorout; use Errorout; +with Name_Table; with Synth.Flags; with Synth.Errors; use Synth.Errors; @@ -35,6 +36,7 @@ with Synth.Source; use Synth.Source; with Synth.Context; with Vhdl.Nodes; +with Vhdl.Utils; package body Synth.Environment is procedure Phi_Assign @@ -50,7 +52,7 @@ package body Synth.Environment is return Wire_Id_Table.Table (Wid).Mark_Flag; end Get_Wire_Mark; - function Alloc_Wire (Kind : Wire_Kind; Obj : Source.Syn_Src) + function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src) return Wire_Id is Res : Wire_Id; @@ -58,6 +60,7 @@ package body Synth.Environment is Wire_Id_Table.Append ((Kind => Kind, Mark_Flag => False, Decl => Obj, + Typ => Typ, Gate => No_Net, Cur_Assign => No_Seq_Assign, Final_Assign => No_Conc_Assign, @@ -692,6 +695,149 @@ package body Synth.Environment is and then Is_Tribuf_Net (N_Val); end Is_Tribuf_Assignment; + function Info_Subrange_Vhdl (Off : Width; Wd : Width; Bnd: Bound_Type) + return String + is + function Image (V : Int32) return String + is + Res : constant String := Int32'Image (V); + begin + if V >= 0 then + return Res (2 .. Res'Last); + else + return Res; + end if; + end Image; + begin + case Bnd.Dir is + when Dir_To => + if Wd = 1 then + return Image (Bnd.Right - Int32 (Off)); + else + return Image (Bnd.Left + Int32 (Bnd.Len - (Off + Wd))) + & " to " + & Image (Bnd.Right - Int32 (Off)); + end if; + when Dir_Downto => + if Wd = 1 then + return Image (Bnd.Right + Int32 (Off)); + else + return Image (Bnd.Left - Int32 (Bnd.Len - (Off + Wd))) + & " downto " + & Image (Bnd.Right + Int32 (Off)); + end if; + end case; + end Info_Subrange_Vhdl; + + procedure Info_Subnet_Vhdl (Loc : Location_Type; + Prefix : String; + Otype : Vhdl.Nodes.Node; + Typ : Type_Acc; + Off : Width; + Wd : Width) is + begin + case Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + pragma Assert (Wd = Typ.W); + pragma Assert (Off = 0); + Info_Msg_Synth (+Loc, " " & Prefix); + when Type_File + | Type_Protected + | Type_Access + | Type_Unbounded_Array + | Type_Unbounded_Record + | Type_Unbounded_Vector => + raise Internal_Error; + when Type_Vector => + pragma Assert (Wd <= Typ.W); + if Off = 0 and Wd = Typ.W then + Info_Msg_Synth (+Loc, " " & Prefix); + else + Info_Msg_Synth + (+Loc, + " " & Prefix + & "(" & Info_Subrange_Vhdl (Off, Wd, Typ.Vbound) & ")"); + end if; + when Type_Slice + | Type_Array => + Info_Msg_Synth (+Loc, " " & Prefix & "(??)"); + when Type_Record => + declare + use Vhdl.Nodes; + Els : constant Iir_Flist := + Get_Elements_Declaration_List (Otype); + begin + for I in Typ.Rec.E'Range loop + declare + El : Rec_El_Type renames Typ.Rec.E (I); + Field : constant Vhdl.Nodes.Node := + Get_Nth_Element (Els, Natural (I - 1)); + Sub_Off : Uns32; + Sub_Wd : Width; + begin + if Off + Wd <= El.Boff then + -- Not covered anymore. + exit; + elsif Off >= El.Boff + El.Typ.W then + -- Not yet covered. + null; + elsif Off <= El.Boff + and then Off + Wd >= El.Boff + El.Typ.W + then + -- Fully covered. + Info_Msg_Synth + (+Loc, + " " & Prefix & '.' + & Vhdl.Utils.Image_Identifier (Field)); + else + -- Partially covered. + if Off < El.Boff then + Sub_Off := 0; + Sub_Wd := Wd - (El.Boff - Off); + Sub_Wd := Width'Min (Sub_Wd, El.Typ.W); + else + Sub_Off := Off - El.Boff; + Sub_Wd := El.Typ.W - (Off - El.Boff); + Sub_Wd := Width'Min (Sub_Wd, Wd); + end if; + Info_Subnet_Vhdl + (+Loc, + Prefix & '.' & Vhdl.Utils.Image_Identifier (Field), + Get_Type (Field), El.Typ, Sub_Off, Sub_Wd); + end if; + end; + end loop; + end; + end case; + end Info_Subnet_Vhdl; + + procedure Info_Subnet + (Decl : Vhdl.Nodes.Node; Typ : Type_Acc; Off : Width; Wd : Width) + is + Loc : Location_Type; + begin + if Typ = null then + -- Type is unknown, cannot display more infos. + return; + end if; + + if Off = 0 and Wd = Typ.W then + -- Whole object, no need to give details. + -- TODO: just say it ? + return; + end if; + + Loc := Vhdl.Nodes.Get_Location (Decl); + Info_Msg_Synth (+Loc, " this concerns these parts of the signal:"); + Info_Subnet_Vhdl (Loc, + Name_Table.Image (Vhdl.Nodes.Get_Identifier (Decl)), + Vhdl.Nodes.Get_Type (Decl), + Typ, Off, Wd); + end Info_Subnet; + -- Compute the VALUE to be assigned to WIRE_REC. Handle partial -- assignment, multiple assignments and error cases. procedure Finalize_Complex_Assignment (Ctxt : Builders.Context_Acc; @@ -795,12 +941,33 @@ package body Synth.Environment is Nbr_Assign := Nbr_Assign - 1; Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn)); else - Error_Msg_Synth - (+Wire_Rec.Decl, "multiple assignments for offsets %v:%v", - (+Next_Off, +(Expected_Off - 1))); - -- TODO: insert resolver - Expected_Off := Next_Off + Get_Width (Get_Conc_Value (Asgn)); - Last_Asgn := Asgn; + declare + Asgn_Wd : constant Width := + Get_Width (Get_Conc_Value (Asgn)); + Overlap_Wd : Width; + begin + Overlap_Wd := Asgn_Wd; + if Next_Off + Overlap_Wd > Expected_Off then + Overlap_Wd := Expected_Off - Next_Off; + end if; + + Error_Msg_Synth + (+Wire_Rec.Decl, + "multiple assignments for %i offsets %v:%v", + (+Wire_Rec.Decl, + +Next_Off, +(Next_Off + Overlap_Wd - 1))); + Info_Subnet (Wire_Rec.Decl, Wire_Rec.Typ, + Next_Off, Overlap_Wd); + + if Next_Off + Asgn_Wd < Expected_Off then + -- Remove this assignment + Nbr_Assign := Nbr_Assign - 1; + Set_Conc_Chain (Last_Asgn, Get_Conc_Chain (Asgn)); + else + Expected_Off := Next_Off + Asgn_Wd; + Last_Asgn := Asgn; + end if; + end; end if; Asgn := Get_Conc_Chain (Asgn); end if; @@ -1589,7 +1756,7 @@ package body Synth.Environment is -- Cached value. Wid := Phis_Table.Table (Last).En; if Wid = No_Wire_Id then - Wid := Alloc_Wire (Wire_Enable, Loc); + Wid := Alloc_Wire (Wire_Enable, Bit_Type, Loc); Phis_Table.Table (Last).En := Wid; -- Create the Enable gate. @@ -1886,6 +2053,7 @@ begin Wire_Id_Table.Append ((Kind => Wire_None, Mark_Flag => False, Decl => Source.No_Syn_Src, + Typ => null, Gate => No_Net, Cur_Assign => No_Seq_Assign, Final_Assign => No_Conc_Assign, diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index 37ab29414..9205512a3 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -68,7 +68,8 @@ package Synth.Environment is ); -- Create a wire. - function Alloc_Wire (Kind : Wire_Kind; Obj : Source.Syn_Src) return Wire_Id; + function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src) + return Wire_Id; -- Mark the wire as free. procedure Free_Wire (Wid : Wire_Id); @@ -280,6 +281,9 @@ private -- Source node that created the wire. Decl : Source.Syn_Src; + -- Type of the net. Only for diagnostic purposes. + Typ : Type_Acc; + -- The initial net for the wire. -- This is a pseudo gate that is needed because the value of the wire -- can be read before anything was assigned to it. diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 93b8a510e..fe02de317 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -1012,7 +1012,7 @@ package body Synth.Insts is case Val.Val.Kind is when Value_Wire => -- Create a gate for the output, so that it could be read. - Val.Val.W := Alloc_Wire (Wire_Output, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, Bit_Type, Inter); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); @@ -1339,7 +1339,7 @@ package body Synth.Insts is pragma Assert (Val.Val.Kind = Value_Wire); -- Create a gate for the output, so that it could be read. - Val.Val.W := Alloc_Wire (Wire_Output, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, Val.Typ, Inter); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); Inp := Get_Input (Self_Inst, Idx); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index ac8796445..b5d10b084 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -1839,7 +1839,7 @@ package body Synth.Stmts is then Val := Get_Value (Subprg_Inst, Inter); -- Arguments are passed by copy. - Wire := Alloc_Wire (Wire_Variable, Inter); + Wire := Alloc_Wire (Wire_Variable, Val.Typ, Inter); Set_Wire_Gate (Wire, Get_Net (Ctxt, Val)); Val := Create_Value_Wire (Wire, Val.Typ); @@ -1929,11 +1929,11 @@ package body Synth.Stmts is Ret_Typ => null, Nbr_Ret => 0); - C.W_En := Alloc_Wire (Wire_Variable, Imp); - C.W_Ret := Alloc_Wire (Wire_Variable, Imp); + C.W_En := Alloc_Wire (Wire_Variable, Bit_Type, Imp); + C.W_Ret := Alloc_Wire (Wire_Variable, Bit_Type, Imp); if Is_Func then - C.W_Val := Alloc_Wire (Wire_Variable, Imp); + C.W_Val := Alloc_Wire (Wire_Variable, null, Imp); end if; -- Create a phi so that all assignments are gathered. @@ -2255,7 +2255,7 @@ package body Synth.Stmts is if Lc.Prev_Loop /= null and then Lc.Prev_Loop.Need_Quit then -- An exit or next statement that targets an outer loop may suspend -- the execution of this loop. - Lc.W_Quit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt); + Lc.W_Quit := Alloc_Wire (Wire_Variable, Bit_Type, Lc.Loop_Stmt); Set_Wire_Gate (Lc.W_Quit, Build_Control_Signal (C.Inst, 1, Stmt)); Phi_Assign_Static (Lc.W_Quit, Bit1); end if; @@ -2277,7 +2277,7 @@ package body Synth.Stmts is if Get_Exit_Flag (Stmt) then -- There is an exit statement for this loop. Create the wire. - Lc.W_Exit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt); + Lc.W_Exit := Alloc_Wire (Wire_Variable, Bit_Type, Lc.Loop_Stmt); Set_Wire_Gate (Lc.W_Exit, Build_Control_Signal (C.Inst, 1, Stmt)); Phi_Assign_Static (Lc.W_Exit, Bit1); end if; @@ -3003,7 +3003,7 @@ package body Synth.Stmts is C := (Mode => Mode_Dynamic, Inst => Make_Instance (Syn_Inst, Proc, C_Sname), Cur_Loop => null, - W_En => Alloc_Wire (Wire_Variable, Proc), + W_En => Alloc_Wire (Wire_Variable, Bit_Type, Proc), W_Ret => No_Wire_Id, W_Val => No_Wire_Id, Ret_Init => No_Net, -- cgit v1.2.3