synth: add const_sb32, add smul/umul.

6 files changed, 105 insertions, 13 deletions

diff --git a/src/synth/ghdlsynth_gates.h b/src/synth/ghdlsynth_gates.h
index bef7a7d97..7eff74f93 100644
--- a/src/synth/ghdlsynth_gates.h
+++ b/src/synth/ghdlsynth_gates.h
@@ -14,7 +14,8 @@ enum Module_Id {
    Id_Xnor = 8,
    Id_Add = 9,
    Id_Sub = 10,
-   Id_Mul = 11,
+   Id_Umul = 11,
+   Id_Smul = 12,
    Id_Buf = 13,
    Id_Not = 14,
    Id_Neg = 15,
@@ -51,12 +52,12 @@ enum Module_Id {
    Id_Sextend = 49,
    Id_Extract = 50,
    Id_Dyn_Extract = 51,
-   Id_Insert = 52,
    Id_Dyn_Insert = 53,
    Id_Edge = 55,
    Id_Assert = 56,
    Id_Assume = 57,
    Id_Const_UB32 = 64,
+   Id_Const_SB32 = 65,
    Id_Const_UL32 = 70,
    Id_Const_UB64 = 66,
    Id_Const_UL64 = 67,
diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index 59994c20a..82c69f1e4 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -140,6 +140,16 @@ package body Netlists.Builders is
                      Typ => Param_Uns32)));
 
       Res := New_User_Module
+        (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_SB32")),
+         Id_Const_SB32, 0, 1, 1);
+      Ctxt.M_Const_SB32 := Res;
+      Outputs := (0 => Create_Output ("o"));
+      Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs);
+      Set_Param_Desc
+        (Res, (0 => (New_Sname_Artificial (Get_Identifier ("val")),
+                     Typ => Param_Uns32)));
+
+      Res := New_User_Module
         (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_UL32")),
          Id_Const_UL32, 0, 1, 2);
       Ctxt.M_Const_UL32 := Res;
@@ -393,8 +403,10 @@ package body Netlists.Builders is
                             Get_Identifier ("add"), Id_Add);
       Create_Dyadic_Module (Design, Res.M_Dyadic (Id_Sub),
                             Get_Identifier ("sub"), Id_Sub);
