aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/synth/netlists-utils.ads7
-rw-r--r--src/synth/synth-context.adb2
-rw-r--r--src/synth/synth-environment-debug.adb20
-rw-r--r--src/synth/synth-environment.adb618
-rw-r--r--src/synth/synth-environment.ads46
-rw-r--r--src/synth/synth-expr.adb1
-rw-r--r--src/synth/synth-expr.ads9
-rw-r--r--src/synth/synth-inference.adb37
-rw-r--r--src/synth/synth-inference.ads2
-rw-r--r--src/synth/synth-stmts.adb48
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);