From 32a60efc00452a5eb037f5d1f5dabb687c170c99 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 9 Apr 2020 21:24:04 +0200 Subject: synth: refactoring to store static values in wires. --- src/synth/synth-context.adb | 72 ++++---- src/synth/synth-context.ads | 5 + src/synth/synth-decls.adb | 4 +- src/synth/synth-environment-debug.adb | 6 +- src/synth/synth-environment.adb | 306 ++++++++++++++++++++++------------ src/synth/synth-environment.ads | 33 +++- src/synth/synth-expr.adb | 118 ++++++++----- src/synth/synth-expr.ads | 8 +- src/synth/synth-insts.adb | 14 +- src/synth/synth-objtypes.ads | 2 + src/synth/synth-oper.adb | 5 +- src/synth/synth-static_oper.adb | 7 +- src/synth/synth-stmts.adb | 148 ++++++++-------- src/synth/synth-stmts.ads | 4 +- src/synth/synth-values-debug.adb | 27 +-- src/synth/synth-values-debug.ads | 2 +- src/synth/synth-values.adb | 19 ++- src/synth/synth-values.ads | 5 +- 18 files changed, 489 insertions(+), 296 deletions(-) diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 576be4987..b02dcbc2e 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -20,7 +20,6 @@ with Ada.Unchecked_Deallocation; -with Types; use Types; with Name_Table; use Name_Table; with Vhdl.Errors; use Vhdl.Errors; @@ -435,17 +434,24 @@ package body Synth.Context is end loop; end Is_Full; - procedure Value2net - (Val : Valtyp; W : Width; Vec : in out Logvec_Array; Res : out Net) + procedure Value2net (Val : Memtyp; + Off : Uns32; + W : Width; + Vec : in out Logvec_Array; + Res : out Net) is - Off : Uns32; + Vec_Off : Uns32; Has_Zx : Boolean; Inst : Instance; Is_0, Is_X : Boolean; begin + -- First convert to logvec. Has_Zx := False; - Off := 0; - Value2logvec (Val, Vec, Off, Has_Zx); + Vec_Off := 0; + Value2logvec (Val, Off, W, Vec, Vec_Off, Has_Zx); + pragma Assert (Vec_Off = W); + + -- Then convert logvec to net. if W = 0 then -- For null range (like the null string literal "") Res := Build_Const_UB32 (Build_Context, 0, 0); @@ -481,6 +487,36 @@ package body Synth.Context is end if; end Value2net; + function Get_Partial_Memtyp_Net (Val : Memtyp; Off : Uns32; Wd : Width) + return Net + is + Nd : constant Digit_Index := Digit_Index ((Wd + 31) / 32); + Res : Net; + begin + if Nd > 64 then + declare + Vecp : Logvec_Array_Acc; + begin + Vecp := new Logvec_Array'(0 .. Nd - 1 => (0, 0)); + Value2net (Val, Off, Wd, Vecp.all, Res); + Free_Logvec_Array (Vecp); + return Res; + end; + else + declare + Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0)); + begin + Value2net (Val, Off, Wd, Vec, Res); + return Res; + end; + end if; + end Get_Partial_Memtyp_Net; + + function Get_Memtyp_Net (Val : Memtyp) return Net is + begin + return Get_Partial_Memtyp_Net (Val, 0, Val.Typ.W); + end Get_Memtyp_Net; + function Get_Net (Val : Valtyp) return Net is begin case Val.Val.Kind is @@ -509,29 +545,7 @@ package body Synth.Context is end if; return Val.Val.C_Net; when Value_Memory => - declare - W : constant Width := Val.Typ.W; - Nd : constant Digit_Index := Digit_Index ((W + 31) / 32); - Res : Net; - begin - if Nd > 64 then - declare - Vecp : Logvec_Array_Acc; - begin - Vecp := new Logvec_Array'(0 .. Nd - 1 => (0, 0)); - Value2net (Val, W, Vecp.all, Res); - Free_Logvec_Array (Vecp); - return Res; - end; - else - declare - Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0)); - begin - Value2net (Val, W, Vec, Res); - return Res; - end; - end if; - end; + return Get_Memtyp_Net (Get_Memtyp (Val)); when others => raise Internal_Error; end case; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 2f1ff9698..ca15a6c66 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -18,6 +18,8 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Types; use Types; + with Netlists; use Netlists; with Netlists.Builders; @@ -125,6 +127,9 @@ package Synth.Context is -- Get a net from a scalar/vector value. This will automatically create -- a net for literals. function Get_Net (Val : Valtyp) return Net; + function Get_Partial_Memtyp_Net (Val : Memtyp; Off : Uns32; Wd : Width) + return Net; + function Get_Memtyp_Net (Val : Memtyp) return Net; function Get_Package_Object (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 89d3b3ad8..f0ccf71db 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -748,7 +748,7 @@ package body Synth.Decls is Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); Create_Var_Wire (Syn_Inst, Decl, Init); if Is_Subprg then - Phi_Assign + Phi_Assign_Net (Get_Build (Syn_Inst), Get_Value (Syn_Inst, Decl).Val.W, Get_Net (Init), 0); end if; @@ -787,7 +787,7 @@ package body Synth.Decls is Base.Val.N, Off.Net_Off, Typ.W), Typ); else - Res := Create_Value_Alias (Base.Val, Off, Typ); + Res := Create_Value_Alias (Base, Off, Typ); end if; if Obj_Typ /= null then Res := Synth_Subtype_Conversion (Res, Obj_Typ, True, Decl); diff --git a/src/synth/synth-environment-debug.adb b/src/synth/synth-environment-debug.adb index 2eec6f3b0..09eb9024f 100644 --- a/src/synth/synth-environment-debug.adb +++ b/src/synth/synth-environment-debug.adb @@ -77,7 +77,11 @@ package body Synth.Environment.Debug is Put (", chain:" & Seq_Assign'Image (Rec.Chain)); New_Line; Put_Line (" value:"); - Dump_Partial_Assign (Rec.Asgns); + if Rec.Val.Is_Static then + Put_Line (" static"); + else + Dump_Partial_Assign (Rec.Val.Asgns); + end if; end Dump_Assign; procedure Dump_Phi (Id : Phi_Id) diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index f170d6093..ec11d4ba2 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -31,6 +31,7 @@ with Errorout; use Errorout; with Synth.Flags; with Synth.Errors; use Synth.Errors; with Synth.Source; use Synth.Source; +with Synth.Context; with Vhdl.Nodes; @@ -136,9 +137,22 @@ package body Synth.Environment is Assign_Table.Table (Asgn).Chain := Chain; end Set_Assign_Chain; + function Get_Assign_Is_Static (Asgn : Seq_Assign) return Boolean is + begin + return Assign_Table.Table (Asgn).Val.Is_Static; + end Get_Assign_Is_Static; + + function Get_Assign_Static_Val (Asgn : Seq_Assign) return Memtyp is + begin + return Assign_Table.Table (Asgn).Val.Val; + end Get_Assign_Static_Val; + function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign is begin - return Assign_Table.Table (Asgn).Asgns; + -- Note: fails if the value is static. + -- Use Get_Assign_Partial_Force if you want to automatically convert + -- the value to a Partial_Assign (a net). + return Assign_Table.Table (Asgn).Val.Asgns; end Get_Assign_Partial; function New_Partial_Assign (Val : Net; Offset : Uns32) @@ -332,28 +346,34 @@ package body Synth.Environment is -- Must be connected to an Id_Output or Id_Signal pragma Assert (Outport /= No_Net); P : Partial_Assign; + Res : Net; begin -- Check output is not already assigned. pragma Assert (Get_Input_Net (Get_Net_Parent (Outport), 0) = No_Net); - P := Asgn_Rec.Asgns; - pragma Assert (P /= No_Partial_Assign); - while P /= No_Partial_Assign loop - declare - Pa : Partial_Assign_Record renames Partial_Assign_Table.Table (P); - Res : Net; - begin - if Synth.Flags.Flag_Debug_Noinference then - Res := Pa.Value; - else - Res := Inference.Infere - (Ctxt, Pa.Value, Pa.Offset, Outport, Stmt); - end if; + if Asgn_Rec.Val.Is_Static then + Res := Synth.Context.Get_Memtyp_Net (Asgn_Rec.Val.Val); + Add_Conc_Assign (Wid, Res, 0, Stmt); + else + P := Asgn_Rec.Val.Asgns; + pragma Assert (P /= No_Partial_Assign); + while P /= No_Partial_Assign loop + declare + Pa : Partial_Assign_Record renames + Partial_Assign_Table.Table (P); + begin + if Synth.Flags.Flag_Debug_Noinference then + Res := Pa.Value; + else + Res := Inference.Infere + (Ctxt, Pa.Value, Pa.Offset, Outport, Stmt); + end if; - Add_Conc_Assign (Wid, Res, Pa.Offset, Stmt); - P := Pa.Next; - end; - end loop; + Add_Conc_Assign (Wid, Res, Pa.Offset, Stmt); + P := Pa.Next; + end; + end loop; + end if; end Pop_And_Merge_Phi_Wire; -- This procedure is called after each concurrent statement to assign @@ -385,27 +405,29 @@ package body Synth.Environment is Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); P : Partial_Assign; begin - P := Asgn_Rec.Asgns; - pragma Assert (P /= No_Partial_Assign); - while P /= No_Partial_Assign loop - declare - Pa : Partial_Assign_Record - renames Partial_Assign_Table.Table (P); - Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); - begin - if Get_Mark_Flag (Res_Inst) - and then Get_Id (Res_Inst) = Gates.Id_Mux2 - then - -- A nop is needed iff the value is reused and will be - -- inferred (which is only possible for Id_Mux2). - Pa.Value := Build_Nop (Ctxt, Pa.Value); - else - Set_Mark_Flag (Res_Inst, True); - end if; + if not Asgn_Rec.Val.Is_Static then + P := Asgn_Rec.Val.Asgns; + pragma Assert (P /= No_Partial_Assign); + while P /= No_Partial_Assign loop + declare + Pa : Partial_Assign_Record + renames Partial_Assign_Table.Table (P); + Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); + begin + if Get_Mark_Flag (Res_Inst) + and then Get_Id (Res_Inst) = Gates.Id_Mux2 + then + -- A nop is needed iff the value is reused and will be + -- inferred (which is only possible for Id_Mux2). + Pa.Value := Build_Nop (Ctxt, Pa.Value); + else + Set_Mark_Flag (Res_Inst, True); + end if; - P := Pa.Next; - end; - end loop; + P := Pa.Next; + end; + end loop; + end if; Asgn := Asgn_Rec.Chain; end; end loop; @@ -417,19 +439,21 @@ package body Synth.Environment is Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); P : Partial_Assign; begin - P := Asgn_Rec.Asgns; - pragma Assert (P /= No_Partial_Assign); - while P /= No_Partial_Assign loop - declare - Pa : Partial_Assign_Record - renames Partial_Assign_Table.Table (P); - Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); - begin - Set_Mark_Flag (Res_Inst, False); - - P := Pa.Next; - end; - end loop; + if not Asgn_Rec.Val.Is_Static then + P := Asgn_Rec.Val.Asgns; + pragma Assert (P /= No_Partial_Assign); + while P /= No_Partial_Assign loop + declare + Pa : Partial_Assign_Record + renames Partial_Assign_Table.Table (P); + Res_Inst : constant Instance := Get_Net_Parent (Pa.Value); + begin + Set_Mark_Flag (Res_Inst, False); + + P := Pa.Next; + end; + end loop; + end if; Asgn := Asgn_Rec.Chain; end; end loop; @@ -465,13 +489,17 @@ package body Synth.Environment is -- Phi_Assign. Next_Asgn := Asgn_Rec.Chain; if Wid <= Mark then - Pasgn := Asgn_Rec.Asgns; - while Pasgn /= No_Partial_Assign loop - Next_Pasgn := Get_Partial_Next (Pasgn); - Set_Partial_Next (Pasgn, No_Partial_Assign); - Phi_Assign (Ctxt, Wid, Pasgn); - Pasgn := Next_Pasgn; - end loop; + if Asgn_Rec.Val.Is_Static then + Phi_Assign_Static (Wid, Asgn_Rec.Val.Val); + else + Pasgn := Asgn_Rec.Val.Asgns; + while Pasgn /= No_Partial_Assign loop + Next_Pasgn := Get_Partial_Next (Pasgn); + Set_Partial_Next (Pasgn, No_Partial_Assign); + Phi_Assign (Ctxt, Wid, Pasgn); + Pasgn := Next_Pasgn; + end loop; + end if; end if; Asgn := Next_Asgn; end; @@ -846,13 +874,17 @@ package body Synth.Environment is raise Internal_Error; end case; + if Asgn_Rec.Val.Is_Static then + return Synth.Context.Get_Memtyp_Net (Asgn_Rec.Val.Val); + end if; + -- Cannot be empty. - pragma Assert (Asgn_Rec.Asgns /= No_Partial_Assign); + pragma Assert (Asgn_Rec.Val.Asgns /= No_Partial_Assign); -- Simple case: fully assigned. declare Pasgn : Partial_Assign_Record renames - Partial_Assign_Table.Table (Asgn_Rec.Asgns); + Partial_Assign_Table.Table (Asgn_Rec.Val.Asgns); begin if Pasgn.Offset = 0 and then Get_Width (Pasgn.Value) = W then return Pasgn.Value; @@ -903,6 +935,12 @@ package body Synth.Environment is return Build2_Extract (Ctxt, Wire_Rec.Gate, Off, Wd); end if; + -- If the current value is static, just return it. + if Get_Assign_Is_Static (First_Seq) then + return Context.Get_Partial_Memtyp_Net + (Get_Assign_Static_Val (First_Seq), Off, Wd); + end if; + -- If the range is the same as the seq assign, return the value. declare P : constant Partial_Assign := Get_Assign_Partial (First_Seq); @@ -931,7 +969,8 @@ package body Synth.Environment is Cur_Wd := Wd; pragma Assert (Wd > 0); loop - -- Find value at CUR_OFF from assignment. + -- Find value at CUR_OFF from assignment. Start at the top + -- phi (which is not a static value). Seq := First_Seq; P := Get_Assign_Partial (Seq); loop @@ -959,15 +998,19 @@ package body Synth.Environment is exit; end if; if Pr.Offset + Pw <= Cur_Off then - -- Next partial; + -- Skip this partial, it is before what we are searching. P := Pr.Next; elsif Pr.Offset > Cur_Off and then Pr.Offset < Cur_Off + Cur_Wd then + -- There is a partial assignment that should be + -- considered, but first we need some values before it. -- Reduce WD and continue to search in previous; Cur_Wd := Pr.Offset - Cur_Off; P := No_Partial_Assign; else + -- The next partial assignment is beyond what we are + -- searching. -- Continue to search in previous. P := No_Partial_Assign; end if; @@ -979,6 +1022,13 @@ package body Synth.Environment is Cur_Off, Cur_Wd)); exit; end if; + if Get_Assign_Is_Static (Seq) then + -- Extract from static value. + Append + (Vec, Context.Get_Partial_Memtyp_Net + (Get_Assign_Static_Val (Seq), Cur_Off, Cur_Wd)); + exit; + end if; P := Get_Assign_Partial (Seq); end if; end; @@ -1097,7 +1147,7 @@ package body Synth.Environment is end Partial_Assign_Append; procedure Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; - W : Wire_Id; + Wid : Wire_Id; List : in out Partial_Assign_List) is Pasgn : Partial_Assign; @@ -1105,7 +1155,7 @@ package body Synth.Environment is while List.First /= No_Partial_Assign loop Pasgn := Get_Partial_Next (List.First); Set_Partial_Next (List.First, No_Partial_Assign); - Phi_Assign (Ctxt, W, List.First); + Phi_Assign (Ctxt, Wid, List.First); List.First := Pasgn; end loop; end Merge_Partial_Assigns; @@ -1200,6 +1250,27 @@ package body Synth.Environment is Merge_Partial_Assigns (Ctxt, W, List); end Merge_Assigns; + -- Force the value of a Seq_Assign to be a net if needed, return it. + function Get_Assign_Partial_Force (Asgn : Seq_Assign) return Partial_Assign + is + Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); + N : Net; + Res : Partial_Assign; + begin + if Asgn_Rec.Val.Is_Static then + N := Synth.Context.Get_Memtyp_Net (Asgn_Rec.Val.Val); + Res := New_Partial_Assign (N, 0); + if False then + -- Overwrite ? + Asgn_Rec.Val := (Is_Static => False, + Asgns => Res); + end if; + else + Res := Asgn_Rec.Val.Asgns; + end if; + return Res; + end Get_Assign_Partial_Force; + -- Add muxes for two lists T and F of assignments. procedure Merge_Phis (Ctxt : Builders.Context_Acc; Sel : Net; @@ -1222,7 +1293,7 @@ package body Synth.Environment is then -- Has an assignment only for the false branch. W := Get_Wire_Id (F_Asgns); - Fp := Get_Assign_Partial (F_Asgns); + Fp := Get_Assign_Partial_Force (F_Asgns); Tp := No_Partial_Assign; F_Asgns := Get_Assign_Chain (F_Asgns); elsif F_Asgns = No_Seq_Assign @@ -1232,14 +1303,14 @@ package body Synth.Environment is -- Has an assignment only for the true branch. W := Get_Wire_Id (T_Asgns); Fp := No_Partial_Assign; - Tp := Get_Assign_Partial (T_Asgns); + Tp := Get_Assign_Partial_Force (T_Asgns); T_Asgns := Get_Assign_Chain (T_Asgns); else -- Has assignments for both the true and the false branch. pragma Assert (Get_Wire_Id (F_Asgns) = Get_Wire_Id (T_Asgns)); W := Get_Wire_Id (F_Asgns); - Fp := Get_Assign_Partial (F_Asgns); - Tp := Get_Assign_Partial (T_Asgns); + Fp := Get_Assign_Partial_Force (F_Asgns); + Tp := Get_Assign_Partial_Force (T_Asgns); T_Asgns := Get_Assign_Chain (T_Asgns); F_Asgns := Get_Assign_Chain (F_Asgns); end if; @@ -1278,7 +1349,7 @@ package body Synth.Environment is Seq_Asgn : Seq_Assign_Record renames Assign_Table.Table (Seq); Prev_El : Partial_Assign; begin - Prev_El := Seq_Asgn.Asgns; + Prev_El := Seq_Asgn.Val.Asgns; if Prev_El = No_Partial_Assign then -- It's empty! return; @@ -1320,7 +1391,7 @@ package body Synth.Environment is begin Inserted := False; Last_El := No_Partial_Assign; - El := Seq_Asgn.Asgns; + El := Seq_Asgn.Val.Asgns; while El /= No_Partial_Assign loop declare P : Partial_Assign_Record renames Partial_Assign_Table.Table (El); @@ -1340,7 +1411,7 @@ package body Synth.Environment is if Last_El /= No_Partial_Assign then Partial_Assign_Table.Table (Last_El).Next := Asgn; else - Seq_Asgn.Asgns := Asgn; + Seq_Asgn.Val.Asgns := Asgn; end if; V.Next := P.Next; Inserted := True; @@ -1364,7 +1435,7 @@ package body Synth.Environment is if Last_El /= No_Partial_Assign then Partial_Assign_Table.Table (Last_El).Next := Asgn; else - Seq_Asgn.Asgns := Asgn; + Seq_Asgn.Val.Asgns := Asgn; end if; V.Next := El; Inserted := True; @@ -1419,7 +1490,7 @@ package body Synth.Environment is if Last_El /= No_Partial_Assign then Partial_Assign_Table.Table (Last_El).Next := Asgn; else - Seq_Asgn.Asgns := Asgn; + Seq_Asgn.Val.Asgns := Asgn; end if; V.Next := El; Inserted := True; @@ -1459,16 +1530,30 @@ package body Synth.Environment is Id => Dest, Prev => Cur_Asgn, Chain => No_Seq_Assign, - Asgns => Pasgn)); + Val => (Is_Static => False, Asgns => Pasgn))); Wire_Rec.Cur_Assign := Assign_Table.Last; Phi_Append_Assign (Assign_Table.Last); else -- Overwrite. + if Get_Assign_Is_Static (Cur_Asgn) then + -- Force seq_assign to be a net. + declare + Asgn_Rec : Seq_Assign_Record renames + Assign_Table.Table (Cur_Asgn); + N : Net; + Pa : Partial_Assign; + begin + N := Synth.Context.Get_Memtyp_Net (Asgn_Rec.Val.Val); + Pa := New_Partial_Assign (N, 0); + Asgn_Rec.Val := (Is_Static => False, Asgns => Pa); + end; + end if; + Insert_Partial_Assign (Ctxt, Cur_Asgn, Pasgn); end if; end Phi_Assign; - procedure Phi_Assign + procedure Phi_Assign_Net (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Val : Net; Offset : Uns32) is Pasgn : Partial_Assign; @@ -1476,52 +1561,50 @@ package body Synth.Environment is Pasgn := New_Partial_Assign (Val, Offset); Phi_Assign (Ctxt, Dest, Pasgn); - end Phi_Assign; + end Phi_Assign_Net; + + procedure Phi_Assign_Static (Dest : Wire_Id; Val : Memtyp) is + Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest); + pragma Assert (Wire_Rec.Kind /= Wire_None); + Cur_Asgn : constant Seq_Assign := Wire_Rec.Cur_Assign; + begin + if Cur_Asgn = No_Seq_Assign + or else Assign_Table.Table (Cur_Asgn).Phi < Current_Phi + then + -- Never assigned, or first assignment in that level + Assign_Table.Append ((Phi => Current_Phi, + Id => Dest, + Prev => Cur_Asgn, + Chain => No_Seq_Assign, + Val => (Is_Static => True, Val => Val))); + Wire_Rec.Cur_Assign := Assign_Table.Last; + Phi_Append_Assign (Assign_Table.Last); + else + Assign_Table.Table (Cur_Asgn).Val := (Is_Static => True, Val => Val); + end if; + end Phi_Assign_Static; -- Return the net driving WID when it is known to be possibly constant. -- Return No_Net is not constant. - function Get_Const_Net_Maybe (Wid : Wire_Id) return Net + function Is_Static_Wire (Wid : Wire_Id) return Boolean is Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); - Pasgn : Partial_Assign; - N : Net; begin if Wire_Rec.Kind /= Wire_Variable then - return No_Net; + return False; end if; if Wire_Rec.Cur_Assign = No_Seq_Assign then - return No_Net; - end if; - Pasgn := Get_Assign_Partial (Wire_Rec.Cur_Assign); - pragma Assert (Pasgn /= No_Partial_Assign); - if Get_Partial_Offset (Pasgn) /= 0 then - return No_Net; - end if; - N := Get_Partial_Value (Pasgn); - if Get_Width (N) /= Get_Width (Wire_Rec.Gate) then - return No_Net; - end if; - return N; - end Get_Const_Net_Maybe; - - function Is_Const_Wire (Wid : Wire_Id) return Boolean - is - N : constant Net := Get_Const_Net_Maybe (Wid); - begin - if N = No_Net then return False; - else - return Is_Const_Net (N); end if; - end Is_Const_Wire; + return Get_Assign_Is_Static (Wire_Rec.Cur_Assign); + end Is_Static_Wire; - function Get_Const_Wire (Wid : Wire_Id) return Net + function Get_Static_Wire (Wid : Wire_Id) return Memtyp is - N : constant Net := Get_Const_Net_Maybe (Wid); + Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); begin - pragma Assert (N /= No_Net); - return N; - end Get_Const_Wire; + return Get_Assign_Static_Val (Wire_Rec.Cur_Assign); + end Get_Static_Wire; begin Wire_Id_Table.Append ((Kind => Wire_None, Mark_Flag => False, @@ -1533,10 +1616,11 @@ begin pragma Assert (Wire_Id_Table.Last = No_Wire_Id); Assign_Table.Append ((Phi => No_Phi_Id, - Id => No_Wire_Id, - Prev => No_Seq_Assign, - Chain => No_Seq_Assign, - Asgns => No_Partial_Assign)); + Id => No_Wire_Id, + Prev => No_Seq_Assign, + Chain => No_Seq_Assign, + Val => (Is_Static => False, + Asgns => No_Partial_Assign))); pragma Assert (Assign_Table.Last = No_Seq_Assign); Partial_Assign_Table.Append ((Next => No_Partial_Assign, diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index f2f6c5dc2..a183e68ca 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -25,6 +25,7 @@ with Netlists; use Netlists; with Netlists.Builders; with Synth.Source; +with Synth.Objtypes; use Synth.Objtypes; package Synth.Environment is -- This package declares the type Wire_Id and its methods. @@ -111,9 +112,12 @@ package Synth.Environment is return Net; -- In the current phi context, assign VAL to DEST. - procedure Phi_Assign + procedure Phi_Assign_Net (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); + -- A Phi represent a split in the control flow (two or more branches). type Phi_Type is private; @@ -165,6 +169,9 @@ package Synth.Environment is function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign; + -- Force the value of a Seq_Assign to be a net if needed, return it. + function Get_Assign_Partial_Force (Asgn : Seq_Assign) return Partial_Assign; + function New_Partial_Assign (Val : Net; Offset : Uns32) return Partial_Assign; @@ -176,7 +183,7 @@ package Synth.Environment is procedure Partial_Assign_Append (List : in out Partial_Assign_List; Pasgn : Partial_Assign); procedure Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; - W : Wire_Id; + Wid : Wire_Id; List : in out Partial_Assign_List); -- P is an array of Partial_Assign. Each element is a list @@ -201,13 +208,13 @@ package Synth.Environment is procedure Finalize_Assignments (Ctxt : Builders.Context_Acc); - -- A const wire is a wire_signal which has one whole (same width as the + -- A static wire is a wire_signal which has one whole (same width as the -- wire) assignment and whose assignment value is a const net. -- That's rather restrictive but still efficient. - function Is_Const_Wire (Wid : Wire_Id) return Boolean; + function Is_Static_Wire (Wid : Wire_Id) return Boolean; - -- Return the corresponding net for a constant wire. - function Get_Const_Wire (Wid : Wire_Id) return Net; + -- Return the corresponding net for a static wire. + function Get_Static_Wire (Wid : Wire_Id) return Memtyp; private type Wire_Id is new Uns32; No_Wire_Id : constant Wire_Id := 0; @@ -264,6 +271,16 @@ private Nbr_Final_Assign : Natural; end record; + type Seq_Assign_Value (Is_Static : Boolean := True) is record + case Is_Static is + when True => + Val : Memtyp; + when False => + -- Values assigned. + Asgns : Partial_Assign; + end case; + end record; + type Seq_Assign_Record is record -- Target of the assignment. Id : Wire_Id; @@ -278,8 +295,8 @@ private -- Next wire in the phi context. Chain : Seq_Assign; - -- Values assigned. - Asgns : Partial_Assign; + -- Current value. + Val : Seq_Assign_Value; end record; type Partial_Assign_Record is record diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index c58454c0b..695418fc6 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -55,23 +55,20 @@ package body Synth.Expr is procedure Set_Location (N : Net; Loc : Node) renames Synth.Source.Set_Location; - function Get_Static_Discrete (V : Valtyp) return Int64 - is - N : Net; + function Get_Static_Discrete (V : Valtyp) return Int64 is begin case V.Val.Kind is when Value_Memory => return Read_Discrete (V); when Value_Const => - return Read_Discrete ((V.Typ, V.Val.C_Val)); + return Read_Discrete (Get_Memtyp (V)); when Value_Net => - N := V.Val.N; + return Get_Net_Int64 (Get_Net (V)); when Value_Wire => - N := Synth.Environment.Get_Const_Wire (V.Val.W); + return Read_Discrete (Synth.Environment.Get_Static_Wire (V.Val.W)); when others => raise Internal_Error; end case; - return Get_Net_Int64 (N); end Get_Static_Discrete; function Is_Positive (V : Valtyp) return Boolean @@ -81,14 +78,14 @@ package body Synth.Expr is begin pragma Assert (V.Typ.Kind = Type_Discrete); case V.Val.Kind is - when Value_Const => - return Read_Discrete ((V.Typ, V.Val.C_Val)) >= 0; + when Value_Const + | Value_Memory => + return Read_Discrete (Get_Memtyp (V)) >= 0; when Value_Net => N := V.Val.N; when Value_Wire => - N := Get_Net (V); - when Value_Memory => - return Read_Discrete (V) >= 0; + return Read_Discrete + (Synth.Environment.Get_Static_Wire (V.Val.W)) >= 0; when others => raise Internal_Error; end case; @@ -213,37 +210,74 @@ package body Synth.Expr is procedure Value2logvec (Mem : Memory_Ptr; Typ : Type_Acc; - Vec : in out Logvec_Array; Off : in out Uns32; + W : in out Width; + Vec : in out Logvec_Array; + Vec_Off : in out Uns32; Has_Zx : in out Boolean) is begin + if Off >= Typ.W then + -- Offset not yet reached. + Off := Off - Typ.W; + return; + end if; + if W = 0 then + return; + end if; + case Typ.Kind is when Type_Bit => - Bit2logvec (Uns32 (Read_U8 (Mem)), Vec, Off); + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Bit2logvec (Uns32 (Read_U8 (Mem)), Vec, Vec_Off); + W := W - Typ.W; when Type_Logic => - Logic2logvec (Int64 (Read_U8 (Mem)), Vec, Off, Has_Zx); + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Logic2logvec (Int64 (Read_U8 (Mem)), Vec, Vec_Off, Has_Zx); + W := W - Typ.W; when Type_Discrete => - Uns2logvec (To_Uns64 (Read_Discrete (Mem, Typ)), Typ.W, Vec, Off); + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Uns2logvec (To_Uns64 (Read_Discrete (Memtyp'(Typ, Mem))), + Typ.W, Vec, Vec_Off); + W := W - Typ.W; + when Type_Float => + -- Fp64 is for sure 64 bits. Assume the endianness of floats is + -- the same as integers endianness. + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Uns2logvec (To_Uns64 (Read_Fp64 (Mem)), 64, Vec, Vec_Off); + W := W - Typ.W; when Type_Vector => declare - Vlen : constant Iir_Index32 := Vec_Length (Typ); + Vlen : Uns32; begin + Vlen := Uns32 (Vec_Length (Typ)); + pragma Assert (Off < Vlen); + pragma Assert (Vlen > 0); + + if Vlen > Off + W then + Vlen := Off + W; + end if; case Typ.Vec_El.Kind is when Type_Bit => -- TODO: optimize off mod 32 = 0. - for I in reverse 1 .. Vlen loop + for I in reverse Off + 1 .. Vlen loop Bit2logvec (Uns32 (Read_U8 (Mem + Size_Type (I - 1))), - Vec, Off); + Vec, Vec_Off); end loop; when Type_Logic => - for I in reverse 1 .. Vlen loop + for I in reverse Off + 1 .. Vlen loop Logic2logvec (Int64 (Read_U8 (Mem + Size_Type (I - 1))), - Vec, Off, Has_Zx); + Vec, Vec_Off, Has_Zx); end loop; when others => raise Internal_Error; end case; + W := W - (Vlen - Off); + Off := 0; end; when Type_Array => declare @@ -251,35 +285,37 @@ package body Synth.Expr is El_Typ : constant Type_Acc := Typ.Arr_El; begin for I in reverse 1 .. Alen loop - Value2logvec (Mem + Size_Type (I - 1) * El_Typ.Sz, - El_Typ, Vec, Off, Has_Zx); + Value2logvec (Mem + Size_Type (I - 1) * El_Typ.Sz, El_Typ, + Off, W, Vec, Vec_Off, Has_Zx); + exit when W = 0; end loop; end; when Type_Record => for I in Typ.Rec.E'Range loop Value2logvec (Mem + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ, - Vec, Off, Has_Zx); + Off, W, Vec, Vec_Off, Has_Zx); + exit when W = 0; end loop; - when Type_Float => - -- Fp64 is for sure 64 bits. Assume the endianness of floats is - -- the same as integers endianness. - Uns2logvec (To_Uns64 (Read_Fp64 (Mem)), 64, Vec, Off); when others => raise Internal_Error; end case; end Value2logvec; - procedure Value2logvec (Val : Valtyp; + procedure Value2logvec (Val : Memtyp; + Off : Uns32; + W : Width; Vec : in out Logvec_Array; - Off : in out Uns32; - Has_Zx : in out Boolean) is + Vec_Off : in out Uns32; + Has_Zx : in out Boolean) + is + Off1 : Uns32; + W1 : Width; begin - if Val.Val.Kind = Value_Const then - Value2logvec (Val.Val.C_Val.Mem, Val.Typ, Vec, Off, Has_Zx); - return; - end if; - - Value2logvec (Val.Val.Mem, Val.Typ, Vec, Off, Has_Zx); + Off1 := Off; + W1 := W; + Value2logvec (Val.Mem, Val.Typ, Off1, W1, Vec, Vec_Off, Has_Zx); + pragma Assert (Off1 = 0); + pragma Assert (W1 = 0); end Value2logvec; -- Resize for a discrete value. @@ -639,7 +675,8 @@ package body Synth.Expr is when Value_Net => return Create_Value_Net (Val.Val.N, Ntype); when Value_Alias => - return Create_Value_Alias (Val.Val.A_Obj, Val.Val.A_Off, Ntype); + return Create_Value_Alias + ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype); when Value_Const => return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); when Value_Memory => @@ -681,6 +718,11 @@ package body Synth.Expr is when Value_Net | Value_Wire | Value_Alias => + if Is_Static_Val (Vt.Val) then + return Create_Value_Discrete + (Get_Static_Discrete (Vt), Dtype); + end if; + N := Get_Net (Vt); if Vtype.Drange.Is_Signed then N := Build2_Sresize diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 42ac1d56c..3a7318550 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -127,8 +127,12 @@ package Synth.Expr is procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation (Logvec_Array, Logvec_Array_Acc); - procedure Value2logvec (Val : Valtyp; + -- Convert W bits from OFF of VAL to a Logvec_Array. + -- OFF and W are offset and width in bit representation. + procedure Value2logvec (Val : Memtyp; + Off : Uns32; + W : Width; Vec : in out Logvec_Array; - Off : in out Uns32; + Vec_Off : in out Uns32; Has_Zx : in out Boolean); end Synth.Expr; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index e271195dc..f022ac71d 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -840,7 +840,9 @@ package body Synth.Insts is Vec := new Logvec_Array'(0 .. Digit_Index (Len - 1) => (0, 0)); Off := 0; Has_Zx := False; - Value2logvec (Vt, Vec.all, Off, Has_Zx); + Value2logvec + (Get_Memtyp (Vt), 0, Vt.Typ.W, Vec.all, Off, Has_Zx); + pragma Assert (Off = Vt.Typ.W); if Has_Zx then Pv := Create_Pval4 (Vt.Typ.W); else @@ -1329,7 +1331,7 @@ package body Synth.Insts is Self_Inst : Instance; Inter : Node; Idx : Port_Idx; - Val : Value_Acc) + Val : Valtyp) is Default : constant Node := Get_Default_Value (Inter); Desc : constant Port_Desc := @@ -1339,10 +1341,10 @@ package body Synth.Insts is Init : Valtyp; Inp : Input; begin - pragma Assert (Val.Kind = Value_Wire); + pragma Assert (Val.Val.Kind = Value_Wire); -- Create a gate for the output, so that it could be read. - Val.W := Alloc_Wire (Wire_Output, Inter); + Val.Val.W := Alloc_Wire (Wire_Output, Inter); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); Inp := Get_Input (Self_Inst, Idx); @@ -1375,7 +1377,7 @@ package body Synth.Insts is Connect (Inp, Value); end if; Set_Location (Value, Inter); - Set_Wire_Gate (Val.W, Value); + Set_Wire_Gate (Val.Val.W, Value); end Create_Output_Wire; procedure Apply_Block_Configuration (Cfg : Node; Blk : Node) @@ -1481,7 +1483,7 @@ package body Synth.Insts is when Port_Out | Port_Inout => Create_Output_Wire - (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt.Val); + (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt); Nbr_Outputs := Nbr_Outputs + 1; end case; Inter := Get_Chain (Inter); diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads index a01183c03..d78b3725c 100644 --- a/src/synth/synth-objtypes.ads +++ b/src/synth/synth-objtypes.ads @@ -161,6 +161,8 @@ package Synth.Objtypes is Mem : Memory_Ptr; end record; + Null_Memtyp : constant Memtyp := (null, null); + -- Offsets for a value. type Value_Offsets is record Net_Off : Uns32; diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index d3c9ae459..4c261f054 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -639,19 +639,20 @@ package body Synth.Oper is return No_Valtyp; end if; Left := Synth_Subtype_Conversion (Left, Left_Typ, False, Expr); - Strip_Const (Left); Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Typ); if Right = No_Valtyp then return No_Valtyp; end if; Right := Synth_Subtype_Conversion (Right, Right_Typ, False, Expr); - Strip_Const (Right); if Is_Static_Val (Left.Val) and Is_Static_Val (Right.Val) then return Synth_Static_Dyadic_Predefined (Syn_Inst, Imp, Left, Right, Expr); end if; + Strip_Const (Left); + Strip_Const (Right); + case Def is when Iir_Predefined_Error => return No_Valtyp; diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index eeb24ed64..97ded46a8 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -69,7 +69,8 @@ package body Synth.Static_Oper is when Value_Net => N := V.Val.N; when Value_Wire => - N := Synth.Environment.Get_Const_Wire (V.Val.W); + return (Kind => Sarr_Value, + Arr => Synth.Environment.Get_Static_Wire (V.Val.W).Mem); when others => raise Internal_Error; end case; @@ -337,8 +338,8 @@ package body Synth.Static_Oper is case Sarr.Kind is when Sarr_Value => for I in 1 .. Vec_Length (Val.Typ) loop - Arr (Natural (I)) := - Std_Ulogic'Val (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); + Arr (Natural (I)) := Std_Ulogic'Val + (Read_U8 (Sarr.Arr + Size_Type (I - 1))); end loop; when Sarr_Net => for I in Arr'Range loop diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 8717842d9..4f846d1fb 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -89,24 +89,6 @@ package body Synth.Stmts is end if; end Synth_Waveform; - procedure Synth_Assign (Wid : Wire_Id; - Typ : Type_Acc; - Val : Valtyp; - Offset : Uns32; - Loc : Source.Syn_Src) - is - Cval : Valtyp; - N : Net; - begin - Cval := Synth_Subtype_Conversion (Val, Typ, False, Loc); - if Cval = No_Valtyp then - -- In case of error. - return; - end if; - N := Get_Net (Cval); - Phi_Assign (Build_Context, Wid, N, Offset); - end Synth_Assign; - procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; Dest_Base : out Valtyp; @@ -139,7 +121,7 @@ package body Synth.Stmts is if Targ.Val.Kind = Value_Alias then -- Replace alias by the aliased name. - Dest_Base := (Targ.Typ, Targ.Val.A_Obj); + Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); Dest_Off := Targ.Val.A_Off; else Dest_Base := Targ; @@ -147,6 +129,7 @@ package body Synth.Stmts is end if; end; when Iir_Kind_Function_Call => + -- Can be the prefix of .all Dest_Base := Synth_Expression (Syn_Inst, Pfx); Dest_Typ := Dest_Base.Typ; Dest_Off := (0, 0); @@ -156,13 +139,13 @@ package body Synth.Stmts is declare Voff : Net; Off : Value_Offsets; - Dest_W : Width; + Pfx_W : Width; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); Strip_Const (Dest_Base); - Dest_W := Dest_Base.Typ.W; + Pfx_W := Dest_Typ.W; Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off); Dest_Typ := Get_Array_Element (Dest_Typ); @@ -173,7 +156,7 @@ package body Synth.Stmts is if Voff /= No_Net then if Dest_Voff = No_Net then Dest_Voff := Voff; - Dest_Rdwd := Dest_W; + Dest_Rdwd := Pfx_W; else Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Voff); @@ -204,11 +187,13 @@ package body Synth.Stmts is Res_Bnd : Bound_Type; Sl_Voff : Net; Sl_Off : Value_Offsets; + Pfx_W : Width; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); Strip_Const (Dest_Base); + Pfx_W := Dest_Typ.W; Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ, @@ -223,7 +208,7 @@ package body Synth.Stmts is Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Sl_Voff); else - Dest_Rdwd := Dest_Base.Typ.W; + Dest_Rdwd := Pfx_W; Dest_Voff := Sl_Voff; end if; Dest_Typ := Create_Slice_Type (Res_Bnd.Len, El_Typ); @@ -251,7 +236,16 @@ package body Synth.Stmts is end Synth_Assignment_Prefix; type Target_Kind is - (Target_Simple, Target_Aggregate, Target_Memory); + ( + -- The target is an object or a static part of it. + Target_Simple, + + -- The target is an aggregate. + Target_Aggregate, + + -- The assignment is dynamically indexed. + Target_Memory + ); type Target_Info (Kind : Target_Kind := Target_Simple) is record -- In all cases, the type of the target is known or computed. @@ -424,46 +418,55 @@ package body Synth.Stmts is procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Target_Info; Val : Valtyp; - Loc : Node) is + Loc : Node) + is + V : Valtyp; begin + V := Synth_Subtype_Conversion (Val, Target.Targ_Type, False, Loc); + pragma Unreferenced (Val); + if V = No_Valtyp then + -- In case of error. + return; + end if; + case Target.Kind is when Target_Aggregate => Synth_Assignment_Aggregate - (Syn_Inst, Target.Aggr, Target.Targ_Type, Val, Loc); + (Syn_Inst, Target.Aggr, Target.Targ_Type, V, Loc); when Target_Simple => if Target.Obj.Val.Kind = Value_Wire then - Synth_Assign (Target.Obj.Val.W, Target.Targ_Type, - Val, Target.Off.Net_Off, Loc); + if Is_Static (V.Val) + and then V.Typ.W = Target.Obj.Typ.W + then + pragma Assert (Target.Off = (0, 0)); + Phi_Assign_Static (Target.Obj.Val.W, Get_Memtyp (V)); + else + Phi_Assign_Net (Get_Build (Syn_Inst), Target.Obj.Val.W, + Get_Net (V), Target.Off.Net_Off); + end if; else - if not Is_Static (Val.Val) then + 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 - declare - V : Valtyp; - begin - V := Val; - Strip_Const (V); - Copy_Memory (Target.Obj.Val.Mem + Target.Off.Mem_Off, - V.Val.Mem, V.Typ.Sz); - end; + Strip_Const (V); + Copy_Memory (Target.Obj.Val.Mem + Target.Off.Mem_Off, + V.Val.Mem, V.Typ.Sz); end if; end if; when Target_Memory => declare - V : Net; + N : Net; begin - V := Get_Current_Assign_Value + N := Get_Current_Assign_Value (Get_Build (Syn_Inst), Target.Mem_Obj.Val.W, Target.Mem_Moff, Target.Mem_Mwidth); - V := Build_Dyn_Insert (Get_Build (Syn_Inst), V, Get_Net (Val), + N := Build_Dyn_Insert (Get_Build (Syn_Inst), N, Get_Net (V), Target.Mem_Voff, Target.Mem_Doff); - Set_Location (V, Loc); - Synth_Assign - (Target.Mem_Obj.Val.W, Target.Targ_Type, - Create_Value_Net (V, Target.Targ_Type), - Target.Mem_Moff, Loc); + Set_Location (N, Loc); + Phi_Assign_Net (Get_Build (Syn_Inst), Target.Mem_Obj.Val.W, + N, Target.Mem_Moff); end; end case; end Synth_Assignment; @@ -712,7 +715,8 @@ package body Synth.Stmts is Off := 0; Has_Zx := False; Vec := (others => (0, 0)); - Value2logvec (Expr_Val, Vec, Off, Has_Zx); + Value2logvec (Get_Memtyp (Expr_Val), 0, Expr_Val.Typ.W, + Vec, Off, Has_Zx); if Has_Zx then Error_Msg_Synth (+Expr, "meta-values never match"); end if; @@ -771,6 +775,7 @@ package body Synth.Stmts is Wid_Heap_Sort (Arr'Length); end Sort_Wire_Id_Array; + -- Count the number of wires used in all the alternatives. function Count_Wires_In_Alternatives (Alts : Alternative_Data_Array) return Natural is @@ -793,6 +798,7 @@ package body Synth.Stmts is return Res; end Count_Wires_In_Alternatives; + -- Fill ARR from wire_id of ALTS. procedure Fill_Wire_Id_Array (Arr : out Wire_Id_Array; Alts : Alternative_Data_Array) is @@ -955,7 +961,8 @@ package body Synth.Stmts is -- If there is an assignment to Wi in Alt, it will define the -- value. if Get_Wire_Id (Alts (I).Asgns) = Wi then - Pasgns (Int32 (I)) := Get_Assign_Partial (Alts (I).Asgns); + Pasgns (Int32 (I)) := + Get_Assign_Partial_Force (Alts (I).Asgns); Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns); else Pasgns (Int32 (I)) := No_Partial_Assign; @@ -1502,7 +1509,7 @@ package body Synth.Stmts is -- Always pass by value. Nbr_Inout := Nbr_Inout + 1; Infos (Nbr_Inout) := Info; - if Info.Kind = Target_Simple + if Info.Kind /= Target_Memory and then Is_Static (Info.Obj.Val) then Val := Create_Value_Memory (Info.Targ_Type); @@ -1514,11 +1521,11 @@ package body Synth.Stmts is end if; when Iir_Kind_Interface_Signal_Declaration => -- Always pass by reference (use an alias). - if Info.Kind /= Target_Simple then + if Info.Kind = Target_Memory then raise Internal_Error; end if; Val := Create_Value_Alias - (Info.Obj.Val, Info.Off, Info.Targ_Type); + (Info.Obj, Info.Off, Info.Targ_Type); when Iir_Kind_Interface_File_Declaration => Val := Info.Obj; when Iir_Kind_Interface_Quantity_Declaration => @@ -1694,18 +1701,18 @@ package body Synth.Stmts is New_Internal_Name (Build_Context), C.Ret_Typ.W)); C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W); - Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0); + Phi_Assign_Net (Build_Context, C.W_Val, C.Ret_Init, 0); end if; Set_Wire_Gate (C.W_En, Build_Signal (Build_Context, New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); + Phi_Assign_Net (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); Set_Wire_Gate (C.W_Ret, Build_Signal (Build_Context, New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); + Phi_Assign_Net (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); if not Is_Error (C.Inst) then @@ -1736,6 +1743,10 @@ package body Synth.Stmts is pragma Unreferenced (Infos); -- Propagate assignments. + -- Wires that have been created for this subprogram will be destroyed. + -- But assignment for outer wires (passed through parameters) have + -- to be kept. We cannot merge phi because this won't be allowed for + -- local wires. Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark); -- Free wires. @@ -1972,7 +1983,8 @@ package body Synth.Stmts is Set_Wire_Gate (Lc.W_Quit, Build_Signal (Get_Build (C.Inst), New_Internal_Name (Build_Context), 1)); - Phi_Assign (Get_Build (C.Inst), Lc.W_Quit, Get_Inst_Bit1 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + Lc.W_Quit, Get_Inst_Bit1 (C.Inst), 0); end if; if Get_Exit_Flag (Stmt) or else Get_Next_Flag (Stmt) then @@ -1986,7 +1998,8 @@ package body Synth.Stmts is Set_Wire_Gate (Lc.W_Exit, Build_Signal (Get_Build (C.Inst), New_Internal_Name (Build_Context), 1)); - Phi_Assign (Get_Build (C.Inst), Lc.W_Exit, Get_Inst_Bit1 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + Lc.W_Exit, Get_Inst_Bit1 (C.Inst), 0); end if; end Loop_Control_Init; @@ -2032,7 +2045,7 @@ package body Synth.Stmts is Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Quit)); end if; - Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0); + Phi_Assign_Net (Get_Build (C.Inst), C.W_En, Res, 0); end Loop_Control_Update; procedure Loop_Control_Finish (C : Seq_Context) @@ -2070,7 +2083,7 @@ package body Synth.Stmts is Release (C.Cur_Loop.Wire_Mark); - Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0); + Phi_Assign_Net (Get_Build (C.Inst), C.W_En, Res, 0); end Loop_Control_Finish; procedure Synth_Dynamic_Exit_Next_Statement @@ -2099,7 +2112,7 @@ package body Synth.Stmts is end if; -- Execution is suspended. - Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0); Lc := C.Cur_Loop; @@ -2113,13 +2126,13 @@ package body Synth.Stmts is loop if Lc.Loop_Stmt = Loop_Label then if Is_Exit then - Phi_Assign (Get_Build (C.Inst), Lc.W_Exit, - Get_Inst_Bit0 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + Lc.W_Exit, Get_Inst_Bit0 (C.Inst), 0); end if; exit; else - Phi_Assign (Get_Build (C.Inst), Lc.W_Quit, - Get_Inst_Bit0 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + Lc.W_Quit, Get_Inst_Bit0 (C.Inst), 0); end if; Lc := Lc.Prev_Loop; end loop; @@ -2395,17 +2408,18 @@ package body Synth.Stmts is end if; end if; if Is_Dyn then - Phi_Assign (Get_Build (C.Inst), C.W_Val, Get_Net (Val), 0); + Phi_Assign_Net (Get_Build (C.Inst), C.W_Val, Get_Net (Val), 0); end if; end if; if Is_Dyn then -- The subprogram has returned. Do not execute further statements. - Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + C.W_En, Get_Inst_Bit0 (C.Inst), 0); if C.W_Ret /= No_Wire_Id then - Phi_Assign (Get_Build (C.Inst), C.W_Ret, - Get_Inst_Bit0 (C.Inst), 0); + Phi_Assign_Net (Get_Build (C.Inst), + C.W_Ret, Get_Inst_Bit0 (C.Inst), 0); end if; end if; @@ -2684,7 +2698,7 @@ package body Synth.Stmts is Set_Wire_Gate (C.W_En, Build_Signal (Build_Context, New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); + Phi_Assign_Net (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); case Iir_Kinds_Process_Statement (Get_Kind (Proc)) is when Iir_Kind_Sensitized_Process_Statement => diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index 349b52991..dce23cf8e 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -35,8 +35,8 @@ package Synth.Stmts is Assoc_Chain : Node); -- Transform PFX into DEST_*. - -- DEST_BASE is the base object. Can be the result, a net or an array - -- larger than the result. + -- DEST_BASE is the base object (with its own typ). Can be the result, + -- a net or an object larger than the result. -- DEST_TYP is the type of the result. -- DEST_NET_OFF/DEST_MEM_OFF/DEST_VOFF are the offsets in the base. -- DEST_NET_OFF is used when diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb index dfea20a98..282082cda 100644 --- a/src/synth/synth-values-debug.adb +++ b/src/synth/synth-values-debug.adb @@ -40,44 +40,45 @@ package body Synth.Values.Debug is Put (']'); end Debug_Bound; - procedure Debug_Memtyp (M : Memory_Ptr; Typ : Type_Acc) is + procedure Debug_Memtyp (M : Memtyp) is begin - case Typ.Kind is + case M.Typ.Kind is when Type_Vector => Put ("vector ("); - Debug_Bound (Typ.Vbound); + Debug_Bound (M.Typ.Vbound); Put ("): "); - for I in 1 .. Typ.Vbound.Len loop - Put_Uns32 (Uns32 (Read_U8 (M + Size_Type (I - 1)))); + for I in 1 .. M.Typ.Vbound.Len loop + Put_Uns32 (Uns32 (Read_U8 (M.Mem + Size_Type (I - 1)))); end loop; when Type_Array => Put ("arr ("); - for I in 1 .. Typ.Abounds.Ndim loop + for I in 1 .. M.Typ.Abounds.Ndim loop if I > 1 then Put (", "); end if; - Debug_Bound (Typ.Abounds.D (I)); + Debug_Bound (M.Typ.Abounds.D (I)); end loop; Put ("): "); - for I in 1 .. Get_Array_Flat_Length (Typ) loop + for I in 1 .. Get_Array_Flat_Length (M.Typ) loop if I > 1 then Put (", "); end if; Debug_Memtyp - (M + Size_Type (I - 1) * Typ.Arr_El.Sz, Typ.Arr_El); + ((M.Typ.Arr_El, M.Mem + Size_Type (I - 1) * M.Typ.Arr_El.Sz)); end loop; when Type_Record => Put ("rec: ("); - for I in Typ.Rec.E'Range loop + for I in M.Typ.Rec.E'Range loop if I > 1 then Put (", "); end if; - Debug_Memtyp (M + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ); + Debug_Memtyp + ((M.Typ.Rec.E (I).Typ, M.Mem + M.Typ.Rec.E (I).Moff)); end loop; Put (")"); when Type_Discrete => Put ("discrete: "); - Put_Int64 (Read_Discrete (M, Typ)); + Put_Int64 (Read_Discrete (M)); when others => Put ("others"); end case; @@ -86,7 +87,7 @@ package body Synth.Values.Debug is procedure Debug_Valtyp (V : Valtyp) is begin - Debug_Memtyp (V.Val.Mem, V.Typ); + Debug_Memtyp (Get_Memtyp (V)); end Debug_Valtyp; end Synth.Values.Debug; diff --git a/src/synth/synth-values-debug.ads b/src/synth/synth-values-debug.ads index 6d59c4a99..8084b7ef6 100644 --- a/src/synth/synth-values-debug.ads +++ b/src/synth/synth-values-debug.ads @@ -20,5 +20,5 @@ package Synth.Values.Debug is procedure Debug_Valtyp (V : Valtyp); - procedure Debug_Memtyp (M : Memory_Ptr; Typ : Type_Acc); + procedure Debug_Memtyp (M : Memtyp); end Synth.Values.Debug; diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 47a354078..54155ed86 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -55,7 +55,7 @@ package body Synth.Values is when Value_Net => return Netlists.Utils.Is_Const_Net (Val.N); when Value_Wire => - return Is_Const_Wire (Val.W); + return Is_Static_Wire (Val.W); when Value_File => return True; when Value_Const => @@ -217,7 +217,7 @@ package body Synth.Values is end Get_Array_Flat_Length; function Create_Value_Alias - (Obj : Value_Acc; Off : Value_Offsets; Typ : Type_Acc) return Valtyp + (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp is pragma Assert (Typ /= null); subtype Value_Type_Alias is Value_Type (Value_Alias); @@ -226,7 +226,8 @@ package body Synth.Values is begin Val := To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Alias, - A_Obj => Obj, + A_Obj => Obj.Val, + A_Typ => Obj.Typ, A_Off => Off))); return (Typ, Val); end Create_Value_Alias; @@ -424,15 +425,15 @@ package body Synth.Values is Write_Discrete (Vt.Val.Mem, Vt.Typ, Val); end Write_Discrete; - function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64 is + function Read_Discrete (Mt : Memtyp) return Int64 is begin - case Typ.Sz is + case Mt.Typ.Sz is when 1 => - return Int64 (Read_U8 (Mem)); + return Int64 (Read_U8 (Mt.Mem)); when 4 => - return Int64 (Read_I32 (Mem)); + return Int64 (Read_I32 (Mt.Mem)); when 8 => - return Int64 (Read_I64 (Mem)); + return Int64 (Read_I64 (Mt.Mem)); when others => raise Internal_Error; end case; @@ -440,7 +441,7 @@ package body Synth.Values is function Read_Discrete (Vt : Valtyp) return Int64 is begin - return Read_Discrete (Vt.Val.Mem, Vt.Typ); + return Read_Discrete (Get_Memtyp (Vt)); end Read_Discrete; function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index ec1c28813..ee0463721 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -85,6 +85,7 @@ package Synth.Values is C_Net : Net; when Value_Alias => A_Obj : Value_Acc; + A_Typ : Type_Acc; -- The type of A_Obj. A_Off : Value_Offsets; end case; end record; @@ -133,7 +134,7 @@ package Synth.Values is return Valtyp; function Create_Value_Alias - (Obj : Value_Acc; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; + (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) return Valtyp; @@ -161,7 +162,7 @@ package Synth.Values is -- Memory access. procedure Write_Discrete (Vt : Valtyp; Val : Int64); - function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64; + function Read_Discrete (Mt : Memtyp) return Int64; function Read_Discrete (Vt : Valtyp) return Int64; procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Index); -- cgit v1.2.3