diff options
| -rw-r--r-- | src/synth/synth-environment.adb | 163 | ||||
| -rw-r--r-- | src/synth/synth-environment.ads | 8 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 16 |
3 files changed, 113 insertions, 74 deletions
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index 791c9cb09..5270c3c0e 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -159,10 +159,10 @@ package body Synth.Environment is return Assign_Table.Table (Asgn).Val.Asgns; end Get_Assign_Partial; - function Get_Assign_Partial (Asgn : Seq_Assign) return Seq_Assign_Value is + function Get_Seq_Assign_Value (Asgn : Seq_Assign) return Seq_Assign_Value is begin return Assign_Table.Table (Asgn).Val; - end Get_Assign_Partial; + end Get_Seq_Assign_Value; function New_Partial_Assign (Val : Net; Offset : Uns32) return Partial_Assign is @@ -1125,7 +1125,7 @@ package body Synth.Environment is -- assignments are poped. Set the offset and width to OFF and WD of the -- result. procedure Extract_Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; - P : in out Partial_Assign_Array; + P : in out Seq_Assign_Value_Array; N : out Net_Array; Off : in out Uns32; Wd : out Width) @@ -1139,34 +1139,61 @@ package body Synth.Environment is 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)); - N_Wd : Width; - N_Off : Uns32; - begin - if Pa.Offset < Off and then Min_Off < Off then - -- There is an assignment for an offset before the - -- current one. Handle it. - pragma Assert (Off >= Min_Off); - N_Off := Uns32'Max (Pa.Offset, Min_Off); - N_Wd := Get_Width (Pa.Value) - (N_Off - Pa.Offset); - Wd := Width'Min (N_Wd, Off - N_Off); - Off := N_Off; - elsif Pa.Offset = Off - or else (Off = Min_Off and then Pa.Offset < Off) - then - -- Reduce the width if the assignment is shorter. - Wd := Width'Min - (Wd, Get_Width (Pa.Value) - (Off - Pa.Offset)); - elsif Pa.Offset < Off + Wd then - -- Reduce the width when there is an assignment after - -- the current offset. - Wd := Pa.Offset - Off; - end if; - end; - end if; + case P (I).Is_Static is + when Unknown => + -- No assignment. + null; + when True => + declare + P_Wd : constant Width := P (I).Val.Typ.W; + begin + if Min_Off >= P_Wd then + -- No net can be beyond the width. + pragma Assert (Off = Uns32'Last); + pragma Assert (Wd = Width'Last); + return; + end if; + + if Off > Min_Off and then Off < P_Wd then + -- There is already an assignment for an offset after + -- the minimum. Stick to the min! + Wd := Off - Min_Off; + Off := Min_Off; + else + -- Either no assignment, or an assignment at Min_Off. + Off := Min_Off; + Wd := Width'Min (Wd, P_Wd - Min_Off); + end if; + end; + when False => + declare + pragma Assert (P (I).Asgns /= No_Partial_Assign); + Pa : Partial_Assign_Record + renames Partial_Assign_Table.Table (P (I).Asgns); + N_Wd : Width; + N_Off : Uns32; + begin + if Pa.Offset < Off and then Min_Off < Off then + -- There is an assignment for an offset before the + -- current one. Handle it. + pragma Assert (Off >= Min_Off); + N_Off := Uns32'Max (Pa.Offset, Min_Off); + N_Wd := Get_Width (Pa.Value) - (N_Off - Pa.Offset); + Wd := Width'Min (N_Wd, Off - N_Off); + Off := N_Off; + elsif Pa.Offset = Off + or else (Off = Min_Off and then Pa.Offset < Off) + then + -- Reduce the width if the assignment is shorter. + Wd := Width'Min + (Wd, Get_Width (Pa.Value) - (Off - Pa.Offset)); + elsif Pa.Offset < Off + Wd then + -- Reduce the width when there is an assignment after + -- the current offset. + Wd := Pa.Offset - Off; + end if; + end; + end case; end loop; -- No more assignments. @@ -1176,30 +1203,39 @@ package body Synth.Environment is -- 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)); + -- Default: no partial assignment. Get extract previous value. + N (I) := No_Net; + + case P (I).Is_Static is + when Unknown => + null; + when True => + N (I) := Context.Get_Partial_Memtyp_Net (P (I).Val, Off, Wd); + when False => + if Get_Partial_Offset (P (I).Asgns) <= Off then + declare + Asgn : constant Partial_Assign := P (I).Asgns; + Val : constant Net := Get_Partial_Value (Asgn); + P_W : constant Width := Get_Width (Val); + P_Off : constant Uns32 := Get_Partial_Offset (Asgn); + begin + -- There is a partial assignment. + if P_Off = Off and then P_W = Wd then + -- Full covered. + N (I) := Val; + P (I).Asgns := Get_Partial_Next (Asgn); + else + N (I) := Build_Extract (Ctxt, Val, Off - P_Off, Wd); + if P_Off + P_W = Off + Wd then + P (I).Asgns := Get_Partial_Next (Asgn); + end if; + end if; + end; + if P (I).Asgns = No_Partial_Assign then + P (I) := No_Seq_Assign_Value; end if; end if; - end; - else - -- No partial assignment. Get extract previous value. - N (I) := No_Net; - end if; + end case; end loop; end Extract_Merge_Partial_Assigns; @@ -1236,13 +1272,13 @@ package body Synth.Environment is procedure Merge_Assigns (Ctxt : Builders.Context_Acc; W : Wire_Id; Sel : Net; - F_Asgns : Partial_Assign; - T_Asgns : Partial_Assign; + F_Asgns : Seq_Assign_Value; + T_Asgns : Seq_Assign_Value; Stmt : Source.Syn_Src) is use Netlists.Gates; use Netlists.Gates_Ports; - P : Partial_Assign_Array (0 .. 1); + P : Seq_Assign_Value_Array (0 .. 1); N : Net_Array (0 .. 1); Min_Off : Uns32; Off : Uns32; @@ -1350,7 +1386,7 @@ package body Synth.Environment is function Get_Assign_Partial_Force (Asgn : Seq_Assign) return Partial_Assign is begin - return Get_Assign_Value_Force (Get_Assign_Partial (Asgn)); + return Get_Assign_Value_Force (Get_Seq_Assign_Value (Asgn)); end Get_Assign_Partial_Force; function Merge_Static_Assigns (Wid : Wire_Id; Tv, Fv : Seq_Assign_Value) @@ -1425,7 +1461,7 @@ package body Synth.Environment is then -- Has an assignment only for the false branch. W := Get_Wire_Id (F_Asgns); - Fv := Get_Assign_Partial (F_Asgns); + Fv := Get_Seq_Assign_Value (F_Asgns); Tv := No_Seq_Assign_Value; F_Asgns := Get_Assign_Chain (F_Asgns); elsif F_Asgns = No_Seq_Assign @@ -1435,14 +1471,14 @@ package body Synth.Environment is -- Has an assignment only for the true branch. W := Get_Wire_Id (T_Asgns); Fv := No_Seq_Assign_Value; - Tv := Get_Assign_Partial (T_Asgns); + Tv := Get_Seq_Assign_Value (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); - Fv := Get_Assign_Partial (F_Asgns); - Tv := Get_Assign_Partial (T_Asgns); + Fv := Get_Seq_Assign_Value (F_Asgns); + Tv := Get_Seq_Assign_Value (T_Asgns); T_Asgns := Get_Assign_Chain (T_Asgns); F_Asgns := Get_Assign_Chain (F_Asgns); end if; @@ -1451,10 +1487,7 @@ package body Synth.Environment is Merge_Partial_Assignments (Ctxt, Fv); Merge_Partial_Assignments (Ctxt, Tv); if not Merge_Static_Assigns (W, Tv, Fv) then - Merge_Assigns (Ctxt, W, Sel, - Get_Assign_Value_Force (Fv), - Get_Assign_Value_Force (Tv), - Stmt); + Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Stmt); end if; end loop; diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index f6d936083..ec76f515a 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -167,7 +167,11 @@ package Synth.Environment is type Partial_Assign is private; No_Partial_Assign : constant Partial_Assign; + type Seq_Assign_Value is private; + No_Seq_Assign_Value : constant Seq_Assign_Value; + function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign; + function Get_Seq_Assign_Value (Asgn : Seq_Assign) return Seq_Assign_Value; -- 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; @@ -177,6 +181,8 @@ package Synth.Environment is type Partial_Assign_Array is array (Int32 range <>) of Partial_Assign; + type Seq_Assign_Value_Array is array (Int32 range <>) of Seq_Assign_Value; + type Partial_Assign_List is limited private; procedure Partial_Assign_Init (List : out Partial_Assign_List); @@ -193,7 +199,7 @@ package Synth.Environment is -- assignments are poped. Set the offset and width to OFF and WD of the -- result. procedure Extract_Merge_Partial_Assigns (Ctxt : Builders.Context_Acc; - P : in out Partial_Assign_Array; + P : in out Seq_Assign_Value_Array; N : out Net_Array; Off : in out Uns32; Wd : out Width); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index e94122674..1666bcf24 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -907,9 +907,9 @@ package body Synth.Stmts is pragma Assert (Idx = Arr'Last + 1); end Fill_Wire_Id_Array; - type Partial_Assign_Array_Acc is access Partial_Assign_Array; - procedure Free_Partial_Assign_Array is new Ada.Unchecked_Deallocation - (Partial_Assign_Array, Partial_Assign_Array_Acc); + type Seq_Assign_Value_Array_Acc is access Seq_Assign_Value_Array; + procedure Free_Seq_Assign_Value_Array is new Ada.Unchecked_Deallocation + (Seq_Assign_Value_Array, Seq_Assign_Value_Array_Acc); procedure Synth_Case_Statement_Dynamic (C : in out Seq_Context; Stmt : Node; Sel : Valtyp) @@ -933,7 +933,7 @@ package body Synth.Stmts is Choice_Idx : Natural; Case_El : Case_Element_Array_Acc; - Pasgns : Partial_Assign_Array_Acc; + Pasgns : Seq_Assign_Value_Array_Acc; Nets : Net_Array_Acc; Nbr_Wires : Natural; @@ -1025,7 +1025,7 @@ package body Synth.Stmts is -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); - Pasgns := new Partial_Assign_Array (1 .. Int32 (Alts'Last)); + Pasgns := new Seq_Assign_Value_Array (1 .. Int32 (Alts'Last)); Nets := new Net_Array (1 .. Int32 (Alts'Last)); Sel_Net := Get_Net (Sel); @@ -1048,10 +1048,10 @@ package body Synth.Stmts is -- value. if Get_Wire_Id (Alts (I).Asgns) = Wi then Pasgns (Int32 (I)) := - Get_Assign_Partial_Force (Alts (I).Asgns); + Get_Seq_Assign_Value (Alts (I).Asgns); Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns); else - Pasgns (Int32 (I)) := No_Partial_Assign; + Pasgns (Int32 (I)) := No_Seq_Assign_Value; end if; end loop; @@ -1111,7 +1111,7 @@ package body Synth.Stmts is Free_Choice_Data_Array (Choice_Data); Free_Annex_Array (Annex_Arr); Free_Alternative_Data_Array (Alts); - Free_Partial_Assign_Array (Pasgns); + Free_Seq_Assign_Value_Array (Pasgns); Free_Net_Array (Nets); end Synth_Case_Statement_Dynamic; |