synth: fold addition on constant nets.

10 files changed, 178 insertions, 49 deletions

diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 20aca706a..ab7c1824a 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -113,6 +113,11 @@ package body Netlists.Utils is
       end case;
    end Is_Const_Module;
 
+   function Is_Const_Net (N : Net) return Boolean is
+   begin
+      return Is_Const_Module (Get_Id (Get_Net_Parent (N)));
+   end Is_Const_Net;
+
    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 2f2570f3e..165e986d8 100644
--- a/src/synth/netlists-utils.ads
+++ b/src/synth/netlists-utils.ads
@@ -44,6 +44,7 @@ package Netlists.Utils is
 
    --  Return True iff ID describe a constant.
    function Is_Const_Module (Id : Module_Id) return Boolean;
+   function Is_Const_Net (N : Net) return Boolean;
 
    --  Return True iff O has at least one sink (ie is connected to at least one
    --  input).
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 5a517b7d5..1d054d21b 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -1104,6 +1104,51 @@ package body Synth.Environment is
 
       Phi_Assign (Ctxt, Dest, Pasgn);
    end Phi_Assign;
+
+   --  Return the net driving WID when it is known to be possibly constant.
+   --  Return No_Net is not constant.
+   function Get_Const_Net_Maybe (Wid : Wire_Id) return Net
+   is
+      Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+      Pasgn : Partial_Assign;
+      N : Net;
+   begin
+      if Wire_Rec.Kind /= Wire_Variable then
+         return No_Net;
+      end if;
+      if Wire_Rec.Cur_Assign = No_Seq_Assign then
+         return No_Net;
+      end if;
+      Pasgn := Get_Assign_Partial (Wire_Rec.Cur_Assign);
+      pragma Assert (Pasgn /= No_Partial_Assign);
+      if Get_Partial_Offset (Pasgn) /= 0 then
+         return No_Net;
+      end if;
+      N := Get_Partial_Value (Pasgn);
+      if Get_Width (N) /= Get_Width (Wire_Rec.Gate) then
+         return No_Net;
+      end if;
+      return N;
+   end Get_Const_Net_Maybe;
+
+   function Is_Const_Wire (Wid : Wire_Id) return Boolean
+   is
+      N : constant Net := Get_Const_Net_Maybe (Wid);
+   begin
+      if N = No_Net then
+         return False;
+      else
+         return Is_Const_Net (N);
+      end if;
+   end Is_Const_Wire;
+
+   function Get_Const_Wire (Wid : Wire_Id) return Net
+   is
+      N : constant Net := Get_Const_Net_Maybe (Wid);
+   begin
+      pragma Assert (N /= No_Net);
+      return N;
+   end Get_Const_Wire;
 begin
    Wire_Id_Table.Append ((Kind => Wire_None,
                           Mark_Flag => False,
diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index 3af1a7318..fff66e01d 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -154,6 +154,14 @@ package Synth.Environment is
                                             N : out Net_Array;
                                             Off : in out Uns32;
                                             Wd : out Width);
+
+   --  A const wire is a wire_signal which has one whole (same width as the
+   --  wire) assignment and whose assignment value is a const net.
+   --  That's rather restrictive but still efficient.
+   function Is_Const_Wire (Wid : Wire_Id) return Boolean;
+
+   --  Return the corresponding net for a constant wire.
+   function Get_Const_Wire (Wid : Wire_Id) return Net;
 private
    type Wire_Id is new Uns32;
    No_Wire_Id : constant Wire_Id := 0;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index a4837e65b..9ddd906d1 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -31,15 +31,16 @@ with Vhdl.Evaluation; use Vhdl.Evaluation;
 
 with Vhdl.Annotations; use Vhdl.Annotations;
 
-with Synth.Errors; use Synth.Errors;
-with Synth.Types; use Synth.Types;
-with Synth.Stmts; use Synth.Stmts;
-with Synth.Oper; use Synth.Oper;
-
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
 with Netlists.Locations; use Netlists.Locations;
 
+with Synth.Types; use Synth.Types;
+with Synth.Errors; use Synth.Errors;
+with Synth.Environment;
+with Synth.Stmts; use Synth.Stmts;
+with Synth.Oper; use Synth.Oper;
+
 package body Synth.Expr is
    function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node)
                        return Value_Acc;
