synth: handle partial assignments in case statements.

3 files changed, 95 insertions, 44 deletions

diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 1174c204b..41e6140ac 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -19,7 +19,6 @@
 --  MA 02110-1301, USA.
 
 with Netlists.Builders; use Netlists.Builders;
-with Netlists.Utils; use Netlists.Utils;
 with Netlists.Concats;
 with Errorout; use Errorout;
 with Synth.Inference;
@@ -574,18 +573,6 @@ package body Synth.Environment is
       end case;
    end Get_Current_Value;
 
-   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 (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)
@@ -767,10 +754,6 @@ package body Synth.Environment is
       end loop;
    end Extract_Merge_Partial_Assigns;
 
-   type Partial_Assign_List is record
-      First, Last : Partial_Assign;
-   end record;
-
    procedure Partial_Assign_Init (List : out Partial_Assign_List) is
    begin
       List := (First | Last => No_Partial_Assign);
diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index 6b817ff00..ea6befb9b 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -22,6 +22,7 @@ with Types; use Types;
 with Dyn_Tables;
 with Tables;
 with Netlists; use Netlists;
+with Netlists.Utils; use Netlists.Utils;
 with Netlists.Builders;
 with Synth.Source;
 
@@ -69,10 +70,6 @@ package Synth.Environment is
    function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id)
                               return Net;
 
-   --  The last assigned value to WID.
-   function Get_Last_Assigned_Value
-     (Ctxt : Builders.Context_Acc; Wid : Wire_Id) return Net;
-
    function Get_Current_Assign_Value
      (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width)
      return Net;
@@ -124,6 +121,38 @@ package Synth.Environment is
      (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src);
 
    procedure Finalize_Assignments (Ctxt : Builders.Context_Acc);
+
+   --  For low-level phi merge.
+   type Partial_Assign is private;
+   No_Partial_Assign : constant Partial_Assign;
+
+   function Get_Assign_Partial (Asgn : Seq_Assign) return Partial_Assign;
+
+   function New_Partial_Assign (Val : Net; Offset : Uns32)
+                               return Partial_Assign;
+
+   type Partial_Assign_Array is array (Int32 range <>) of Partial_Assign;
+
+   type Partial_Assign_List is limited private;
+
+   procedure Partial_Assign_Init (List : out Partial_Assign_List);
+   procedure Partial_Assign_Append (List : in out Partial_Assign_List;
+                                    Pasgn : Partial_Assign);
+   procedure Merge_Partial_Assigns (Ctxt : Builders.Context_Acc;
+                                    W : Wire_Id;
+                                    List : in out Partial_Assign_List);
+
+   --  P is an array of Partial_Assign.  Each element is a list
+   --  of partial assign from a different basic block.
+   --  Extract the value to nets N of the maximal partial assignment starting
+   --  at offset OFF for all partial assignments.  Fully handled partial
+   --  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;
+                                            N : out Net_Array;
+                                            Off : in out Uns32;
+                                            Wd : out Width);
 private
    type Wire_Id is new Uns32;
    No_Wire_Id : constant Wire_Id := 0;
@@ -136,7 +165,9 @@ private
    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 Partial_Assign_List is record
+      First, Last : Partial_Assign;
+   end record;
 
    type Conc_Assign is new Uns32;
    No_Conc_Assign : constant Conc_Assign := 0;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 9c309345e..a97a00558 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -721,6 +721,10 @@ package body Synth.Stmts is
       Res := Els (Els'First).Val;
    end Synth_Case;
 
+   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);
+
    procedure Synth_Case_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
    is
       use Vhdl.Sem_Expr;
@@ -742,6 +746,8 @@ package body Synth.Stmts is
       Choice_Idx : Natural;
 
       Case_El : Case_Element_Array_Acc;
+      Pasgns : Partial_Assign_Array_Acc;
+      Nets : Net_Array_Acc;
 
       Nbr_Wires : Natural;
       Wires : Wire_Id_Array_Acc;
@@ -847,48 +853,77 @@ 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));
+      Nets := new Net_Array (1 .. Int32 (Alts'Last));
+
       Sel_Net := Get_Net (Sel);
 
       --  For each wire, compute the result.
       for I in Wires'Range loop
          declare
             Wi : constant Wire_Id := Wires (I);
-            Last_Val : constant Net :=
-              Get_Last_Assigned_Value (Build_Context, Wi);
+            Last_Val : Net;
             Res : Net;
             Default : Net;
             C : Natural;
+            Min_Off, Off : Uns32;
+            Wd : Width;
+            List : Partial_Assign_List;
          begin
             --  Extract the value for each alternative.
-            for Alt of Alts.all loop
+            for I in Alts'Range loop
                --  If there is an assignment to Wi in Alt, it will define the
                --  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 (Build_Context, Alt.Asgns);
-                  Alt.Asgns := Get_Assign_Chain (Alt.Asgns);
+               if Get_Wire_Id (Alts (I).Asgns) = Wi then
+                  Pasgns (Int32 (I)) := Get_Assign_Partial (Alts (I).Asgns);
+                  Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns);
                else
-                  Alt.Val := Last_Val;
+                  Pasgns (Int32 (I)) := No_Partial_Assign;
                end if;
             end loop;
 
-            --  Build the map between choices and values.
-            for J in Annex_Arr'Range loop
-               C := Natural (Annex_Arr (J));
-               Case_El (J) := (Sel => Choice_Data (C).Val,
-                               Val => Alts (Choice_Data (C).Alt).Val);
-            end loop;
+            Partial_Assign_Init (List);
+            Min_Off := 0;
+            loop
+               Off := Min_Off;
+               Extract_Merge_Partial_Assigns
+                 (Build_Context, Pasgns.all, Nets.all, Off, Wd);
+               exit when Off = Uns32'Last and Wd = Width'Last;
+
+               Last_Val := No_Net;
+               for I in Nets'Range loop
+                  if Nets (I) = No_Net then
+                     if Last_Val = No_Net then
+                        Last_Val := Get_Current_Assign_Value
+                          (Build_Context, Wi, Off, Wd);
+                     end if;
+                     Nets (I) := Last_Val;
+                  end if;
+               end loop;
 
-            --  Extract default value (for missing alternative).
-            if Others_Alt_Idx /= 0 then
-               Default := Alts (Others_Alt_Idx).Val;
-            else
-               Default := No_Net;
-            end if;
+               --  Build the map between choices and values.
+               for J in Annex_Arr'Range loop
+                  C := Natural (Annex_Arr (J));
+                  Case_El (J) := (Sel => Choice_Data (C).Val,
+                                  Val => Nets (Int32 (Choice_Data (C).Alt)));
+               end loop;
+
+               --  Extract default value (for missing alternative).
+               if Others_Alt_Idx /= 0 then
+                  Default := Nets (Int32 (Others_Alt_Idx));
+               else
+                  Default := No_Net;
+               end if;
+
+               --  Generate the muxes tree.
+               Synth_Case (Sel_Net, Case_El.all, Default, Res);
+
+               Partial_Assign_Append (List, New_Partial_Assign (Res, Off));
+               Min_Off := Off + Wd;
+            end loop;
 
-            --  Generate the muxes tree.
-            Synth_Case (Sel_Net, Case_El.all, Default, Res);
-            Phi_Assign (Build_Context, Wi, Res, 0);
+            Merge_Partial_Assigns (Build_Context, Wi, List);
          end;
       end loop;
 
@@ -898,6 +933,8 @@ 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_Net_Array (Nets);
    end Synth_Case_Statement;
 
    procedure Synth_Selected_Signal_Assignment