-      Create_Dyadic_Module (Design, Res.M_Dyadic (Id_Mul),
-                            Get_Identifier ("mul"), Id_Mul);
+      Create_Dyadic_Module (Design, Res.M_Dyadic (Id_Smul),
+                            Get_Identifier ("smul"), Id_Smul);
+      Create_Dyadic_Module (Design, Res.M_Dyadic (Id_Umul),
+                            Get_Identifier ("umul"), Id_Umul);
 
       Create_Monadic_Module (Design, Res.M_Monadic (Id_Not), Name_Not, Id_Not);
       Create_Monadic_Module (Design, Res.M_Monadic (Id_Neg),
@@ -575,6 +587,21 @@ package body Netlists.Builders is
       return O;
    end Build_Const_UB32;
 
+   function Build_Const_SB32 (Ctxt : Context_Acc;
+                              Val : Int32;
+                              W : Width) return Net
+   is
+      pragma Assert (W > 0);
+      Inst : Instance;
+      O : Net;
+   begin
+      Inst := New_Internal_Instance (Ctxt, Ctxt.M_Const_SB32);
+      O := Get_Output (Inst, 0);
+      Set_Param_Uns32 (Inst, 0, To_Uns32 (Val));
+      Set_Width (O, W);
+      return O;
+   end Build_Const_SB32;
+
    function Build_Const_UL32 (Ctxt : Context_Acc;
                               Val : Uns32;
                               Xz : Uns32;
@@ -641,6 +668,30 @@ package body Netlists.Builders is
       end if;
    end Build2_Const_Uns;
 
+   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
+                             return Net is
+   begin
+      if Val in -2**31 .. 2**31 - 1 then
+         return Build_Const_SB32 (Ctxt, Int32 (Val), W);
+      else
+         pragma Assert (W > 32);
+         declare
+            V : constant Uns64 := To_Uns64 (Val);
+            S : constant Uns32 :=
+              Uns32 (Shift_Right_Arithmetic (V, 63) and 16#ffff_ffff#);
+            Inst : Instance;
+         begin
+            Inst := Build_Const_Bit (Ctxt, W);
+            Set_Param_Uns32 (Inst, 0, Uns32 (V and 16#ffff_ffff#));
+            Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (V, 32)));
+            for I in 2 .. (W + 31) / 32 loop
+               Set_Param_Uns32 (Inst, Param_Idx (I), S);
+            end loop;
+            return Get_Output (Inst, 0);
+         end;
+      end if;
+   end Build2_Const_Int;
+
    function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net
    is
       pragma Assert (Get_Width (Src) = 1);
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index 5ef01e6e9..ac98e12a3 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -60,10 +60,18 @@ package Netlists.Builders is
                               Xz : Uns32;
                               W : Width) return Net;
 
+   function Build_Const_SB32 (Ctxt : Context_Acc;
+                              Val : Int32;
+                              W : Width) return Net;
+
    --  Build a const from VAL.  Result is either a Const_UB32 or a Const_Bit.
    function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
                              return Net;
 
+   --  Build a const from VAL.  Result is either a Const_SB32 or a Const_Bit.
+   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
+                             return Net;
+
    --  Large constants.
    --  Bit means only 0 or 1.
    --  Log means 0/1/Z/X.  Parameters 2N are aval, 2N+1 are bval.
@@ -155,6 +163,7 @@ private
       M_Concat : Module_Arr (Concat_Module_Id);
       M_Concatn : Module;
       M_Const_UB32 : Module;
+      M_Const_SB32 : Module;
       M_Const_UL32 : Module;
       M_Const_Z : Module;
       M_Const_Bit : Module;
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index e131469d5..e97f3ff5a 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -645,7 +645,7 @@ package body Netlists.Disp_Vhdl is
          when Id_Sub =>
             Disp_Template ("  \o0 <= std_logic_vector (\ui0 - \ui1);" & NL,
                            Inst);
-         when Id_Mul =>
+         when Id_Umul =>
             Disp_Template
               ("  \o0 <= std_logic_vector (resize (\ui0 * \ui1, \n0));" & NL,
                Inst, (0 => Get_Width (Get_Output (Inst, 0))));
diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads
index 57f2fd500..162ef0a6f 100644
--- a/src/synth/netlists-gates.ads
+++ b/src/synth/netlists-gates.ads
@@ -29,9 +29,10 @@ package Netlists.Gates is
 
    Id_Add : constant Module_Id := 9;
    Id_Sub : constant Module_Id := 10;
-   Id_Mul : constant Module_Id := 11;
+   Id_Umul : constant Module_Id := 11;
+   Id_Smul : constant Module_Id := 12;
 
-   subtype Dyadic_Module_Id is Module_Id range Id_And .. Id_Mul;
+   subtype Dyadic_Module_Id is Module_Id range Id_And .. Id_Smul;
 
    Id_Buf : constant Module_Id := 13;
    Id_Not : constant Module_Id := 14;
@@ -139,6 +140,7 @@ package Netlists.Gates is
    --  kind of constant gates: for small width, the value is stored as a
    --  parameter, possibly signed or unsigned extended.
    Id_Const_UB32 : constant Module_Id := 64;
+   Id_Const_SB32 : constant Module_Id := 65;
    Id_Const_UL32 : constant Module_Id := 70;
    Id_Const_UB64 : constant Module_Id := 66;
    Id_Const_UL64 : constant Module_Id := 67;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 78a843b6b..da6ea7190 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -234,7 +234,14 @@ package body Synth.Expr is
    begin
       if Is_Const (Val) then
          if Wn /= W then
-            raise Internal_Error;
+            pragma Assert (Val.Kind = Value_Discrete);
+            if Val.Typ.Drange.Is_Signed then
+               Res := Build2_Const_Int (Build_Context, Val.Scal, W);
+            else
+               Res := Build2_Const_Uns (Build_Context, To_Uns64 (Val.Scal), W);
+            end if;
+            Set_Location (Res, Loc);
+            return Res;
          end if;
       end if;
 
@@ -1207,6 +1214,20 @@ package body Synth.Expr is
             --  "-" (Unsigned, Unsigned)
             return Synth_Dyadic_Uns (Id_Sub, True);
 
+         when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Sgn =>
+            declare
+               L : constant Net := Get_Net (Left);
+               R : constant Net := Get_Net (Right);
+               W : constant Width := Get_Width (L) + Get_Width (R);
+               Rtype : Type_Acc;
+               N : Net;
+            begin
+               Rtype := Create_Vec_Type_By_Length (W, Left.Typ.Vec_El);
+               N := Build_Dyadic (Build_Context, Id_Smul, L, R);
+               Set_Location (N, Expr);
+               return Create_Value_Net (N, Rtype);
+            end;
+
          when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat =>
             --  "=" (Unsigned, Natural)
             return Synth_Compare_Uns_Nat (Id_Eq);
@@ -1337,7 +1358,7 @@ package body Synth.Expr is
                  (Left.Scal * Right.Scal,
                   Get_Value_Type (Syn_Inst, Get_Type (Expr)));
             else
-               return Synth_Int_Dyadic (Id_Mul);
+               return Synth_Int_Dyadic (Id_Smul);
             end if;
          when Iir_Predefined_Integer_Div =>
             if Is_Const (Left) and then Is_Const (Right) then
@@ -1611,10 +1632,18 @@ package body Synth.Expr is
             Off := 0;
          end if;
       elsif Pfx_Type.Kind = Type_Array then
-         Voff := Dyn_Index_To_Offset (Pfx_Type.Abounds.D (1), Idx_Val, Name);
          W := Get_Type_Width (Pfx_Type.Arr_El);
-         Mul := W;
-         Off := 0;
+         if Idx_Val.Kind = Value_Discrete then
+            Voff := No_Net;
+            Off := Index_To_Offset
+              (Pfx_Type.Abounds.D (1), Idx_Val.Scal, Name);
+            Mul := 0;
+         else
+            Voff := Dyn_Index_To_Offset
+              (Pfx_Type.Abounds.D (1), Idx_Val, Name);
+            Mul := W;
+            Off := 0;
+         end if;
       else
          raise Internal_Error;
       end if;
@@ -1710,7 +1739,7 @@ package body Synth.Expr is
                --  It's a substraction, but without any constant value.
                return;
             end if;
-         elsif Get_Id (Get_Module (Inst)) = Id_Mul then
+         elsif Get_Id (Get_Module (Inst)) = Id_Smul then
             Val_I0 := Get_Input_Net (Inst, 0);
             Val_I1 := Get_Input_Net (Inst, 1);
             if Is_Const (Val_I0) then