diff options
Diffstat (limited to 'src/synth/synth-environment.adb')
| -rw-r--r-- | src/synth/synth-environment.adb | 308 |
1 files changed, 45 insertions, 263 deletions
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; |