synth: add value_const.

7 files changed, 69 insertions, 9 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 5f7c7c153..726406f6d 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -32,6 +32,7 @@ with Netlists.Builders; use Netlists.Builders;
 with Netlists.Concats;
 
 with Synth.Expr; use Synth.Expr;
+with Netlists.Locations;
 
 package body Synth.Context is
    package Packages_Table is new Tables
@@ -581,6 +582,13 @@ package body Synth.Context is
                   return Get_Net (Val.A_Obj);
                end if;
             end;
+         when Value_Const =>
+            if Val.C_Net = No_Net then
+               Val.C_Net := Get_Net (Val.C_Val);
+               Locations.Set_Location (Get_Net_Parent (Val.C_Net),
+                                       Get_Location (Val.C_Loc));
+            end if;
+            return Val.C_Net;
          when others =>
             raise Internal_Error;
       end case;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index b7aade231..63661a82e 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -405,6 +405,7 @@ package body Synth.Decls is
       First_Decl : Node;
       Decl_Type : Node;
       Val : Value_Acc;
+      Cst : Value_Acc;
       Obj_Type : Type_Acc;
    begin
       if Deferred_Decl = Null_Node
@@ -438,7 +439,8 @@ package body Synth.Decls is
          --  For constant functions, the value must be constant.
          pragma Assert (not Get_Instance_Const (Syn_Inst)
                           or else Is_Const (Val));
-         Create_Object_Force (Syn_Inst, First_Decl, Val);
+         Cst := Create_Value_Const (Val, Decl);
+         Create_Object_Force (Syn_Inst, First_Decl, Cst);
       end if;
    end Synth_Constant_Declaration;
 
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index e4e12f6e5..9be6d5182 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -1558,6 +1558,7 @@ package body Synth.Expr is
                N : Net;
             begin
                Res := Synth_Expression (Syn_Inst, Pfx);
+               Strip_Const (Res);
                Res_Typ := Res.Typ.Rec.E (Idx + 1).Typ;
                if Res.Kind = Value_Const_Record then
                   return Res.Rec.V (Idx + 1);
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
index dd36ef4aa..d2d4e5cb9 100644
--- a/src/synth/synth-oper.adb
+++ b/src/synth/synth-oper.adb
@@ -409,8 +409,10 @@ package body Synth.Oper is
    begin
       Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Typ);
       Left := Synth_Subtype_Conversion (Left, Left_Typ, False, Expr);
+      Strip_Const (Left);
       Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Typ);
       Right := Synth_Subtype_Conversion (Right, Right_Typ, False, Expr);
+      Strip_Const (Right);
 
       case Def is
          when Iir_Predefined_Error =>
@@ -936,6 +938,7 @@ package body Synth.Oper is
    begin
       Operand := Synth_Expression_With_Type (Syn_Inst, Operand_Expr, Oper_Typ);
       Operand := Synth_Subtype_Conversion (Operand, Oper_Typ, False, Loc);
+      Strip_Const (Operand);
 
       case Def is
          when Iir_Predefined_Error =>
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 6ffb56fab..2cc37ce67 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -179,11 +179,14 @@ package body Synth.Stmts is
                      Dest_Voff := Build_Addidx
                        (Get_Build (Syn_Inst), Dest_Voff, Voff);
                   end if;
-               elsif Dest_Obj.Kind = Value_Const_Array then
-                  Dest_Obj := Dest_Obj.Arr.V
-                    (Iir_Index32 ((Dest_W - Dest_Off) / W));
-                  Dest_Off := 0;
-                  Dest_W := W;
+               else
+                  Strip_Const (Dest_Obj);
+                  if Dest_Obj.Kind = Value_Const_Array then
+                     Dest_Obj := Dest_Obj.Arr.V
+                       (Iir_Index32 ((Dest_W - Dest_Off) / W));
+                     Dest_Off := 0;
+                     Dest_W := W;
+                  end if;
                end if;
             end;
 
@@ -195,6 +198,7 @@ package body Synth.Stmts is
                Synth_Assignment_Prefix
                  (Syn_Inst, Get_Prefix (Pfx),
                   Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
+               Strip_Const (Dest_Obj);
                Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off;
                Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ;
             end;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 30695afa2..2bbe7dd97 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -56,6 +56,8 @@ package body Synth.Values is
             return False;
          when Value_Alias =>
             return Is_Const (Val.A_Obj);
+         when Value_Const =>
+            return True;
          when Value_Instance
            | Value_Subtype =>
             --  Not really a value.
@@ -79,6 +81,8 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
+         when Value_Const =>
+            return True;
          when Value_Instance
            | Value_Subtype
            | Value_Alias =>
@@ -565,6 +569,27 @@ package body Synth.Values is
                                    Typ => Typ)));
    end Create_Value_Alias;
 
+   function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src)
+                               return Value_Acc
+   is
+      subtype Value_Type_Const is Value_Type (Value_Const);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const);
+   begin
+      return To_Value_Acc (Alloc (Current_Pool,
+                                  (Kind => Value_Const,
+                                   C_Val => Val,
+                                   C_Loc => Loc,
+                                   C_Net => No_Net,
+                                   Typ => Val.Typ)));
+   end Create_Value_Const;
+
+   procedure Strip_Const (Val : in out Value_Acc) is
+   begin
+      if Val.Kind = Value_Const then
+         Val := Val.C_Val;
+      end if;
+   end Strip_Const;
+
    function Copy (Src: in Value_Acc) return Value_Acc
    is
       Res: Value_Acc;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 5fc406e9e..93c3d530e 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -19,11 +19,14 @@
 --  MA 02110-1301, USA.
 
 with Types; use Types;
+with Areapools; use Areapools;
+
 with Netlists; use Netlists;
+
 with Vhdl.Nodes; use Vhdl.Nodes;
-with Synth.Environment; use Synth.Environment;
-with Areapools; use Areapools;
 
+with Synth.Environment; use Synth.Environment;
+with Synth.Source; use Synth.Source;
 
 package Synth.Values is
    type Discrete_Range_Type is record
@@ -158,7 +161,12 @@ package Synth.Values is
       --  A package.
       Value_Instance,
 
-      --  An alias
+      --  A constant.  This is a named value.  One purpose is to avoid to
+      --  create many times the same net for the same value.
+      Value_Const,
+
+      --  An alias.  This is a reference to another value with a different
+      --  (but compatible) type.
       Value_Alias,
 
       --  A subtype.  Contains only a type.
@@ -201,6 +209,10 @@ package Synth.Values is
             Rec : Value_Array_Acc;
          when Value_Instance =>
             Instance : Instance_Id;
+         when Value_Const =>
+            C_Val : Value_Acc;
+            C_Loc : Syn_Src;
+            C_Net : Net;
          when Value_Alias =>
             A_Obj : Value_Acc;
             A_Off : Uns32;
@@ -284,6 +296,11 @@ package Synth.Values is
 
    function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc)
                                return Value_Acc;
+   function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src)
+                               return Value_Acc;
+
+   --  If VAL is a const, replace it by its value.
+   procedure Strip_Const (Val : in out Value_Acc);
 
    function Unshare (Src : Value_Acc; Pool : Areapool_Acc)
                     return Value_Acc;