@@ -57,6 +58,37 @@ package body Synth.Expr is
       end if;
    end Set_Location;
 
+   function Get_Const_Discrete (V : Value_Acc) return Int64
+   is
+      N : Net;
+      Inst : Instance;
+   begin
+      case V.Kind is
+         when Value_Discrete =>
+            return V.Scal;
+         when Value_Net =>
+            N := V.N;
+         when Value_Wire =>
+            N := Synth.Environment.Get_Const_Wire (V.W);
+         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;
+   end Get_Const_Discrete;
+
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is
    begin
       case Enum is
@@ -1155,39 +1187,44 @@ package body Synth.Expr is
          return;
       end if;
 
-      if Is_Const (Left) and then Is_Const (Right) then
-         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;
+      if Is_Const_Val (Left) and then Is_Const_Val (Right) then
+         declare
+            L : constant Int64 := Get_Const_Discrete (Left);
+            R : constant Int64 := Get_Const_Discrete (Right);
+         begin
+            Inp := No_Net;
+            Step := 0;
+
+            if not In_Bounds (Pfx_Bnd, Int32 (L))
+              or else not In_Bounds (Pfx_Bnd, Int32 (R))
+            then
+               Error_Msg_Synth (+Name, "index not within bounds");
+               Wd := 0;
+               Off := 0;
+               return;
+            end if;
 
-         case Pfx_Bnd.Dir is
-            when Iir_To =>
-               Wd := Width (Right.Scal - Left.Scal + 1);
-               Res_Bnd := (Dir => Iir_To,
-                           Wlen => Wd,
-                           Wbounds => Wd,
-                           Len => Wd,
-                           Left => Int32 (Left.Scal),
-                           Right => Int32 (Right.Scal));
-               Off := Pfx_Bnd.Right - Res_Bnd.Right;
-            when Iir_Downto =>
-               Wd := Width (Left.Scal - Right.Scal + 1);
-               Res_Bnd := (Dir => Iir_Downto,
-                           Wlen => Wd,
-                           Wbounds => Wd,
-                           Len => Wd,
-                           Left => Int32 (Left.Scal),
-                           Right => Int32 (Right.Scal));
-               Off := Res_Bnd.Right - Pfx_Bnd.Right;
-         end case;
+            case Pfx_Bnd.Dir is
+               when Iir_To =>
+                  Wd := Width (R - L + 1);
+                  Res_Bnd := (Dir => Iir_To,
+                              Wlen => Wd,
+                              Wbounds => Wd,
+                              Len => Wd,
+                              Left => Int32 (L),
+                              Right => Int32 (R));
+                  Off := Pfx_Bnd.Right - Res_Bnd.Right;
+               when Iir_Downto =>
+                  Wd := Width (L - R + 1);
+                  Res_Bnd := (Dir => Iir_Downto,
+                              Wlen => Wd,
+                              Wbounds => Wd,
+                              Len => Wd,
+                              Left => Int32 (L),
+                              Right => Int32 (R));
+                  Off := Res_Bnd.Right - Pfx_Bnd.Right;
+            end case;
+         end;
       else
          if Is_Const (Left) or else Is_Const (Right) then
             Error_Msg_Synth
@@ -1339,7 +1376,7 @@ package body Synth.Expr is
       Val := Synth_Expression (Syn_Inst, Expr);
       case Get_Kind (Conv_Type) is
          when Iir_Kind_Integer_Subtype_Definition =>
-            if Is_Float (Val) then
+            if Val.Typ.Kind = Type_Float then
                return Create_Value_Discrete
                  (Int64 (Val.Fp), Get_Value_Type (Syn_Inst, Conv_Type));
             else
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 835da87ab..5ce27e49b 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -36,6 +36,8 @@ package Synth.Expr is
      (Val : Value_Acc; Dtype : Type_Acc; Loc : Source.Syn_Src)
      return Value_Acc;
 
+   function Get_Const_Discrete (V : Value_Acc) return Int64;
+
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32);
    procedure From_Bit (Enum : Int64; Val : out Uns32);
    procedure To_Logic
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
index ac11d0606..2327d32d9 100644
--- a/src/synth/synth-oper.adb
+++ b/src/synth/synth-oper.adb
@@ -585,9 +585,9 @@ package body Synth.Oper is
                  (N, Create_Vector_Type (Bnd, Left.Typ.Vec_El));
             end;
          when Iir_Predefined_Integer_Plus =>
