aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2020-05-03 10:14:10 +0200
committerTristan Gingold <tgingold@free.fr>2020-05-04 19:04:07 +0200
commita7fce446f6334b4e791026b99987987b835d78a5 (patch)
tree104062091af260ee09821910722ab462a6e6a502
parentdbbd98a06f7802cc309e2884f7dfabf71942c115 (diff)
downloadghdl-a7fce446f6334b4e791026b99987987b835d78a5.tar.gz
ghdl-a7fce446f6334b4e791026b99987987b835d78a5.tar.bz2
ghdl-a7fce446f6334b4e791026b99987987b835d78a5.zip
synth: partial refactoring to improve handling of controls in case statements.
-rw-r--r--src/synth/synth-environment.adb163
-rw-r--r--src/synth/synth-environment.ads8
-rw-r--r--src/synth/synth-stmts.adb16
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;