synth: add syn_extract for dynamic slices.

6 files changed, 273 insertions, 63 deletions

diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index 054699233..14323413b 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -161,6 +161,27 @@ package body Netlists.Builders is
                      Typ => Param_Uns32)));
    end Create_Extract_Module;
 
+   procedure Create_Dyn_Extract_Module (Ctxt : Context_Acc)
+   is
+      Outputs : Port_Desc_Array (0 .. 0);
+      Inputs : Port_Desc_Array (0 .. 1);
+      Res : Module;
+   begin
+      Res := New_User_Module
+        (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("dyn_extract")),
+         Id_Extract, 2, 1, 2);
+      Ctxt.M_Dyn_Extract := Res;
+      Outputs := (0 => Create_Output ("o"));
+      Inputs := (0 => Create_Input ("i"),
+                 1 => Create_Input ("v"));
+      Set_Port_Desc (Res, Inputs, Outputs);
+      Set_Param_Desc
+        (Res, (0 => (New_Sname_Artificial (Get_Identifier ("step")),
+                     Typ => Param_Uns32),
+               1 => (New_Sname_Artificial (Get_Identifier ("offset")),
+                     Typ => Param_Uns32)));
+   end Create_Dyn_Extract_Module;
+
    procedure Create_Insert_Module (Ctxt : Context_Acc)
    is
       Outputs : Port_Desc_Array (0 .. 0);
@@ -337,6 +358,7 @@ package body Netlists.Builders is
       Create_Const_Modules (Res);
 
       Create_Extract_Module (Res);
