diff options
| -rw-r--r-- | src/synth/netlists-utils.ads | 7 | ||||
| -rw-r--r-- | src/synth/synth-context.adb | 2 | ||||
| -rw-r--r-- | src/synth/synth-environment-debug.adb | 20 | ||||
| -rw-r--r-- | src/synth/synth-environment.adb | 618 | ||||
| -rw-r--r-- | src/synth/synth-environment.ads | 46 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 1 | ||||
| -rw-r--r-- | src/synth/synth-expr.ads | 9 | ||||
| -rw-r--r-- | src/synth/synth-inference.adb | 37 | ||||
| -rw-r--r-- | src/synth/synth-inference.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 48 |
10 files changed, 608 insertions, 182 deletions
diff --git a/src/synth/netlists-utils.ads b/src/synth/netlists-utils.ads index bd8bd3e1c..d98eca7ac 100644 --- a/src/synth/netlists-utils.ads +++ b/src/synth/netlists-utils.ads @@ -17,8 +17,14 @@ -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Ada.Unchecked_Deallocation; package Netlists.Utils is + type Net_Array is array (Int32 range <>) of Net; + type Net_Array_Acc is access Net_Array; + procedure Free_Net_Array is new Ada.Unchecked_Deallocation + (Net_Array, Net_Array_Acc); + function Get_Nbr_Inputs (Inst : Instance) return Port_Nbr; function Get_Nbr_Outputs (Inst : Instance) return Port_Nbr; function Get_Nbr_Params (Inst : Instance) return Param_Nbr; @@ -55,4 +61,5 @@ package Netlists.Utils is -- Unlink all unused instances of M. procedure Remove_Unused_Instances (M : Module); + end Netlists.Utils; diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index be229c4cd..49a5e54ef 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -338,7 +338,7 @@ package body Synth.Context is begin case Val.Kind is when Value_Wire => - return Get_Current_Value (Val.W); + return Get_Current_Value (Build_Context, Val.W); when Value_Net => return Val.N; when Value_Mux2 => diff --git a/src/synth/synth-environment-debug.adb b/src/synth/synth-environment-debug.adb index fae810429..ca7c989b8 100644 --- a/src/synth/synth-environment-debug.adb +++ b/src/synth/synth-environment-debug.adb @@ -48,16 +48,28 @@ package body Synth.Environment.Debug is end if; end Dump_Value; Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); + P : Partial_Assign; begin Put ("Assign" & Seq_Assign'Image (Asgn)); - Put (" Id:" & Wire_Id'Image (Rec.Id)); + Put (" Wire Id:" & Wire_Id'Image (Rec.Id)); Put (", prev_assign:" & Seq_Assign'Image (Rec.Prev)); Put (", phi:" & Phi_Id'Image (Rec.Phi)); Put (", chain:" & Seq_Assign'Image (Rec.Chain)); New_Line; - Put (" value: "); - Dump_Value (Rec.Value); - New_Line; + Put_Line (" value:"); + P := Rec.Asgns; + while P /= No_Partial_Assign loop + declare + Pasgn : Partial_Assign_Record renames + Partial_Assign_Table.Table (P); + begin + Put (" off:" & Uns32'Image (Pasgn.Offset)); + Put (", "); + Dump_Value (Pasgn.Value); + New_Line; + P := Pasgn.Next; + end; + end loop; end Dump_Assign; procedure Dump_Phi (Id : Phi_Id) diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index d6f64e21f..1ae10f951 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -20,7 +20,6 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Utils; use Netlists.Utils; -with Netlists.Gates; use Netlists.Gates; with Errorout; use Errorout; with Synth.Inference; with Synth.Errors; use Synth.Errors; @@ -28,6 +27,10 @@ with Vhdl.Nodes; with Vhdl.Errors; use Vhdl.Errors; package body Synth.Environment is + function Get_Current_Assign_Value + (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width) + return Net; + procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True) is begin Wire_Id_Table.Table (Wid).Mark_Flag := Mark; @@ -79,6 +82,26 @@ package body Synth.Environment is Assign_Table.Table (Asgn).Chain := Chain; end Set_Assign_Chain; + function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign is + begin + return Assign_Table.Table (Asgn).Asgns; + end Get_Assign_Partial; + + function Get_Partial_Offset (Asgn : Partial_Assign) return Uns32 is + begin + return Partial_Assign_Table.Table (Asgn).Offset; + end Get_Partial_Offset; + + function Get_Partial_Value (Asgn : Partial_Assign) return Net is + begin + return Partial_Assign_Table.Table (Asgn).Value; + end Get_Partial_Value; + + function Get_Partial_Next (Asgn : Partial_Assign) return Partial_Assign is + begin + return Partial_Assign_Table.Table (Asgn).Next; + end Get_Partial_Next; + function Current_Phi return Phi_Id is begin return Phis_Table.Last; @@ -131,7 +154,7 @@ package body Synth.Environment is Conc_Assign_Table.Table (Asgn).Next := Chain; end Set_Conc_Chain; - procedure Add_Conc_Assign_Partial + procedure Add_Conc_Assign (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src) is Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); @@ -142,97 +165,6 @@ package body Synth.Environment is Stmt => Stmt)); Wire_Rec.Final_Assign := Conc_Assign_Table.Last; Wire_Rec.Nbr_Final_Assign := Wire_Rec.Nbr_Final_Assign + 1; - end Add_Conc_Assign_Partial; - - function Is_Partial_Assignment (Val : Net; Prev_Val : Net) return Boolean - is - Inst : Instance; - V : Net; - begin - if Val = Prev_Val then - -- This particular case is a loop. - return False; - end if; - - V := Val; - loop - Inst := Get_Parent (V); - if Get_Id (Inst) = Id_Insert then - V := Get_Input_Net (Inst, 0); - else - return V = Prev_Val; - end if; - end loop; - end Is_Partial_Assignment; - - procedure Add_Conc_Assign_Comb - (Wid : Wire_Id; Val : Net; Stmt : Source.Syn_Src) - is - Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); - begin - -- Check for partial assignment. - if Is_Partial_Assignment (Val, Wire_Rec.Gate) then - declare - Wd : constant Width := Get_Width (Val); - Idx : Uns32; - Len : Width; - Inst : Instance; - V : Net; - Ins_Idx : Uns32; - Ins_Inp : Net; - Ins_Wd : Width; - begin - -- Sweep all the bits. - Idx := 0; - while Idx < Wd loop - -- We are interested in bits from Idx to the end. - Len := Wd - Idx; - V := Val; - loop - Inst := Get_Parent (V); - if Get_Id (Inst) = Id_Insert then - Ins_Idx := Get_Param_Uns32 (Inst, 0); - Ins_Inp := Get_Input_Net (Inst, 1); - Ins_Wd := Get_Width (Ins_Inp); - if Idx < Ins_Idx then - -- Consider bits before this insert; continue. - Len := Ins_Idx - Idx; - elsif Idx >= Ins_Idx + Ins_Wd then - -- Already handled; continue. - null; - else - -- Partially handled. - Len := Ins_Idx + Ins_Wd - Idx; - if Len = Ins_Wd and then Idx = Ins_Idx then - -- Fully convered by this insert. - Add_Conc_Assign_Partial (Wid, Ins_Inp, Idx, Stmt); - else - -- TODO: extract bits from ins_inp. - raise Internal_Error; - end if; - Idx := Idx + Len; - exit; - end if; - -- Check with next insert gate. - V := Get_Input_Net (Inst, 0); - else - -- Not assigned. - pragma Assert (V = Wire_Rec.Gate); - Idx := Idx + Len; - exit; - end if; - end loop; - end loop; - end; - else - Add_Conc_Assign_Partial (Wid, Val, 0, Stmt); - end if; - end Add_Conc_Assign_Comb; - - procedure Add_Conc_Assign - (Wid : Wire_Id; Val : Net; Stmt : Source.Syn_Src) is - begin - Add_Conc_Assign_Partial (Wid, Val, 0, Stmt); end Add_Conc_Assign; -- This procedure is called after each concurrent statement to assign @@ -254,28 +186,33 @@ package body Synth.Environment is Outport : constant Net := Wire_Rec.Gate; -- Must be connected to an Id_Output or Id_Signal pragma Assert (Outport /= No_Net); - Gate_Inst : Instance; - Gate_In : Input; - Drv : Net; + P : Partial_Assign; begin - Gate_Inst := Get_Parent (Outport); - Gate_In := Get_Input (Gate_Inst, 0); - Drv := Get_Driver (Gate_In); - case Wire_Rec.Kind is when Wire_Output | Wire_Signal | Wire_Variable => - if Drv /= No_Net then - -- Output already assigned - raise Internal_Error; - end if; + -- Check output is not already assigned. + pragma Assert + (Get_Input_Net (Get_Parent (Outport), 0) = No_Net); - Inference.Infere (Ctxt, Wid, Asgn_Rec.Value, Outport, Stmt); when others => raise Internal_Error; end case; + 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); + begin + Inference.Infere + (Ctxt, Wid, Pa.Value, Pa.Offset, Outport, Stmt); + P := Pa.Next; + end; + end loop; + Asgn := Asgn_Rec.Chain; end; end loop; @@ -569,47 +506,284 @@ package body Synth.Environment is return Res; end Sort_Phi; - function Get_Assign_Value (Asgn : Seq_Assign) return Net + function Get_Assign_Value (Ctxt : Builders.Context_Acc; Asgn : Seq_Assign) + return Net is Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn); + Wid_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Asgn_Rec.Id); + W : constant Width := Get_Width (Wid_Rec.Gate); begin - case Wire_Id_Table.Table (Asgn_Rec.Id).Kind is + case Wid_Rec.Kind is when Wire_Signal | Wire_Output | Wire_Inout | Wire_Variable => - return Asgn_Rec.Value; + null; when Wire_Input | Wire_None => raise Internal_Error; end case; + + -- Cannot be empty. + pragma Assert (Asgn_Rec.Asgns /= No_Partial_Assign); + + -- Simple case: fully assigned. + declare + Pasgn : Partial_Assign_Record renames + Partial_Assign_Table.Table (Asgn_Rec.Asgns); + begin + if Pasgn.Offset = 0 and then Get_Width (Pasgn.Value) = W then + return Pasgn.Value; + end if; + end; + + return Get_Current_Assign_Value (Ctxt, Asgn_Rec.Id, 0, W); end Get_Assign_Value; - function Get_Current_Value (Wid : Wire_Id) return Net + function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id) + return Net is Wid_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); begin case Wid_Rec.Kind is when Wire_Variable => if Wid_Rec.Cur_Assign = No_Seq_Assign then + -- The variable was never assigned, so the variable value is + -- the initial value. + -- FIXME: use initial value directly ? return Wid_Rec.Gate; else - return Assign_Table.Table (Wid_Rec.Cur_Assign).Value; + return Get_Assign_Value (Ctxt, Wid_Rec.Cur_Assign); end if; when Wire_Signal | Wire_Output | Wire_Inout | Wire_Input => + -- For signals, always read the previous value. return Wid_Rec.Gate; when Wire_None => raise Internal_Error; end case; end Get_Current_Value; - function Get_Last_Assigned_Value (Wid : Wire_Id) return Net + function Get_Last_Assigned_Value + (Ctxt : Builders.Context_Acc; Wid : Wire_Id) return Net is Wid_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); begin if Wid_Rec.Cur_Assign = No_Seq_Assign then return Wid_Rec.Gate; else - return Get_Assign_Value (Wid_Rec.Cur_Assign); + return Get_Assign_Value (Ctxt, Wid_Rec.Cur_Assign); end if; end Get_Last_Assigned_Value; + -- Get the current value of W for WD bits at offset OFF. + function Get_Current_Assign_Value + (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width) + return Net + is + Wire : Wire_Id_Record renames Wire_Id_Table.Table (Wid); + First_Seq : Seq_Assign; + begin + -- Latest seq assign + First_Seq := Wire.Cur_Assign; + + -- If no seq assign, return current value. + if First_Seq = No_Seq_Assign then + if Off = 0 and then Wd = Get_Width (Wire.Gate) then + return Wire.Gate; + else + return Build_Extract (Ctxt, Wire.Gate, Off, Wd); + end if; + 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); + V : Net; + begin + if Get_Partial_Offset (P) = Off then + V := Get_Partial_Value (P); + if Get_Width (V) = Wd then + return V; + end if; + end if; + end; + + -- Build a vector + declare + Vec : Net_Tables.Instance; + Seq : Seq_Assign; + P : Partial_Assign; + Cur_Off : Uns32; + Cur_Wd : Width; + + Last : Int32; + Inst : Instance; + Res : Net; + begin + Net_Tables.Init (Vec); + Cur_Off := Off; + Cur_Wd := Wd; + pragma Assert (Wd > 0); + loop + -- Find value at CUR_OFF from assignment. + Seq := First_Seq; + P := Get_Assign_Partial (Seq); + loop + pragma Assert (P /= No_Partial_Assign); + declare + Pr : Partial_Assign_Record renames + Partial_Assign_Table.Table (P); + Pw : constant Width := Get_Width (Pr.Value); + begin + if Pr.Offset <= Cur_Off + and then Pr.Offset + Pw > Cur_Off + then + -- Found. + if Pr.Offset = Cur_Off and then Pw = Cur_Wd then + -- No need to extract. + Net_Tables.Append (Vec, Pr.Value); + else + Cur_Wd := Width'Min + (Cur_Wd, Pw - (Cur_Off - Pr.Offset)); + Net_Tables.Append + (Vec, Build_Extract (Ctxt, Pr.Value, + Cur_Off - Pr.Offset, Cur_Wd)); + end if; + exit; + end if; + if Pr.Offset + Pw < Cur_Off then + -- Next partial; + P := Pr.Next; + elsif Pr.Offset > Cur_Off + and then Pr.Offset < Cur_Off + Cur_Wd + then + -- Reduce WD and continue to search in previous; + Cur_Wd := Pr.Offset - Cur_Off; + P := No_Partial_Assign; + else + -- Continue to search in previous. + P := No_Partial_Assign; + end if; + if P = No_Partial_Assign then + Seq := Get_Assign_Prev (Seq); + if Seq = No_Seq_Assign then + -- Extract from gate. + Net_Tables.Append + (Vec, Build_Extract (Ctxt, Wire.Gate, + Cur_Off, Cur_Wd)); + exit; + end if; + end if; + end; + end loop; + + Cur_Off := Cur_Off + Cur_Wd; + Cur_Wd := Wd - (Cur_Off - Off); + exit when Cur_Off = Off + Wd; + end loop; + + -- Concat + Last := Net_Tables.Last (Vec); + case Last is + when Int32'First .. 0 => + raise Internal_Error; + when 1 => + Res := Vec.Table (1); + when 2 => + Res := Build_Concat2 (Ctxt, Vec.Table (1), Vec.Table (2)); + when 3 => + Res := Build_Concat3 + (Ctxt, Vec.Table (1), Vec.Table (2), Vec.Table (3)); + when 4 => + Res := Build_Concat4 + (Ctxt, + Vec.Table (1), Vec.Table (2), Vec.Table (3), Vec.Table (4)); + when 5 .. Int32'Last => + Res := Build_Concatn (Ctxt, Wd, Uns32 (Last)); + Inst := Get_Parent (Res); + for I in Net_Tables.First .. Last loop + Connect (Get_Input (Inst, Port_Idx (I - 1)), Vec.Table (I)); + end loop; + end case; + -- Free the vector and return it. + Net_Tables.Free (Vec); + return Res; + end; + end Get_Current_Assign_Value; + + procedure Merge_Assigns (Ctxt : Builders.Context_Acc; + W : Wire_Id; + Sel : Net; + F_Asgns : Partial_Assign; + T_Asgns : Partial_Assign) + is + P : Partial_Assign_Array (0 .. 1); + N : Net_Array (0 .. 1); + Min_Off : Uns32; + Off : Uns32; + Wd : Width; + Res : Net; + begin + P := (0 => F_Asgns, 1 => T_Asgns); + + Min_Off := 0; + loop + -- Look for the partial assign with the least offset (but still + -- greather than Min_Off). Also extract the least width. + Off := Uns32'Last; + Wd := Width'Last; + for I in P'Range loop + if P (I) /= No_Partial_Assign then + declare + Pa : Partial_Assign_Record + renames Partial_Assign_Table.Table (P (I)); + begin + if Pa.Offset <= Off then + Off := Uns32'Max (Pa.Offset, Min_Off); + Wd := Width'Min + (Wd, Get_Width (Pa.Value) - (Off - Pa.Offset)); + end if; + end; + end if; + end loop; + + -- No more assignments. + if Off = Uns32'Last and Wd = Width'Last then + return; + end if; + + -- Get the values for that offset/width. Update lists. + for I in P'Range loop + if P (I) /= No_Partial_Assign + and then Get_Partial_Offset (P (I)) <= Off + then + declare + Val : constant Net := Get_Partial_Value (P (I)); + P_W : constant Width := Get_Width (Val); + P_Off : constant Uns32 := Get_Partial_Offset (P (I)); + begin + -- There is a partial assignment. + if P_Off = Off and then P_W = Wd then + -- Full covered. + N (I) := Val; + P (I) := Get_Partial_Next (P (I)); + else + N (I) := Build_Extract (Ctxt, Val, Off - P_Off, Wd); + if P_Off + P_W = Off + Wd then + P (I) := Get_Partial_Next (P (I)); + end if; + end if; + end; + else + -- No partial assignment. Get extract previous value. + N (I) := Get_Current_Assign_Value (Ctxt, W, Off, Wd); + end if; + end loop; + + -- Build mux. + Res := Netlists.Builders.Build_Mux2 (Ctxt, Sel, N (0), N (1)); + Phi_Assign (Ctxt, W, Res, Off); + + Min_Off := Off + Wd; + end loop; + end Merge_Assigns; + -- Add muxes for two lists T and F of assignments. procedure Merge_Phis (Ctxt : Builders.Context_Acc; Sel : Net; @@ -618,8 +792,7 @@ package body Synth.Environment is T_Asgns : Seq_Assign; F_Asgns : Seq_Assign; W : Wire_Id; - Te, Fe : Net; - Res : Net; + Tp, Fp : Partial_Assign; begin T_Asgns := Sort_Phi (T); F_Asgns := Sort_Phi (F); @@ -632,8 +805,8 @@ package body Synth.Environment is then -- Has an assignment only for the false branch. W := Get_Wire_Id (F_Asgns); - Te := Get_Last_Assigned_Value (W); - Fe := Get_Assign_Value (F_Asgns); + Fp := Get_Assign_Partial (F_Asgns); + Tp := No_Partial_Assign; F_Asgns := Get_Assign_Chain (F_Asgns); elsif F_Asgns = No_Seq_Assign or else (T_Asgns /= No_Seq_Assign @@ -641,20 +814,20 @@ package body Synth.Environment is then -- Has an assignment only for the true branch. W := Get_Wire_Id (T_Asgns); - Te := Get_Assign_Value (T_Asgns); - Fe := Get_Last_Assigned_Value (W); + Fp := No_Partial_Assign; + Tp := Get_Assign_Partial (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); - Te := Get_Assign_Value (T_Asgns); - Fe := Get_Assign_Value (F_Asgns); + Fp := Get_Assign_Partial (F_Asgns); + Tp := Get_Assign_Partial (T_Asgns); T_Asgns := Get_Assign_Chain (T_Asgns); F_Asgns := Get_Assign_Chain (F_Asgns); end if; - Res := Netlists.Builders.Build_Mux2 (Ctxt, Sel, Fe, Te); - Phi_Assign (W, Res); + Merge_Assigns (Ctxt, W, Sel, Fp, Tp); + end loop; end Merge_Phis; @@ -672,25 +845,205 @@ package body Synth.Environment is P.Nbr := P.Nbr + 1; end Phi_Insert_Assign; - procedure Phi_Assign (Dest : Wire_Id; Val : Net) + -- Check consistency: + -- - ordered. + -- - no overlaps. + procedure Check (Seq : Seq_Assign) + is + Seq_Asgn : Seq_Assign_Record renames Assign_Table.Table (Seq); + Prev_El : Partial_Assign; + begin + Prev_El := Seq_Asgn.Asgns; + if Prev_El = No_Partial_Assign then + -- It's empty! + return; + end if; + loop + declare + Prev : Partial_Assign_Record + renames Partial_Assign_Table.Table (Prev_El); + El : constant Partial_Assign := Prev.Next; + begin + if El = No_Partial_Assign then + -- Done. + exit; + end if; + declare + Cur : Partial_Assign_Record + renames Partial_Assign_Table.Table (El); + begin + -- Check no overlap. + if Cur.Offset < Prev.Offset + Get_Width (Prev.Value) then + raise Internal_Error; + end if; + end; + Prev_El := El; + end; + end loop; + end Check; + + -- Insert partial assignment ASGN to list SEQ. + -- Deal with overrides. Place it correctly. + procedure Insert_Partial_Assign + (Ctxt : Builders.Context_Acc; Seq : Seq_Assign; Asgn : Partial_Assign) + is + V : Partial_Assign_Record renames Partial_Assign_Table.Table (Asgn); + V_Next : constant Uns32 := V.Offset + Get_Width (V.Value); + Seq_Asgn : Seq_Assign_Record renames Assign_Table.Table (Seq); + El, Last_El : Partial_Assign; + Inserted : Boolean; + begin + Inserted := False; + Last_El := No_Partial_Assign; + El := Seq_Asgn.Asgns; + while El /= No_Partial_Assign loop + declare + P : Partial_Assign_Record renames Partial_Assign_Table.Table (El); + P_Next : constant Uns32 := P.Offset + Get_Width (P.Value); + begin + if V.Offset < P_Next and then V_Next > P.Offset then + -- Override. + if V.Offset <= P.Offset and then V_Next >= P_Next then + -- Full override: + -- V.Off V.Next + -- |------------------|| + -- |----------|| + -- P.Off P.Next + -- Remove it. + -- FIXME: free it. + if not Inserted then + if Last_El /= No_Partial_Assign then + Partial_Assign_Table.Table (Last_El).Next := Asgn; + else + Seq_Asgn.Asgns := Asgn; + end if; + V.Next := P.Next; + Inserted := True; + Last_El := Asgn; + else + pragma Assert (Last_El /= No_Partial_Assign); + Partial_Assign_Table.Table (Last_El).Next := P.Next; + end if; + elsif V.Offset <= P.Offset and then V_Next < P_Next then + -- Overrides the beginning of EL. + -- V.Off V.Next + -- |--------------|| + -- |----------|| + -- P.Off P.Next + -- Shrink EL. + P.Value := Build_Extract (Ctxt, P.Value, + Off => V_Next - P.Offset, + W => P_Next - V_Next); + P.Offset := V_Next; + if not Inserted then + if Last_El /= No_Partial_Assign then + Partial_Assign_Table.Table (Last_El).Next := Asgn; + else + Seq_Asgn.Asgns := Asgn; + end if; + V.Next := El; + Inserted := True; + end if; + -- No more possible overlaps. + exit; + elsif V.Offset > P.Offset and then P_Next <= V_Next then + -- Overrides the end of EL. + -- V.Off V.Next + -- |------------------|| + -- |----------|| + -- P.Off P.Next + -- Shrink EL. + P.Value := Build_Extract (Ctxt, P.Value, + Off => 0, + W => V.Offset - P.Offset); + pragma Assert (not Inserted); + V.Next := P.Next; + P.Next := Asgn; + Last_El := Asgn; + Inserted := True; + elsif V.Offset > P.Offset and then V_Next < P_Next then + -- Contained within EL. + -- V.Off V.Next + -- |----------|| + -- |---------------|| + -- P.Off P.Next + -- Split EL. + pragma Assert (not Inserted); + Partial_Assign_Table.Append + ((Next => P.Next, + Value => Build_Extract (Ctxt, P.Value, + Off => V_Next - P.Offset, + W => P_Next - V_Next), + Offset => V_Next)); + V.Next := Partial_Assign_Table.Last; + P.Value := Build_Extract (Ctxt, P.Value, + Off => 0, + W => V.Offset - P.Offset); + P.Next := Asgn; + Inserted := True; + -- No more possible overlaps. + exit; + else + -- No other case. + raise Internal_Error; + end if; + else + if V.Offset < P.Offset then + -- Insert before P (if not already inserted). + if not Inserted then + if Last_El /= No_Partial_Assign then + Partial_Assign_Table.Table (Last_El).Next := Asgn; + else + Seq_Asgn.Asgns := Asgn; + end if; + V.Next := El; + Inserted := True; + end if; + exit; + elsif P.Next = No_Partial_Assign then + if not Inserted then + -- Insert after P. + P.Next := Asgn; + Inserted := True; + end if; + exit; + else + Last_El := El; + end if; + end if; + + El := P.Next; + end; + end loop; + pragma Assert (Inserted); + pragma Debug (Check (Seq)); + end Insert_Partial_Assign; + + procedure Phi_Assign + (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Val : Net; Offset : Uns32) is Cur_Asgn : constant Seq_Assign := Wire_Id_Table.Table (Dest).Cur_Assign; + Pasgn : Partial_Assign; begin + Partial_Assign_Table.Append ((Next => No_Partial_Assign, + Value => Val, + Offset => Offset)); + Pasgn := Partial_Assign_Table.Last; + 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, - Value => Val)); + Id => Dest, + Prev => Cur_Asgn, + Chain => No_Seq_Assign, + Asgns => Pasgn)); Wire_Id_Table.Table (Dest).Cur_Assign := Assign_Table.Last; Phi_Insert_Assign (Assign_Table.Last); else -- Overwrite. - -- FIXME: may need to merge in case of partial assignment. - Assign_Table.Table (Cur_Asgn).Value := Val; + Insert_Partial_Assign (Ctxt, Cur_Asgn, Pasgn); end if; end Phi_Assign; begin @@ -707,9 +1060,14 @@ begin Id => No_Wire_Id, Prev => No_Seq_Assign, Chain => No_Seq_Assign, - Value => No_Net)); + Asgns => No_Partial_Assign)); pragma Assert (Assign_Table.Last = No_Seq_Assign); + Partial_Assign_Table.Append ((Next => No_Partial_Assign, + Value => No_Net, + Offset => 0)); + pragma Assert (Partial_Assign_Table.Last = No_Partial_Assign); + Phis_Table.Append ((First => No_Seq_Assign, Nbr => 0)); pragma Assert (Phis_Table.Last = No_Phi_Id); diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index f57ab0ab6..604991dd5 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -19,6 +19,7 @@ -- MA 02110-1301, USA. with Types; use Types; +with Dyn_Tables; with Tables; with Netlists; use Netlists; with Netlists.Builders; @@ -65,10 +66,12 @@ package Synth.Environment is -- The current value of WID. For variables, this is the last assigned -- value. For signals, this is the initial value. - function Get_Current_Value (Wid : Wire_Id) return Net; + function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id) + return Net; -- The last assigned value to WID. - function Get_Last_Assigned_Value (Wid : Wire_Id) return Net; + function Get_Last_Assigned_Value + (Ctxt : Builders.Context_Acc; Wid : Wire_Id) return Net; -- Read and write the mark flag. function Get_Wire_Mark (Wid : Wire_Id) return Boolean; @@ -79,7 +82,9 @@ package Synth.Environment is function Get_Wire_Id (W : Seq_Assign) return Wire_Id; function Get_Assign_Chain (Asgn : Seq_Assign) return Seq_Assign; - function Get_Assign_Value (Asgn : Seq_Assign) return Net; + + function Get_Assign_Value (Ctxt : Builders.Context_Acc; Asgn : Seq_Assign) + return Net; type Phi_Type is private; @@ -103,15 +108,15 @@ package Synth.Environment is function Sort_Phi (P : Phi_Type) return Seq_Assign; -- In the current phi context, assign VAL to DEST. - procedure Phi_Assign (Dest : Wire_Id; Val : Net); + procedure Phi_Assign + (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Val : Net; Offset : Uns32); -- Get current phi context. function Current_Phi return Phi_Id; pragma Inline (Current_Phi); - procedure Add_Conc_Assign (Wid : Wire_Id; Val : Net; Stmt : Source.Syn_Src); - procedure Add_Conc_Assign_Comb - (Wid : Wire_Id; Val : Net; Stmt : Source.Syn_Src); + procedure Add_Conc_Assign + (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src); procedure Finalize_Assignments (Ctxt : Builders.Context_Acc); private @@ -123,6 +128,11 @@ private type Seq_Assign is new Uns32; No_Seq_Assign : constant Seq_Assign := 0; + type Partial_Assign is new Uns32; + No_Partial_Assign : constant Partial_Assign := 0; + + type Partial_Assign_Array is array (Int32 range <>) of Partial_Assign; + type Conc_Assign is new Uns32; No_Conc_Assign : constant Conc_Assign := 0; @@ -173,8 +183,16 @@ private -- Next wire in the phi context. Chain : Seq_Assign; - -- Value assigned. + -- Values assigned. + Asgns : Partial_Assign; + end record; + + type Partial_Assign_Record is record + Next : Partial_Assign; + + -- Assignment at OFFSET. The width is set by the width of the value. Value : Net; + Offset : Uns32; end record; type Conc_Assign_Record is record @@ -213,9 +231,21 @@ private Table_Low_Bound => No_Seq_Assign, Table_Initial => 1024); + package Partial_Assign_Table is new Tables + (Table_Component_Type => Partial_Assign_Record, + Table_Index_Type => Partial_Assign, + Table_Low_Bound => No_Partial_Assign, + Table_Initial => 1024); + package Conc_Assign_Table is new Tables (Table_Component_Type => Conc_Assign_Record, Table_Index_Type => Conc_Assign, Table_Low_Bound => No_Conc_Assign, Table_Initial => 1024); + + package Net_Tables is new Dyn_Tables + (Table_Component_Type => Net, + Table_Index_Type => Int32, + Table_Low_Bound => 1, + Table_Initial => 32); end Synth.Environment; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 5c0abe189..a21309b47 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -40,7 +40,6 @@ with Synth.Environment; use Synth.Environment; with Netlists.Gates; use Netlists.Gates; with Netlists.Builders; use Netlists.Builders; -with Netlists.Utils; use Netlists.Utils; with Netlists.Locations; use Netlists.Locations; package body Synth.Expr is diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 06b824fe2..9292ab105 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -18,9 +18,11 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. -with Ada.Unchecked_Deallocation; with Types; use Types; + with Netlists; use Netlists; +with Netlists.Utils; use Netlists.Utils; + with Synth.Source; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; @@ -51,11 +53,6 @@ package Synth.Expr is function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node) return Value_Acc; - type Net_Array is array (Int32 range <>) of Net; - type Net_Array_Acc is access Net_Array; - procedure Free_Net_Array is new Ada.Unchecked_Deallocation - (Net_Array, Net_Array_Acc); - function Concat_Array (Arr : Net_Array_Acc) return Net; function Synth_Expression_With_Type diff --git a/src/synth/synth-inference.adb b/src/synth/synth-inference.adb index a6b4cd094..8ff6dc1a6 100644 --- a/src/synth/synth-inference.adb +++ b/src/synth/synth-inference.adb @@ -21,7 +21,6 @@ with Netlists.Utils; use Netlists.Utils; with Netlists.Gates; use Netlists.Gates; with Netlists.Gates_Ports; use Netlists.Gates_Ports; -with Types; use Types; package body Synth.Inference is -- DFF inference. @@ -177,9 +176,32 @@ package body Synth.Inference is end case; end Extract_Clock; + procedure Check_FF_Else (Els : Net; Prev_Val : Net; Off : Uns32) + is + Inst : Instance; + begin + if Els = Prev_Val then + if Off /= 0 then + raise Internal_Error; + end if; + return; + end if; + Inst := Get_Parent (Els); + if Get_Id (Inst) /= Id_Extract then + raise Internal_Error; + end if; + if Get_Param_Uns32 (Inst, 0) /= Off then + raise Internal_Error; + end if; + if Get_Input_Net (Inst, 0) /= Prev_Val then + raise Internal_Error; + end if; + end Check_FF_Else; + procedure Infere_FF (Ctxt : Context_Acc; Wid : Wire_Id; Prev_Val : Net; + Off : Uns32; Last_Mux : Instance; Clk : Net; Enable : Net; @@ -202,10 +224,8 @@ package body Synth.Inference is -- 1. Remove the mux that creates the loop (will be replaced by the -- dff). Disconnect (Sel); - if Get_Driver (I0) /= Prev_Val then - -- There must be no 'else' part for clock expression. - raise Internal_Error; - end if; + -- There must be no 'else' part for clock expression. + Check_FF_Else (Get_Driver (I0), Prev_Val, Off); -- Don't try to free driver of I0 as this is Prev_Val. Disconnect (I0); Data := Get_Driver (I1); @@ -316,12 +336,13 @@ package body Synth.Inference is Free_Instance (Last_Mux); - Add_Conc_Assign (Wid, Res, Stmt); + Add_Conc_Assign (Wid, Res, Off, Stmt); end Infere_FF; procedure Infere (Ctxt : Context_Acc; Wid : Wire_Id; Val : Net; + Off : Uns32; Prev_Val : Net; Stmt : Source.Syn_Src) is @@ -336,7 +357,7 @@ package body Synth.Inference is Find_Longest_Loop (Val, Prev_Val, Last_Mux, Len); if Len <= 0 then -- No logical loop or self assignment. - Add_Conc_Assign_Comb (Wid, Val, Stmt); + Add_Conc_Assign (Wid, Val, Off, Stmt); else -- So there is a logical loop. Sel := Get_Mux2_Sel (Last_Mux); @@ -346,7 +367,7 @@ package body Synth.Inference is raise Internal_Error; else -- Clock -> FF - Infere_FF (Ctxt, Wid, Prev_Val, Last_Mux, Clk, Enable, Stmt); + Infere_FF (Ctxt, Wid, Prev_Val, Off, Last_Mux, Clk, Enable, Stmt); end if; end if; end Infere; diff --git a/src/synth/synth-inference.ads b/src/synth/synth-inference.ads index 371932f3e..377b481ab 100644 --- a/src/synth/synth-inference.ads +++ b/src/synth/synth-inference.ads @@ -18,6 +18,7 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Types; use Types; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Synth.Environment; use Synth.Environment; @@ -30,6 +31,7 @@ package Synth.Inference is procedure Infere (Ctxt : Context_Acc; Wid : Wire_Id; Val : Net; + Off : Uns32; Prev_Val : Net; Stmt : Source.Syn_Src); end Synth.Inference; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 96efdca72..f37b1388e 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -48,7 +48,7 @@ with Vhdl.Annotations; use Vhdl.Annotations; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Netlists.Gates; -with Netlists.Utils; +with Netlists.Utils; use Netlists.Utils; with Netlists.Locations; use Netlists.Locations; package body Synth.Stmts is @@ -76,13 +76,15 @@ package body Synth.Stmts is end if; end Synth_Waveform; - procedure Synth_Assign - (Dest : Value_Acc; Val : Value_Acc; Loc : Source.Syn_Src) is + procedure Synth_Assign (Dest : Value_Acc; + Val : Value_Acc; + Offset : Uns32; + Loc : Source.Syn_Src) is begin pragma Assert (Dest.Kind = Value_Wire); - Phi_Assign - (Dest.W, - Get_Net (Synth_Subtype_Conversion (Val, Dest.Typ, Loc))); + Phi_Assign (Build_Context, Dest.W, + Get_Net (Synth_Subtype_Conversion (Val, Dest.Typ, Loc)), + Offset); end Synth_Assign; procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; @@ -136,20 +138,19 @@ package body Synth.Stmts is Synth_Indexed_Name (Syn_Inst, Target, Targ.Typ, Voff, Mul, Off, W); pragma Assert (Get_Type_Width (Val.Typ) = W); - Targ_Net := Get_Last_Assigned_Value (Targ.W); - Val_Net := Get_Net (Val); if Voff = No_Net then -- FIXME: check index. pragma Assert (Mul = 0); - V := Build_Insert (Build_Context, Targ_Net, Val_Net, Off); - Set_Location (V, Target); + Synth_Assign (Targ, Val, Off, Loc); else + Targ_Net := Get_Last_Assigned_Value (Build_Context, Targ.W); + Val_Net := Get_Net (Val); V := Build_Dyn_Insert (Build_Context, Targ_Net, Val_Net, Voff, Mul, Int32 (Off)); Set_Location (V, Target); + Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ), 0, Loc); end if; - Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ), Loc); end Synth_Indexed_Assignment; procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; @@ -164,7 +165,7 @@ package body Synth.Stmts is | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => - Synth_Assign (Get_Value (Syn_Inst, Target), Val, Loc); + Synth_Assign (Get_Value (Syn_Inst, Target), Val, 0, Loc); when Iir_Kind_Aggregate => Synth_Assignment_Aggregate (Syn_Inst, Target, Val, Loc); when Iir_Kind_Indexed_Name => @@ -190,18 +191,18 @@ package body Synth.Stmts is end if; Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ.Vbound, Res_Bnd, Inp, Step, Off, Wd); - Targ_Net := Get_Last_Assigned_Value (Targ.W); - V := Get_Net (Val); if Inp /= No_Net then + Targ_Net := Get_Last_Assigned_Value (Build_Context, Targ.W); + V := Get_Net (Val); Res := Build_Dyn_Insert (Build_Context, Targ_Net, V, Inp, Step, Off); + Set_Location (Res, Target); + Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El); + Synth_Assign + (Targ, Create_Value_Net (Res, Res_Type), 0, Loc); else - Res := Build_Insert - (Build_Context, Targ_Net, V, Uns32 (Off)); + Synth_Assign (Targ, Val, Uns32 (Off), Loc); end if; - Set_Location (Res, Target); - Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El); - Synth_Assign (Targ, Create_Value_Net (Res, Res_Type), Loc); end; when others => Error_Kind ("synth_assignment", Target); @@ -750,7 +751,8 @@ package body Synth.Stmts is for I in Wires'Range loop declare Wi : constant Wire_Id := Wires (I); - Last_Val : constant Net := Get_Last_Assigned_Value (Wi); + Last_Val : constant Net := + Get_Last_Assigned_Value (Build_Context, Wi); Res : Net; Default : Net; C : Natural; @@ -761,7 +763,7 @@ package body Synth.Stmts is -- value. Otherwise, use Last_Val, ie the last assignment -- before the case. if Get_Wire_Id (Alt.Asgns) = Wi then - Alt.Val := Get_Assign_Value (Alt.Asgns); + Alt.Val := Get_Assign_Value (Build_Context, Alt.Asgns); Alt.Asgns := Get_Assign_Chain (Alt.Asgns); else Alt.Val := Last_Val; @@ -784,7 +786,7 @@ package body Synth.Stmts is -- Generate the muxes tree. Synth_Case (Sel_Net, Case_El.all, Default, Res); - Phi_Assign (Wi, Res); + Phi_Assign (Build_Context, Wi, Res, 0); end; end loop; @@ -1358,7 +1360,6 @@ package body Synth.Stmts is function Synth_Psl_Sequence_Directive (Syn_Inst : Synth_Instance_Acc; Stmt : Node) return Net is - use Netlists.Utils; use Netlists.Gates; Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt); Init : Net; @@ -1416,7 +1417,6 @@ package body Synth.Stmts is is use PSL.Types; use PSL.NFAs; - use Netlists.Utils; use Netlists.Gates; NFA : constant PSL_NFA := Get_PSL_NFA (Stmt); Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt); |