diff options
| -rw-r--r-- | src/synth/netlists-inference.adb | 24 | ||||
| -rw-r--r-- | src/synth/netlists-inference.ads | 5 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 2 | ||||
| -rw-r--r-- | src/synth/synth-environment-debug.adb | 8 | ||||
| -rw-r--r-- | src/synth/synth-environment-debug.ads | 1 | ||||
| -rw-r--r-- | src/synth/synth-environment.adb | 308 | ||||
| -rw-r--r-- | src/synth/synth-environment.ads | 96 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 11 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 10 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 87 | ||||
| -rw-r--r-- | src/synth/synth-stmts.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-values-debug.adb | 2 | ||||
| -rw-r--r-- | src/synth/synth-values.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_context.adb | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_context.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_environment.adb | 213 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_environment.ads | 65 | ||||
| -rw-r--r-- | src/synth/synthesis.adb | 2 |
18 files changed, 479 insertions, 363 deletions
diff --git a/src/synth/netlists-inference.adb b/src/synth/netlists-inference.adb index 4f50bc044..00a029ea2 100644 --- a/src/synth/netlists-inference.adb +++ b/src/synth/netlists-inference.adb @@ -25,7 +25,6 @@ with Netlists.Internings; with Netlists.Folds; use Netlists.Folds; with Netlists.Memories; use Netlists.Memories; -with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; with Synth.Flags; @@ -486,7 +485,7 @@ package body Netlists.Inference is Clock_Mux : Instance; Clk : Net; Clk_Enable : Net; - Stmt : Synth.Source.Syn_Src) return Net + Loc : Location_Type) return Net is O : constant Net := Get_Output (Clock_Mux, 0); Mux_Loc : constant Location_Type := Get_Location (Clock_Mux); @@ -597,16 +596,16 @@ package body Netlists.Inference is -- Add the negation of the condition to the enable signal. -- Negate the condition for the current reset. Mux_Not_Rst := Build_Monadic (Ctxt, Id_Not, Mux_Rst); - Set_Location (Mux_Not_Rst, Stmt); + Set_Location (Mux_Not_Rst, Loc); if Rst /= No_Net then Rst := Build_Dyadic (Ctxt, Id_And, Rst, Mux_Not_Rst); - Set_Location (Rst, Stmt); + Set_Location (Rst, Loc); end if; if Enable = No_Net then Enable := Mux_Not_Rst; else Enable := Build_Dyadic (Ctxt, Id_And, Enable, Mux_Not_Rst); - Set_Location (Enable, Stmt); + Set_Location (Enable, Loc); end if; if Prev_Mux /= No_Instance then @@ -748,7 +747,7 @@ package body Netlists.Inference is function Infere_Latch (Ctxt : Context_Acc; Val : Net; Prev_Val : Net; - Stmt : Synth.Source.Syn_Src) return Net + Loc : Location_Type) return Net is Name : Sname; begin @@ -781,7 +780,7 @@ package body Netlists.Inference is else Name := Get_Instance_Name (Get_Net_Parent (Prev_Val)); end if; - Error_Msg_Synth (+Stmt, "latch infered for net %n", +Name); + Error_Msg_Synth (Loc, "latch infered for net %n", +Name); return Val; end Infere_Latch; @@ -792,7 +791,7 @@ package body Netlists.Inference is Val : Net; Off : Uns32; Prev_Val : Net; - Stmt : Synth.Source.Syn_Src; + Loc : Location_Type; Last_Use : Boolean) return Net is pragma Assert (Val /= No_Net); @@ -859,14 +858,14 @@ package body Netlists.Inference is Extract_Clock (Ctxt, Get_Driver (Sel), Clk, Enable); if Clk = No_Net then -- No clock -> latch or combinational loop - Res := Infere_Latch (Ctxt, Val, Prev_Val, Stmt); + Res := Infere_Latch (Ctxt, Val, Prev_Val, Loc); else -- Clock -> FF First_Mux := Get_Net_Parent (Val); pragma Assert (Get_Id (First_Mux) = Id_Mux2); Res := Infere_FF (Ctxt, Val, Prev_Val, Off, Last_Mux, - Clk, Enable, Stmt); + Clk, Enable, Loc); end if; return Res; @@ -913,9 +912,8 @@ package body Netlists.Inference is function Infere_Assert (Ctxt : Context_Acc; Val : Net; En_Gate : Net; - Stmt : Synth.Source.Syn_Src) return Net + Loc : Location_Type) return Net is - Loc : constant Location_Type := Synth.Source."+" (Stmt); Inst : Instance; First_Inst : Instance; Last_Inst : Instance; @@ -962,7 +960,7 @@ package body Netlists.Inference is -- If the next mux is in1, negate COND. if Next_Inst = Get_Net_Parent (Get_Input_Net (Inst, 2)) then Cond := Build_Monadic (Ctxt, Id_Not, Cond); - Synth.Source.Set_Location (Cond, Stmt); + Set_Location (Cond, Loc); end if; -- 'And' COND to Areset. diff --git a/src/synth/netlists-inference.ads b/src/synth/netlists-inference.ads index 4945bbcf1..61eab9fb2 100644 --- a/src/synth/netlists-inference.ads +++ b/src/synth/netlists-inference.ads @@ -18,7 +18,6 @@ with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; -with Synth.Source; package Netlists.Inference is -- Walk the And-net N, and extract clock (posedge/negedge) if found. @@ -37,12 +36,12 @@ package Netlists.Inference is Val : Net; Off : Uns32; Prev_Val : Net; - Stmt : Synth.Source.Syn_Src; + Loc : Location_Type; Last_Use : Boolean) return Net; -- Called when there is an assignment to a enable gate. function Infere_Assert (Ctxt : Context_Acc; Val : Net; En_Gate : Net; - Stmt : Synth.Source.Syn_Src) return Net; + Loc : Location_Type) return Net; end Netlists.Inference; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 98485b6ff..a8f92c1f9 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -30,7 +30,7 @@ with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; -with Synth.Environment; use Synth.Environment; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Expr; use Synth.Expr; with Synth.Stmts; with Synth.Source; use Synth.Source; diff --git a/src/synth/synth-environment-debug.adb b/src/synth/synth-environment-debug.adb index 46e88ecfa..a05512b17 100644 --- a/src/synth/synth-environment-debug.adb +++ b/src/synth/synth-environment-debug.adb @@ -19,7 +19,7 @@ with Ada.Text_IO; use Ada.Text_IO; with Netlists.Dump; use Netlists.Dump; -with Synth.Values.Debug; use Synth.Values.Debug; +-- with Synth.Values.Debug; use Synth.Values.Debug; package body Synth.Environment.Debug is procedure Put_Wire_Id (Wid : Wire_Id) is @@ -34,7 +34,7 @@ package body Synth.Environment.Debug is Put ("Wire:"); Put_Wire_Id (Wid); Put_Line (" kind: " & Wire_Kind'Image (W_Rec.Kind)); - Put_Line (" decl:" & Source.Syn_Src'Image (W_Rec.Decl)); +-- Put_Line (" decl:" & Source.Syn_Src'Image (W_Rec.Decl)); Put (" gate: "); Dump_Net_Name (W_Rec.Gate, True); New_Line; @@ -84,7 +84,7 @@ package body Synth.Environment.Debug is declare W_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Rec.Id); begin - Put_Line (" wire decl:" & Source.Syn_Src'Image (W_Rec.Decl)); +-- Put_Line (" wire decl:" & Source.Syn_Src'Image (W_Rec.Decl)); Put (" wire gate: "); Dump_Net_Name (W_Rec.Gate, True); New_Line; @@ -95,7 +95,7 @@ package body Synth.Environment.Debug is Put_Line (" ??? (unknown)"); when True => Put_Line (" static:"); - Debug_Memtyp (Rec.Val.Val); +-- Debug_Memtyp (Rec.Val.Val); when False => Dump_Partial_Assign (Rec.Val.Asgns); end case; diff --git a/src/synth/synth-environment-debug.ads b/src/synth/synth-environment-debug.ads index 6e846eff6..13264cddf 100644 --- a/src/synth/synth-environment-debug.ads +++ b/src/synth/synth-environment-debug.ads @@ -16,6 +16,7 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +generic package Synth.Environment.Debug is procedure Put_Wire_Id (Wid : Wire_Id); procedure Debug_Wire (Wid : Wire_Id); diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index c791c5a2d..001b417ca 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -25,16 +25,7 @@ with Netlists.Utils; use Netlists.Utils; 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; -with Synth.Source; use Synth.Source; -with Synth.Vhdl_Context; - -with Vhdl.Nodes; -with Vhdl.Utils; package body Synth.Environment is procedure Phi_Assign @@ -50,15 +41,13 @@ package body Synth.Environment is return Wire_Id_Table.Table (Wid).Mark_Flag; end Get_Wire_Mark; - function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src) - return Wire_Id + function Alloc_Wire (Kind : Wire_Kind; Decl : Decl_Type) return Wire_Id is Res : Wire_Id; begin Wire_Id_Table.Append ((Kind => Kind, Mark_Flag => False, - Decl => Obj, - Typ => Typ, + Decl => Decl, Gate => No_Net, Cur_Assign => No_Seq_Assign, Final_Assign => No_Conc_Assign, @@ -118,7 +107,7 @@ package body Synth.Environment is return Assign_Table.Table (Asgn).Val.Is_Static = True; end Get_Assign_Is_Static; - function Get_Assign_Static_Val (Asgn : Seq_Assign) return Memtyp is + function Get_Assign_Static_Val (Asgn : Seq_Assign) return Static_Type is begin return Assign_Table.Table (Asgn).Val.Val; end Get_Assign_Static_Val; @@ -363,23 +352,21 @@ package body Synth.Environment is Conc_Assign_Table.Table (Asgn).Next := Chain; end Set_Conc_Chain; - procedure Add_Conc_Assign - (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src) + procedure Add_Conc_Assign (Wid : Wire_Id; Val : Net; Off : Uns32) is Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); begin pragma Assert (Wire_Rec.Kind /= Wire_None); Conc_Assign_Table.Append ((Next => Wire_Rec.Final_Assign, Value => Val, - Offset => Off, - Stmt => Stmt)); + Offset => Off)); Wire_Rec.Final_Assign := Conc_Assign_Table.Last; Wire_Rec.Nbr_Final_Assign := Wire_Rec.Nbr_Final_Assign + 1; end Add_Conc_Assign; procedure Pop_And_Merge_Phi_Wire (Ctxt : Builders.Context_Acc; Asgn_Rec : Seq_Assign_Record; - Stmt : Source.Syn_Src) + Loc : Location_Type) is Wid : constant Wire_Id := Asgn_Rec.Id; Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); @@ -397,11 +384,11 @@ package body Synth.Environment is raise Internal_Error; when True => -- Create a net. No inference to do. - Res := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + Res := Static_To_Net (Ctxt, Asgn_Rec.Val.Val); if Wire_Rec.Kind = Wire_Enable then Connect (Get_Input (Get_Net_Parent (Outport), 0), Res); else - Add_Conc_Assign (Wid, Res, 0, Stmt); + Add_Conc_Assign (Wid, Res, 0); end if; when False => P := Asgn_Rec.Val.Asgns; @@ -418,16 +405,16 @@ package body Synth.Environment is pragma Assert (Pa.Offset = 0); pragma Assert (Pa.Next = No_Partial_Assign); Res := Inference.Infere_Assert - (Ctxt, Pa.Value, Outport, Stmt); + (Ctxt, Pa.Value, Outport, Loc); Connect (Get_Input (Get_Net_Parent (Outport), 0), Res); else -- Note: lifetime is currently based on the kind of the -- wire (variable -> not reused beyond this process). -- This is OK for vhdl but not general. Res := Inference.Infere - (Ctxt, Pa.Value, Pa.Offset, Outport, Stmt, + (Ctxt, Pa.Value, Pa.Offset, Outport, Loc, Wire_Rec.Kind = Wire_Variable); - Add_Conc_Assign (Wid, Res, Pa.Offset, Stmt); + Add_Conc_Assign (Wid, Res, Pa.Offset); end if; P := Pa.Next; end; @@ -438,12 +425,13 @@ package body Synth.Environment is -- This procedure is called after each concurrent statement to assign -- values to signals. procedure Pop_And_Merge_Phi (Ctxt : Builders.Context_Acc; - Stmt : Source.Syn_Src) + Loc : Location_Type) is Phi : Phi_Type; Asgn : Seq_Assign; begin Pop_Phi (Phi); + -- Must be the last phi. pragma Assert (Phis_Table.Last = No_Phi_Id); -- It is possible that the same value is assigned to different targets. @@ -523,7 +511,7 @@ package body Synth.Environment is declare Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); begin - Pop_And_Merge_Phi_Wire (Ctxt, Asgn_Rec, Stmt); + Pop_And_Merge_Phi_Wire (Ctxt, Asgn_Rec, Loc); Asgn := Asgn_Rec.Chain; end; end loop; @@ -700,149 +688,6 @@ 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; @@ -885,23 +730,14 @@ package body Synth.Environment is Asgn := Get_Conc_Chain (Asgn); elsif Next_Off > Expected_Off then -- There is an hole. - if Next_Off = Expected_Off + 1 then - Warning_Msg_Synth - (+Wire_Rec.Decl, "no assignment for offset %v of %n", - (1 => +Expected_Off, 2 => +Wire_Rec.Decl)); - else - Warning_Msg_Synth - (+Wire_Rec.Decl, "no assignment for offsets %v:%v of %n", - (+Expected_Off, +(Next_Off - 1), +Wire_Rec.Decl)); - end if; + Warning_No_Assignment (Wire_Rec.Decl, Expected_Off, Next_Off - 1); -- Insert conc_assign with initial value. -- FIXME: handle initial values. Conc_Assign_Table.Append ((Next => Asgn, Value => Build_Const_Z (Ctxt, Next_Off - Expected_Off), - Offset => Expected_Off, - Stmt => Source.No_Syn_Src)); + Offset => Expected_Off)); New_Asgn := Conc_Assign_Table.Last; if Last_Asgn = No_Conc_Assign then First_Assign := New_Asgn; @@ -956,13 +792,8 @@ package body Synth.Environment is 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); + Error_Multiple_Assignments + (Wire_Rec.Decl, Next_Off, Next_Off + Overlap_Wd - 1); if Next_Off + Asgn_Wd < Expected_Off then -- Remove this assignment @@ -1003,7 +834,6 @@ package body Synth.Environment is procedure Finalize_Assignment (Ctxt : Builders.Context_Acc; Wid : Wire_Id) is - use Vhdl.Nodes; Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); Gate_Inst : constant Instance := Get_Net_Parent (Wire_Rec.Gate); Inp : constant Input := Get_Input (Gate_Inst, 0); @@ -1013,11 +843,8 @@ package body Synth.Environment is when 0 => -- TODO: use initial value ? -- TODO: fix that in synth-decls.finalize_object. - if Wire_Rec.Decl /= Null_Node - and then Wire_Rec.Kind = Wire_Output - then - Warning_Msg_Synth - (+Wire_Rec.Decl, "no assignment for %n", +Wire_Rec.Decl); + if Wire_Rec.Kind = Wire_Output then + Warning_No_Assignment (Wire_Rec.Decl, 1, 0); if Get_Id (Gate_Inst) = Gates.Id_Iinout then Value := Get_Input_Net (Gate_Inst, 1); else @@ -1154,7 +981,7 @@ package body Synth.Environment is end case; if Asgn_Rec.Val.Is_Static = True then - return Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + return Static_To_Net (Ctxt, Asgn_Rec.Val.Val); end if; -- Cannot be empty. @@ -1217,7 +1044,7 @@ package body Synth.Environment is -- If the current value is static, just return it. if Get_Assign_Is_Static (First_Seq) then - return Vhdl_Context.Get_Partial_Memtyp_Net + return Partial_Static_To_Net (Ctxt, Get_Assign_Static_Val (First_Seq), Off, Wd); end if; @@ -1305,7 +1132,7 @@ package body Synth.Environment is end if; if Get_Assign_Is_Static (Seq) then -- Extract from static value. - Append (Vec, Vhdl_Context.Get_Partial_Memtyp_Net + Append (Vec, Partial_Static_To_Net (Ctxt, Get_Assign_Static_Val (Seq), Cur_Off, Cur_Wd)); exit; @@ -1353,7 +1180,7 @@ package body Synth.Environment is null; when True => declare - P_Wd : constant Width := P (I).Val.Typ.W; + P_Wd : constant Width := Get_Width (P (I).Val); --.Typ.W; begin if Min_Off >= P_Wd then -- No net can be beyond the width. @@ -1418,8 +1245,7 @@ package body Synth.Environment is when Unknown => null; when True => - N (I) := Vhdl_Context.Get_Partial_Memtyp_Net - (Ctxt, P (I).Val, Off, Wd); + N (I) := Partial_Static_To_Net (Ctxt, P (I).Val, Off, Wd); when False => if Get_Partial_Offset (P (I).Asgns) <= Off then declare @@ -1448,51 +1274,6 @@ package body Synth.Environment is end loop; end Extract_Merge_Partial_Assigns; - function Is_Assign_Value_Array_Static - (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Memtyp - is - Res : Memtyp; - Prev_Val : Memtyp; - begin - Prev_Val := Null_Memtyp; - for I in Arr'Range loop - case Arr (I).Is_Static is - when False => - -- A value is not static. - return Null_Memtyp; - when Unknown => - if Prev_Val = Null_Memtyp then - -- First use of previous value. - if not Is_Static_Wire (Wid) then - -- The previous value is not static. - return Null_Memtyp; - end if; - Prev_Val := Get_Static_Wire (Wid); - if Res /= Null_Memtyp then - -- There is already a result. - if not Is_Equal (Res, Prev_Val) then - -- The previous value is different from the result. - return Null_Memtyp; - end if; - else - Res := Prev_Val; - end if; - end if; - when True => - if Res = Null_Memtyp then - -- First value. Keep it. - Res := Arr (I).Val; - else - if not Is_Equal (Res, Arr (I).Val) then - -- Value is different. - return Null_Memtyp; - end if; - end if; - end case; - end loop; - return Res; - end Is_Assign_Value_Array_Static; - procedure Partial_Assign_Init (List : out Partial_Assign_List) is begin List := (First | Last => No_Partial_Assign); @@ -1528,7 +1309,7 @@ package body Synth.Environment is Sel : Net; F_Asgns : Seq_Assign_Value; T_Asgns : Seq_Assign_Value; - Stmt : Source.Syn_Src) + Loc : Location_Type) is use Netlists.Gates; use Netlists.Gates_Ports; @@ -1588,11 +1369,11 @@ package body Synth.Environment is Res := N1_Net; Disconnect (N1_Sel); N1_Sel_Net := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net); - Set_Location (N1_Sel_Net, Stmt); + Set_Location (N1_Sel_Net, Loc); Connect (N1_Sel, N1_Sel_Net); else Res := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net); - Set_Location (Res, Stmt); + Set_Location (Res, Loc); Res := Build_Mux2 (Ctxt, Res, N (0), Get_Driver (Get_Mux2_I1 (N1_Inst))); end if; @@ -1604,7 +1385,7 @@ package body Synth.Environment is else Res := Build_Mux2 (Ctxt, Sel, N (0), N (1)); end if; - Set_Location (Res, Stmt); + Set_Location (Res, Loc); -- Keep the result in a list. Pasgn := New_Partial_Assign (Res, Off); @@ -1622,7 +1403,7 @@ package body Synth.Environment is function Merge_Static_Assigns (Wid : Wire_Id; Tv, Fv : Seq_Assign_Value) return Boolean is - Prev : Memtyp; + Prev : Static_Type; begin -- First case: both TV and FV are static. if Tv.Is_Static = True and then Fv.Is_Static = True then @@ -1673,7 +1454,7 @@ package body Synth.Environment is procedure Merge_Phis (Ctxt : Builders.Context_Acc; Sel : Net; T, F : Phi_Type; - Stmt : Source.Syn_Src) + Loc : Location_Type) is T_Asgns : Seq_Assign; F_Asgns : Seq_Assign; @@ -1717,7 +1498,7 @@ package body Synth.Environment is Merge_Partial_Assignments (Ctxt, Fv); Merge_Partial_Assignments (Ctxt, Tv); if not Merge_Static_Assigns (W, Tv, Fv) then - Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Stmt); + Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Loc); end if; end loop; @@ -1745,8 +1526,11 @@ package body Synth.Environment is Phi_Append_Assign (Phis_Table.Table (Phis_Table.Last), Asgn); end Phi_Append_Assign; - function Phi_Enable (Ctxt : Builders.Context_Acc; Loc : Source.Syn_Src) - return Net + function Phi_Enable (Ctxt : Builders.Context_Acc; + Decl : Decl_Type; + Val_0 : Static_Type; + Val_1 : Static_Type; + Loc : Location_Type) return Net is Last : constant Phi_Id := Phis_Table.Last; Wid : Wire_Id; @@ -1765,7 +1549,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, Bit_Type, Loc); + Wid := Alloc_Wire (Wire_Enable, Decl); Phis_Table.Table (Last).En := Wid; -- Create the Enable gate. @@ -1780,13 +1564,13 @@ package body Synth.Environment is Id => Wid, Prev => No_Seq_Assign, Chain => No_Seq_Assign, - Val => (Is_Static => True, Val => Bit0))); + Val => (Is_Static => True, Val => Val_0))); Asgn := Assign_Table.Last; Wire_Id_Table.Table (Wid).Cur_Assign := Asgn; Phi_Append_Assign (Phis_Table.Table (No_Phi_Id + 1), Asgn); -- Assign to '1'. - Phi_Assign_Static (Wid, Bit1); + Phi_Assign_Static (Wid, Val_1); return N; else return Get_Current_Value (Ctxt, Wid); @@ -1995,7 +1779,7 @@ package body Synth.Environment is N : Net; Pa : Partial_Assign; begin - N := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + N := Static_To_Net (Ctxt, Asgn_Rec.Val.Val); Pa := New_Partial_Assign (N, 0); Asgn_Rec.Val := (Is_Static => False, Asgns => Pa); end; @@ -2015,7 +1799,7 @@ package body Synth.Environment is Phi_Assign (Ctxt, Dest, Pasgn); end Phi_Assign_Net; - procedure Phi_Assign_Static (Dest : Wire_Id; Val : Memtyp) + procedure Phi_Assign_Static (Dest : Wire_Id; Val : Static_Type) is Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest); pragma Assert (Wire_Rec.Kind /= Wire_None); @@ -2052,7 +1836,7 @@ package body Synth.Environment is return Get_Assign_Is_Static (Wire_Rec.Cur_Assign); end Is_Static_Wire; - function Get_Static_Wire (Wid : Wire_Id) return Memtyp + function Get_Static_Wire (Wid : Wire_Id) return Static_Type is Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); begin @@ -2061,8 +1845,7 @@ package body Synth.Environment is begin Wire_Id_Table.Append ((Kind => Wire_None, Mark_Flag => False, - Decl => Source.No_Syn_Src, - Typ => null, + Decl => <>, Gate => No_Net, Cur_Assign => No_Seq_Assign, Final_Assign => No_Conc_Assign, @@ -2090,7 +1873,6 @@ begin Conc_Assign_Table.Append ((Next => No_Conc_Assign, Value => No_Net, - Offset => 0, - Stmt => Source.No_Syn_Src)); + Offset => 0)); pragma Assert (Conc_Assign_Table.Last = No_Conc_Assign); end Synth.Environment; diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index 90842ef03..70e472ac9 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -22,9 +22,25 @@ with Tables; with Netlists; use Netlists; with Netlists.Builders; -with Synth.Source; -with Synth.Objtypes; use Synth.Objtypes; +generic + -- Declaration type use for reporting errors. + type Decl_Type is private; + + -- Static value + type Static_Type is private; + + with function Is_Equal (L, R : Static_Type) return Boolean; + with function Get_Width (Val : Static_Type) return Uns32; + with function Static_To_Net (Ctxt : Builders.Context_Acc; Val : Static_Type) + return Net; + with function Partial_Static_To_Net + (Ctxt : Builders.Context_Acc; Val : Static_Type; Off : Uns32; Wd : Uns32) + return Net; + with procedure Warning_No_Assignment + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32); + with procedure Error_Multiple_Assignments + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32); package Synth.Environment is -- This package declares the type Wire_Id and its methods. -- @@ -66,8 +82,7 @@ package Synth.Environment is ); -- Create a wire. - function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src) - return Wire_Id; + function Alloc_Wire (Kind : Wire_Kind; Decl : Decl_Type) return Wire_Id; -- Mark the wire as free. procedure Free_Wire (Wid : Wire_Id); @@ -117,7 +132,7 @@ package Synth.Environment is (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Val : Net; Offset : Uns32); -- Assign a static value to DEST. VAL is copied. - procedure Phi_Assign_Static (Dest : Wire_Id; Val : Memtyp); + procedure Phi_Assign_Static (Dest : Wire_Id; Val : Static_Type); -- A Phi represent a split in the control flow (two or more branches). type Phi_Type is private; @@ -130,7 +145,7 @@ package Synth.Environment is -- Destroy the current phi context and merge it. Can apply only for the -- first non-top level phi context. procedure Pop_And_Merge_Phi (Ctxt : Builders.Context_Acc; - Stmt : Source.Syn_Src); + Loc : Location_Type); -- All assignments in PHI to wires below MARK are propagated to the -- current phi. Used to propagate assignments to wires defined out of @@ -144,14 +159,17 @@ package Synth.Environment is procedure Merge_Phis (Ctxt : Builders.Context_Acc; Sel : Net; T, F : Phi_Type; - Stmt : Source.Syn_Src); + Loc : Location_Type); -- Create or get (if already created) a net that is true iff the current -- phi is selected. Used to enable sequential assertions. -- Because a wire is created, inference will run on it and therefore -- a dff is created if needed. - function Phi_Enable (Ctxt : Builders.Context_Acc; Loc : Source.Syn_Src) - return Net; + function Phi_Enable (Ctxt : Builders.Context_Acc; + Decl : Decl_Type; + Val_0 : Static_Type; + Val_1 : Static_Type; + Loc : Location_Type) return Net; -- Lower level part. -- Currently public to handle case statements. @@ -175,8 +193,25 @@ package Synth.Environment is type Partial_Assign is private; No_Partial_Assign : constant Partial_Assign; - type Seq_Assign_Value is private; - No_Seq_Assign_Value : constant Seq_Assign_Value; + type Seq_Assign_Value (Is_Static : Tri_State_Type := True) is record + case Is_Static is + when Unknown => + -- Used only for no value (in that case, it will use the previous + -- value). + -- This is used only for temporary handling, and is never stored + -- in Seq_Assign. + null; + when True => + Val : Static_Type; + when False => + -- Values assigned. + Asgns : Partial_Assign; + end case; + end record; + +-- +-- type Seq_Assign_Value is private; +-- No_Seq_Assign_Value : constant Seq_Assign_Value; function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign; function Get_Seq_Assign_Value (Asgn : Seq_Assign) return Seq_Assign_Value; @@ -196,8 +231,8 @@ package Synth.Environment is -- 3) All the values are equal. -- then assign directly. -- WID is used in case of unknown value. - function Is_Assign_Value_Array_Static - (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Memtyp; +-- function Is_Assign_Value_Array_Static +-- (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Static_Type; type Partial_Assign_List is limited private; @@ -227,8 +262,7 @@ package Synth.Environment is type Conc_Assign is private; No_Conc_Assign : constant Conc_Assign; - procedure Add_Conc_Assign - (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src); + procedure Add_Conc_Assign (Wid : Wire_Id; Val : Net; Off : Uns32); procedure Finalize_Assignment (Ctxt : Builders.Context_Acc; Wid : Wire_Id); @@ -241,7 +275,7 @@ package Synth.Environment is function Is_Static_Wire (Wid : Wire_Id) return Boolean; -- Return the corresponding net for a static wire. - function Get_Static_Wire (Wid : Wire_Id) return Memtyp; + function Get_Static_Wire (Wid : Wire_Id) return Static_Type; private type Wire_Id is new Uns32; No_Wire_Id : constant Wire_Id := 0; @@ -279,11 +313,8 @@ private -- cleared after usage. Mark_Flag : Boolean; - -- Source node that created the wire. - Decl : Source.Syn_Src; - - -- Type of the net. Only for diagnostic purposes. - Typ : Type_Acc; + -- Source node that created the wire. Only for diagnostic purposes. + Decl : Decl_Type; -- The initial net for the wire. -- This is a pseudo gate that is needed because the value of the wire @@ -301,24 +332,6 @@ private Nbr_Final_Assign : Natural; end record; - type Seq_Assign_Value (Is_Static : Tri_State_Type := True) is record - case Is_Static is - when Unknown => - -- Used only for no value (in that case, it will use the previous - -- value). - -- This is used only for temporary handling, and is never stored - -- in Seq_Assign. - null; - when True => - Val : Memtyp; - when False => - -- Values assigned. - Asgns : Partial_Assign; - end case; - end record; - - No_Seq_Assign_Value : constant Seq_Assign_Value := (Is_Static => Unknown); - type Seq_Assign_Record is record -- Target of the assignment. Id : Wire_Id; @@ -351,9 +364,6 @@ private -- Concurrent assignment at OFFSET. The width is set by value width. Value : Net; Offset : Uns32; - - -- Source of the assignment. Useful to report errors. - Stmt : Source.Syn_Src; end record; type Phi_Type is record @@ -366,6 +376,8 @@ private En : Wire_Id; end record; + No_Seq_Assign_Value : constant Seq_Assign_Value := (Is_Static => Unknown); + package Phis_Table is new Tables (Table_Component_Type => Phi_Type, Table_Index_Type => Phi_Id, diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index e05eee89b..d05c0d089 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -41,7 +41,7 @@ with Netlists.Locations; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; -with Synth.Environment; +with Synth.Vhdl_Environment; with Synth.Decls; with Synth.Stmts; use Synth.Stmts; with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; @@ -67,7 +67,7 @@ package body Synth.Expr is when Value_Const => return Get_Memtyp (V); when Value_Wire => - return Synth.Environment.Get_Static_Wire (V.Val.W); + return Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W); when Value_Alias => declare Res : Memtyp; @@ -88,7 +88,8 @@ package body Synth.Expr is when Value_Const => return Read_Discrete (Get_Memtyp (V)); when Value_Wire => - return Read_Discrete (Synth.Environment.Get_Static_Wire (V.Val.W)); + return Read_Discrete + (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W)); when others => raise Internal_Error; end case; @@ -107,9 +108,9 @@ package body Synth.Expr is when Value_Net => N := V.Val.N; when Value_Wire => - if Synth.Environment.Is_Static_Wire (V.Val.W) then + if Synth.Vhdl_Environment.Env.Is_Static_Wire (V.Val.W) then return Read_Discrete - (Synth.Environment.Get_Static_Wire (V.Val.W)) >= 0; + (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W)) >= 0; else return False; end if; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 89340b255..ac37f8b0a 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -45,7 +45,7 @@ with Vhdl.Ieee.Math_Real; with Synth.Memtype; use Synth.Memtype; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; -with Synth.Environment; use Synth.Environment; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Stmts; use Synth.Stmts; with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; @@ -1125,7 +1125,7 @@ package body Synth.Insts is Synth_Instantiate_Module (Syn_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Stmt)); - Pop_And_Merge_Phi (Get_Build (Syn_Inst), Stmt); + Pop_And_Merge_Phi (Get_Build (Syn_Inst), Get_Location (Stmt)); end Synth_Direct_Instantiation_Statement; procedure Synth_Design_Instantiation_Statement @@ -1182,7 +1182,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, Bit_Type, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Bit_Type)); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); @@ -1352,7 +1352,7 @@ package body Synth.Insts is end loop; end; - Pop_And_Merge_Phi (Ctxt, Stmt); + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); Finalize_Declarations (Comp_Inst, Get_Port_Chain (Component)); end Synth_Component_Instantiation_Statement; @@ -1521,7 +1521,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, Val.Typ, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Val.Typ)); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); if Default /= Null_Node then diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index c77fc92be..8f33e3421 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -791,7 +791,7 @@ package body Synth.Stmts is Pop_Phi (Phi_False); Cond_Net := Get_Net (Ctxt, Cond_Val); - Merge_Phis (Ctxt, Cond_Net, Phi_True, Phi_False, Stmt); + Merge_Phis (Ctxt, Cond_Net, Phi_True, Phi_False, Get_Location (Stmt)); end if; end Synth_If_Statement; @@ -1058,6 +1058,51 @@ package body Synth.Stmts is procedure Free_Seq_Assign_Value_Array is new Ada.Unchecked_Deallocation (Seq_Assign_Value_Array, Seq_Assign_Value_Array_Acc); + function Is_Assign_Value_Array_Static + (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Memtyp + is + Res : Memtyp; + Prev_Val : Memtyp; + begin + Prev_Val := Null_Memtyp; + for I in Arr'Range loop + case Arr (I).Is_Static is + when False => + -- A value is not static. + return Null_Memtyp; + when Unknown => + if Prev_Val = Null_Memtyp then + -- First use of previous value. + if not Is_Static_Wire (Wid) then + -- The previous value is not static. + return Null_Memtyp; + end if; + Prev_Val := Get_Static_Wire (Wid); + if Res /= Null_Memtyp then + -- There is already a result. + if not Is_Equal (Res, Prev_Val) then + -- The previous value is different from the result. + return Null_Memtyp; + end if; + else + Res := Prev_Val; + end if; + end if; + when True => + if Res = Null_Memtyp then + -- First value. Keep it. + Res := Arr (I).Val; + else + if not Is_Equal (Res, Arr (I).Val) then + -- Value is different. + return Null_Memtyp; + end if; + end if; + end case; + end loop; + return Res; + end Is_Assign_Value_Array_Static; + procedure Synth_Case_Statement_Dynamic (C : in out Seq_Context; Stmt : Node; Sel : Valtyp) is @@ -1190,7 +1235,7 @@ package body Synth.Stmts is Get_Seq_Assign_Value (Alts (I).Asgns); Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns); else - Pasgns (Int32 (I)) := No_Seq_Assign_Value; + Pasgns (Int32 (I)) := (Is_Static => Unknown); end if; end loop; @@ -1841,7 +1886,7 @@ package body Synth.Stmts is then Val := Get_Value (Subprg_Inst, Inter); -- Arguments are passed by copy. - Wire := Alloc_Wire (Wire_Variable, Val.Typ, Inter); + Wire := Alloc_Wire (Wire_Variable, (Inter, Val.Typ)); Set_Wire_Gate (Wire, Get_Net (Ctxt, Val)); Val := Create_Value_Wire (Wire, Val.Typ); @@ -1931,11 +1976,11 @@ package body Synth.Stmts is Ret_Typ => null, Nbr_Ret => 0); - C.W_En := Alloc_Wire (Wire_Variable, Bit_Type, Imp); - C.W_Ret := Alloc_Wire (Wire_Variable, Bit_Type, Imp); + C.W_En := Alloc_Wire (Wire_Variable, (Imp, Bit_Type)); + C.W_Ret := Alloc_Wire (Wire_Variable, (Imp, Bit_Type)); if Is_Func then - C.W_Val := Alloc_Wire (Wire_Variable, null, Imp); + C.W_Val := Alloc_Wire (Wire_Variable, (Imp, null)); end if; -- Create a phi so that all assignments are gathered. @@ -2247,7 +2292,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, Bit_Type, Lc.Loop_Stmt); + Lc.W_Quit := Alloc_Wire (Wire_Variable, (Lc.Loop_Stmt, Bit_Type)); Set_Wire_Gate (Lc.W_Quit, Build_Control_Signal (C.Inst, 1, Stmt)); Phi_Assign_Static (Lc.W_Quit, Bit1); end if; @@ -2269,7 +2314,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, Bit_Type, Lc.Loop_Stmt); + Lc.W_Exit := Alloc_Wire (Wire_Variable, (Lc.Loop_Stmt, Bit_Type)); Set_Wire_Gate (Lc.W_Exit, Build_Control_Signal (C.Inst, 1, Stmt)); Phi_Assign_Static (Lc.W_Exit, Bit1); end if; @@ -2471,8 +2516,8 @@ package body Synth.Stmts is Push_Phi; Pop_Phi (Phi_False); - Merge_Phis (Ctxt, - Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False, Stmt); + Merge_Phis (Ctxt, Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False, + Get_Location (Stmt)); end if; end Synth_Dynamic_Exit_Next_Statement; @@ -2869,7 +2914,8 @@ package body Synth.Stmts is return; end if; N := Get_Net (Ctxt, Cond); - En := Phi_Enable (Ctxt, Stmt); + En := Phi_Enable (Ctxt, (Stmt, Bit_Type), Bit0, Bit1, + Get_Location (Stmt)); if En /= No_Net then -- Build: En -> Cond N := Build2_Imp (Ctxt, En, N, Loc); @@ -2972,7 +3018,7 @@ package body Synth.Stmts is Push_Phi; Pop_Phi (Phi_F); Merge_Phis (Ctxt, Get_Current_Value (Ctxt, C.W_En), - Phi_T, Phi_F, Stmt); + Phi_T, Phi_F, Get_Location (Stmt)); end if; if Is_Static_Bit0 (C.W_En) then -- Not more execution. @@ -3022,7 +3068,8 @@ package body Synth.Stmts is Push_Phi; Pop_Phi (Phi_False); - Merge_Phis (Ctxt, Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False, Stmt); + Merge_Phis (Ctxt, Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False, + Get_Location (Stmt)); end Synth_Process_Sequential_Statements; procedure Synth_Process_Statement @@ -3045,7 +3092,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, Bit_Type, Proc), + W_En => Alloc_Wire (Wire_Variable, (Proc, Bit_Type)), W_Ret => No_Wire_Id, W_Val => No_Wire_Id, Ret_Init => No_Net, @@ -3074,7 +3121,7 @@ package body Synth.Stmts is end case; end if; - Pop_And_Merge_Phi (Ctxt, Proc); + Pop_And_Merge_Phi (Ctxt, Get_Location (Proc)); Finalize_Declarations (C.Inst, Decls_Chain); @@ -3551,19 +3598,19 @@ package body Synth.Stmts is when Iir_Kind_Concurrent_Simple_Signal_Assignment => Push_Phi; Synth_Simple_Signal_Assignment (Syn_Inst, Stmt); - Pop_And_Merge_Phi (Ctxt, Stmt); + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); when Iir_Kind_Concurrent_Conditional_Signal_Assignment => Push_Phi; Synth_Conditional_Signal_Assignment (Syn_Inst, Stmt); - Pop_And_Merge_Phi (Ctxt, Stmt); + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); when Iir_Kind_Concurrent_Selected_Signal_Assignment => Push_Phi; Synth_Selected_Signal_Assignment (Syn_Inst, Stmt); - Pop_And_Merge_Phi (Ctxt, Stmt); + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); when Iir_Kind_Concurrent_Procedure_Call_Statement => Push_Phi; Synth_Procedure_Call (Syn_Inst, Stmt); - Pop_And_Merge_Phi (Ctxt, Stmt); + Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); when Iir_Kinds_Process_Statement => Synth_Process_Statement (Syn_Inst, Stmt); when Iir_Kind_If_Generate_Statement => @@ -3675,7 +3722,7 @@ package body Synth.Stmts is N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W); Set_Location (N, Val); - Add_Conc_Assign (Base.Val.W, N, 0, Val); + Add_Conc_Assign (Base.Val.W, N, 0); end; end Synth_Attribute_Formal; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index f240ca33e..2009b1d4f 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -24,7 +24,7 @@ with Netlists; use Netlists; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Vhdl_Context; use Synth.Vhdl_Context; -with Synth.Environment; use Synth.Environment; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; package Synth.Stmts is procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb index f10b6497f..a6f887f08 100644 --- a/src/synth/synth-values-debug.adb +++ b/src/synth/synth-values-debug.adb @@ -21,7 +21,7 @@ with Utils_IO; use Utils_IO; with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Environment.Debug; use Synth.Environment.Debug; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Debug; package body Synth.Values.Debug is procedure Put_Dir (Dir : Direction_Type) is diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 6094509d1..f5db25da6 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -27,7 +27,7 @@ with Netlists; use Netlists; with Synth.Memtype; use Synth.Memtype; with Synth.Objtypes; use Synth.Objtypes; -with Synth.Environment; use Synth.Environment; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Source; use Synth.Source; package Synth.Values is diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 2a497ae0f..0ef9b417e 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -316,7 +316,7 @@ package body Synth.Vhdl_Context is if Kind = Wire_None then Wid := No_Wire_Id; else - Wid := Alloc_Wire (Kind, Otyp, Obj); + Wid := Alloc_Wire (Kind, (Obj, Otyp)); end if; Val := Create_Value_Wire (Wid, Otyp); diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads index 35972409f..eef073232 100644 --- a/src/synth/synth-vhdl_context.ads +++ b/src/synth/synth-vhdl_context.ads @@ -24,7 +24,7 @@ with Netlists.Builders; use Netlists.Builders; with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Environment; use Synth.Environment; +with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; diff --git a/src/synth/synth-vhdl_environment.adb b/src/synth/synth-vhdl_environment.adb new file mode 100644 index 000000000..c7f7daccc --- /dev/null +++ b/src/synth/synth-vhdl_environment.adb @@ -0,0 +1,213 @@ +-- Environment definition for synthesis. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Name_Table; +with Errorout; use Errorout; + +with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; + +with Synth.Errors; use Synth.Errors; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; + +package body Synth.Vhdl_Environment is + function Get_Bitwidth (Val : Memtyp) return Uns32 is + begin + return Val.Typ.W; + end Get_Bitwidth; + + function Memtyp_To_Net (Ctxt : Builders.Context_Acc; Val : Memtyp) + return Net is + begin + return Get_Memtyp_Net (Ctxt, Val); + end Memtyp_To_Net; + + function Partial_Memtyp_To_Net + (Ctxt : Builders.Context_Acc; Val : Memtyp; Off : Uns32; Wd : Uns32) + return Net is + begin + return Get_Partial_Memtyp_Net (Ctxt, Val, Off, Wd); + end Partial_Memtyp_To_Net; + + procedure Warning_No_Assignment + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32) is + begin + if Last_Off < First_Off then + Warning_Msg_Synth + (+Decl.Obj, "no assignment for %n", +Decl.Obj); + elsif Last_Off = First_Off then + Warning_Msg_Synth (+Decl.Obj, "no assignment for offset %v of %n", + (1 => +First_Off, 2 => +Decl.Obj)); + else + Warning_Msg_Synth (+Decl.Obj, "no assignment for offsets %v:%v of %n", + (+First_Off, +Last_Off, +Decl.Obj)); + end if; + end Warning_No_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 + 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; + + procedure Error_Multiple_Assignments + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32) is + begin + Error_Msg_Synth (+Decl.Obj, "multiple assignments for %i offsets %v:%v", + (+Decl.Obj, +First_Off, +Last_Off)); + Info_Subnet (Decl.Obj, Decl.Typ, First_Off, Last_Off + 1 - First_Off); + end Error_Multiple_Assignments; + +end Synth.Vhdl_Environment; diff --git a/src/synth/synth-vhdl_environment.ads b/src/synth/synth-vhdl_environment.ads new file mode 100644 index 000000000..e9bf6129f --- /dev/null +++ b/src/synth/synth-vhdl_environment.ads @@ -0,0 +1,65 @@ +-- Environment definition for synthesis. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Types; use Types; + +with Netlists; use Netlists; +with Netlists.Builders; + +with Vhdl.Nodes; + +with Synth.Environment; +with Synth.Environment.Debug; +with Synth.Objtypes; use Synth.Objtypes; +-- with Synth_Vhdl.Context; + +package Synth.Vhdl_Environment is + + type Decl_Type is record + Obj : Vhdl.Nodes.Node; + Typ : Type_Acc; + end record; + + function Get_Bitwidth (Val : Memtyp) return Uns32; + + function Memtyp_To_Net (Ctxt : Builders.Context_Acc; Val : Memtyp) + return Net; + + function Partial_Memtyp_To_Net + (Ctxt : Builders.Context_Acc; Val : Memtyp; Off : Uns32; Wd : Uns32) + return Net; + + procedure Warning_No_Assignment + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32); + + procedure Error_Multiple_Assignments + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32); + + package Env is new Synth.Environment + (Decl_Type => Decl_Type, + Static_Type => Standard.Synth.Objtypes.Memtyp, + Get_Width => Get_Bitwidth, + Is_Equal => Is_Equal, + Static_To_Net => Memtyp_To_Net, + Partial_Static_To_Net => Partial_Memtyp_To_Net, + Warning_No_Assignment => Warning_No_Assignment, + Error_Multiple_Assignments => Error_Multiple_Assignments); +-- "+" => Vhdl.Nodes.Get_Location); + + package Debug is new Env.Debug; +end Synth.Vhdl_Environment; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 09bc3a36b..6e3dabfc0 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -22,8 +22,6 @@ with Vhdl.Errors; use Vhdl.Errors; with Synth.Objtypes; with Synth.Insts; use Synth.Insts; -with Synth.Environment.Debug; -pragma Unreferenced (Synth.Environment.Debug); with Synth.Values.Debug; pragma Unreferenced (Synth.Values.Debug); |