synth: do more constant propagation (on build2

4 files changed, 82 insertions, 50 deletions

diff --git a/src/synth/netlists-folds.adb b/src/synth/netlists-folds.adb
index fd35ed8ed..9028c15ea 100644
--- a/src/synth/netlists-folds.adb
+++ b/src/synth/netlists-folds.adb
@@ -21,6 +21,7 @@
 with Types_Utils; use Types_Utils;
 
 with Netlists.Gates; use Netlists.Gates;
+with Netlists.Utils; use Netlists.Utils;
 with Netlists.Locations;
 
 package body Netlists.Folds is
@@ -136,11 +137,29 @@ package body Netlists.Folds is
       if Wn = W then
          return I;
       else
-         if Wn > W then
-            Res := Build_Trunc (Ctxt, Id_Utrunc, I, W);
+         if W <= 64 and then Is_Const_Net (I) then
+            declare
+               V : Uns64;
+            begin
+               V := Get_Net_Uns64 (I);
+               if Wn < W then
+                  --  Extend.
+                  pragma Assert (Shift_Right (V, Natural (Wn)) = 0);
+                  null;
+               else
+                  --  Truncate
+                  V := Shift_Left (V, Natural (64 - Wn));
+                  V := Shift_Right (V, Natural (64 - Wn));
+               end if;
+               Res := Build2_Const_Uns (Ctxt, V, W);
+            end;
          else
-            pragma Assert (Wn < W);
-            Res := Build_Extend (Ctxt, Id_Uextend, I, W);
+            if Wn > W then
+               Res := Build_Trunc (Ctxt, Id_Utrunc, I, W);
+            else
+               pragma Assert (Wn < W);
+               Res := Build_Extend (Ctxt, Id_Uextend, I, W);
+            end if;
          end if;
          Locations.Set_Location (Res, Loc);
          return Res;
@@ -159,11 +178,23 @@ package body Netlists.Folds is
       if Wn = W then
          return I;
       else
-         if Wn > W then
-            Res := Build_Trunc (Ctxt, Id_Strunc, I, W);
+         if W <= 64 and then Is_Const_Net (I) then
+            declare
+               V : Uns64;
+               Sh : constant Natural := Natural (Width'Min (Wn, W));
+            begin
+               V := Get_Net_Uns64 (I);
+               V := Shift_Left (V, 64 - Sh);
+               V := Shift_Right_Arithmetic (V, 64 - Sh);
+               Res := Build2_Const_Int (Ctxt, To_Int64 (V), W);
+            end;
          else
-            pragma Assert (Wn < W);
-            Res := Build_Extend (Ctxt, Id_Sextend, I, W);
+            if Wn > W then
+               Res := Build_Trunc (Ctxt, Id_Strunc, I, W);
+            else
+               pragma Assert (Wn < W);
+               Res := Build_Extend (Ctxt, Id_Sextend, I, W);
+            end if;
          end if;
          Locations.Set_Location (Res, Loc);
          return Res;
diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 7d9d71f5b..d3861215e 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -18,8 +18,11 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
-with Netlists.Gates; use Netlists.Gates;
 with Mutils;
+with Types_Utils; use Types_Utils;
+
+with Netlists.Gates; use Netlists.Gates;
+
 
 package body Netlists.Utils is
    function Get_Nbr_Inputs (Inst : Instance) return Port_Nbr
@@ -122,6 +125,30 @@ package body Netlists.Utils is
       return Is_Const_Module (Get_Id (Get_Net_Parent (N)));
    end Is_Const_Net;
 
+   function Get_Net_Uns64 (N : Net) return Uns64
+   is
+      Inst : constant Instance := Get_Net_Parent (N);
+   begin
+      case Get_Id (Inst) is
+         when Id_Const_UB32 =>
+            declare
+               Va : constant Uns32 := Get_Param_Uns32 (Inst, 0);
+               Wd : constant Width := Get_Width (N);
+            begin
+               --  There must not be any garbage.
+               pragma Assert (Shift_Right (Va, Natural (Wd)) = 0);
+               return Uns64 (Va);
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Net_Uns64;
+
+   function Get_Net_Int64 (N : Net) return Int64 is
+   begin
+      return To_Int64 (Get_Net_Uns64 (N));
+   end Get_Net_Int64;
+
    function Is_Connected (O : Net) return Boolean is
    begin
       return Get_First_Sink (O) /= No_Input;
diff --git a/src/synth/netlists-utils.ads b/src/synth/netlists-utils.ads
index e8565c823..67a06cecd 100644
--- a/src/synth/netlists-utils.ads
+++ b/src/synth/netlists-utils.ads
@@ -45,6 +45,12 @@ package Netlists.Utils is
    function Is_Const_Module (Id : Module_Id) return Boolean;
    function Is_Const_Net (N : Net) return Boolean;
 
+   --  Assuming than N is a const net, return the value (for small values).
+   function Get_Net_Uns64 (N : Net) return Uns64;
+
+   function Get_Net_Int64 (N : Net) return Int64;
+   pragma Inline (Get_Net_Int64);
+
    --  Return True iff O has at least one sink (ie is connected to at least one
    --  input).
    function Is_Connected (O : Net) return Boolean;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index f1bdeeead..fddc32954 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -51,7 +51,6 @@ package body Synth.Expr is
    function Get_Const_Discrete (V : Value_Acc) return Int64
    is
       N : Net;
-      Inst : Instance;
    begin
       case V.Kind is
          when Value_Discrete =>
@@ -65,20 +64,7 @@ package body Synth.Expr is
          when others =>
             raise Internal_Error;
       end case;
-      Inst := Get_Net_Parent (N);
-      case Get_Id (Inst) is
-         when Id_Const_UB32 =>
-            declare
-               Va : constant Uns32 := Get_Param_Uns32 (Inst, 0);
-               Wd : constant Natural := Natural (Get_Width (N));
-               T : Uns64;
-            begin
-               T := Shift_Left (Uns64 (Va), 64 - Wd);
-               return To_Int64 (Shift_Right_Arithmetic (T, 64 - Wd));
-            end;
-         when others =>
-            raise Internal_Error;
-      end case;
+      return Get_Net_Int64 (N);
    end Get_Const_Discrete;
 
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is
@@ -806,16 +792,20 @@ package body Synth.Expr is
             declare
                N : Net;
             begin
-               if Vtype.W > Dtype.W then
+               if Vtype.W /= Dtype.W then
                   --  Truncate.
                   --  TODO: check overflow.
                   case Val.Kind is
                      when Value_Net
                        | Value_Wire =>
                         N := Get_Net (Val);
-                        N := Build_Trunc
-                          (Build_Context, Id_Utrunc, N, Dtype.W);
-                        Set_Location (N, Loc);
+                        if Vtype.Drange.Is_Signed then
+                           N := Build2_Sresize
+                             (Build_Context, N, Dtype.W, Get_Location (Loc));
+                        else
+                           N := Build2_Uresize
+                             (Build_Context, N, Dtype.W, Get_Location (Loc));
+                        end if;
                         return Create_Value_Net (N, Dtype);
                      when Value_Discrete =>
                         return Create_Value_Discrete (Val.Scal, Dtype);
@@ -824,28 +814,6 @@ package body Synth.Expr is
                      when others =>
                         raise Internal_Error;
                   end case;
-               elsif Vtype.W < Dtype.W then
-                  --  Extend.
-                  case Val.Kind is
-                     when Value_Discrete =>
-                        return Create_Value_Discrete (Val.Scal, Dtype);
-                     when Value_Const =>
-                        return Create_Value_Discrete (Val.C_Val.Scal, Dtype);
-                     when Value_Net
-                       | Value_Wire =>
-                        N := Get_Net (Val);
-                        if Vtype.Drange.Is_Signed then
-                           N := Build_Extend
-                             (Build_Context, Id_Sextend, N, Dtype.W);
-                        else
-                           N := Build_Extend
-                             (Build_Context, Id_Uextend, N, Dtype.W);
-                        end if;
-                        Set_Location (N, Loc);
-                        return Create_Value_Net (N, Dtype);
-                     when others =>
-                        raise Internal_Error;
-                  end case;
                else
                   --  TODO: check overflow if sign differ.
                   return Val;