aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/areapools.adb5
-rw-r--r--src/areapools.ads4
-rw-r--r--src/ghdldrv/ghdlsynth.adb8
-rw-r--r--src/simul/simul-vhdl_simul.adb23
-rw-r--r--src/synth/elab-vhdl_decls.adb4
-rw-r--r--src/synth/elab-vhdl_decls.ads2
-rw-r--r--src/synth/elab-vhdl_insts.adb8
-rw-r--r--src/synth/elab-vhdl_values.adb52
-rw-r--r--src/synth/elab-vhdl_values.ads11
-rw-r--r--src/synth/synth-vhdl_context.adb13
-rw-r--r--src/synth/synth-vhdl_context.ads6
-rw-r--r--src/synth/synth-vhdl_decls.adb65
-rw-r--r--src/synth/synth-vhdl_expr.adb3
-rw-r--r--src/synth/synth-vhdl_insts.adb86
-rw-r--r--src/synth/synth-vhdl_stmts.adb181
-rw-r--r--src/synth/synthesis.adb7
16 files changed, 362 insertions, 116 deletions
diff --git a/src/areapools.adb b/src/areapools.adb
index 6b49b2d64..7081e8c1b 100644
--- a/src/areapools.adb
+++ b/src/areapools.adb
@@ -128,6 +128,11 @@ package body Areapools is
return Pool.Last = null;
end Is_Empty;
+ function Is_At_Mark (Pool : Areapool; M : Mark_Type) return Boolean is
+ begin
+ return Pool.Last = M.Last and Pool.Next_Use = M.Next_Use;
+ end Is_At_Mark;
+
function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T)
return System.Address
is
diff --git a/src/areapools.ads b/src/areapools.ads
index f1e4276c9..026bb0483 100644
--- a/src/areapools.ads
+++ b/src/areapools.ads
@@ -49,6 +49,10 @@ package Areapools is
procedure Release (M : Mark_Type;
Pool : in out Areapool);
+ -- Return True iff POOL is at the mark level (ie, calling Relase will be
+ -- a no-op).
+ function Is_At_Mark (Pool : Areapool; M : Mark_Type) return Boolean;
+
Empty_Marker : constant Mark_Type;
private
-- Minimal size of allocation.
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 138dca8df..9a70bc912 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -49,6 +49,7 @@ with Netlists.Rename;
with Elab.Vhdl_Context; use Elab.Vhdl_Context;
with Elab.Vhdl_Insts;
with Elab.Debugger;
+with Elab.Vhdl_Objtypes;
with Synthesis;
with Synth.Disp_Vhdl;
@@ -465,6 +466,7 @@ package body Ghdlsynth is
return Module
is
use Vhdl.Configuration;
+ use Elab.Vhdl_Objtypes;
Args : Argument_List (1 .. Argc);
Res : Module;
Cmd : Command_Synth;
@@ -499,11 +501,15 @@ package body Ghdlsynth is
Inst := Elab.Vhdl_Insts.Elab_Top_Unit (Get_Library_Unit (Config));
+ pragma Assert (Is_Expr_Pool_Empty);
+
Res := Synthesis.Synth_Design (Config, Inst, Cmd.Top_Encoding);
if Res = No_Module then
return No_Module;
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
Disp_Design (Cmd, Format_None, Res, Config, Inst);
-- De-elaborate all packages, so that they could be re-used for
@@ -514,6 +520,8 @@ package body Ghdlsynth is
end loop;
Set_Elab_Flag (Vhdl.Std_Package.Std_Standard_Unit, False);
+ pragma Assert (Is_Expr_Pool_Empty);
+
Vhdl.Annotations.Finalize_Annotate;
Synth.Vhdl_Context.Free_Base_Instance;
return Res;
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index f23934103..5d86ee4a2 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -1968,10 +1968,12 @@ package body Simul.Vhdl_Simul is
Res : Valtyp;
- Marker : Mark_Type;
+ Expr_Marker, Inst_Marker : Mark_Type;
begin
- Mark_Expr_Pool (Marker);
+ Mark_Expr_Pool (Expr_Marker);
Instance_Pool := Process_Pool'Access;
+ Areapools.Mark (Inst_Marker, Instance_Pool.all);
+ pragma Assert (Areapools.Is_Empty (Instance_Pool.all));
-- Create the type.
Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (R.Idx_Typ.Drange, Len);
@@ -2004,8 +2006,11 @@ package body Simul.Vhdl_Simul is
Exec_Write_Signal (R.Sig, (Res.Typ, Res.Val.Mem),
Write_Signal_Driving_Value);
- Release_Expr_Pool (Marker);
+ Release_Expr_Pool (Expr_Marker);
+ Areapools.Release (Inst_Marker, Instance_Pool.all);
+
pragma Assert (Is_Expr_Pool_Empty);
+ pragma Assert (Areapools.Is_Empty (Instance_Pool.all));
end Resolution_Proc;
function Create_Scalar_Signal (Typ : Type_Acc; Val : Ghdl_Value_Ptr)
@@ -2411,10 +2416,11 @@ package body Simul.Vhdl_Simul is
Val : Memtyp;
Dst : Memtyp;
- Marker : Mark_Type;
+ Expr_Marker, Inst_Marker : Mark_Type;
begin
+ Areapools.Mark (Inst_Marker, Process_Pool);
+ Mark_Expr_Pool (Expr_Marker);
Instance_Pool := Process_Pool'Access;
- Mark_Expr_Pool (Marker);
Current_Process := null;
Val := Create_Memory (Conv.Src_Typ);
@@ -2437,7 +2443,8 @@ package body Simul.Vhdl_Simul is
(Conv.Dst_Sig, Dst, Write_Signal_Driving_Value);
end case;
- Release_Expr_Pool (Marker);
+ Release_Expr_Pool (Expr_Marker);
+ Areapools.Release (Inst_Marker, Process_Pool);
Instance_Pool := null;
end Conversion_Proc;
@@ -3027,6 +3034,7 @@ package body Simul.Vhdl_Simul is
end if;
pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Areapools.Is_Empty (Process_Pool));
Synth.Flags.Severity_Level := Grt.Options.Severity_Level;
@@ -3037,6 +3045,9 @@ package body Simul.Vhdl_Simul is
Status := Grt.Main.Run_Through_Longjump
(Grt.Processes.Simulation_Init'Access);
+ pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Areapools.Is_Empty (Process_Pool));
+
if Status = 0 then
if Grt.Processes.Flag_AMS then
Grt.Analog_Solver.Start;
diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb
index f873730ba..599d4a342 100644
--- a/src/synth/elab-vhdl_decls.adb
+++ b/src/synth/elab-vhdl_decls.adb
@@ -185,9 +185,7 @@ package body Elab.Vhdl_Decls is
begin
F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl);
Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
- Current_Pool := Instance_Pool;
- Res := Create_Value_File (Obj_Typ, F);
- Current_Pool := Expr_Pool'Access;
+ Res := Create_Value_File (Obj_Typ, F, Instance_Pool);
Create_Object (Syn_Inst, Decl, Res);
end Elab_File_Declaration;
diff --git a/src/synth/elab-vhdl_decls.ads b/src/synth/elab-vhdl_decls.ads
index dd1d647d6..0dc1f98c4 100644
--- a/src/synth/elab-vhdl_decls.ads
+++ b/src/synth/elab-vhdl_decls.ads
@@ -24,6 +24,8 @@ with Elab.Vhdl_Context; use Elab.Vhdl_Context;
package Elab.Vhdl_Decls is
procedure Elab_Subprogram_Declaration
(Syn_Inst : Synth_Instance_Acc; Subprg : Node);
+ procedure Elab_File_Declaration (Syn_Inst : Synth_Instance_Acc;
+ Decl : Node);
procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node;
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
index 3e4906228..8705909db 100644
--- a/src/synth/elab-vhdl_insts.adb
+++ b/src/synth/elab-vhdl_insts.adb
@@ -842,7 +842,7 @@ package body Elab.Vhdl_Insts is
-- Use global memory.
Instance_Pool := Global_Pool'Access;
- pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Is_Expr_Pool_Empty);
-- Start elaboration.
Make_Root_Instance;
@@ -857,7 +857,7 @@ package body Elab.Vhdl_Insts is
Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity));
Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch));
- pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Is_Expr_Pool_Empty);
-- Compute generics.
Inter := Get_Generic_Chain (Entity);
@@ -880,7 +880,7 @@ package body Elab.Vhdl_Insts is
Inter := Get_Chain (Inter);
end loop;
- pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Is_Expr_Pool_Empty);
-- Elaborate port types.
-- FIXME: what about unconstrained ports ? Get the type from the
@@ -909,7 +909,7 @@ package body Elab.Vhdl_Insts is
Inter := Get_Chain (Inter);
end loop;
- pragma Assert (Areapools.Is_Empty (Expr_Pool));
+ pragma Assert (Is_Expr_Pool_Empty);
Elab_Instance_Body (Top_Inst);
diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb
index f86f4739a..3dc7cd1e2 100644
--- a/src/synth/elab-vhdl_values.adb
+++ b/src/synth/elab-vhdl_values.adb
@@ -95,13 +95,13 @@ package body Elab.Vhdl_Values is
return Is_Equal (Get_Memtyp (L), Get_Memtyp (R));
end Is_Equal;
- function Create_Value_Wire (S : Uns32) return Value_Acc
+ function Create_Value_Wire (S : Uns32; Pool : Areapool_Acc)
+ return Value_Acc
is
subtype Value_Type_Wire is Value_Type (Value_Wire);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Wire);
begin
- return To_Value_Acc
- (Alloc (Current_Pool, (Kind => Value_Wire, N => S)));
+ return To_Value_Acc (Alloc (Pool, (Kind => Value_Wire, N => S)));
end Create_Value_Wire;
function Create_Value_Net (S : Uns32) return Value_Acc
@@ -154,21 +154,22 @@ package body Elab.Vhdl_Values is
return Create_Value_Memory ((Vtype, To_Memory_Ptr (M)), Pool);
end Create_Value_Memory;
- function Create_Value_File (File : File_Index) return Value_Acc
+ function Create_Value_File (File : File_Index; Pool : Areapool_Acc)
+ return Value_Acc
is
subtype Value_Type_File is Value_Type (Value_File);
function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_File);
begin
- return To_Value_Acc (Alloc (Current_Pool,
- (Kind => Value_File, File => File)));
+ return To_Value_Acc (Alloc (Pool, (Kind => Value_File, File => File)));
end Create_Value_File;
- function Create_Value_File (Vtype : Type_Acc; File : File_Index)
- return Valtyp
+ function Create_Value_File (Vtype : Type_Acc;
+ File : File_Index;
+ Pool : Areapool_Acc) return Valtyp
is
pragma Assert (Vtype /= null);
begin
- return (Vtype, Create_Value_File (File));
+ return (Vtype, Create_Value_File (File, Pool));
end Create_Value_File;
function Create_Value_Quantity (Q : Quantity_Index_Type) return Value_Acc
@@ -241,22 +242,23 @@ package body Elab.Vhdl_Values is
return Val;
end Create_Value_Dyn_Alias;
- function Create_Value_Const (Val : Value_Acc; Loc : Node) return Value_Acc
+ function Create_Value_Const
+ (Val : Value_Acc; Loc : Node; Pool : Areapool_Acc) 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
pragma Assert (Val = null or else Val.Kind /= Value_Const);
- return To_Value_Acc (Alloc (Current_Pool,
- (Kind => Value_Const,
- C_Val => Val,
- C_Loc => Loc,
- C_Net => 0)));
+ return To_Value_Acc (Alloc (Pool, (Kind => Value_Const,
+ C_Val => Val,
+ C_Loc => Loc,
+ C_Net => 0)));
end Create_Value_Const;
- function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp is
+ function Create_Value_Const (Val : Valtyp; Loc : Node; Pool : Areapool_Acc)
+ return Valtyp is
begin
- return (Val.Typ, Create_Value_Const (Val.Val, Loc));
+ return (Val.Typ, Create_Value_Const (Val.Val, Loc, Pool));
end Create_Value_Const;
procedure Strip_Const (Vt : in out Valtyp) is
@@ -285,18 +287,24 @@ package body Elab.Vhdl_Values is
when Value_Net =>
Res := (Src.Typ, Create_Value_Net (Src.Val.N));
when Value_Wire =>
- Res := (Src.Typ, Create_Value_Wire (Src.Val.N));
+ Res := (Src.Typ, Create_Value_Wire (Src.Val.N, Current_Pool));
when Value_File =>
- Res := Create_Value_File (Src.Typ, Src.Val.File);
+ Res := Create_Value_File (Src.Typ, Src.Val.File, Current_Pool);
when Value_Quantity
| Value_Terminal =>
raise Internal_Error;
when Value_Signal =>
raise Internal_Error;
when Value_Const =>
- Res := (Src.Typ,
- Create_Value_Const (Src.Val.C_Val, Src.Val.C_Loc));
- Res.Val.C_Net := Src.Val.C_Net;
+ declare
+ Cst : Valtyp;
+ begin
+ Cst := Copy ((Src.Typ, Src.Val.C_Val));
+ Res := (Src.Typ,
+ Create_Value_Const (Cst.Val, Src.Val.C_Loc,
+ Current_Pool));
+ Res.Val.C_Net := Src.Val.C_Net;
+ end;
when Value_Alias =>
Res := Create_Value_Alias ((Src.Val.A_Typ, Src.Val.A_Obj),
Src.Val.A_Off, Src.Typ,
diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads
index 67009ba5f..1bb5d4683 100644
--- a/src/synth/elab-vhdl_values.ads
+++ b/src/synth/elab-vhdl_values.ads
@@ -140,7 +140,8 @@ package Elab.Vhdl_Values is
function Create_Value_Net (S : Uns32) return Value_Acc;
-- Create a Value_Wire.
- function Create_Value_Wire (S : Uns32) return Value_Acc;
+ function Create_Value_Wire (S : Uns32; Pool : Areapool_Acc)
+ return Value_Acc;
-- Create a Value_Signal, always on the instance_pool.
function Create_Value_Signal (S : Signal_Index_Type; Init : Value_Acc)
@@ -162,8 +163,9 @@ package Elab.Vhdl_Values is
function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp;
- function Create_Value_File (Vtype : Type_Acc; File : File_Index)
- return Valtyp;
+ function Create_Value_File (Vtype : Type_Acc;
+ File : File_Index;
+ Pool : Areapool_Acc) return Valtyp;
function Create_Value_Quantity (Vtype : Type_Acc; Q : Quantity_Index_Type)
return Valtyp;
@@ -182,7 +184,8 @@ package Elab.Vhdl_Values is
Eoff : Uns32;
Pool : Areapool_Acc) return Value_Acc;
- function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp;
+ function Create_Value_Const (Val : Valtyp; Loc : Node; Pool : Areapool_Acc)
+ return Valtyp;
-- If VAL is a const, replace it by its value.
procedure Strip_Const (Vt : in out Valtyp);
diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb
index 7b6c81cbb..5326c4356 100644
--- a/src/synth/synth-vhdl_context.adb
+++ b/src/synth/synth-vhdl_context.adb
@@ -180,7 +180,7 @@ package body Synth.Vhdl_Context is
else
Wid := Alloc_Wire (Kind, (Obj, Otyp));
end if;
- Val := Create_Value_Wire (Wid, Otyp);
+ Val := Create_Value_Wire (Wid, Otyp, Current_Pool);
Create_Object (Syn_Inst, Obj, Val);
end Create_Wire_Object;
@@ -354,18 +354,21 @@ package body Synth.Vhdl_Context is
Val.N := To_Uns32 (W);
end Set_Value_Wire;
- function Create_Value_Wire (W : Wire_Id) return Value_Acc
+ function Create_Value_Wire (W : Wire_Id; Pool : Areapool_Acc)
+ return Value_Acc
is
function To_Uns32 is new Ada.Unchecked_Conversion (Wire_Id, Uns32);
begin
- return Create_Value_Wire (To_Uns32 (W));
+ return Create_Value_Wire (To_Uns32 (W), Pool);
end Create_Value_Wire;
- function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp
+ function Create_Value_Wire (W : Wire_Id;
+ Wtype : Type_Acc;
+ Pool : Areapool_Acc) return Valtyp
is
pragma Assert (Wtype /= null);
begin
- return (Wtype, Create_Value_Wire (W));
+ return (Wtype, Create_Value_Wire (W, Pool));
end Create_Value_Wire;
function Create_Value_Net (N : Net) return Value_Acc
diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads
index d71a78172..396f0718d 100644
--- a/src/synth/synth-vhdl_context.ads
+++ b/src/synth/synth-vhdl_context.ads
@@ -17,7 +17,7 @@
-- along with this program. If not, see <gnu.org/licenses>.
with Types; use Types;
-with Areapools;
+with Areapools; use Areapools;
with Elab.Vhdl_Context; use Elab.Vhdl_Context;
with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
@@ -107,7 +107,9 @@ package Synth.Vhdl_Context is
function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp;
-- Create a Value_Wire. For a bit wire, RNG must be null.
- function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp;
+ function Create_Value_Wire (W : Wire_Id;
+ Wtype : Type_Acc;
+ Pool : Areapool_Acc) return Valtyp;
-- Create a Value_Dyn_Alias
function Create_Value_Dyn_Alias (Obj : Value_Acc;
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb
index 9cc7dc1bc..36fbf818d 100644
--- a/src/synth/synth-vhdl_decls.adb
+++ b/src/synth/synth-vhdl_decls.adb
@@ -18,6 +18,7 @@
with Types; use Types;
with Std_Names;
+with Areapools;
with Errorout; use Errorout;
with Netlists.Builders; use Netlists.Builders;
@@ -32,7 +33,6 @@ with Vhdl.Std_Package;
with Elab.Vhdl_Values; use Elab.Vhdl_Values;
with Elab.Vhdl_Types; use Elab.Vhdl_Types;
with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;
-with Elab.Vhdl_Files;
with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
@@ -70,7 +70,7 @@ package body Synth.Vhdl_Decls is
Set_Location (Value, Decl);
Set_Wire_Gate (Wid, Value);
- return Create_Value_Wire (Wid, Init.Typ);
+ return Create_Value_Wire (Wid, Init.Typ, Instance_Pool);
end Create_Var_Wire;
function Type_To_Param_Type (Atype : Node) return Param_Type
@@ -129,12 +129,15 @@ package body Synth.Vhdl_Decls is
Last_Type : in out Node)
is
Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl);
+ Marker : Mark_Type;
First_Decl : Node;
Decl_Type : Node;
Val : Valtyp;
Cst : Valtyp;
Obj_Type : Type_Acc;
begin
+ Mark_Expr_Pool (Marker);
+
Obj_Type := Elab_Declaration_Type (Syn_Inst, Decl);
if Deferred_Decl = Null_Node
or else Get_Deferred_Declaration_Flag (Decl)
@@ -173,19 +176,26 @@ package body Synth.Vhdl_Decls is
(Syn_Inst, Get_Default_Value (Decl), Obj_Type);
if Val = No_Valtyp then
Set_Error (Syn_Inst);
+ Release_Expr_Pool (Marker);
return;
end if;
Val := Synth_Subtype_Conversion (Syn_Inst, Val, Obj_Type, True, Decl);
-- For constant functions, the value must be constant.
pragma Assert (not Get_Instance_Const (Syn_Inst)
- or else Is_Static (Val.Val));
+ or else Is_Static (Val.Val));
+
+ 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);
+ Cst := Create_Value_Const (Val, Decl, Instance_Pool);
else
if not Is_Subprg then
Error_Msg_Synth
@@ -196,6 +206,7 @@ package body Synth.Vhdl_Decls is
end if;
end case;
Create_Object_Force (Syn_Inst, First_Decl, Cst);
+ Release_Expr_Pool (Marker);
end Synth_Constant_Declaration;
procedure Synth_Attribute_Object (Syn_Inst : Synth_Instance_Acc;
@@ -373,6 +384,7 @@ package body Synth.Vhdl_Decls is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
Def : constant Node := Get_Default_Value (Decl);
Decl_Type : constant Node := Get_Type (Decl);
+ Marker : Mark_Type;
Init : Valtyp;
Val : Valtyp;
Obj_Typ : Type_Acc;
@@ -387,13 +399,16 @@ package body Synth.Vhdl_Decls is
return;
end if;
+ Mark_Expr_Pool (Marker);
if Obj_Typ.Wkind /= Wkind_Net
and then not Get_Instance_Const (Syn_Inst)
then
Error_Msg_Synth
(+Decl, "variable with access type is not synthesizable");
-- FIXME: use a poison value ?
- Create_Object (Syn_Inst, Decl, Create_Value_Default (Obj_Typ));
+ Init := Create_Value_Default (Obj_Typ);
+ Init := Unshare (Init, Instance_Pool);
+ Create_Object (Syn_Inst, Decl, Init);
else
if Is_Valid (Def) then
Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
@@ -411,7 +426,7 @@ package body Synth.Vhdl_Decls is
end if;
if Get_Instance_Const (Syn_Inst) then
Init := Strip_Alias_Const (Init);
- Init := Unshare (Init, Current_Pool);
+ Init := Unshare (Init, Instance_Pool);
Create_Object (Syn_Inst, Decl, Init);
else
Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init);
@@ -428,11 +443,13 @@ package body Synth.Vhdl_Decls is
end if;
end if;
end if;
+ Release_Expr_Pool (Marker);
end Synth_Variable_Declaration;
procedure Synth_Shared_Variable_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node)
is
+ Marker : Mark_Type;
Init : Valtyp;
Val : Valtyp;
begin
@@ -442,7 +459,10 @@ package body Synth.Vhdl_Decls is
Set_Error (Syn_Inst);
else
if Init.Val = null then
+ Mark_Expr_Pool (Marker);
Init := Create_Value_Default (Init.Typ);
+ Init := Unshare (Init, Instance_Pool);
+ Release_Expr_Pool (Marker);
end if;
end if;
@@ -478,6 +498,7 @@ package body Synth.Vhdl_Decls is
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
Atype : constant Node := Get_Declaration_Type (Decl);
+ Marker : Mark_Type;
Off : Value_Offsets;
Dyn : Vhdl_Stmts.Dyn_Name;
Res : Valtyp;
@@ -493,6 +514,8 @@ package body Synth.Vhdl_Decls is
Obj_Typ := null;
end if;
+ Mark_Expr_Pool (Marker);
+
Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl),
Base, Typ, Off, Dyn);
pragma Assert (Dyn.Voff = No_Net);
@@ -511,12 +534,14 @@ package body Synth.Vhdl_Decls is
Res := Synth_Subtype_Conversion (Syn_Inst, Res, Obj_Typ, True, Decl);
end if;
Res := Unshare (Res, Instance_Pool);
+ Release_Expr_Pool (Marker);
Create_Object (Syn_Inst, Decl, Res);
end Synth_Object_Alias_Declaration;
procedure Synth_Concurrent_Object_Alias_Declaration
(Syn_Inst : Synth_Instance_Acc; Decl : Node)
is
+ Marker : Mark_Type;
Val : Valtyp;
Aval : Valtyp;
Obj : Value_Acc;
@@ -527,6 +552,8 @@ package body Synth.Vhdl_Decls is
pragma Assert (Val.Val.Kind = Value_Alias);
Obj := Val.Val.A_Obj;
if Obj.Kind = Value_Signal then
+ Mark_Expr_Pool (Marker);
+
-- A signal must have been changed to a wire or a net, but the
-- aliases have not been updated. Update here.
Base := Decl;
@@ -547,21 +574,30 @@ package body Synth.Vhdl_Decls is
if Aval.Val.Kind = Value_Net then
-- Object is a net if it is not writable. Extract the
-- bits for the alias.
+ Current_Pool := Instance_Pool;
Aval := Create_Value_Net
(Build2_Extract (Get_Build (Syn_Inst), Get_Value_Net (Aval.Val),
Off, Val.Typ.W),
Val.Typ);
+ Current_Pool := Expr_Pool'Access;
Val.Val.A_Off := (0, 0);
+ else
+ Aval := Unshare (Aval, Instance_Pool);
end if;
Val.Val.A_Obj := Aval.Val;
+ Release_Expr_Pool (Marker);
end if;
end Synth_Concurrent_Object_Alias_Declaration;
procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc;
Decl : Node;
Is_Subprg : Boolean;
- Last_Type : in out Node) is
+ Last_Type : in out Node)
+ is
+ Marker : Mark_Type;
begin
+ Mark_Expr_Pool (Marker);
+
case Get_Kind (Decl) is
when Iir_Kind_Variable_Declaration =>
Synth_Variable_Declaration (Syn_Inst, Decl, Is_Subprg);
@@ -613,17 +649,7 @@ package body Synth.Vhdl_Decls is
when Iir_Kind_Component_Declaration =>
null;
when Iir_Kind_File_Declaration =>
- declare
- F : File_Index;
- Res : Valtyp;
- Obj_Typ : Type_Acc;
- begin
- F := Elab.Vhdl_Files.Elaborate_File_Declaration
- (Syn_Inst, Decl);
- Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
- Res := Create_Value_File (Obj_Typ, F);
- Create_Object (Syn_Inst, Decl, Res);
- end;
+ Elab.Vhdl_Decls.Elab_File_Declaration (Syn_Inst, Decl);
when Iir_Kind_Protected_Type_Body =>
null;
when Iir_Kind_Psl_Default_Clock =>
@@ -639,6 +665,8 @@ package body Synth.Vhdl_Decls is
when others =>
Vhdl.Errors.Error_Kind ("synth_declaration", Decl);
end case;
+
+ pragma Assert (Areapools.Is_At_Mark (Expr_Pool, Marker));
end Synth_Declaration;
procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc;
@@ -835,6 +863,7 @@ package body Synth.Vhdl_Decls is
when others =>
Vhdl.Errors.Error_Kind ("synth_concurrent_declaration", Decl);
end case;
+ pragma Assert (Is_Expr_Pool_Empty);
end Synth_Concurrent_Declaration;
procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc;
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index 9f581a8ce..c2becbe6c 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -498,7 +498,8 @@ package body Synth.Vhdl_Expr is
begin
case Val.Val.Kind is
when Value_Wire =>
- return Create_Value_Wire (Get_Value_Wire (Val.Val), Ntype);
+ return Create_Value_Wire
+ (Get_Value_Wire (Val.Val), Ntype, Current_Pool);
when Value_Net =>
return Create_Value_Net (Get_Value_Net (Val.Val), Ntype);
when Value_Alias =>
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb
index 9c88861a2..352ab3f12 100644
--- a/src/synth/synth-vhdl_insts.adb
+++ b/src/synth/synth-vhdl_insts.adb
@@ -24,6 +24,7 @@ with Std_Names;
with Hash; use Hash;
with Dyn_Tables;
with Interning;
+with Areapools;
with Synthesis; use Synthesis;
with Grt.Algos;
@@ -479,6 +480,7 @@ package body Synth.Vhdl_Insts is
Inter := Get_Port_Chain (Decl);
Nbr_Inputs := 0;
Nbr_Outputs := 0;
+ Current_Pool := Global_Pool'Access;
while Is_Valid (Inter) loop
Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ;
@@ -488,12 +490,14 @@ package body Synth.Vhdl_Insts is
Nbr_Inputs := Nbr_Inputs + Count_Nbr_Ports (Inter_Typ);
when Port_Out
| Port_Inout =>
- Val := Create_Value_Wire (No_Wire_Id, Inter_Typ);
+ Val := Create_Value_Wire
+ (No_Wire_Id, Inter_Typ, Current_Pool);
Nbr_Outputs := Nbr_Outputs + Count_Nbr_Ports (Inter_Typ);
end case;
Replace_Signal (Params.Syn_Inst, Inter, Val);
Inter := Get_Chain (Inter);
end loop;
+ Current_Pool := Expr_Pool'Access;
-- Declare module.
-- Build it now because it may be referenced for instantiations before
@@ -835,12 +839,14 @@ package body Synth.Vhdl_Insts is
Assoc : Node;
Inter_Inst : Synth_Instance_Acc;
Inter : Node;
- Inter_Typ : Type_Acc)
- return Net
+ Inter_Typ : Type_Acc) return Net
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ Marker : Mark_Type;
Res : Valtyp;
+ Res_Net : Net;
begin
+ Mark_Expr_Pool (Marker);
case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is
when Iir_Kind_Association_Element_Open =>
Res := Synth_Single_Input_Assoc
@@ -851,13 +857,19 @@ package body Synth.Vhdl_Insts is
Res := Synth_Single_Input_Assoc
(Syn_Inst, Inter_Typ, Syn_Inst, Get_Actual (Assoc), Assoc);
when Iir_Kind_Association_Element_By_Individual =>
- return Synth_Individual_Input_Assoc (Syn_Inst, Assoc, Inter_Inst);
+ Res_Net := Synth_Individual_Input_Assoc
+ (Syn_Inst, Assoc, Inter_Inst);
+ Release_Expr_Pool (Marker);
+ return Res_Net;
end case;
if Res = No_Valtyp then
return No_Net;
end if;
- return Get_Net (Ctxt, Res);
+ Res_Net := Get_Net (Ctxt, Res);
+ Release_Expr_Pool (Marker);
+
+ return Res_Net;
end Synth_Input_Assoc;
procedure Synth_Individual_Output_Assoc (Outp : Net;
@@ -865,6 +877,7 @@ package body Synth.Vhdl_Insts is
Assoc : Node;
Inter_Inst : Synth_Instance_Acc)
is
+ Marker : Mark_Type;
Iassoc : Node;
V : Valtyp;
Off : Uns32;
@@ -872,6 +885,8 @@ package body Synth.Vhdl_Insts is
O : Net;
Port : Net;
begin
+ Mark_Expr_Pool (Marker);
+
Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp);
Set_Location (Port, Assoc);
@@ -891,6 +906,8 @@ package body Synth.Vhdl_Insts is
-- 3. Assign.
Synth_Assignment (Syn_Inst, Get_Actual (Iassoc), V, Iassoc);
+ Release_Expr_Pool (Marker);
+
Iassoc := Get_Chain (Iassoc);
end loop;
end Synth_Individual_Output_Assoc;
@@ -901,6 +918,7 @@ package body Synth.Vhdl_Insts is
Inter_Inst : Synth_Instance_Acc;
Inter : Node)
is
+ Marker : Mark_Type;
Actual : Node;
Formal_Typ : Type_Acc;
Port : Net;
@@ -920,12 +938,14 @@ package body Synth.Vhdl_Insts is
Formal_Typ := Get_Value (Inter_Inst, Inter).Typ;
+ Mark_Expr_Pool (Marker);
-- Create a port gate (so that is has a name).
Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp);
Set_Location (Port, Assoc);
O := Create_Value_Net (Port, Formal_Typ);
-- Assign the port output to the actual (a net).
Synth_Assignment (Syn_Inst, Actual, O, Assoc);
+ Release_Expr_Pool (Marker);
end Synth_Output_Assoc;
procedure Inst_Input_Connect (Syn_Inst : Synth_Instance_Acc;
@@ -1013,6 +1033,7 @@ package body Synth.Vhdl_Insts is
-- Instantiate the module
-- Elaborate ports + map aspect for the inputs (component then entity)
-- Elaborate ports + map aspect for the outputs (entity then component)
+ Marker : Mark_Type;
Assoc : Node;
Assoc_Inter : Node;
@@ -1022,6 +1043,8 @@ package body Synth.Vhdl_Insts is
Nbr_Outputs : Port_Nbr;
N : Net;
begin
+ Mark_Expr_Pool (Marker);
+
Assoc := Ports_Assoc;
Assoc_Inter := Get_Port_Chain (Ent);
Nbr_Inputs := 0;
@@ -1038,13 +1061,17 @@ package body Synth.Vhdl_Insts is
(Syn_Inst, Assoc, Ent_Inst, Inter, Inter_Typ);
Inst_Input_Connect
(Syn_Inst, Inst, Nbr_Inputs, Inter_Typ, N);
+
when Port_Out
| Port_Inout =>
Inst_Output_Connect
(Syn_Inst, Inst, Nbr_Outputs, Inter_Typ, N);
+
Synth_Output_Assoc
(N, Syn_Inst, Assoc, Ent_Inst, Inter);
+
end case;
+ pragma Assert (Areapools.Is_At_Mark (Expr_Pool, Marker));
end if;
Next_Association_Interface (Assoc, Assoc_Inter);
end loop;
@@ -1108,6 +1135,7 @@ package body Synth.Vhdl_Insts is
Syn_Inst => Sub_Inst,
Encoding => Enc));
+ pragma Assert (Is_Expr_Pool_Empty);
-- Do the instantiation.
Inst := New_Instance
@@ -1116,14 +1144,21 @@ package body Synth.Vhdl_Insts is
New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)));
Set_Location (Inst, Stmt);
+ pragma Assert (Is_Expr_Pool_Empty);
+
Push_Phi;
Synth_Instantiate_Module_Ports
(Syn_Inst, Inst, Inst_Obj.Syn_Inst, Inst_Obj.Decl,
Get_Port_Map_Aspect_Chain (Stmt));
+ pragma Assert (Is_Expr_Pool_Empty);
+
Synth_Instantiate_Module_Generics (Inst, Inst_Obj);
+ pragma Assert (Is_Expr_Pool_Empty);
Pop_And_Merge_Phi (Get_Build (Syn_Inst), Get_Location (Stmt));
+
+ pragma Assert (Is_Expr_Pool_Empty);
end Synth_Direct_Instantiation_Statement;
procedure Synth_Design_Instantiation_Statement
@@ -1187,6 +1222,7 @@ package body Synth.Vhdl_Insts is
Bind : constant Node := Get_Binding_Indication (Config);
Aspect : constant Node := Get_Entity_Aspect (Bind);
+ Marker : Mark_Type;
Ent : Node;
Arch : Node;
Sub_Config : Node;
@@ -1197,6 +1233,8 @@ package body Synth.Vhdl_Insts is
M : Module;
begin
+ Mark_Expr_Pool (Marker);
+ pragma Assert (Is_Expr_Pool_Empty);
pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity);
Push_Phi;
@@ -1231,7 +1269,8 @@ package body Synth.Vhdl_Insts is
Val := Create_Value_Net (N, Inter_Typ);
when Port_Out
| Port_Inout =>
- Val := Create_Value_Wire (No_Wire_Id, Inter_Typ);
+ Val := Create_Value_Wire
+ (No_Wire_Id, Inter_Typ, Instance_Pool);
Create_Component_Wire
(Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name,
Assoc);
@@ -1321,6 +1360,8 @@ package body Synth.Vhdl_Insts is
Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt));
Finalize_Declarations (Comp_Inst, Get_Port_Chain (Component));
+
+ Release_Expr_Pool (Marker);
end Synth_Component_Instantiation_Statement;
procedure Synth_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node)
@@ -1415,6 +1456,8 @@ package body Synth.Vhdl_Insts is
Elab.Debugger.Debug_Init (Arch);
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
-- Dependencies first.
Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity));
Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));
@@ -1434,6 +1477,8 @@ package body Synth.Vhdl_Insts is
Syn_Inst => Syn_Inst,
Encoding => Encoding));
pragma Unreferenced (Inst_Obj);
+
+ pragma Assert (Is_Expr_Pool_Empty);
end Synth_Top_Entity;
procedure Create_Input_Wire (Syn_Inst : Synth_Instance_Acc;
@@ -1459,6 +1504,7 @@ package body Synth.Vhdl_Insts is
Default : constant Node := Get_Default_Value (Inter);
Desc : constant Port_Desc :=
Get_Output_Desc (Get_Module (Self_Inst), Idx);
+ Marker : Mark_Type;
Inter_Typ : Type_Acc;
Value : Net;
Vout : Net;
@@ -1472,11 +1518,13 @@ package body Synth.Vhdl_Insts is
-- pragma Assert (Desc.W = Get_Type_Width (Val.Typ));
if Default /= Null_Node then
+ Mark_Expr_Pool (Marker);
Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter));
Init := Synth_Expression_With_Type (Syn_Inst, Default, Inter_Typ);
Init := Synth_Subtype_Conversion
(Syn_Inst, Init, Inter_Typ, False, Inter);
Init_Net := Get_Net (Ctxt, Init);
+ Release_Expr_Pool (Marker);
else
Init_Net := No_Net;
end if;
@@ -1528,6 +1576,7 @@ package body Synth.Vhdl_Insts is
Entity : constant Node := Inst.Decl;
Arch : constant Node := Inst.Arch;
Syn_Inst : constant Synth_Instance_Acc := Inst.Syn_Inst;
+ Marker : Mark_Type;
Self_Inst : Instance;
Inter : Node;
Vt : Valtyp;
@@ -1543,6 +1592,8 @@ package body Synth.Vhdl_Insts is
Errors.Info_Msg_Synth (+Entity, "synthesizing %n", (1 => +Entity));
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
-- Save the current architecture, so that files can be open using a
-- path relative to the architecture filename.
Elab.Vhdl_Files.Set_Design_Unit (Arch);
@@ -1553,6 +1604,11 @@ package body Synth.Vhdl_Insts is
Self_Inst := Get_Self_Instance (Inst.M);
Set_Location (Self_Inst, Entity);
+ pragma Assert (Is_Expr_Pool_Empty);
+
+ Areapools.Mark (Marker, Process_Pool);
+ Instance_Pool := Process_Pool'Access;
+
-- Create wires for inputs and outputs.
Inter := Get_Port_Chain (Entity);
Nbr_Inputs := 0;
@@ -1567,6 +1623,7 @@ package body Synth.Vhdl_Insts is
Create_Output_Wire
(Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt);
end case;
+ pragma Assert (Is_Expr_Pool_Empty);
Inter := Get_Chain (Inter);
end loop;
@@ -1581,29 +1638,42 @@ package body Synth.Vhdl_Insts is
(Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
if not Is_Error (Syn_Inst) then
Synth_Attribute_Values (Syn_Inst, Entity);
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
-- Architecture
if not Is_Error (Syn_Inst) then
Synth_Concurrent_Declarations
(Syn_Inst, Get_Declaration_Chain (Arch));
end if;
+
+ pragma Assert (Is_Expr_Pool_Empty);
+
if not Is_Error (Syn_Inst) then
Synth_Concurrent_Statements
(Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
if not Is_Error (Syn_Inst) then
Synth_Attribute_Values (Syn_Inst, Arch);
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
-- Vunits
if not Is_Error (Syn_Inst) then
Synth_Verification_Units (Syn_Inst);
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
-- Finalize
Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
@@ -1611,7 +1681,11 @@ package body Synth.Vhdl_Insts is
Finalize_Wires;
+ Areapools.Release (Marker, Process_Pool);
+
Synthesis.Instance_Passes (Get_Build (Syn_Inst), Inst.M);
+
+ pragma Assert (Is_Expr_Pool_Empty);
end Synth_Instance;
procedure Synth_All_Instances
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index a10167cf3..6007fd975 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -699,19 +699,23 @@ package body Synth.Vhdl_Stmts is
procedure Synth_Simple_Signal_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
+ Marker : Mark_Type;
Targ : Target_Info;
Val : Valtyp;
begin
+ Mark_Expr_Pool (Marker);
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Val := Synth_Waveform
(Syn_Inst, Get_Waveform_Chain (Stmt), Targ.Targ_Type);
Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
+ Release_Expr_Pool (Marker);
end Synth_Simple_Signal_Assignment;
procedure Synth_Conditional_Signal_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ Marker : Mark_Type;
Targ : Target_Info;
Cond : Node;
Cwf : Node;
@@ -721,6 +725,7 @@ package body Synth.Vhdl_Stmts is
First, Last : Net;
V : Net;
begin
+ Mark_Expr_Pool (Marker);
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Last := No_Net;
Cwf := Get_Conditional_Waveform_Chain (Stmt);
@@ -767,6 +772,7 @@ package body Synth.Vhdl_Stmts is
end if;
Val := Create_Value_Net (First, Targ.Targ_Type);
Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
+ Release_Expr_Pool (Marker);
end Synth_Conditional_Signal_Assignment;
procedure Synth_Variable_Assignment (Inst : Synth_Instance_Acc; Stmt : Node)
@@ -873,24 +879,33 @@ package body Synth.Vhdl_Stmts is
Cond : constant Node := Get_Condition (Stmt);
Els : constant Node := Get_Else_Clause (Stmt);
Ctxt : constant Context_Acc := Get_Build (C.Inst);
+ Cond_Static : Int64;
+ Marker : Mark_Type;
Cond_Val : Valtyp;
Cond_Net : Net;
Phi_True : Phi_Type;
Phi_False : Phi_Type;
begin
+ Mark_Expr_Pool (Marker);
+
Cond_Val := Synth_Expression (C.Inst, Cond);
if Cond_Val = No_Valtyp then
Set_Error (C.Inst);
+ Release_Expr_Pool (Marker);
return;
end if;
+
if Is_Static_Val (Cond_Val.Val) then
Strip_Const (Cond_Val);
- if Read_Discrete (Get_Value_Memtyp (Cond_Val)) = 1 then
+ Cond_Static := Read_Discrete (Get_Value_Memtyp (Cond_Val));
+ Release_Expr_Pool (Marker);
+
+ if Cond_Static = 1 then
-- True.
Synth_Sequential_Statements
(C, Get_Sequential_Statement_Chain (Stmt));
else
- pragma Assert (Read_Discrete (Get_Value_Memtyp (Cond_Val)) = 0);
+ pragma Assert (Cond_Static = 0);
if Is_Valid (Els) then
-- Else part
if Is_Null (Get_Condition (Els)) then
@@ -904,6 +919,9 @@ package body Synth.Vhdl_Stmts is
end if;
end if;
else
+ Cond_Net := Get_Net (Ctxt, Cond_Val);
+ Release_Expr_Pool (Marker);
+
-- The statements for the 'then' part.
Push_Phi;
Synth_Sequential_Statements
@@ -925,7 +943,6 @@ package body Synth.Vhdl_Stmts is
Pop_Phi (Phi_False);
- Cond_Net := Get_Net (Ctxt, Cond_Val);
Merge_Phis (Ctxt, Cond_Net, Phi_True, Phi_False, Get_Location (Stmt));
end if;
end Synth_If_Statement;
@@ -1000,9 +1017,11 @@ package body Synth.Vhdl_Stmts is
Choice : in out Node)
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ Marker : Mark_Type;
Cond : Net;
Res : Net;
begin
+ Mark_Expr_Pool (Marker);
Res := No_Net;
loop
case Iir_Kinds_Case_Choice (Get_Kind (Choice)) is
@@ -1021,6 +1040,7 @@ package body Synth.Vhdl_Stmts is
(Ctxt, Id_Eq, Sel, Get_Net (Ctxt, V));
Set_Location (Cond, Choice);
end if;
+ Release_Expr_Pool (Marker);
end;
when Iir_Kind_Choice_By_Range =>
@@ -1066,6 +1086,7 @@ package body Synth.Vhdl_Stmts is
Cond := Build_Dyadic (Ctxt, Id_And, L, R);
Set_Location (Cond, Choice);
+ Release_Expr_Pool (Marker);
end;
when Iir_Kind_Choice_By_Others =>
@@ -1551,16 +1572,20 @@ package body Synth.Vhdl_Stmts is
procedure Synth_Case_Statement (C : in out Seq_Context; Stmt : Node)
is
Expr : constant Node := Get_Expression (Stmt);
+ Marker : Mark_Type;
Sel : Valtyp;
Stmts : Node;
begin
+ Mark_Expr_Pool (Marker);
Sel := Synth_Expression_With_Basetype (C.Inst, Expr);
Strip_Const (Sel);
if Is_Static (Sel.Val) then
Stmts := Execute_Static_Case_Statement (C.Inst, Stmt, Sel);
+ Release_Expr_Pool (Marker);
Synth_Sequential_Statements (C, Stmts);
else
Synth_Case_Statement_Dynamic (C, Stmt, Sel);
+ Release_Expr_Pool (Marker);
end if;
end Synth_Case_Statement;
@@ -1573,6 +1598,8 @@ package body Synth.Vhdl_Stmts is
Expr : constant Node := Get_Expression (Stmt);
Choices : constant Node := Get_Selected_Waveform_Chain (Stmt);
+ Marker : Mark_Type;
+
Targ : Target_Info;
Targ_Type : Type_Acc;
@@ -1592,6 +1619,7 @@ package body Synth.Vhdl_Stmts is
Sel : Valtyp;
Sel_Net : Net;
begin
+ Mark_Expr_Pool (Marker);
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Targ_Type := Targ.Targ_Type;
@@ -1684,6 +1712,7 @@ package body Synth.Vhdl_Stmts is
-- free.
Free_Alternative_Data_Array (Alts);
Free_Net_Array (Nets);
+ Release_Expr_Pool (Marker);
end Synth_Selected_Signal_Assignment;
function Synth_Label (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
@@ -2097,7 +2126,7 @@ package body Synth.Vhdl_Stmts is
Wire := Alloc_Wire (Wire_Variable, (Inter, Val.Typ));
Set_Wire_Gate (Wire, Get_Net (Ctxt, Val));
- Val := Create_Value_Wire (Wire, Val.Typ);
+ Val := Create_Value_Wire (Wire, Val.Typ, Instance_Pool);
Create_Object_Force (Subprg_Inst, Inter, No_Valtyp);
Create_Object_Force (Subprg_Inst, Inter, Val);
end if;
@@ -2178,6 +2207,7 @@ package body Synth.Vhdl_Stmts is
Is_Func : constant Boolean := Is_Function_Declaration (Imp);
Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp);
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
+ Ret_Typ : Type_Acc;
Res : Valtyp;
C : Seq_Context (Mode_Dynamic);
Wire_Mark : Wire_Id;
@@ -2209,11 +2239,12 @@ package body Synth.Vhdl_Stmts is
if Is_Func then
-- Set a default value for the return.
- C.Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp));
+ Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp));
+ C.Ret_Typ := Ret_Typ;
Set_Wire_Gate (C.W_Val,
- Build_Control_Signal (Sub_Inst, C.Ret_Typ.W, Imp));
- C.Ret_Init := Build_Const_X (Ctxt, C.Ret_Typ.W);
+ Build_Control_Signal (Sub_Inst, Ret_Typ.W, Imp));
+ C.Ret_Init := Build_Const_X (Ctxt, Ret_Typ.W);
Phi_Assign_Net (Ctxt, C.W_Val, C.Ret_Init, 0);
end if;
@@ -2242,8 +2273,8 @@ package body Synth.Vhdl_Stmts is
elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value.Val) then
Res := C.Ret_Value;
else
- Res := Create_Value_Net
- (Get_Current_Value (Ctxt, C.W_Val), C.Ret_Value.Typ);
+ Res := Create_Value_Net (Get_Current_Value (Ctxt, C.W_Val),
+ Unshare_Type (C.Ret_Typ, Ret_Typ));
end if;
else
Res := No_Valtyp;
@@ -2577,6 +2608,9 @@ package body Synth.Vhdl_Stmts is
Free_Instance (Sub_Inst);
+ -- Note: instance_pool is not released, as the result may be on that
+ -- pool. Must be done by the caller.
+
return Res;
end Exec_Resolution_Call;
@@ -2785,6 +2819,7 @@ package body Synth.Vhdl_Stmts is
Ctxt : constant Context_Acc := Get_Build (C.Inst);
Cond : constant Node := Get_Condition (Stmt);
Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement;
+ Marker : Mark_Type;
Static_Cond : Boolean;
Loop_Label : Node;
Lc : Loop_Context_Acc;
@@ -2792,12 +2827,14 @@ package body Synth.Vhdl_Stmts is
Phi_True : Phi_Type;
Phi_False : Phi_Type;
begin
+ Mark_Expr_Pool (Marker);
if Cond /= Null_Node then
Cond_Val := Synth_Expression (C.Inst, Cond);
Static_Cond := Is_Static_Val (Cond_Val.Val);
if Static_Cond then
if Get_Static_Discrete (Cond_Val) = 0 then
-- Not executed.
+ Release_Expr_Pool (Marker);
return;
end if;
else
@@ -2844,6 +2881,7 @@ package body Synth.Vhdl_Stmts is
Merge_Phis (Ctxt, Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False,
Get_Location (Stmt));
end if;
+ Release_Expr_Pool (Marker);
end Synth_Dynamic_Exit_Next_Statement;
procedure Synth_Static_Exit_Next_Statement
@@ -2851,21 +2889,26 @@ package body Synth.Vhdl_Stmts is
is
Cond : constant Node := Get_Condition (Stmt);
Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement;
+ Marker : Mark_Type;
Loop_Label : Node;
Lc : Loop_Context_Acc;
Cond_Val : Valtyp;
begin
if Cond /= Null_Node then
+ Mark_Expr_Pool (Marker);
Cond_Val := Synth_Expression (C.Inst, Cond);
if Cond_Val = No_Valtyp then
Set_Error (C.Inst);
+ Release_Expr_Pool (Marker);
return;
end if;
pragma Assert (Is_Static_Val (Cond_Val.Val));
if Get_Static_Discrete (Cond_Val) = 0 then
-- Not executed.
+ Release_Expr_Pool (Marker);
return;
end if;
+ Release_Expr_Pool (Marker);
end if;
-- Execution is suspended.
@@ -3005,7 +3048,9 @@ package body Synth.Vhdl_Stmts is
is
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
Cond : constant Node := Get_Condition (Stmt);
+ Marker : Mark_Type;
Val : Valtyp;
+ Cv : Boolean;
Lc : aliased Loop_Context (Mode_Dynamic);
Iter_Nbr : Natural;
begin
@@ -3025,12 +3070,16 @@ package body Synth.Vhdl_Stmts is
loop
if Cond /= Null_Node then
+ Mark_Expr_Pool (Marker);
Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type);
if not Is_Static (Val.Val) then
Error_Msg_Synth (+Cond, "loop condition must be static");
+ Release_Expr_Pool (Marker);
exit;
end if;
- exit when Read_Discrete (Val) = 0;
+ Cv := Read_Discrete (Val) = 0;
+ Release_Expr_Pool (Marker);
+ exit when Cv;
end if;
Synth_Sequential_Statements (C, Stmts);
@@ -3060,7 +3109,9 @@ package body Synth.Vhdl_Stmts is
is
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
Cond : constant Node := Get_Condition (Stmt);
+ Marker : Mark_Type;
Val : Valtyp;
+ Cv : Boolean;
Lc : aliased Loop_Context (Mode_Static);
begin
Lc := (Mode => Mode_Static,
@@ -3072,9 +3123,12 @@ package body Synth.Vhdl_Stmts is
loop
if Cond /= Null_Node then
+ Mark_Expr_Pool (Marker);
Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type);
pragma Assert (Is_Static (Val.Val));
- exit when Read_Discrete (Val) = 0;
+ Cv := Read_Discrete (Val) = 0;
+ Release_Expr_Pool (Marker);
+ exit when Cv;
end if;
Synth_Sequential_Statements (C, Stmts);
@@ -3091,35 +3145,37 @@ package body Synth.Vhdl_Stmts is
is
Is_Dyn : constant Boolean := not Get_Instance_Const (C.Inst);
Ctxt : constant Context_Acc := Get_Build (C.Inst);
- Val : Valtyp;
Expr : constant Node := Get_Expression (Stmt);
+ Val : Valtyp;
begin
if Expr /= Null_Node then
-- Return in function.
Val := Synth_Expression_With_Type (C.Inst, Expr, C.Ret_Typ);
+ if Val /= No_Valtyp then
+ Val := Synth_Subtype_Conversion
+ (C.Inst, Val, C.Ret_Typ, True, Stmt);
+ end if;
if Val = No_Valtyp then
Set_Error (C.Inst);
- return;
- end if;
-
- Val := Synth_Subtype_Conversion (C.Inst, Val, C.Ret_Typ, True, Stmt);
-
- if C.Nbr_Ret = 0 then
- C.Ret_Value := Val;
- if not Is_Bounded_Type (C.Ret_Typ) then
- -- The function was declared with an unconstrained return type.
- -- Now that a value has been returned, we know the subtype of
- -- the returned values. So adjust it.
- -- All the returned values must have the same length.
- C.Ret_Typ := Val.Typ;
- if Is_Dyn then
- Set_Width (Get_Wire_Gate (C.W_Val), C.Ret_Typ.W);
- Set_Width (C.Ret_Init, C.Ret_Typ.W);
+ else
+ if C.Nbr_Ret = 0 then
+ C.Ret_Value := Val;
+ if not Is_Bounded_Type (C.Ret_Typ) then
+ -- The function was declared with an unconstrained
+ -- return type. Now that a value has been returned,
+ -- we know the subtype of the returned values.
+ -- So adjust it. All the returned values must have the
+ -- same length.
+ C.Ret_Typ := Unshare (Val.Typ, Instance_Pool);
+ if Is_Dyn then
+ Set_Width (Get_Wire_Gate (C.W_Val), C.Ret_Typ.W);
+ Set_Width (C.Ret_Init, C.Ret_Typ.W);
+ end if;
end if;
end if;
- end if;
- if Is_Dyn then
- Phi_Assign_Net (Ctxt, C.W_Val, Get_Net (Ctxt, Val), 0);
+ if Is_Dyn then
+ Phi_Assign_Net (Ctxt, C.W_Val, Get_Net (Ctxt, Val), 0);
+ end if;
end if;
end if;
@@ -3295,16 +3351,22 @@ package body Synth.Vhdl_Stmts is
procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc;
Stmt : Node)
is
+ Marker : Mark_Type;
Cond : Valtyp;
+ C : Boolean;
begin
+ Mark_Expr_Pool (Marker);
Cond := Synth_Expression (Inst, Get_Assertion_Condition (Stmt));
if Cond = No_Valtyp then
Set_Error (Inst);
+ Release_Expr_Pool (Marker);
return;
end if;
pragma Assert (Is_Static (Cond.Val));
Strip_Const (Cond);
- if Read_Discrete (Cond) = 1 then
+ C := Read_Discrete (Cond) = 1;
+ Release_Expr_Pool (Marker);
+ if C then
return;
end if;
Exec_Failed_Assertion (Inst, Stmt);
@@ -3314,6 +3376,7 @@ package body Synth.Vhdl_Stmts is
is
Ctxt : constant Context_Acc := Get_Build (C.Inst);
Loc : constant Location_Type := Get_Location (Stmt);
+ Marker : Mark_Type;
Cond : Valtyp;
N : Net;
En : Net;
@@ -3323,12 +3386,17 @@ package body Synth.Vhdl_Stmts is
return;
end if;
+ Mark_Expr_Pool (Marker);
Cond := Synth_Expression (C.Inst, Get_Assertion_Condition (Stmt));
if Cond = No_Valtyp then
Set_Error (C.Inst);
+ Release_Expr_Pool (Marker);
return;
end if;
+
N := Get_Net (Ctxt, Cond);
+ Release_Expr_Pool (Marker);
+
En := Phi_Enable (Ctxt, (Stmt, Bit_Type), Bit0, Bit1,
Get_Location (Stmt));
if En /= No_Net then
@@ -3344,10 +3412,13 @@ package body Synth.Vhdl_Stmts is
is
Is_Dyn : constant Boolean := not Get_Instance_Const (C.Inst);
Ctxt : constant Context_Acc := Get_Build (C.Inst);
+ Marker : Mark_Type;
Stmt : Node;
Phi_T, Phi_F : Phi_Type;
Has_Phi : Boolean;
begin
+ Mark_Expr_Pool (Marker);
+
Stmt := Stmts;
while Is_Valid (Stmt) loop
if Is_Dyn then
@@ -3442,6 +3513,8 @@ package body Synth.Vhdl_Stmts is
return;
end if;
end if;
+ -- Not possible due to returns.
+-- pragma Assert (Areapools.Is_At_Mark (Expr_Pool, Marker));
Stmt := Get_Chain (Stmt);
end loop;
end Synth_Sequential_Statements;
@@ -3451,6 +3524,7 @@ package body Synth.Vhdl_Stmts is
(C : in out Seq_Context; Proc : Node)
is
Ctxt : constant Context_Acc := Get_Build (C.Inst);
+ Marker : Mark_Type;
Stmt : Node;
Cond : Node;
Cond_Val : Valtyp;
@@ -3465,6 +3539,8 @@ package body Synth.Vhdl_Stmts is
return;
end if;
+ Mark_Expr_Pool (Marker);
+
-- Handle the condition as an if.
Cond := Get_Condition_Clause (Stmt);
if Cond = Null_Node then
@@ -3481,6 +3557,8 @@ package body Synth.Vhdl_Stmts is
Merge_Phis (Ctxt, Get_Net (Ctxt, Cond_Val), Phi_True, Phi_False,
Get_Location (Stmt));
+
+ Release_Expr_Pool (Marker);
end Synth_Process_Sequential_Statements;
procedure Synth_Process_Statement
@@ -3516,7 +3594,10 @@ package body Synth.Vhdl_Stmts is
Push_Phi;
+ pragma Assert (Is_Expr_Pool_Empty);
+
Synth_Declarations (C.Inst, Decls_Chain);
+ pragma Assert (Is_Expr_Pool_Empty);
Set_Wire_Gate (C.W_En, Build_Control_Signal (Syn_Inst, 1, Proc));
Phi_Assign_Static (C.W_En, Bit1);
@@ -3531,10 +3612,12 @@ package body Synth.Vhdl_Stmts is
Synth_Process_Sequential_Statements (C, Proc);
end case;
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
Pop_And_Merge_Phi (Ctxt, Get_Location (Proc));
Finalize_Declarations (C.Inst, Decls_Chain);
+ pragma Assert (Is_Expr_Pool_Empty);
Free_Instance (C.Inst);
Release (M, Proc_Pool);
@@ -3579,29 +3662,28 @@ package body Synth.Vhdl_Stmts is
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
Cond : constant Node := Get_Assertion_Condition (Stmt);
+ Marker : Mark_Type;
Val : Valtyp;
Inst : Instance;
begin
+ Mark_Expr_Pool (Marker);
Val := Synth_Expression (Syn_Inst, Cond);
if Val = No_Valtyp then
Set_Error (Syn_Inst);
- return;
- end if;
- if Is_Static (Val.Val) then
+ elsif Is_Static (Val.Val) then
if Read_Discrete (Val) /= 1 then
Exec_Failed_Assertion (Syn_Inst, Stmt);
end if;
- return;
- end if;
-
- if not Flags.Flag_Formal then
+ elsif Flags.Flag_Formal then
+ Inst := Build_Assert
+ (Ctxt, Synth_Label (Syn_Inst, Stmt), Get_Net (Ctxt, Val));
+ Set_Location (Inst, Get_Location (Stmt));
+ else
-- Ignore the net.
- return;
+ null;
end if;
- Inst := Build_Assert
- (Ctxt, Synth_Label (Syn_Inst, Stmt), Get_Net (Ctxt, Val));
- Set_Location (Inst, Get_Location (Stmt));
+ Release_Expr_Pool (Marker);
end Synth_Concurrent_Assertion_Statement;
procedure Synth_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node)
@@ -3704,6 +3786,7 @@ package body Synth.Vhdl_Stmts is
is
Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt);
+ Marker : Mark_Type;
Has_Async_Abort : Boolean;
States : Net;
Init : Net;
@@ -3711,6 +3794,7 @@ package body Synth.Vhdl_Stmts is
Clk : Net;
Clk_Inst : Instance;
begin
+ Mark_Expr_Pool (Marker);
Instance_Pool := Proc_Pool'Access;
-- create init net, clock net
@@ -3723,6 +3807,7 @@ package body Synth.Vhdl_Stmts is
if Get_Id (Clk_Inst) not in Edge_Module_Id then
Error_Msg_Synth (+Stmt, "clock is not an edge");
Next_States := No_Net;
+ Release_Expr_Pool (Marker);
return;
end if;
@@ -3765,6 +3850,7 @@ package body Synth.Vhdl_Stmts is
Connect (Get_Input (Get_Net_Parent (States), 1), Next_States);
Instance_Pool := null;
+ Release_Expr_Pool (Marker);
end Synth_Psl_Dff;
function Synth_Psl_Final
@@ -4063,7 +4149,7 @@ package body Synth.Vhdl_Stmts is
Error_Kind ("synth_concurrent_statement", Stmt);
end case;
- pragma Assert (Areapools.Is_Empty (Process_Pool));
+ pragma Assert (Is_Expr_Pool_Empty);
Instance_Pool := null;
end Synth_Concurrent_Statement;
@@ -4086,6 +4172,8 @@ package body Synth.Vhdl_Stmts is
is
Spec : constant Node := Get_Attribute_Specification (Val);
Sig : constant Node := Get_Designated_Entity (Val);
+ Marker : Mark_Type;
+ Cv : Boolean;
V : Valtyp;
begin
-- The type must be boolean
@@ -4105,9 +4193,12 @@ package body Synth.Vhdl_Stmts is
end if;
-- The value must be true
+ Mark_Expr_Pool (Marker);
V := Synth_Expression_With_Type
(Syn_Inst, Get_Expression (Spec), Boolean_Type);
- if Read_Discrete (V) /= 1 then
+ Cv := Read_Discrete (V) = 1;
+ Release_Expr_Pool (Marker);
+ if not Cv then
return;
end if;
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index e83cdb4ea..40c9e5d30 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -25,6 +25,7 @@ with Netlists.Expands;
with Elab.Vhdl_Values.Debug;
pragma Unreferenced (Elab.Vhdl_Values.Debug);
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
with Synth.Vhdl_Insts; use Synth.Vhdl_Insts;
@@ -58,6 +59,8 @@ package body Synthesis is
Synth_Initialize_Foreign.all;
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
Unit := Get_Library_Unit (Design);
if Get_Kind (Unit) = Iir_Kind_Foreign_Module then
if Synth_Top_Foreign = null then
@@ -68,8 +71,12 @@ package body Synthesis is
Synth_Top_Entity (Base, Design, Encoding, Inst);
end if;
+ pragma Assert (Is_Expr_Pool_Empty);
+
Synth.Vhdl_Insts.Synth_All_Instances;
+ pragma Assert (Is_Expr_Pool_Empty);
+
if Errorout.Nbr_Errors > 0 then
return No_Module;
end if;
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 13:07:09 +0000