+      Create_Dyn_Extract_Module (Res);
       Create_Insert_Module (Res);
 
       Create_Monadic_Module (Design, Res.M_Truncate (Id_Utrunc),
@@ -727,7 +749,7 @@ package body Netlists.Builders is
       return O;
    end Build_Iadff;
 
-   function Build_Slice
+   function Build_Extract
      (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net
    is
       Wd : constant Width := Get_Width (I);
@@ -743,12 +765,33 @@ package body Netlists.Builders is
       Connect (Get_Input (Inst, 0), I);
       Set_Param_Uns32 (Inst, 0, Off);
       return O;
-   end Build_Slice;
+   end Build_Extract;
+
+   function Build_Dyn_Extract
+     (Ctxt : Context_Acc;
+      I : Net; V : Net; Step : Uns32; Off : Uns32; W : Width) return Net
+   is
+      Wd : constant Width := Get_Width (I);
+      pragma Assert (Wd /= No_Width);
+      pragma Assert (W > 0);
+      pragma Assert (W + Off <= Wd);
+      Inst : Instance;
+      O : Net;
+   begin
+      Inst := New_Internal_Instance (Ctxt, Ctxt.M_Dyn_Extract);
+      O := Get_Output (Inst, 0);
+      Set_Width (O, W);
+      Connect (Get_Input (Inst, 0), I);
+      Connect (Get_Input (Inst, 1), V);
+      Set_Param_Uns32 (Inst, 0, Step);
+      Set_Param_Uns32 (Inst, 1, Off);
+      return O;
+   end Build_Dyn_Extract;
 
    function Build_Extract_Bit
      (Ctxt : Context_Acc; I : Net; Off : Width) return Net is
    begin
-      return Build_Slice (Ctxt, I, Off, 1);
+      return Build_Extract (Ctxt, I, Off, 1);
    end Build_Extract_Bit;
 
 end Netlists.Builders;
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index a4f635b77..644e558c4 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -69,11 +69,15 @@ package Netlists.Builders is
    function Build_Extend
      (Ctxt : Context_Acc; Id : Module_Id; I : Net; W : Width) return Net;
 
-   function Build_Slice
+   function Build_Extract
      (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net;
    function Build_Extract_Bit
      (Ctxt : Context_Acc; I : Net; Off : Width) return Net;
 
+   function Build_Dyn_Extract
+     (Ctxt : Context_Acc;
+      I : Net; V : Net; Step : Uns32; Off : Uns32; W : Width) return Net;
+
    function Build_Insert
      (Ctxt : Context_Acc; I : Net; V : Net; Off : Width) return Net;
 
@@ -126,5 +130,6 @@ private
       M_Extend : Module_Arr (Extend_Module_Id);
       M_Extract : Module;
       M_Insert : Module;
+      M_Dyn_Extract : Module;
    end record;
 end Netlists.Builders;
diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads
index 20df29ad2..60591bb5f 100644
--- a/src/synth/netlists-gates.ads
+++ b/src/synth/netlists-gates.ads
@@ -101,10 +101,11 @@ package Netlists.Gates is
    subtype Extend_Module_Id is Module_Id range Id_Uextend .. Id_Sextend;
 
    --  Extract a bit or a slice at a constant offset.
+   --  OUT := IN0[OFF+WD-1:OFF]
    Id_Extract : constant Module_Id := 44;
 
+   --  OUT := IN0[IN1*STEP+OFF+WD-1:IN1*STEP+OFF]
    Id_Dyn_Extract : constant Module_Id := 45;
-   Id_Step_Extract : constant Module_Id := 46;
 
    --  This gate has two inputs A, B and one parameter POS.
    --  It replaces bits POS + width(B) - 1 .. POS of A by B, ie:
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 04830971a..dd759362d 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -35,7 +35,6 @@ with Synth.Errors; use Synth.Errors;
 with Synth.Types; use Synth.Types;
 with Synth.Stmts;
 
-with Netlists; use Netlists;
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
 
@@ -137,20 +136,6 @@ package body Synth.Expr is
       end case;
    end Bit_Extract;
 
-   function Vec_Extract (Val : Value_Acc; Off : Uns32; Bnd : Value_Bound_Acc)
-                        return Value_Acc is
-   begin
-      case Val.Kind is
-         when Value_Net
-           | Value_Wire =>
-            return Create_Value_Net
-              (Build_Slice (Build_Context,
-                            Get_Net (Val, Null_Node), Off, Bnd.Len), Bnd);
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Vec_Extract;
-
    function Synth_Uresize (N : Net; W : Width) return Net
    is
       Wn : constant Width := Get_Width (N);
@@ -895,11 +880,153 @@ package body Synth.Expr is
       return Bit_Extract (Pfx, Off);
    end Synth_Indexed_Name;
 
+   function Is_Const (N : Net) return Boolean is
+   begin
+      case Get_Id (Get_Module (Get_Parent (N))) is
+         when Id_Const_UB32 =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Const;
+
+   function To_Int32 is new Ada.Unchecked_Conversion
+     (Uns32, Int32);
+
+   function Get_Const (N : Net) return Int32
+   is
+      Inst : constant Instance := Get_Parent (N);
+   begin
+      case Get_Id (Get_Module (Inst)) is
+         when Id_Const_UB32 =>
+            return To_Int32 (Get_Param_Uns32 (Inst, 0));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Const;
+
+   procedure Decompose_Mul_Add (Val : Net;
+                                Inp : out Net;
+                                Factor : out Int32;
+                                Addend : out Int32)
+   is
+      Inst : Instance;
+      Val_I0, Val_I1 : Net;
+   begin
+      Factor := 1;
+      Addend := 0;
+      Inp := Val;
+
+      loop
+         Inst := Get_Parent (Inp);
+         if Get_Id (Get_Module (Inst)) = Id_Add then
+            Val_I0 := Get_Driver (Get_Input (Inst, 0));
+            Val_I1 := Get_Driver (Get_Input (Inst, 1));
+            if Is_Const (Val_I0) then
+               Addend := Addend + Get_Const (Val_I0) * Factor;
+               Inp := Val_I1;
+            elsif Is_Const (Val_I1) then
+               Addend := Addend + Get_Const (Val_I1) * Factor;
+               Inp := Val_I0;
+            else
+               --  It's an addition, but without any constant value.
+               return;
+            end if;
+         elsif Get_Id (Get_Module (Inst)) = Id_Sub then
+            Val_I0 := Get_Driver (Get_Input (Inst, 0));
+            Val_I1 := Get_Driver (Get_Input (Inst, 1));
+            if Is_Const (Val_I1) then
+               Addend := Addend - Get_Const (Val_I1) * Factor;
+               Inp := Val_I0;
+            else
+               --  It's a substraction, but without any constant value.
+               return;
+            end if;
+         elsif Get_Id (Get_Module (Inst)) = Id_Mul then
+            Val_I0 := Get_Driver (Get_Input (Inst, 0));
+            Val_I1 := Get_Driver (Get_Input (Inst, 1));
+            if Is_Const (Val_I0) then
+               Factor := Factor * Get_Const (Val_I0);
+               Inp := Val_I1;
+            elsif Is_Const (Val_I1) then
+               Factor := Factor * Get_Const (Val_I1);
+               Inp := Val_I0;
+            else
+               --  A mul but without any constant value.
+               return;
+            end if;
+         elsif Get_Id (Get_Module (Inst)) = Id_Uextend then
+            Inp := Get_Driver (Get_Input (Inst, 0));
+         else
+            --  Cannot decompose it.
+            return;
+         end if;
+      end loop;
+   end Decompose_Mul_Add;
+
+   procedure Synth_Extract_Dyn_Suffix (Loc : Node;
+                                       Pfx_Bnd : Value_Bound_Acc;
+                                       Left : Net;
+                                       Right : Net;
+                                       Inp : out Net;
+                                       Step : out Uns32;
+                                       Off : out Uns32;
+                                       Width : out Uns32)
+   is
+      L_Inp, R_Inp : Net;
+      L_Fac, R_Fac : Int32;
+      L_Add, R_Add : Int32;
+   begin
+      Inp := No_Net;
+      Step := 0;
+      Off := 0;
+      Width := 0;
+
+      if Left = Right then
+         L_Inp := Left;
+         R_Inp := Right;
+         L_Fac := 1;
+         R_Fac := 1;
+         L_Add := 0;
+         R_Add := 0;
+      else
+         Decompose_Mul_Add (Left, L_Inp, L_Fac, L_Add);
+         Decompose_Mul_Add (Right, R_Inp, R_Fac, R_Add);
+      end if;
+
+      if L_Inp /= R_Inp then
+         Error_Msg_Synth
+           (+Loc, "cannot extract same variable factor for dynamic slice");
+         return;
+      end if;
+      Inp := L_Inp;
+
+      if L_Fac /= R_Fac then
+         Error_Msg_Synth
+           (+Loc, "cannot extract same constant factor for dynamic slice");
+         return;
+      end if;
+      --  FIXME: what to do with negative values.
+      Step := Uns32 (L_Fac);
+
+      case Pfx_Bnd.Dir is
+         when Iir_To =>
+            Off := Uns32 (L_Add - Pfx_Bnd.Left);
+            Width := Uns32 (R_Add - L_Add + 1);
+         when Iir_Downto =>
+            Off := Uns32 (R_Add - Pfx_Bnd.Right);
+            Width := Uns32 (L_Add - R_Add + 1);
+      end case;
+   end Synth_Extract_Dyn_Suffix;
+
    procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc;
                                  Name : Node;
                                  Pfx_Bnd : Value_Bound_Acc;
                                  Res_Bnd : out Value_Bound_Acc;
-                                 Off : out Uns32)
+                                 Inp : out Net;
+                                 Step : out Uns32;
+                                 Off : out Uns32;
+                                 Wd : out Uns32)
    is
       Expr : constant Node := Get_Suffix (Name);
       Left, Right : Value_Acc;
@@ -917,60 +1044,84 @@ package body Synth.Expr is
             Error_Msg_Synth (+Expr, "only range supported for slices");
       end case;
 
-      if Left.Kind /= Value_Discrete then
-         Error_Msg_Synth (+Name, "non constant integer left not supported");
-         return;
-      end if;
-
-      if Right.Kind /= Value_Discrete then
-         Error_Msg_Synth (+Name, "non constant integer right not supported");
-         return;
-      end if;
-
       if Pfx_Bnd.Dir /= Dir then
          Error_Msg_Synth (+Name, "direction mismatch in slice");
+         Step := 0;
+         Wd := 0;
          return;
       end if;
 
-      if not In_Bounds (Pfx_Bnd, Int32 (Left.Scal))
-        or else not In_Bounds (Pfx_Bnd, Int32 (Right.Scal))
-      then
-         Error_Msg_Synth (+Name, "index not within bounds");
-         return;
-      end if;
+      if not Is_Const (Left) or else not Is_Const (Right) then
+         if Left.Kind /= Value_Net and Right.Kind /= Value_Net then
+            Error_Msg_Synth
+              (+Name, "left and right bounds of a slice must be "
+                 & "either constant or dynamic");
+            return;
+         else
+            Synth_Extract_Dyn_Suffix (Name, Pfx_Bnd, Left.N, Right.N,
+                                      Inp, Step, Off, Wd);
+         end if;
+      else
+         Inp := No_Net;
+         Step := 0;
+
+         if not In_Bounds (Pfx_Bnd, Int32 (Left.Scal))
+           or else not In_Bounds (Pfx_Bnd, Int32 (Right.Scal))
+         then
+            Error_Msg_Synth (+Name, "index not within bounds");
+            Wd := 0;
+            Off := 0;
+            return;
+         end if;
 
-      case Pfx_Bnd.Dir is
-         when Iir_To =>
-            Res_Bnd := Create_Value_Bound
-              (Value_Bound_Type'
-                 (Dir => Iir_To,
-                  Len => Width (Right.Scal - Left.Scal + 1),
-                  Left => Int32 (Left.Scal),
-                  Right => Int32 (Right.Scal)));
-            Off := Uns32 (Pfx_Bnd.Right - Res_Bnd.Right);
-         when Iir_Downto =>
-            Res_Bnd := Create_Value_Bound
-              (Value_Bound_Type'
-                 (Dir => Iir_Downto,
-                  Len => Width (Left.Scal - Right.Scal + 1),
-                  Left => Int32 (Left.Scal),
-                  Right => Int32 (Right.Scal)));
-            Off := Uns32 (Res_Bnd.Right - Pfx_Bnd.Right);
-      end case;
+         case Pfx_Bnd.Dir is
+            when Iir_To =>
+               Wd := Width (Right.Scal - Left.Scal + 1);
+               Res_Bnd := Create_Value_Bound
+                 (Value_Bound_Type'(Dir => Iir_To,
+                                    Len => Wd,
+                                    Left => Int32 (Left.Scal),
+                                    Right => Int32 (Right.Scal)));
+               Off := Uns32 (Pfx_Bnd.Right - Res_Bnd.Right);
+            when Iir_Downto =>
+               Wd := Width (Left.Scal - Right.Scal + 1);
+               Res_Bnd := Create_Value_Bound
+                 (Value_Bound_Type'(Dir => Iir_Downto,
+                                    Len => Wd,
+                                    Left => Int32 (Left.Scal),
+                                    Right => Int32 (Right.Scal)));
+               Off := Uns32 (Res_Bnd.Right - Pfx_Bnd.Right);
+         end case;
+      end if;
    end Synth_Slice_Suffix;
 
    function Synth_Slice_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
                               return Value_Acc
    is
