synth: factorize code (reuse synth_constant_declaration)

8 files changed, 22 insertions, 71 deletions

diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb
index bdc5ef6c8..94d7c0e97 100644
--- a/src/ghdldrv/ghdlsimul.adb
+++ b/src/ghdldrv/ghdlsimul.adb
@@ -89,6 +89,8 @@ package body Ghdlsimul is
          end if;
       end loop;
 
+      Synth.Flags.Flag_Simulation := True;
+
       Lib_Unit := Get_Library_Unit (Config);
       pragma Assert (Get_Kind (Lib_Unit) /= Iir_Kind_Foreign_Module);
       Inst := Elab.Vhdl_Insts.Elab_Top_Unit (Lib_Unit);
diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb
index 9c89cfa81..68135502c 100644
--- a/src/simul/simul-vhdl_elab.adb
+++ b/src/simul/simul-vhdl_elab.adb
@@ -149,7 +149,7 @@ package body Simul.Vhdl_Elab is
 
       --  Set it to the default value.
       if Val.Val.Init /= null then
-         Copy_Memory (E.Val, Val.Val.Init.Mem, E.Typ.Sz);
+         Copy_Memory (E.Val, Get_Memory (Val.Val.Init), E.Typ.Sz);
       else
          Write_Value_Default (E.Val, E.Typ);
       end if;
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index cbf51ff18..28c13d941 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -2759,6 +2759,7 @@ package body Simul.Vhdl_Simul is
                   Mark_Expr_Pool (Marker);
                   Val := Synth.Vhdl_Expr.Synth_Expression_With_Type
                     (C.Assoc_Inst, Get_Actual (C.Assoc), C.Formal.Typ);
+                  Val := Strip_Alias_Const (Val);
                   Signal_Associate_Cst
                     (Sig_Index (Signals_Table.Table (C.Formal.Base).Sig,
                                 C.Formal.Offs.Net_Off),
@@ -3190,7 +3191,6 @@ package body Simul.Vhdl_Simul is
       pragma Assert (Areapools.Is_Empty (Process_Pool));
 
       Synth.Flags.Severity_Level := Grt.Options.Severity_Level;
-      Synth.Flags.Flag_Simulation := True;
 
       if Flag_Interractive then
          Elab.Debugger.Debug_Elab (Vhdl_Elab.Top_Instance);
diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
index 7be65af08..6b3eca650 100644
--- a/src/synth/elab-vhdl_decls.adb
+++ b/src/synth/elab-vhdl_decls.adb
@@ -29,6 +29,7 @@ with Elab.Vhdl_Insts;
 
 with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
 with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
+with Synth.Vhdl_Decls;
 
 package body Elab.Vhdl_Decls is
    procedure Elab_Subprogram_Declaration
@@ -50,68 +51,6 @@ package body Elab.Vhdl_Decls is
       pragma Unreferenced (Typ);
    end Elab_Subprogram_Declaration;
 
-   procedure Elab_Constant_Declaration (Syn_Inst : Synth_Instance_Acc;
-                                        Decl : Node;
-                                        Last_Type : in out Node)
-   is
-      Em : Mark_Type;
-      Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl);
-      First_Decl : Node;
-      Decl_Type : Node;
-      Val : Valtyp;
-      Obj_Type : Type_Acc;
-   begin
-      Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl);
-      if Deferred_Decl = Null_Node
-        or else Get_Deferred_Declaration_Flag (Decl)
-      then
-         --  Create the object (except for full declaration of a
-         --  deferred constant).
-         Create_Object (Syn_Inst, Decl, No_Valtyp);
-      end if;
-      --  Initialize the value (except for a deferred declaration).
-      if Get_Deferred_Declaration_Flag (Decl) then
-         return;
-      end if;
-      if Deferred_Decl = Null_Node then
-         --  A normal constant declaration
-         First_Decl := Decl;
-      else
-         --  The full declaration of a deferred constant.
-         First_Decl := Deferred_Decl;
-      end if;
-      pragma Assert (First_Decl /= Null_Node);
-
-      --  Use the type of the declaration.  The type of the constant may
-      --  be derived from the value.
-      --  FIXME: what about multiple declarations ?
-      Decl_Type := Get_Subtype_Indication (Decl);
-      if Decl_Type = Null_Node then
-         Decl_Type := Last_Type;
-      else
-         if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then
-            --  Type mark.
-            Decl_Type := Get_Type (Get_Named_Entity (Decl_Type));
-         end if;
-         Last_Type := Decl_Type;
-      end if;
-
-      --  Compute expression.
-      Mark_Expr_Pool (Em);
-      Val := Synth_Expression_With_Type
-        (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
-      if Val = No_Valtyp then
-         Set_Error (Syn_Inst);
-         return;
-      end if;
-      Val := Exec_Subtype_Conversion (Val, Obj_Type, True, Decl);
-      Val := Unshare (Val, Instance_Pool);
-      Val.Typ := Unshare (Val.Typ, Instance_Pool);
-      Release_Expr_Pool (Em);
-
-      Create_Object_Force (Syn_Inst, First_Decl, Val);
-   end Elab_Constant_Declaration;
-
    procedure Create_Signal (Syn_Inst : Synth_Instance_Acc;
                             Decl : Node;
                             Typ : Type_Acc)
@@ -320,7 +259,9 @@ package body Elab.Vhdl_Decls is
    procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc;
                                Decl : Node;
                                Force_Init : Boolean;
-                               Last_Type : in out Node) is
+                               Last_Type : in out Node)
+   is
+      use Synth.Vhdl_Decls;
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Variable_Declaration =>
@@ -330,7 +271,7 @@ package body Elab.Vhdl_Decls is
          --     Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
          --     Create_Var_Wire (Syn_Inst, Decl, No_Valtyp);
          when Iir_Kind_Constant_Declaration =>