-            if Is_Const (Left) and then Is_Const (Right) then
+            if Is_Const_Val (Left) and then Is_Const_Val (Right) then
                return Create_Value_Discrete
-                 (Left.Scal + Right.Scal,
+                 (Get_Const_Discrete (Left) + Get_Const_Discrete (Right),
                   Get_Value_Type (Syn_Inst, Get_Type (Expr)));
             else
                return Synth_Int_Dyadic (Id_Add);
@@ -995,7 +995,7 @@ package body Synth.Oper is
                function Log2 (Arg : Fp64) return Fp64;
                pragma Import (C, Log2);
             begin
-               if not Is_Float (V) then
+               if V.Typ.Kind /= Type_Float then
                   Error_Msg_Synth
                     (+Expr, "argument must be a float value");
                   return null;
@@ -1010,7 +1010,7 @@ package body Synth.Oper is
                function Ceil (Arg : Fp64) return Fp64;
                pragma Import (C, Ceil);
             begin
-               if not Is_Float (V) then
+               if V.Typ.Kind /= Type_Float then
                   Error_Msg_Synth
                     (+Expr, "argument must be a float value");
                   return null;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 8ce6bad34..08a1daa36 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -22,6 +22,8 @@ with Ada.Unchecked_Conversion;
 with System;
 with Mutils; use Mutils;
 
+with Netlists.Utils;
+
 package body Synth.Values is
    function To_Bound_Array_Acc is new Ada.Unchecked_Conversion
      (System.Address, Bound_Array_Acc);
@@ -40,7 +42,8 @@ package body Synth.Values is
    function Is_Const (Val : Value_Acc) return Boolean is
    begin
       case Val.Kind is
-         when Value_Discrete =>
+         when Value_Discrete
+           | Value_Float =>
             return True;
          when Value_Net
            | Value_Wire
@@ -52,16 +55,39 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
-         when others =>
-            --  TODO.
+         when Value_Instance
+           | Value_Subtype
+           | Value_Alias =>
+            --  Not really a value.
             raise Internal_Error;
       end case;
    end Is_Const;
 
-   function Is_Float (Val : Value_Acc) return Boolean is
+   function Is_Const_Val (Val : Value_Acc) return Boolean is
    begin
-      return Val.Kind = Value_Float;
-   end Is_Float;
+      case Val.Kind is
+         when Value_Discrete
+           | Value_Float =>
+            return True;
+         when Value_Net =>
+            return Netlists.Utils.Is_Const_Net (Val.N);
+         when Value_Wire =>
+            return Is_Const_Wire (Val.W);
+         when Value_Mux2 =>
+            return False;
+         when Value_Const_Array
+           | Value_Const_Record =>
+            return True;
+         when Value_Array
+           | Value_Record =>
+            return False;
+         when Value_Instance
+           | Value_Subtype
+           | Value_Alias =>
+            --  Not really a value.
+            raise Internal_Error;
+      end case;
+   end Is_Const_Val;
 
    function Is_Bounded_Type (Typ : Type_Acc) return Boolean is
    begin
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index d3af338ab..7c1de0ad9 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -241,7 +241,9 @@ package Synth.Values is
    function Is_Bounded_Type (Typ : Type_Acc) return Boolean;
 
    function Is_Const (Val : Value_Acc) return Boolean;
-   function Is_Float (Val : Value_Acc) return Boolean;
+
+   --  Can also return true for nets and wires.
+   function Is_Const_Val (Val : Value_Acc) return Boolean;
 
    function Is_Equal (L, R : Value_Acc) return Boolean;
 
diff --git a/src/synth/types_utils.ads b/src/synth/types_utils.ads
index d89d9e58a..4e01d89fc 100644
--- a/src/synth/types_utils.ads
+++ b/src/synth/types_utils.ads
@@ -29,4 +29,7 @@ package Types_Utils is
 
    function To_Uns64 is new Ada.Unchecked_Conversion
      (Int64, Uns64);
+
+   function To_Int64 is new Ada.Unchecked_Conversion
+     (Uns64, Int64);
 end Types_Utils;