synth: handle some rotation and shifts. Fix #1077

7 files changed, 203 insertions, 1 deletions

diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index 1f4b24711..acf97c45f 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -85,6 +85,7 @@ package Synth.Environment is
 
    --  The current value of WID.  For variables, this is the last assigned
    --  value.  For signals, this is the initial value.
+   --  A builder is needed in case of concatenation.
    function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id)
                               return Net;
 
@@ -92,7 +93,6 @@ package Synth.Environment is
      (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width)
      return Net;
 
-
    --  Read and write the mark flag.
    function Get_Wire_Mark (Wid : Wire_Id) return Boolean;
    procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True);
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 8e334cc2a..15d0d622d 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -68,6 +68,35 @@ package body Synth.Expr is
       return Get_Net_Int64 (N);
    end Get_Static_Discrete;
 
+   function Is_Positive (V : Value_Acc) return Boolean
+   is
+      N : Net;
+      Inst : Instance;
+   begin
+      pragma Assert (V.Typ.Kind = Type_Discrete);
+      case V.Kind is
+         when Value_Discrete =>
+            return V.Scal >= 0;
+         when Value_Const =>
+            return V.C_Val.Scal >= 0;
+         when Value_Net =>
+            N := V.N;
+         when Value_Wire =>
+            N := Get_Net (V);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Inst := Get_Net_Parent (N);
+      case Get_Id (Inst) is
+         when Id_Uextend
+           | Id_Const_UB32 =>
+            return True;
+         when others =>
+            --  Be conservative.
+            return False;
+      end case;
+   end Is_Positive;
+
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is
    begin
       case Enum is
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 08936a15a..c5969b483 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -38,13 +38,19 @@ package Synth.Expr is
                                       Loc : Source.Syn_Src)
                                      return Value_Acc;
 
+   --  For a static value V, return the value.
    function Get_Static_Discrete (V : Value_Acc) return Int64;
 
+   --  Return True only if discrete value V is known to be positive or 0.
+   --  False means either not positive or unknown.
+   function Is_Positive (V : Value_Acc) return Boolean;
+
    --  Return the bounds of a one dimensional array/vector type and the
    --  width of the element.
    procedure Get_Onedimensional_Array_Bounds
      (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc);
 
+   --  Create an array subtype from bound BND.
    function Create_Onedimensional_Array_Subtype
      (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc;
 
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
index c32099fd3..513eef626 100644
--- a/src/synth/synth-oper.adb
+++ b/src/synth/synth-oper.adb
@@ -34,6 +34,7 @@ with Netlists; use Netlists;
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
 with Netlists.Folds; use Netlists.Folds;
+with Netlists.Utils;
 
 with Synth.Errors; use Synth.Errors;
 with Synth.Stmts; use Synth.Stmts;
@@ -416,6 +417,64 @@ package body Synth.Oper is
          Set_Location (N, Expr);
          return Create_Value_Net (N, Res_Typ);
       end Synth_Compare_Sgn_Sgn;
+
+      function Synth_Shift (Id_Pos : Module_Id; Id_Neg : Module_Id)
+                           return Value_Acc
+      is
+         pragma Unreferenced (Id_Neg);
+         L1, R1 : Net;
+         N : Net;
+         Is_Pos : Boolean;
+      begin
+         Is_Pos := Is_Positive (Right);
+
+         L1 := Get_Net (Left);
+         R1 := Get_Net (Right);
+         if Is_Pos then
+            N := Build_Shift_Rotate (Ctxt, Id_Pos, L1, R1);
+         else
+            raise Internal_Error;
+         end if;
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, Create_Res_Bound (Left));
+      end Synth_Shift;
+
+      function Synth_Rotation (Id : Module_Id) return Value_Acc
+      is
+         Amt : Int64;
+         Ww : Width;
+         L1, R1 : Net;
+         N : Net;
+      begin
+         if Is_Static_Val (Right) then
+            Amt := Get_Static_Discrete (Right);
+            if Amt < 0 then
+               raise Internal_Error;
+            end if;
+            Amt := Amt mod Int64 (Left.Typ.W);
+            R1 := Build_Const_UB32 (Ctxt, Uns32 (Amt), Right.Typ.W);
+            Set_Location (R1, Right_Expr);
+         elsif not Is_Positive (Right) then
+            Error_Msg_Synth (+Expr, "rotation quantity must be unsigned");
+            return Left;
+         else
+            R1 := Get_Net (Right);
+            Ww := Netlists.Utils.Clog2 (Left.Typ.W);
+            if Right.Typ.W >= Ww then
+               if Mutils.Is_Power2 (Uns64 (Left.Typ.W)) then
+                  R1 := Build2_Trunc (Ctxt, Id_Utrunc, R1, Ww, +Expr);
+               else
+                  Error_Msg_Synth
+                    (+Expr, "vector length of rotation must be a power of 2");
+                  return Left;
+               end if;
+            end if;
+         end if;
+         L1 := Get_Net (Left);
+         N := Build_Shift_Rotate (Ctxt, Id, L1, R1);
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, Create_Res_Bound (Left));
+      end Synth_Rotation;
    begin
       Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Typ);
       Left := Synth_Subtype_Conversion (Left, Left_Typ, False, Expr);