-            Elab_Constant_Declaration (Syn_Inst, Decl, Last_Type);
+            Synth_Constant_Declaration (Syn_Inst, Decl, False, Last_Type);
          when Iir_Kind_Signal_Declaration =>
             Elab_Signal_Declaration (Syn_Inst, Decl);
          when Iir_Kind_Object_Alias_Declaration =>
diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads
index 1bb5d4683..de06d7941 100644
--- a/src/synth/elab-vhdl_values.ads
+++ b/src/synth/elab-vhdl_values.ads
@@ -197,6 +197,7 @@ package Elab.Vhdl_Values is
 
    --  Return the memory of a Value_Memory value, but also handle const and
    --  aliases.
+   function Get_Memory (V : Value_Acc) return Memory_Ptr;
    function Get_Memory (V : Valtyp) return Memory_Ptr;
 
    --  Return the memtyp of V; also strip const and aliases.
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index 04458cbca..7930426f5 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -190,15 +190,19 @@ package body Synth.Vhdl_Decls is
       Val := Unshare (Val, Instance_Pool);
       Val.Typ := Unshare (Val.Typ, Instance_Pool);
 
-      --  TODO: share above code with elab_constant_declaration
-
       case Val.Val.Kind is
          when Value_Const
             | Value_Alias =>
             Cst := Val;
          when others =>
             if Is_Static (Val.Val) then
-               Cst := Create_Value_Const (Val, Decl, Instance_Pool);
+               if Synth.Flags.Flag_Simulation then
+                  Cst := Val;
+               else
+                  --  For synthesis, add a Value_Const to try to reuse the
+                  --  net.
+                  Cst := Create_Value_Const (Val, Decl, Instance_Pool);
+               end if;
             else
                if not Is_Subprg then
                   Error_Msg_Synth
diff --git a/src/synth/synth-vhdl_decls.ads b/src/synth/synth-vhdl_decls.ads
index 2373aaec1..4f099ff88 100644
--- a/src/synth/synth-vhdl_decls.ads
+++ b/src/synth/synth-vhdl_decls.ads
@@ -31,6 +31,11 @@ package Synth.Vhdl_Decls is
    --  Convert MT to a Pval.
    function Memtyp_To_Pval (Mt : Memtyp) return Pval;
 
+   procedure Synth_Constant_Declaration (Syn_Inst : Synth_Instance_Acc;
+                                         Decl : Node;
+                                         Is_Subprg : Boolean;
+                                         Last_Type : in out Node);
+
    procedure Synth_Object_Alias_Declaration
      (Syn_Inst : Synth_Instance_Acc; Decl : Node);
 
diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb
index 1bb0bff82..6957ba4e3 100644
--- a/src/vhdl/vhdl-annotations.adb
+++ b/src/vhdl/vhdl-annotations.adb
@@ -393,8 +393,6 @@ package body Vhdl.Annotations is
             end if;
 
          when Iir_Kind_Access_Type_Definition =>
-            Annotate_Anonymous_Type_Definition
-              (Block_Info, Get_Designated_Type (Def));
             if Flag_Synthesis then
                --  For the designated type.
                Create_Object_Info (Block_Info, Def, Kind_Type);