-      Pfx : constant Value_Acc :=
-        Synth_Expression (Syn_Inst, Get_Prefix (Name));
+      Pfx_Node : constant Node := Get_Prefix (Name);
+      Pfx : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx_Node);
       Bnd : Value_Bound_Acc;
       Res_Bnd : Value_Bound_Acc;
+      Inp : Net;
+      Step : Uns32;
       Off : Uns32;
+      Wd : Uns32;
    begin
       Bnd := Extract_Bound (Pfx);
-      Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Off);
-      return Vec_Extract (Pfx, Off, Res_Bnd);
+      Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Inp, Step, Off, Wd);
+      if Inp /= No_Net then
+         return Create_Value_Net
+           (Build_Dyn_Extract (Build_Context,
+                               Get_Net (Pfx, Get_Type (Pfx_Node)),
+                               Inp, Step, Off, Wd),
+            null);
+      else
+         return Create_Value_Net
+           (Build_Extract (Build_Context,
+                           Get_Net (Pfx, Get_Type (Pfx_Node)),
+                           Off, Wd),
+            Res_Bnd);
+      end if;
    end Synth_Slice_Name;
 
    --  Match: clk_signal_name'event
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 21758b797..84c7e6860 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -19,6 +19,7 @@
 --  MA 02110-1301, USA.
 
 with Types; use Types;
