aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/ghdldrv/ghdlsimul.adb2
-rw-r--r--src/simul/simul-vhdl_elab.adb2
-rw-r--r--src/simul/simul-vhdl_simul.adb2
-rw-r--r--src/synth/elab-vhdl_decls.adb69
-rw-r--r--src/synth/elab-vhdl_values.ads1
-rw-r--r--src/synth/synth-vhdl_decls.adb10
-rw-r--r--src/synth/synth-vhdl_decls.ads5
-rw-r--r--src/vhdl/vhdl-annotations.adb2
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);