@@ -951,6 +1010,15 @@ package body Synth.Oper is
             Error_Msg_Synth (+Expr, "non-constant division not supported");
             return null;
 
+         when Iir_Predefined_Ieee_Numeric_Std_Sra_Sgn_Int =>
+            return Synth_Shift (Id_Asr, Id_None);
+
+         when Iir_Predefined_Ieee_Numeric_Std_Sll_Uns_Int =>
+            return Synth_Shift (Id_Lsl, Id_None);
+
+         when Iir_Predefined_Ieee_1164_Vector_Ror =>
+            return Synth_Rotation (Id_Ror);
+
          when others =>
             Error_Msg_Synth (+Expr, "synth_dyadic_operation: unhandled "
                                & Iir_Predefined_Functions'Image (Def));
diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb
index 15a41a9dc..6db92757c 100644
--- a/src/synth/synth-static_oper.adb
+++ b/src/synth/synth-static_oper.adb
@@ -260,6 +260,44 @@ package body Synth.Static_Oper is
       end;
    end Synth_Mul_Sgn_Sgn;
 
+   function Synth_Shift (Val : Value_Acc;
+                         Amt : Uns32;
+                         Right : Boolean;
+                         Arith : Boolean) return Value_Acc
+   is
+      Len : constant Uns32 := Uns32 (Val.Arr.Len);
+      Arr : Std_Logic_Vector (1 .. Natural (Len));
+      Pad : Std_Ulogic;
+   begin
+      if Len = 0 or Amt >= Len then
+         Arr := (others => '0');
+      else
+         To_Std_Logic_Vector (Val, Arr);
+         if Arith then
+            Pad := Arr (1);
+         else
+            Pad := '0';
+         end if;
+
+         if Right then
+            for I in reverse Amt + 1 .. Len loop
+               Arr (Natural (I)) := Arr (Natural (I - Amt));
+            end loop;
+            for I in 1 .. Amt loop
+               Arr (Natural (I)) := Pad;
+            end loop;
+         else
+            for I in 1 .. Len - Amt loop
+               Arr (Natural (I)) := Arr (Natural (I + Amt));
+            end loop;
+            for I in Len - Amt + 1 .. Len loop
+               Arr (Natural (I)) := Pad;
+            end loop;
+         end if;
+      end if;
+      return To_Value_Acc (Arr, Val.Typ.Vec_El);
+   end Synth_Shift;
+
    function Synth_Static_Dyadic_Predefined (Syn_Inst : Synth_Instance_Acc;
                                             Imp : Node;
                                             Left : Value_Acc;
@@ -467,6 +505,18 @@ package body Synth.Static_Oper is
          when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Sgn =>
             return Synth_Mul_Sgn_Sgn (Left, Right, Expr);
 
+         when Iir_Predefined_Ieee_Numeric_Std_Srl_Uns_Int =>
+            declare
+               Amt : Int64;
+            begin
+               Amt := Get_Static_Discrete (Right);
+               if Amt >= 0 then
+                  return Synth_Shift (Left, Uns32 (Amt), True, False);
+               else
+                  return Synth_Shift (Left, Uns32 (-Amt), False, False);
+               end if;
+            end;
+
          when others =>
             Error_Msg_Synth
               (+Expr, "synth_static_dyadic_predefined: unhandled "
diff --git a/src/vhdl/vhdl-ieee-std_logic_1164.adb b/src/vhdl/vhdl-ieee-std_logic_1164.adb
index 9c123d16a..be78f6afc 100644
--- a/src/vhdl/vhdl-ieee-std_logic_1164.adb
+++ b/src/vhdl/vhdl-ieee-std_logic_1164.adb
@@ -19,6 +19,7 @@ with Types; use Types;
 with Name_Table;
 with Std_Names; use Std_Names;
 with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Std_Package;
 
 package body Vhdl.Ieee.Std_Logic_1164 is
    function Is_Scalar_Parameter (Inter : Iir) return Boolean is
@@ -34,6 +35,12 @@ package body Vhdl.Ieee.Std_Logic_1164 is
         or Base_Type = Std_Logic_Vector_Type;
    end Is_Vector_Parameter;
 
+   function Is_Integer_Parameter (Inter : Iir) return Boolean is
+   begin
+      return (Get_Base_Type (Get_Type (Inter))
+                = Std_Package.Integer_Type_Definition);
+   end Is_Integer_Parameter;
+
    --  Return True iff the profile of FUNC is: (l, r : std_ulogic)
    function Is_Scalar_Scalar_Function (Func : Iir) return Boolean
    is
@@ -98,6 +105,30 @@ package body Vhdl.Ieee.Std_Logic_1164 is
       return True;
    end Is_Vector_Vector_Function;
 
+   --  Return True iff the profile of FUNC is:
+   --    (l : std_[u]logic_vector; r : integer)
+   function Is_Vector_Integer_Function (Func : Iir) return Boolean
+   is
+      Inter : constant Iir := Get_Interface_Declaration_Chain (Func);
+      Inter2 : Iir;
+   begin
+      if Get_Implicit_Definition (Func) /= Iir_Predefined_None then
+         return False;
+      end if;
+      if Inter = Null_Iir or else not Is_Vector_Parameter (Inter) then
+         return False;
+      end if;
+      Inter2 := Get_Chain (Inter);
+      if Inter2 =  Null_Iir or else not Is_Integer_Parameter (Inter2) then
+         return False;
+      end if;
+      if Get_Chain (Inter2) /= Null_Iir then
+         return False;
+      end if;
+
+      return True;
+   end Is_Vector_Integer_Function;
+
    --  Return True iff the profile of FUNC is: (l : std_[u]logic_vector)
    function Is_Vector_Function (Func : Iir) return Boolean
    is
@@ -310,6 +341,19 @@ package body Vhdl.Ieee.Std_Logic_1164 is
                         when others =>
                            Predefined := Iir_Predefined_None;
                      end case;
+                  elsif Is_Vector_Integer_Function (Decl) then
+                     case Get_Identifier (Decl) is
+                        when Name_Sll =>
+                           Predefined := Iir_Predefined_Ieee_1164_Vector_Sll;
+                        when Name_Srl =>
+                           Predefined := Iir_Predefined_Ieee_1164_Vector_Srl;
+                        when Name_Rol =>
+                           Predefined := Iir_Predefined_Ieee_1164_Vector_Rol;
+                        when Name_Ror =>
+                           Predefined := Iir_Predefined_Ieee_1164_Vector_Ror;
+                        when others =>
+                           Predefined := Iir_Predefined_None;
+                     end case;
                   else
                      Predefined := Iir_Predefined_None;
                   end if;
diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads
index c7bec2747..44618964c 100644
--- a/src/vhdl/vhdl-nodes.ads
+++ b/src/vhdl/vhdl-nodes.ads
@@ -5456,6 +5456,11 @@ package Vhdl.Nodes is
       Iir_Predefined_Ieee_1164_Vector_And_Reduce,
       Iir_Predefined_Ieee_1164_Vector_Or_Reduce,
 
+      Iir_Predefined_Ieee_1164_Vector_Sll,
+      Iir_Predefined_Ieee_1164_Vector_Srl,
+      Iir_Predefined_Ieee_1164_Vector_Rol,
+      Iir_Predefined_Ieee_1164_Vector_Ror,
+
       Iir_Predefined_Ieee_1164_Condition_Operator,
 
       --  Numeric_Std.