+with Netlists; use Netlists;
 with Synth.Values; use Synth.Values;
 with Synth.Context; use Synth.Context;
 with Vhdl.Nodes; use Vhdl.Nodes;
@@ -59,5 +60,8 @@ package Synth.Expr is
                                  Name : Node;
                                  Pfx_Bnd : Value_Bound_Acc;
                                  Res_Bnd : out Value_Bound_Acc;
-                                 Off : out Uns32);
+                                 Inp : out Net;
+                                 Step : out Uns32;
+                                 Off : out Uns32;
+                                 Wd : out Uns32);
 end Synth.Expr;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index c05568261..b43170078 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -156,14 +156,20 @@ package body Synth.Stmts is
                  Get_Value (Syn_Inst, Get_Base_Name (Pfx));
                V : Net;
                Res_Bnd : Value_Bound_Acc;
+               Inp : Net;
+               Step : Uns32;
                Off : Uns32;
+               Wd : Uns32;
             begin
                if Targ.Kind /= Value_Wire then
                   --  Only support assignment of vector.
                   raise Internal_Error;
                end if;
                Synth_Slice_Suffix (Syn_Inst, Target, Extract_Bound (Targ),
-                                   Res_Bnd, Off);
+                                   Res_Bnd, Inp, Step, Off, Wd);
+               if Step /= 0 then
+                  raise Internal_Error;
+               end if;
                V := Build_Insert (Build_Context,
                                   Get_Net (Targ, Get_Type (Pfx)),
                                   Get_Net (Val, Get_Type (Target)), Off);
@@ -485,8 +491,8 @@ package body Synth.Stmts is
 
       --  Handle SEL bits by 2, so group case_element by 4.
       for I in 1 .. Natural (Wd / 2) loop
-         Sub_Sel := Build_Slice (Build_Context,
-                                 Sel, Width (2 * (I - 1)), 2);
+         Sub_Sel := Build_Extract (Build_Context,
+                                   Sel, Width (2 * (I - 1)), 2);
          Mask := Shift_Left (not 0, Natural (2 * I));
          Iels := Els'First;
          Oels := Els'First;