diff options
Diffstat (limited to 'src/synth')
25 files changed, 839 insertions, 175 deletions
diff --git a/src/synth/elab-vhdl_context-debug.adb b/src/synth/elab-vhdl_context-debug.adb index 13f615558..79b59187a 100644 --- a/src/synth/elab-vhdl_context-debug.adb +++ b/src/synth/elab-vhdl_context-debug.adb @@ -45,6 +45,9 @@ package body Elab.Vhdl_Context.Debug is when Obj_Instance => Put ("instance"); New_Line; + when Obj_Marker => + Put ("marker"); + New_Line; end case; end loop; end Debug_Synth_Instance; diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb index 048ac1ae4..248eb6a4f 100644 --- a/src/synth/elab-vhdl_context.adb +++ b/src/synth/elab-vhdl_context.adb @@ -287,6 +287,18 @@ package body Elab.Vhdl_Context is Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); end Create_Object_Force; + procedure Create_Object_Marker + (Syn_Inst : Synth_Instance_Acc; N : Node; Pool : Areapools.Areapool_Acc) + is + use Areapools; + Info : constant Sim_Info_Acc := Get_Info (N); + begin + Create_Object (Syn_Inst, Info.Slot, 1); + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Marker, + M_Mark => Empty_Marker); + Mark (Syn_Inst.Objects (Info.Slot).M_Mark, Pool.all); + end Create_Object_Marker; + procedure Create_Object (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) is @@ -466,9 +478,8 @@ package body Elab.Vhdl_Context is Last => Syn_Inst.Elab_Objects); end Destroy_Init; - procedure Destroy_Object (D : in out Destroy_Type; Decl : Node) + procedure Destroy_Check (D : in out Destroy_Type; Info : Sim_Info_Acc) is - Info : constant Sim_Info_Acc := Get_Info (Decl); Slot : constant Object_Slot_Type := Info.Slot; begin if Info.Obj_Scope /= D.Inst.Block_Scope then @@ -486,9 +497,28 @@ package body Elab.Vhdl_Context is if Slot < D.First then D.First := Slot; end if; - D.Inst.Objects (Slot) := (Kind => Obj_None); + end Destroy_Check; + + procedure Destroy_Object (D : in out Destroy_Type; Decl : Node) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + Destroy_Check (D, Info); + D.Inst.Objects (Info.Slot) := (Kind => Obj_None); end Destroy_Object; + procedure Destroy_Marker + (D : in out Destroy_Type; N : Node; Pool : Areapools.Areapool_Acc) + is + use Areapools; + Info : constant Sim_Info_Acc := Get_Info (N); + Slot : constant Object_Slot_Type := Info.Slot; + begin + Destroy_Check (D, Info); + Release (D.Inst.Objects (Slot).M_Mark, Pool.all); + D.Inst.Objects (Slot) := (Kind => Obj_None); + end Destroy_Marker; + procedure Destroy_Finish (D : in out Destroy_Type) is begin if D.First = Object_Slot_Type'Last then diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads index 404325742..e02ed714e 100644 --- a/src/synth/elab-vhdl_context.ads +++ b/src/synth/elab-vhdl_context.ads @@ -17,6 +17,7 @@ -- along with this program. If not, see <gnu.org/licenses>. with Types; use Types; +with Areapools; with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Nodes; use Vhdl.Nodes; @@ -145,10 +146,17 @@ package Elab.Vhdl_Context is procedure Mutate_Object (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + -- Save an areapool mark (likely the instance_pool). + -- Used by for-loop. + procedure Create_Object_Marker + (Syn_Inst : Synth_Instance_Acc; N : Node; Pool : Areapools.Areapool_Acc); + type Destroy_Type is limited private; procedure Destroy_Init (D : out Destroy_Type; Syn_Inst : Synth_Instance_Acc); procedure Destroy_Object (D : in out Destroy_Type; Decl : Node); + procedure Destroy_Marker + (D : in out Destroy_Type; N : Node; Pool : Areapools.Areapool_Acc); procedure Destroy_Finish (D : in out Destroy_Type); -- Get the value of OBJ. @@ -197,7 +205,8 @@ private Obj_None, Obj_Object, Obj_Subtype, - Obj_Instance + Obj_Instance, + Obj_Marker ); type Obj_Type (Kind : Obj_Kind := Obj_None) is record @@ -210,6 +219,8 @@ private T_Typ : Type_Acc; when Obj_Instance => I_Inst : Synth_Instance_Acc; + when Obj_Marker => + M_Mark : Areapools.Mark_Type; end case; end record; diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index 08cbda879..e4b83375b 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -19,7 +19,6 @@ with Name_Table; use Name_Table; with Simple_IO; use Simple_IO; with Utils_IO; use Utils_IO; with Files_Map; -with Areapools; with Libraries; with Std_Names; with Errorout; @@ -1245,7 +1244,6 @@ package body Elab.Vhdl_Debug is procedure Print_Proc (Line : String) is use Vhdl.Tokens; - use Areapools; use Errorout; Cur_Inst : constant Synth_Instance_Acc := Debug_Current_Instance; Prev_Nbr_Errors : constant Natural := Nbr_Errors; @@ -1313,7 +1311,7 @@ package body Elab.Vhdl_Debug is Vhdl.Annotations.Annotate_Expand_Table; Vhdl.Canon.Canon_Expression (Expr); - Mark (Marker, Expr_Pool); + Mark_Expr_Pool (Marker); if Opt_Name then case Get_Kind (Expr) is @@ -1338,7 +1336,7 @@ package body Elab.Vhdl_Debug is New_Line; -- Free value - Release (Marker, Expr_Pool); + Release_Expr_Pool (Marker); end Print_Proc; procedure Append_Commands is diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb index 08f64a575..97836929c 100644 --- a/src/synth/elab-vhdl_decls.adb +++ b/src/synth/elab-vhdl_decls.adb @@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Areapools; + with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; @@ -53,6 +55,7 @@ package body Elab.Vhdl_Decls is 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; @@ -93,6 +96,9 @@ package body Elab.Vhdl_Decls is 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 @@ -100,6 +106,10 @@ package body Elab.Vhdl_Decls is 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; @@ -108,11 +118,17 @@ package body Elab.Vhdl_Decls is Typ : Type_Acc) is Def : constant Iir := Get_Default_Value (Decl); + Expr_Mark : Mark_Type; Init : Valtyp; begin + pragma Assert (Typ.Is_Global); + if Is_Valid (Def) then + Mark_Expr_Pool (Expr_Mark); Init := Synth_Expression_With_Type (Syn_Inst, Def, Typ); Init := Exec_Subtype_Conversion (Init, Typ, False, Decl); + Init := Unshare (Init, Instance_Pool); + Release_Expr_Pool (Expr_Mark); else Init := No_Valtyp; end if; @@ -135,6 +151,7 @@ package body Elab.Vhdl_Decls is is Def : constant Node := Get_Default_Value (Decl); Decl_Type : constant Node := Get_Type (Decl); + Marker : Mark_Type; Init : Valtyp; Obj_Typ : Type_Acc; begin @@ -144,16 +161,23 @@ package body Elab.Vhdl_Decls is return; end if; + + Mark_Expr_Pool (Marker); if Is_Valid (Def) then Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl); + Init := Unshare (Init, Instance_Pool); else if Force_Init then + Current_Pool := Instance_Pool; Init := Create_Value_Default (Obj_Typ); + Current_Pool := Expr_Pool'Access; else Init := (Typ => Obj_Typ, Val => null); end if; end if; + Release_Expr_Pool (Marker); + Create_Object (Syn_Inst, Decl, Init); end Elab_Variable_Declaration; @@ -166,7 +190,9 @@ 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; Create_Object (Syn_Inst, Decl, Res); end Elab_File_Declaration; @@ -228,10 +254,13 @@ package body Elab.Vhdl_Decls is is Attr_Decl : constant Node := Get_Named_Entity (Get_Attribute_Designator (Spec)); + Marker : Mark_Type; Value : Node; Val : Valtyp; Val_Type : Type_Acc; begin + Mark_Expr_Pool (Marker); + Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl)); Value := Get_Attribute_Value_Spec_Chain (Spec); while Value /= Null_Iir loop @@ -252,8 +281,10 @@ package body Elab.Vhdl_Decls is -- -- 4. Each new attribute instance is assigned the value of -- the expression. + Val := Unshare (Val, Instance_Pool); + Val.Typ := Unshare (Val.Typ, Instance_Pool); Create_Object (Syn_Inst, Value, Val); - -- Unshare (Val, Instance_Pool); + Release_Expr_Pool (Marker); Value := Get_Spec_Chain (Value); end loop; @@ -263,6 +294,7 @@ package body Elab.Vhdl_Decls is (Syn_Inst : Synth_Instance_Acc; Decl : Node) is Atype : constant Node := Get_Declaration_Type (Decl); + Marker : Mark_Type; Off : Value_Offsets; Res : Valtyp; Obj_Typ : Type_Acc; @@ -270,6 +302,8 @@ package body Elab.Vhdl_Decls is Typ : Type_Acc; Dyn : Dyn_Name; begin + Mark_Expr_Pool (Marker); + -- Subtype indication may not be present. if Atype /= Null_Node then Synth_Subtype_Indication (Syn_Inst, Atype); @@ -280,11 +314,14 @@ package body Elab.Vhdl_Decls is Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off, Dyn); pragma Assert (Dyn = No_Dyn_Name); - Res := Create_Value_Alias (Base, Off, Typ); + Typ := Unshare (Typ, Instance_Pool); + Res := Create_Value_Alias (Base, Off, Typ, Expr_Pool'Access); if Obj_Typ /= null then Res := Exec_Subtype_Conversion (Res, Obj_Typ, True, Decl); end if; + Res := Unshare (Res, Instance_Pool); Create_Object (Syn_Inst, Decl, Res); + Release_Expr_Pool (Marker); end Elab_Object_Alias_Declaration; procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc; @@ -376,12 +413,18 @@ package body Elab.Vhdl_Decls is declare Val : Valtyp; begin + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + + Current_Pool := Instance_Pool; Val := Create_Value_Memory (Create_Memory_U32 (0)); + Current_Pool := Expr_Pool'Access; Create_Object (Syn_Inst, Decl, Val); end; when others => Vhdl.Errors.Error_Kind ("elab_declaration", Decl); end case; + + pragma Assert (Is_Expr_Pool_Empty); end Elab_Declaration; procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc; diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index 391a75c92..d6a2f6618 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -83,7 +83,7 @@ package body Elab.Vhdl_Expr is Res_Type := Create_Array_Type (Bnd, True, El_Typ); end if; - Res := Create_Value_Memory (Res_Type); + Res := Create_Value_Memory (Res_Type, Current_Pool); for I in Flist_First .. Last loop -- Elements are supposed to be static, so no need for enable. @@ -331,10 +331,11 @@ package body Elab.Vhdl_Expr is | Iir_Kind_Dereference => declare Val : Valtyp; + Obj : Memtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); - Val := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); - return Val.Typ; + Obj := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + return Obj.Typ; end; when Iir_Kind_Function_Call => declare @@ -400,7 +401,7 @@ package body Elab.Vhdl_Expr is | Iir_Kind_Dereference => declare Val : Valtyp; - Res : Valtyp; + Res : Memtyp; begin -- Maybe do not dereference it if its type is known ? Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); @@ -452,7 +453,7 @@ package body Elab.Vhdl_Expr is else Res_Type := Create_Array_Type (Bounds, True, El_Type); end if; - Res := Create_Value_Memory (Res_Type); + Res := Create_Value_Memory (Res_Type, Current_Pool); -- Only U8 are handled. pragma Assert (El_Type.Sz = 1); diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index 8c01c30bf..8b71e7f63 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -177,6 +177,7 @@ package body Elab.Vhdl_Files is File_Type : constant Node := Get_Type (Decl); External_Name : constant Node := Get_File_Logical_Name (Decl); Open_Kind : constant Node := Get_File_Open_Kind (Decl); + Marker : Mark_Type; File_Name : Valtyp; C_Name : C_File_Name; C_Name_Len : Natural; @@ -215,6 +216,8 @@ package body Elab.Vhdl_Files is return F; end if; + Mark_Expr_Pool (Marker); + File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name); if Open_Kind /= Null_Node then @@ -232,6 +235,9 @@ package body Elab.Vhdl_Files is end if; Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); + + Release_Expr_Pool (Marker); + if Status = Op_Ok then if Get_Text_File_Flag (File_Type) then Ghdl_Text_File_Open diff --git a/src/synth/elab-vhdl_heap.adb b/src/synth/elab-vhdl_heap.adb index a6027bfef..60c215405 100644 --- a/src/synth/elab-vhdl_heap.adb +++ b/src/synth/elab-vhdl_heap.adb @@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Ada.Unchecked_Conversion; + with Types; use Types; with Tables; @@ -23,8 +25,13 @@ with Elab.Memtype; use Elab.Memtype; package body Elab.Vhdl_Heap is + type Heap_Entry is record + Obj : Memory_Ptr; + Typ : Memory_Ptr; + end record; + package Heap_Table is new Tables - (Table_Component_Type => Valtyp, + (Table_Component_Type => Heap_Entry, Table_Index_Type => Heap_Index, Table_Low_Bound => 1, Table_Initial => 16); @@ -32,59 +39,71 @@ package body Elab.Vhdl_Heap is function Alloc_Mem (Sz : Size_Type) return Memory_Ptr; pragma Import (C, Alloc_Mem, "malloc"); - function Allocate_Memory (T : Type_Acc) return Value_Acc + -- ACC_TYP is the access type, + -- OBJ_TYP is the object type. + procedure Allocate (Acc_Typ : Type_Acc; + Obj_Typ : Type_Acc; + Res : out Memory_Ptr; + Idx : out Heap_Index) is - M : Memory_Ptr; + Typ_Sz : constant Size_Type := Acc_Typ.Acc_Bnd_Sz; + E : Heap_Entry; + T : Type_Acc; begin - M := Alloc_Mem (T.Sz); - return new Value_Type'(Kind => Value_Memory, Mem => M); - end Allocate_Memory; + pragma Assert (Acc_Typ.Kind = Type_Access); - function Allocate_By_Type (T : Type_Acc) return Value_Acc - is - Res : Value_Acc; - begin - Res := Allocate_Memory (T); - Write_Value_Default (Res.Mem, T); - return Res; - end Allocate_By_Type; + E.Obj := Alloc_Mem (Obj_Typ.Sz); + E.Typ := Alloc_Mem (Typ_Sz); + + T := Save_Type (Obj_Typ, E.Typ, Typ_Sz); + pragma Unreferenced (T); + Res := E.Obj; - function Allocate_By_Type (T : Type_Acc) return Heap_Index is + Heap_Table.Append (E); + Idx := Heap_Table.Last; + end Allocate; + + function Allocate_By_Type (Acc_Typ : Type_Acc; T : Type_Acc) + return Heap_Index + is + Res : Memory_Ptr; + Idx : Heap_Index; begin - -- FIXME: allocate type. - Heap_Table.Append ((T, Allocate_By_Type (T))); - return Heap_Table.Last; + Allocate (Acc_Typ, T, Res, Idx); + Write_Value_Default (Res, T); + return Idx; end Allocate_By_Type; - function Allocate_By_Value (V : Valtyp) return Value_Acc + function Allocate_By_Value (Acc_Typ : Type_Acc; V : Valtyp) + return Heap_Index is - Res : Value_Acc; + Mem : Memory_Ptr; + Idx : Heap_Index; begin - Res := Allocate_Memory (V.Typ); - Write_Value (Res.Mem, V); - return Res; + Allocate (Acc_Typ, V.Typ, Mem, Idx); + Write_Value (Mem, V); + return Idx; end Allocate_By_Value; - function Allocate_By_Value (V : Valtyp) return Heap_Index is - begin - Heap_Table.Append ((V.Typ, Allocate_By_Value (V))); - return Heap_Table.Last; - end Allocate_By_Value; + function Synth_Dereference (Idx : Heap_Index) return Memtyp + is + function To_Type_Acc is new Ada.Unchecked_Conversion + (Memory_Ptr, Type_Acc); - function Synth_Dereference (Idx : Heap_Index) return Valtyp is + E : Heap_Entry renames Heap_Table.Table (Idx); begin - return Heap_Table.Table (Idx); + return (To_Type_Acc (E.Typ), E.Obj); end Synth_Dereference; - procedure Free (Obj : in out Valtyp) is + procedure Free (Obj : in out Heap_Entry) is begin -- TODO - Obj := No_Valtyp; + Obj := (null, null); end Free; procedure Synth_Deallocate (Idx : Heap_Index) is begin - if Heap_Table.Table (Idx) = No_Valtyp then + if Heap_Table.Table (Idx).Obj = null then return; end if; Free (Heap_Table.Table (Idx)); diff --git a/src/synth/elab-vhdl_heap.ads b/src/synth/elab-vhdl_heap.ads index e6c9db777..7c2846a31 100644 --- a/src/synth/elab-vhdl_heap.ads +++ b/src/synth/elab-vhdl_heap.ads @@ -20,11 +20,14 @@ with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Elab.Vhdl_Values; use Elab.Vhdl_Values; package Elab.Vhdl_Heap is + -- Allocate a value. - function Allocate_By_Type (T : Type_Acc) return Heap_Index; - function Allocate_By_Value (V : Valtyp) return Heap_Index; + function Allocate_By_Type (Acc_Typ : Type_Acc; T : Type_Acc) + return Heap_Index; + function Allocate_By_Value (Acc_Typ : Type_Acc; V : Valtyp) + return Heap_Index; - function Synth_Dereference (Idx : Heap_Index) return Valtyp; + function Synth_Dereference (Idx : Heap_Index) return Memtyp; procedure Synth_Deallocate (Idx : Heap_Index); end Elab.Vhdl_Heap; diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index 1b26a2ce5..835474445 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -18,6 +18,7 @@ with Types; use Types; with Libraries; +with Areapools; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; @@ -60,6 +61,7 @@ package body Elab.Vhdl_Insts is Inter_Chain : Node; Assoc_Chain : Node) is + Marker : Mark_Type; Inter : Node; Inter_Type : Type_Acc; Assoc : Node; @@ -67,6 +69,8 @@ package body Elab.Vhdl_Insts is Actual : Node; Val : Valtyp; begin + Mark_Expr_Pool (Marker); + Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop @@ -97,10 +101,15 @@ package body Elab.Vhdl_Insts is (+Assoc, "value of generic %i must be static", +Inter); Val := No_Valtyp; Set_Error (Sub_Inst); + else + Val := Unshare (Val, Global_Pool'Access); + Val.Typ := Unshare (Val.Typ, Global_Pool'Access); end if; Create_Object (Sub_Inst, Inter, Val); + Release_Expr_Pool (Marker); + when Iir_Kind_Interface_Package_Declaration => declare Actual : constant Iir := @@ -127,8 +136,10 @@ package body Elab.Vhdl_Insts is else Act_Typ := Get_Subtype_Object (Syn_Inst, Act); end if; + Act_Typ := Unshare (Act_Typ, Instance_Pool); Create_Subtype_Object (Sub_Inst, Get_Type (Inter), Act_Typ); + Release_Expr_Pool (Marker); end; end if; @@ -329,8 +340,10 @@ package body Elab.Vhdl_Insts is Inter : Node; Assoc : Node) return Type_Acc is + Marker : Mark_Type; Inter_Typ : Type_Acc; Val : Valtyp; + Res : Type_Acc; begin if not Is_Fully_Constrained_Type (Get_Type (Inter)) then -- TODO @@ -341,6 +354,8 @@ package body Elab.Vhdl_Insts is raise Internal_Error; end if; + Mark_Expr_Pool (Marker); + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression and then not Get_Inertial_Flag (Assoc) then @@ -348,19 +363,23 @@ package body Elab.Vhdl_Insts is Inter_Typ := Elab_Declaration_Type (Sub_Inst, Inter); Val := Synth_Expression_With_Type (Syn_Inst, Get_Actual (Assoc), Inter_Typ); - return Val.Typ; + Res := Val.Typ; + else + case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is + when Iir_Kinds_Association_Element_By_Actual => + Res := Exec_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); + when Iir_Kind_Association_Element_By_Individual => + Res := Synth_Subtype_Indication + (Syn_Inst, Get_Actual_Type (Assoc)); + when Iir_Kind_Association_Element_Open => + Res := Exec_Type_Of_Object + (Syn_Inst, Get_Default_Value (Inter)); + end case; end if; - case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is - when Iir_Kinds_Association_Element_By_Actual => - return Exec_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); - when Iir_Kind_Association_Element_By_Individual => - return Synth_Subtype_Indication - (Syn_Inst, Get_Actual_Type (Assoc)); - when Iir_Kind_Association_Element_Open => - return Exec_Type_Of_Object - (Syn_Inst, Get_Default_Value (Inter)); - end case; + Res := Unshare (Res, Global_Pool'Access); + Release_Expr_Pool (Marker); + return Res; else return Elab_Declaration_Type (Sub_Inst, Inter); end if; @@ -580,6 +599,8 @@ package body Elab.Vhdl_Insts is return; end if; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Entity := Get_Entity (Arch); Apply_Block_Configuration (Config, Arch); @@ -589,15 +610,26 @@ package body Elab.Vhdl_Insts is Elab_Concurrent_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Elab_Verification_Units (Syn_Inst, Entity); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); Elab_Concurrent_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Elab_Recurse_Instantiations (Syn_Inst, Arch); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Elab_Verification_Units (Syn_Inst, Arch); + + pragma Assert (Areapools.Is_Empty (Expr_Pool)); end Elab_Instance_Body; procedure Elab_Direct_Instantiation_Statement @@ -614,19 +646,26 @@ package body Elab.Vhdl_Insts is Create_Sub_Instance (Syn_Inst, Stmt, Sub_Inst); + pragma Assert (Is_Expr_Pool_Empty); + Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity)); Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch)); + pragma Assert (Is_Expr_Pool_Empty); Elab_Generics_Association (Sub_Inst, Syn_Inst, Get_Generic_Chain (Entity), Get_Generic_Map_Aspect_Chain (Stmt)); + pragma Assert (Is_Expr_Pool_Empty); + -- Elaborate port types. Elab_Ports_Association_Type (Sub_Inst, Syn_Inst, Get_Port_Chain (Entity), Get_Port_Map_Aspect_Chain (Stmt)); + pragma Assert (Is_Expr_Pool_Empty); + if Is_Error (Sub_Inst) then -- TODO: Free it? return; @@ -648,15 +687,21 @@ package body Elab.Vhdl_Insts is Sub_Config : Node; Sub_Inst : Synth_Instance_Acc; begin + pragma Assert (Is_Expr_Pool_Empty); + -- Create the sub-instance for the component -- Elaborate generic + map aspect Comp_Inst := Make_Elab_Instance (Syn_Inst, Component, Config); Create_Sub_Instance (Syn_Inst, Stmt, Comp_Inst); + pragma Assert (Is_Expr_Pool_Empty); + Elab_Generics_Association (Comp_Inst, Syn_Inst, Get_Generic_Chain (Component), Get_Generic_Map_Aspect_Chain (Stmt)); + pragma Assert (Is_Expr_Pool_Empty); + -- Create objects for the inputs and the outputs of the component, -- assign inputs (that's nets) and create wires for outputs. declare @@ -681,6 +726,8 @@ package body Elab.Vhdl_Insts is Set_Component_Configuration (Stmt, Null_Node); + pragma Assert (Is_Expr_Pool_Empty); + if Bind = Null_Iir then -- No association. Create_Component_Instance (Comp_Inst, null); @@ -737,6 +784,7 @@ package body Elab.Vhdl_Insts is Elab_Ports_Association_Type (Sub_Inst, Comp_Inst, Get_Port_Chain (Ent), Get_Port_Map_Aspect_Chain (Bind)); + pragma Assert (Is_Expr_Pool_Empty); end Elab_Component_Instantiation_Statement; procedure Elab_Design_Instantiation_Statement @@ -767,6 +815,8 @@ package body Elab.Vhdl_Insts is Config := Get_Block_Configuration (Config); Ent := Get_Entity (Arch); + pragma Assert (Is_Expr_Pool_Empty); + Elab_Direct_Instantiation_Statement (Syn_Inst, Stmt, Ent, Arch, Config); end Elab_Design_Instantiation_Statement; @@ -790,6 +840,10 @@ package body Elab.Vhdl_Insts is Vhdl.Annotations.Annotate (Design_Units.Table (I)); end loop; + -- Use global memory. + Instance_Pool := Global_Pool'Access; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + -- Start elaboration. Make_Root_Instance; @@ -803,22 +857,31 @@ 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)); + -- Compute generics. Inter := Get_Generic_Chain (Entity); while Is_Valid (Inter) loop declare + Em : Mark_Type; Val : Valtyp; Inter_Typ : Type_Acc; begin + Mark_Expr_Pool (Em); Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter); Val := Synth_Expression_With_Type (Top_Inst, Get_Default_Value (Inter), Inter_Typ); pragma Assert (Is_Static (Val.Val)); + Val := Unshare (Val, Instance_Pool); + Val.Typ := Unshare (Val.Typ, Instance_Pool); Create_Object (Top_Inst, Inter, Val); + Release_Expr_Pool (Em); end; Inter := Get_Chain (Inter); end loop; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + -- Elaborate port types. -- FIXME: what about unconstrained ports ? Get the type from the -- association. @@ -846,8 +909,14 @@ package body Elab.Vhdl_Insts is Inter := Get_Chain (Inter); end loop; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Elab_Instance_Body (Top_Inst); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + + Instance_Pool := null; + -- Clear elab_flag for I in Design_Units.First .. Design_Units.Last loop Set_Elab_Flag (Design_Units.Table (I), False); diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb index 87850f85a..432b3a6a8 100644 --- a/src/synth/elab-vhdl_objtypes.adb +++ b/src/synth/elab-vhdl_objtypes.adb @@ -223,6 +223,72 @@ package body Elab.Vhdl_Objtypes is Is_Signed => L < 0 or R < 0); end Build_Discrete_Range_Type; + procedure Realign (Res : in out Size_Type; + Align : Size_Type) is + begin + Res := (Res + Align - 1) and not (Align - 1); + end Realign; + + -- For Compute_Size_Type. + procedure Add_Size_Type (Typ : Type_Acc; + Sz : in out Size_Type; + Align : in out Size_Type); + + procedure Add_Array_Size_Type (El_Typ : Type_Acc; + Sz : in out Size_Type; + Align : in out Size_Type) + is + subtype T is Type_Type (Type_Array); + begin + Align := Size_Type'Max (Align, T'Alignment); + Realign (Sz, Align); + Sz := Sz + (T'Size / System.Storage_Unit); + Add_Size_Type (El_Typ, Sz, Align); + end Add_Array_Size_Type; + + procedure Add_Size_Type (Typ : Type_Acc; + Sz : in out Size_Type; + Align : in out Size_Type) is + begin + case Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + -- Never copied. + return; + when Type_Access + | Type_File + | Type_Protected => + -- Never copied + return; + when Type_Array + | Type_Vector => + Add_Array_Size_Type (Typ.Arr_El, Sz, Align); + when Type_Unbounded_Array + | Type_Unbounded_Vector => + Add_Array_Size_Type (Typ.Uarr_El, Sz, Align); + when Type_Record + | Type_Unbounded_Record => + -- TODO + raise Internal_Error; + when Type_Slice => + raise Internal_Error; + end case; + end Add_Size_Type; + + -- Compute the memory size needed to store T. + function Compute_Size_Type (T : Type_Acc) return Size_Type + is + Align : Size_Type; + Size : Size_Type; + begin + Size := 0; + Align := 1; + Add_Size_Type (T, Size, Align); + return Size; + end Compute_Size_Type; + function Create_Bit_Type return Type_Acc is subtype Bit_Type_Type is Type_Type (Type_Bit); @@ -235,6 +301,7 @@ package body Elab.Vhdl_Objtypes is Dir => Dir_To, Is_Signed => False), Al => 0, + Is_Global => False, Sz => 1, W => 1))); end Create_Bit_Type; @@ -251,6 +318,7 @@ package body Elab.Vhdl_Objtypes is Dir => Dir_To, Is_Signed => False), Al => 0, + Is_Global => False, Sz => 1, W => 1))); end Create_Logic_Type; @@ -275,6 +343,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, Wkind => Wkind_Net, Al => Al, + Is_Global => False, Sz => Sz, W => W, Drange => Rng))); @@ -288,6 +357,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, Wkind => Wkind_Net, Al => 3, + Is_Global => False, Sz => 8, W => 64, Frange => Rng))); @@ -304,6 +374,7 @@ package body Elab.Vhdl_Objtypes is (Alloc (Current_Pool, (Kind => Type_Vector, Wkind => El_Type.Wkind, Al => El_Type.Al, + Is_Global => False, Sz => El_Type.Sz * Size_Type (Bnd.Len), W => Bnd.Len, Alast => True, @@ -321,6 +392,7 @@ package body Elab.Vhdl_Objtypes is (Kind => Type_Slice, Wkind => El_Type.Wkind, Al => El_Type.Al, + Is_Global => False, Sz => Size_Type (Len) * El_Type.Sz, W => Len * El_Type.W, Slice_El => El_Type))); @@ -346,6 +418,7 @@ package body Elab.Vhdl_Objtypes is (Kind => Type_Array, Wkind => El_Type.Wkind, Al => El_Type.Al, + Is_Global => False, Sz => El_Type.Sz * Size_Type (Bnd.Len), W => El_Type.W * Bnd.Len, Abound => Bnd, @@ -362,6 +435,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array, Wkind => El_Type.Wkind, Al => El_Type.Al, + Is_Global => False, Sz => 0, W => 0, Ulast => Last, @@ -378,6 +452,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Vector, Wkind => El_Type.Wkind, Al => El_Type.Al, + Is_Global => False, Sz => 0, W => 0, Ulast => True, @@ -438,7 +513,8 @@ package body Elab.Vhdl_Objtypes is end if; end Get_Range_Length; - function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc + function Create_Rec_El_Array (Nels : Iir_Index32; Pool : Areapool_Acc) + return Rec_El_Array_Acc is subtype Data_Type is Rec_El_Array (Nels); Res : Address; @@ -446,7 +522,7 @@ package body Elab.Vhdl_Objtypes is -- Manually allocate the array to handle large arrays without -- creating a large temporary value. Areapools.Allocate - (Current_Pool.all, Res, + (Pool.all, Res, Data_Type'Size / Storage_Unit, Data_Type'Alignment); declare @@ -464,6 +540,11 @@ package body Elab.Vhdl_Objtypes is return To_Rec_El_Array_Acc (Res); end Create_Rec_El_Array; + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc is + begin + return Create_Rec_El_Array (Nels, Current_Pool); + end Create_Rec_El_Array; + function Align (Off : Size_Type; Al : Palign_Type) return Size_Type is Mask : constant Size_Type := 2 ** Natural (Al) - 1; @@ -508,6 +589,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, Wkind => Wkind, Al => Al, + Is_Global => False, Sz => Sz, W => W, Rec => Els))); @@ -522,6 +604,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Record, Wkind => Wkind_Net, Al => 0, + Is_Global => False, Sz => 0, W => 0, Rec => Els))); @@ -531,13 +614,17 @@ package body Elab.Vhdl_Objtypes is is subtype Access_Type_Type is Type_Type (Type_Access); function Alloc is new Areapools.Alloc_On_Pool_Addr (Access_Type_Type); + Bnd_Sz : Size_Type; begin + Bnd_Sz := Compute_Size_Type (Acc_Type); return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access, Wkind => Wkind_Sim, Al => 2, + Is_Global => False, Sz => 4, W => 1, - Acc_Acc => Acc_Type))); + Acc_Acc => Acc_Type, + Acc_Bnd_Sz => Bnd_Sz))); end Create_Access_Type; function Create_File_Type (File_Type : Type_Acc) return Type_Acc @@ -548,6 +635,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File, Wkind => Wkind_Sim, Al => 2, + Is_Global => False, Sz => 4, W => 1, File_Typ => File_Type, @@ -562,6 +650,7 @@ package body Elab.Vhdl_Objtypes is return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Protected, Wkind => Wkind_Sim, Al => 2, + Is_Global => False, Sz => 4, W => 1))); end Create_Protected_Type; @@ -696,31 +785,34 @@ package body Elab.Vhdl_Objtypes is end case; end Write_Discrete; - function Alloc_Memory (Sz : Size_Type; Align2 : Natural) return Memory_Ptr + function Alloc_Memory (Sz : Size_Type; + Align2 : Natural; + Pool : Areapool_Acc) return Memory_Ptr is function To_Memory_Ptr is new Ada.Unchecked_Conversion (System.Address, Memory_Ptr); M : System.Address; begin - Areapools.Allocate (Current_Pool.all, M, Sz, Size_Type (2 ** Align2)); + Areapools.Allocate (Pool.all, M, Sz, Size_Type (2 ** Align2)); return To_Memory_Ptr (M); end Alloc_Memory; - function Alloc_Memory (Vtype : Type_Acc) return Memory_Ptr is + function Alloc_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) + return Memory_Ptr is begin - return Alloc_Memory (Vtype.Sz, Natural (Vtype.Al)); + return Alloc_Memory (Vtype.Sz, Natural (Vtype.Al), Pool); end Alloc_Memory; function Create_Memory (Vtype : Type_Acc) return Memtyp is begin - return (Vtype, Alloc_Memory (Vtype)); + return (Vtype, Alloc_Memory (Vtype, Current_Pool)); end Create_Memory; function Create_Memory_Zero (Vtype : Type_Acc) return Memtyp is Mem : Memory_Ptr; begin - Mem := Alloc_Memory (Vtype); + Mem := Alloc_Memory (Vtype, Current_Pool); for I in 1 .. Vtype.Sz loop Write_U8 (Mem + (I - 1), 0); end loop; @@ -733,7 +825,7 @@ package body Elab.Vhdl_Objtypes is pragma Assert (Vtype.Sz = 1); Res : Memory_Ptr; begin - Res := Alloc_Memory (Vtype); + Res := Alloc_Memory (Vtype, Current_Pool); Write_U8 (Res, Val); return (Vtype, Res); end Create_Memory_U8; @@ -744,7 +836,7 @@ package body Elab.Vhdl_Objtypes is pragma Assert (Vtype.Sz = 8); Res : Memory_Ptr; begin - Res := Alloc_Memory (Vtype); + Res := Alloc_Memory (Vtype, Current_Pool); Write_Fp64 (Res, Val); return (Vtype, Res); end Create_Memory_Fp64; @@ -754,7 +846,7 @@ package body Elab.Vhdl_Objtypes is is Res : Memory_Ptr; begin - Res := Alloc_Memory (Vtype); + Res := Alloc_Memory (Vtype, Current_Pool); case Vtype.Sz is when 1 => Write_U8 (Res, Ghdl_U8 (Val)); @@ -772,7 +864,7 @@ package body Elab.Vhdl_Objtypes is is Res : Memory_Ptr; begin - Res := Alloc_Memory (4, 2); + Res := Alloc_Memory (4, 2, Current_Pool); Write_U32 (Res, Ghdl_U32 (Val)); return (null, Res); end Create_Memory_U32; @@ -871,13 +963,10 @@ package body Elab.Vhdl_Objtypes is function Unshare (Src : Memtyp; Pool : Areapool_Acc) return Memtyp is - Prev_Pool : constant Areapool_Acc := Current_Pool; Res : Memory_Ptr; begin - Current_Pool := Pool; - Res := Alloc_Memory (Src.Typ); + Res := Alloc_Memory (Src.Typ, Pool); Copy_Memory (Res, Src.Mem, Src.Typ.Sz); - Current_Pool := Prev_Pool; return (Src.Typ, Res); end Unshare; @@ -885,11 +974,207 @@ package body Elab.Vhdl_Objtypes is is Res : Memory_Ptr; begin - Res := Alloc_Memory (Src.Typ); + Res := Alloc_Memory (Src.Typ, Current_Pool); Copy_Memory (Res, Src.Mem, Src.Typ.Sz); return (Src.Typ, Res); end Unshare; + function Raw_Copy (T : Type_Acc; Pool : Areapool_Acc) return Type_Acc + is + Addr : System.Address; + Sz : Size_Type; + begin + Sz := T.all'Size / Storage_Unit; + Allocate (Pool.all, Addr, Sz, T.all'Alignment); + Copy_Memory (To_Memory_Ptr (Addr), To_Memory_Ptr (T.all'Address), Sz); + return To_Type_Acc (Addr); + end Raw_Copy; + + function Unshare (T : Type_Acc; Pool : Areapool_Acc) return Type_Acc + is + Res : Type_Acc; + begin + if T.Is_Global then + return T; + end if; + + Res := Raw_Copy (T, Pool); + Res.Is_Global := True; + + case Res.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + null; + when Type_Slice => + raise Internal_Error; + when Type_Array + | Type_Vector => + Res.Arr_El := Unshare (T.Arr_El, Pool); + when Type_Unbounded_Array + | Type_Unbounded_Vector => + Res.Uarr_El := Unshare (T.Uarr_El, Pool); + Res.Uarr_Idx := Unshare (T.Uarr_Idx, Pool); + when Type_Record + | Type_Unbounded_Record => + Res.Rec := Create_Rec_El_Array (T.Rec.Len, Pool); + for I in T.Rec.E'Range loop + Res.Rec.E (I) := (Offs => T.Rec.E (I).Offs, + Typ => Unshare (T.Rec.E (I).Typ, Pool)); + end loop; + when Type_Access => + Res.Acc_Acc := Unshare (T.Acc_Acc, Pool); + when Type_File => + Res.File_Typ := Unshare (T.File_Typ, Pool); + when Type_Protected => + raise Internal_Error; + end case; + return Res; + end Unshare; + + function Unshare_Type (Typ : Type_Acc; Base : Type_Acc) return Type_Acc + is + Res : Type_Acc; + begin + if Typ = Base or else not Typ.Is_Global then + return Typ; + end if; + Res := Raw_Copy (Typ, Expr_Pool'Access); + Res.Is_Global := False; + + case Res.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + null; + when Type_Slice => + raise Internal_Error; + when Type_Array + | Type_Vector => + Res.Arr_El := Unshare_Type (Typ.Arr_El, Base.Uarr_El); + when Type_Unbounded_Array + | Type_Unbounded_Vector + | Type_Unbounded_Record => + raise Internal_Error; + when Type_Record => + Res.Rec := Create_Rec_El_Array (Typ.Rec.Len, Expr_Pool'Access); + for I in Typ.Rec.E'Range loop + Res.Rec.E (I) := (Offs => Typ.Rec.E (I).Offs, + Typ => Unshare_Type (Typ.Rec.E (I).Typ, + Base.Rec.E (I).Typ)); + end loop; + when Type_Access => + raise Internal_Error; + when Type_File => + raise Internal_Error; + when Type_Protected => + raise Internal_Error; + end case; + return Res; + end Unshare_Type; + + procedure Save_Type (Typ : Type_Acc; + Res : out Type_Acc; + Mem : Memory_Ptr; + Off : in out Size_Type; + Mem_Sz : Size_Type) + is + Sz : constant Size_Type := Typ.all'Size / Storage_Unit; + Raw_Res : Address; + begin + -- Don't copy scalar types. + case Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + Res := Typ; + return; + when others => + null; + end case; + + -- Copy Typ. + Realign (Off, Typ.all'Alignment); + pragma Assert (Off + Sz <= Mem_Sz); + Raw_Res := To_Address (Mem + Off); + Off := Off + Sz; + Res := To_Type_Acc (Raw_Res); + Copy_Memory (To_Memory_Ptr (Raw_Res), + To_Memory_Ptr (Typ.all'Address), Sz); + Res.Is_Global := True; + + -- Copy elements. + case Res.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + raise Internal_Error; + when Type_Slice => + raise Internal_Error; + when Type_Array + | Type_Vector => + Save_Type (Typ.Arr_El, Res.Arr_El, Mem, Off, Mem_Sz); + when Type_Unbounded_Array + | Type_Unbounded_Vector + | Type_Unbounded_Record => + raise Internal_Error; + when Type_Record => + declare + subtype Data_Type is Rec_El_Array (Typ.Rec.Len); + begin + Realign (Off, Data_Type'Alignment); + pragma Assert (Off + Sz <= Mem_Sz); + Raw_Res := To_Address (Mem + Off); + Off := Off + Sz; + Res.Rec := To_Rec_El_Array_Acc (Raw_Res); + for I in Typ.Rec.E'Range loop + Res.Rec.E (I).Offs := Typ.Rec.E (I).Offs; + Save_Type (Res.Rec.E (I).Typ, + Typ.Rec.E (I).Typ, + Mem, Off, Mem_Sz); + end loop; + end; + when Type_Access => + raise Internal_Error; + when Type_File => + raise Internal_Error; + when Type_Protected => + raise Internal_Error; + end case; + end Save_Type; + + function Save_Type (Typ : Type_Acc; + Mem : Memory_Ptr; + Mem_Sz : Size_Type) return Type_Acc + is + Off : Size_Type; + Res : Type_Acc; + begin + Off := 0; + Save_Type (Typ, Res, Mem, Off, Mem_Sz); + pragma Assert (Off <= Mem_Sz); + return Res; + end Save_Type; + + procedure Mark_Expr_Pool (M : out Mark_Type) is + begin + Mark (M, Expr_Pool); + end Mark_Expr_Pool; + + procedure Release_Expr_Pool (M : Mark_Type) is + begin + Release (M, Expr_Pool); + end Release_Expr_Pool; + + function Is_Expr_Pool_Empty return Boolean is + begin + return Is_Empty (Expr_Pool); + end Is_Expr_Pool_Empty; + Bit0_Mem : constant Memory_Element := 0; Bit1_Mem : constant Memory_Element := 1; @@ -899,15 +1184,24 @@ package body Elab.Vhdl_Objtypes is procedure Initialize is begin if Boolean_Type /= null then + -- Restarting. Free the global pool. Release (Empty_Marker, Global_Pool); end if; - Instance_Pool := Global_Pool'Access; + -- Alloc fundamental types (on the global pool). + Current_Pool := Global_Pool'Access; Boolean_Type := Create_Bit_Type; Logic_Type := Create_Logic_Type; Bit_Type := Create_Bit_Type; Protected_Type := Create_Protected_Type; + Boolean_Type.Is_Global := True; + Logic_Type.Is_Global := True; + Bit_Type.Is_Global := True; + Protected_Type.Is_Global := True; + + Current_Pool := Expr_Pool'Access; + Bit0 := (Bit_Type, To_Memory_Ptr (Bit0_Mem'Address)); Bit1 := (Bit_Type, To_Memory_Ptr (Bit1_Mem'Address)); end Initialize; diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads index 3dd777a5e..4ca3e6d37 100644 --- a/src/synth/elab-vhdl_objtypes.ads +++ b/src/synth/elab-vhdl_objtypes.ads @@ -140,6 +140,12 @@ package Elab.Vhdl_Objtypes is -- Alignment (in bytes) for this type. Al : Palign_Type; + -- Lifetime of the type. If true, the type is not allocated on a + -- temporary pool (Expr_Pool). + -- The purpose of this flag is to avoid to duplicate the type when + -- unshared. + Is_Global : Boolean; + -- Number of bytes (when in memory) for this type. Sz : Size_Type; @@ -175,6 +181,8 @@ package Elab.Vhdl_Objtypes is Rec : Rec_El_Array_Acc; when Type_Access => Acc_Acc : Type_Acc; + -- Memory size to store the type. + Acc_Bnd_Sz : Size_Type; when Type_File => File_Typ : Type_Acc; File_Signature : String_Acc; @@ -190,14 +198,34 @@ package Elab.Vhdl_Objtypes is Null_Memtyp : constant Memtyp := (null, null); + -- Memory pools, which defines where the memory is allocated for data, + -- types, values... + + -- The global pool is for data that live forever: packages, hierarchy, ... Global_Pool : aliased Areapool; + + -- Pool for sensitized processes: will be fully released when the process + -- returns. + Process_Pool : aliased Areapool; + + -- A temporary pool for expressions. Expr_Pool : aliased Areapool; + -- Pool for objects created. Either Global_Pool (for global objects) or + -- a process pool (for objects in subprograms). + Instance_Pool : Areapool_Acc; + + -- Memory pool for wires static values. + Wireval_Pool : aliased Areapool; + -- Areapool used by Create_*_Value Current_Pool : Areapool_Acc := Expr_Pool'Access; - -- Pool for objects allocated in the current instance. - Instance_Pool : Areapool_Acc; + -- Aliases and utils to avoid the use of low-level subprograms. + subtype Mark_Type is Areapools.Mark_Type; + procedure Mark_Expr_Pool (M : out Mark_Type); + procedure Release_Expr_Pool (M : Mark_Type); + function Is_Expr_Pool_Empty return Boolean; -- Types. function Create_Discrete_Type (Rng : Discrete_Range_Type; @@ -292,7 +320,8 @@ package Elab.Vhdl_Objtypes is -- For states. function Create_Memory_U32 (Val : Uns32) return Memtyp; - function Alloc_Memory (Vtype : Type_Acc) return Memory_Ptr; + function Alloc_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) + return Memory_Ptr; function Create_Memory (Vtype : Type_Acc) return Memtyp; -- Like Create_Memory but initialize to 0. To be used only for types @@ -306,6 +335,17 @@ package Elab.Vhdl_Objtypes is function Unshare (Src : Memtyp) return Memtyp; function Unshare (Src : Memtyp; Pool : Areapool_Acc) return Memtyp; + -- Unshare type T if not global. + function Unshare (T : Type_Acc; Pool : Areapool_Acc) return Type_Acc; + + -- Unshare parts of TYP that is not in BASE. + function Unshare_Type (Typ : Type_Acc; Base : Type_Acc) return Type_Acc; + + -- Copy TYP to MEM; MEM_SZ. + function Save_Type (Typ : Type_Acc; + Mem : Memory_Ptr; + Mem_Sz : Size_Type) return Type_Acc; + procedure Initialize; procedure Finalize; diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb index 25ef975aa..8a0312200 100644 --- a/src/synth/elab-vhdl_stmts.adb +++ b/src/synth/elab-vhdl_stmts.adb @@ -47,8 +47,12 @@ package body Elab.Vhdl_Stmts is Create_Object (Bod_Inst, Iterator, Iterator_Val); end if; + pragma Assert (Is_Expr_Pool_Empty); + Elab_Declarations (Bod_Inst, Decls_Chain); + pragma Assert (Is_Expr_Pool_Empty); + Elab_Concurrent_Statements (Bod_Inst, Get_Concurrent_Statement_Chain (Bod)); @@ -67,7 +71,6 @@ package body Elab.Vhdl_Stmts is Config : Node; It_Rng : Type_Acc; Val : Valtyp; - Ival : Valtyp; Dval : Int64; Len : Uns32; begin @@ -78,7 +81,7 @@ package body Elab.Vhdl_Stmts is -- Initial value. It_Rng := Get_Subtype_Object (Syn_Inst, Get_Type (Iterator)); Len := Get_Range_Length (It_Rng.Drange); - Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); + Dval := It_Rng.Drange.Left; Gen_Inst := Make_Elab_Generate_Instance (Syn_Inst, Stmt, Configs, Natural (Len)); @@ -86,11 +89,6 @@ package body Elab.Vhdl_Stmts is Create_Sub_Instance (Syn_Inst, Stmt, Gen_Inst); for I in 1 .. Len loop - -- Create a copy of the current iterator value for the generate - -- block. - Dval := Read_Discrete (Val); - Ival := Create_Value_Discrete (Dval, It_Rng); - -- Find and apply the config block. declare Spec : Node; @@ -114,7 +112,7 @@ package body Elab.Vhdl_Stmts is else Val := Synth_Expression_With_Type (Syn_Inst, Get_Nth_Element (Idxes, 0), It_Rng); - exit when Is_Equal (Val, Ival); + exit when Read_Discrete (Val) = Dval; end if; when Iir_Kind_Slice_Name => Synth_Discrete_Range (Syn_Inst, Get_Suffix (Spec), Drng); @@ -131,24 +129,38 @@ package body Elab.Vhdl_Stmts is Apply_Block_Configuration (Config, Bod); end; + -- Allocate the iterator value for the body. + Current_Pool := Instance_Pool; + Val := Create_Value_Discrete (Dval, It_Rng); + Current_Pool := Expr_Pool'Access; + Sub_Inst := Elab_Generate_Statement_Body - (Gen_Inst, Bod, Config, Iterator, Ival); + (Gen_Inst, Bod, Config, Iterator, Val); Set_Generate_Sub_Instance (Gen_Inst, Positive (I), Sub_Inst); - Update_Index (It_Rng.Drange, Val); + -- Update index. + case It_Rng.Drange.Dir is + when Dir_To => + Dval := Dval + 1; + when Dir_Downto => + Dval := Dval - 1; + end case; end loop; end Elab_For_Generate_Statement; procedure Elab_If_Generate_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is + Marker : Mark_Type; Gen : Node; Bod : Node; Icond : Node; Cond : Valtyp; + Cond_Val : Boolean; Config : Node; Sub_Inst : Synth_Instance_Acc; begin + Mark_Expr_Pool (Marker); Gen := Stmt; loop @@ -156,11 +168,14 @@ package body Elab.Vhdl_Stmts is if Icond /= Null_Node then Cond := Synth_Expression (Syn_Inst, Icond); Strip_Const (Cond); + Cond_Val := Read_Discrete (Cond) = 1; else -- It is the else generate. - Cond := No_Valtyp; + Cond_Val := True; end if; - if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then + Release_Expr_Pool (Marker); + + if Cond_Val then Bod := Get_Generate_Statement_Body (Gen); Config := Get_Generate_Block_Configuration (Bod); @@ -238,6 +253,7 @@ package body Elab.Vhdl_Stmts is when others => Error_Kind ("elab_concurrent_statement", Stmt); end case; + pragma Assert (Is_Expr_Pool_Empty); end Elab_Concurrent_Statement; procedure Elab_Concurrent_Statements diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb index b8c1c0665..33b5feb8c 100644 --- a/src/synth/elab-vhdl_types.adb +++ b/src/synth/elab-vhdl_types.adb @@ -396,8 +396,10 @@ package body Elab.Vhdl_Types is procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) is + Marker : Mark_Type; Typ : Type_Acc; begin + Mark_Expr_Pool (Marker); case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition => Typ := Elab_Enumeration_Type_Definition (Def); @@ -417,8 +419,10 @@ package body Elab.Vhdl_Types is Vhdl.Errors.Error_Kind ("synth_type_definition", Def); end case; if Typ /= null then + Typ := Unshare (Typ, Instance_Pool); Create_Subtype_Object (Syn_Inst, Def, Typ); end if; + Release_Expr_Pool (Marker); end Elab_Type_Definition; function Elab_Scalar_Type_Definition (Def : Node; St : Node) return Type_Acc @@ -438,8 +442,10 @@ package body Elab.Vhdl_Types is procedure Elab_Anonymous_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node) is + Marker : Mark_Type; Typ : Type_Acc; begin + Mark_Expr_Pool (Marker); case Get_Kind (Def) is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Physical_Type_Definition => @@ -460,7 +466,9 @@ package body Elab.Vhdl_Types is when others => Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def); end case; + Typ := Unshare (Typ, Instance_Pool); Create_Subtype_Object (Syn_Inst, Def, Typ); + Release_Expr_Pool (Marker); end Elab_Anonymous_Type_Definition; function Synth_Discrete_Range_Constraint @@ -618,9 +626,12 @@ package body Elab.Vhdl_Types is (Syn_Inst : Synth_Instance_Acc; Atype : Node) is Typ : Type_Acc; + Marker : Mark_Type; begin + Mark_Expr_Pool (Marker); Typ := Synth_Subtype_Indication (Syn_Inst, Atype); - Create_Subtype_Object (Syn_Inst, Atype, Typ); + Create_Subtype_Object (Syn_Inst, Atype, Unshare (Typ, Instance_Pool)); + Release_Expr_Pool (Marker); end Synth_Subtype_Indication; function Get_Declaration_Type (Decl : Node) return Node @@ -659,6 +670,7 @@ package body Elab.Vhdl_Types is function Elab_Declaration_Type (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc is + Marker : Mark_Type; Atype : Node; Typ : Type_Acc; begin @@ -668,8 +680,11 @@ package body Elab.Vhdl_Types is when Iir_Kinds_Subtype_Definition => if not Get_Is_Ref (Decl) then -- That's a new type. + Mark_Expr_Pool (Marker); Typ := Synth_Subtype_Indication (Syn_Inst, Atype); + Typ := Unshare (Typ, Instance_Pool); Create_Subtype_Object (Syn_Inst, Atype, Typ); + Release_Expr_Pool (Marker); return Typ; end if; when Iir_Kinds_Denoting_Name => @@ -680,7 +695,10 @@ package body Elab.Vhdl_Types is Pfx : constant Node := Get_Prefix (Atype); Vt : Valtyp; begin + Mark_Expr_Pool (Marker); Vt := Synth_Name (Syn_Inst, Pfx); + Release_Expr_Pool (Marker); + pragma Assert (Vt.Typ.Is_Global); return Vt.Typ; end; when others => diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index a571d6b62..58f407da5 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -131,12 +131,13 @@ package body Elab.Vhdl_Values is function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Signal); begin return To_Value_Acc - (Alloc (Current_Pool, Value_Type_Signal'(Kind => Value_Signal, - S => S, - Init => Init))); + (Alloc (Instance_Pool, Value_Type_Signal'(Kind => Value_Signal, + S => S, + Init => Init))); end Create_Value_Signal; - function Create_Value_Memory (Vtype : Type_Acc) return Valtyp + function Create_Value_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) + return Valtyp is subtype Value_Type_Memory is Value_Type (Value_Memory); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Memory); @@ -145,11 +146,11 @@ package body Elab.Vhdl_Values is V : Value_Acc; M : System.Address; begin - Areapools.Allocate (Current_Pool.all, M, + Areapools.Allocate (Pool.all, M, Vtype.Sz, Size_Type (2 ** Natural (Vtype.Al))); V := To_Value_Acc - (Alloc (Current_Pool, Value_Type_Memory'(Kind => Value_Memory, - Mem => To_Memory_Ptr (M)))); + (Alloc (Pool, Value_Type_Memory'(Kind => Value_Memory, + Mem => To_Memory_Ptr (M)))); return (Vtype, V); end Create_Value_Memory; @@ -216,19 +217,20 @@ package body Elab.Vhdl_Values is return (Vtype, Create_Value_Terminal (T)); end Create_Value_Terminal; - function Create_Value_Alias - (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp + function Create_Value_Alias (Obj : Valtyp; + Off : Value_Offsets; + Typ : Type_Acc; + Pool : Areapool_Acc) return Valtyp is pragma Assert (Typ /= null); subtype Value_Type_Alias is Value_Type (Value_Alias); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Alias); Val : Value_Acc; begin - Val := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Alias, - A_Obj => Obj.Val, - A_Typ => Obj.Typ, - A_Off => Off))); + Val := To_Value_Acc (Alloc (Pool, (Kind => Value_Alias, + A_Obj => Obj.Val, + A_Typ => Obj.Typ, + A_Off => Off))); return (Typ, Val); end Create_Value_Alias; @@ -236,20 +238,20 @@ package body Elab.Vhdl_Values is Poff : Uns32; Ptyp : Type_Acc; Voff : Uns32; - Eoff : Uns32) return Value_Acc + Eoff : Uns32; + Pool : Areapool_Acc) return Value_Acc is subtype Value_Type_Dyn_Alias is Value_Type (Value_Dyn_Alias); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Dyn_Alias); Val : Value_Acc; begin - Val := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Dyn_Alias, - D_Obj => Obj, - D_Poff => Poff, - D_Ptyp => Ptyp, - D_Voff => Voff, - D_Eoff => Eoff))); + Val := To_Value_Acc (Alloc (Pool, (Kind => Value_Dyn_Alias, + D_Obj => Obj, + D_Poff => Poff, + D_Ptyp => Ptyp, + D_Voff => Voff, + D_Eoff => Eoff))); return Val; end Create_Value_Dyn_Alias; @@ -292,10 +294,8 @@ package body Elab.Vhdl_Values is begin case Src.Val.Kind is when Value_Memory => - Res := Create_Value_Memory (Src.Typ); - for I in 1 .. Src.Typ.Sz loop - Res.Val.Mem (I - 1) := Src.Val.Mem (I - 1); - end loop; + Res := Create_Value_Memory (Src.Typ, Current_Pool); + Copy_Memory (Res.Val.Mem, Src.Val.Mem, Src.Typ.Sz); when Value_Net => Res := (Src.Typ, Create_Value_Net (Src.Val.N)); when Value_Wire => @@ -308,10 +308,19 @@ package body Elab.Vhdl_Values is when Value_Signal => raise Internal_Error; when Value_Const => - raise Internal_Error; - when Value_Alias - | Value_Dyn_Alias => - raise Internal_Error; + Res := (Src.Typ, + Create_Value_Const (Src.Val.C_Val, Src.Val.C_Loc)); + Res.Val.C_Net := Src.Val.C_Net; + when Value_Alias => + Res := Create_Value_Alias ((Src.Val.A_Typ, Src.Val.A_Obj), + Src.Val.A_Off, Src.Typ, + Current_Pool); + when Value_Dyn_Alias => + Res := (Src.Typ, + Create_Value_Dyn_Alias (Src.Val.D_Obj, + Src.Val.D_Poff, Src.Val.D_Ptyp, + Src.Val.D_Voff, Src.Val.D_Eoff, + Current_Pool)); end case; return Res; end Copy; @@ -321,6 +330,10 @@ package body Elab.Vhdl_Values is Prev_Pool : constant Areapool_Acc := Current_Pool; Res : Valtyp; begin + if Src = No_Valtyp then + return Src; + end if; + Current_Pool := Pool; Res := Copy (Src); Current_Pool := Prev_Pool; @@ -365,7 +378,7 @@ package body Elab.Vhdl_Values is Res : Valtyp; pragma Assert (Vtype /= null); begin - Res := Create_Value_Memory (Vtype); + Res := Create_Value_Memory (Vtype, Current_Pool); Write_Fp64 (Res.Val.Mem, Val); return Res; end Create_Value_Float; @@ -387,7 +400,7 @@ package body Elab.Vhdl_Values is is Res : Valtyp; begin - Res := Create_Value_Memory (Vtype); + Res := Create_Value_Memory (Vtype, Current_Pool); case Vtype.Sz is when 1 => Write_U8 (Res.Val.Mem, Ghdl_U8 (Val)); @@ -405,7 +418,7 @@ package body Elab.Vhdl_Values is is Res : Valtyp; begin - Res := Create_Value_Memory (Vtype); + Res := Create_Value_Memory (Vtype, Current_Pool); case Vtype.Sz is when 1 => Write_U8 (Res.Val.Mem, Ghdl_U8 (Val)); @@ -421,7 +434,7 @@ package body Elab.Vhdl_Values is is Res : Valtyp; begin - Res := Create_Value_Memory (Vtype); + Res := Create_Value_Memory (Vtype, Current_Pool); case Vtype.Sz is when 4 => Write_I32 (Res.Val.Mem, Ghdl_I32 (Val)); @@ -483,7 +496,7 @@ package body Elab.Vhdl_Values is is Res : Valtyp; begin - Res := Create_Value_Memory (Typ); + Res := Create_Value_Memory (Typ, Current_Pool); Write_Value_Default (Res.Val.Mem, Typ); return Res; end Create_Value_Default; @@ -493,7 +506,7 @@ package body Elab.Vhdl_Values is is Res : Valtyp; begin - Res := Create_Value_Memory (Acc_Typ); + Res := Create_Value_Memory (Acc_Typ, Current_Pool); Write_Access (Res.Val.Mem, Val); return Res; end Create_Value_Access; diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 15cdfeb20..28323ba1b 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -141,10 +141,12 @@ package Elab.Vhdl_Values is -- Create a Value_Wire. function Create_Value_Wire (S : Uns32) return Value_Acc; + -- Create a Value_Signal, always on the instance_pool. function Create_Value_Signal (S : Signal_Index_Type; Init : Value_Acc) return Value_Acc; - function Create_Value_Memory (Vtype : Type_Acc) return Valtyp; + function Create_Value_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) + return Valtyp; function Create_Value_Memory (Mt : Memtyp) return Valtyp; function Create_Value_Uns (Val : Uns64; Vtype : Type_Acc) return Valtyp; @@ -165,14 +167,17 @@ package Elab.Vhdl_Values is function Create_Value_Terminal (Vtype : Type_Acc; T : Terminal_Index_Type) return Valtyp; - function Create_Value_Alias - (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; + function Create_Value_Alias (Obj : Valtyp; + Off : Value_Offsets; + Typ : Type_Acc; + Pool : Areapool_Acc) return Valtyp; function Create_Value_Dyn_Alias (Obj : Value_Acc; Poff : Uns32; Ptyp : Type_Acc; Voff : Uns32; - Eoff : Uns32) return Value_Acc; + Eoff : Uns32; + Pool : Areapool_Acc) return Value_Acc; function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp; diff --git a/src/synth/synth-ieee-numeric_std.adb b/src/synth/synth-ieee-numeric_std.adb index f850456b0..19fa1145d 100644 --- a/src/synth/synth-ieee-numeric_std.adb +++ b/src/synth/synth-ieee-numeric_std.adb @@ -50,7 +50,11 @@ package body Synth.Ieee.Numeric_Std is if Otyp.Abound.Len = Len and then Otyp.Abound.Right = 0 and then Otyp.Abound.Dir = Dir_Downto + and then not Otyp.Is_Global then + -- Try to reuse the same type as the parameter. + -- But the result type must be allocated on the expr_pool. + -- FIXME: is this code ever executed ? pragma Assert (Otyp.Abound.Left = Int32 (Len) - 1); return Otyp; end if; @@ -847,7 +851,7 @@ package body Synth.Ieee.Numeric_Std is is Res : Memory_Ptr; begin - Res := Alloc_Memory (V.Typ); + Res := Alloc_Memory (V.Typ, Current_Pool); Neg_Vec (V.Mem, Res, V.Typ); return Res; diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb index bd198e944..b8af2edf3 100644 --- a/src/synth/synth-vhdl_aggr.adb +++ b/src/synth/synth-vhdl_aggr.adb @@ -202,7 +202,7 @@ package body Synth.Vhdl_Aggr is Err_P := True; end if; for I in 1 .. Pos32'Min (Pos32 (Str_Len), Pos32 (Bound.Len)) loop - E := Create_Value_Memory (El_Typ); + E := Create_Value_Memory (El_Typ, Current_Pool); V := Str_Table.Element_String8 (Str_Id, I); Write_U8 (E.Val.Mem, Nat8'Pos (V)); Res (Pos) := E; @@ -450,7 +450,7 @@ package body Synth.Vhdl_Aggr is declare Off : Size_Type; begin - Res := Create_Value_Memory (Aggr_Type); + Res := Create_Value_Memory (Aggr_Type, Current_Pool); Off := 0; for I in Tab_Res'Range loop if Tab_Res (I).Val /= null then @@ -511,7 +511,7 @@ package body Synth.Vhdl_Aggr is end case; if Const_P then - Res := Create_Value_Memory (Res_Typ); + Res := Create_Value_Memory (Res_Typ, Current_Pool); for I in Aggr_Type.Rec.E'Range loop -- Note: elements are put in reverse order in Tab_Res, -- so reverse again... diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 1d7aa5538..7b6c81cbb 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -387,10 +387,13 @@ package body Synth.Vhdl_Context is Ptyp : Type_Acc; Voff : Net; Eoff : Uns32; - Typ : Type_Acc) return Valtyp is + Typ : Type_Acc; + Pool : Areapools.Areapool_Acc) + return Valtyp is begin return (Typ, - Create_Value_Dyn_Alias (Obj, Poff, Ptyp, To_Uns32 (Voff), Eoff)); + Create_Value_Dyn_Alias (Obj, Poff, Ptyp, To_Uns32 (Voff), Eoff, + Pool)); end Create_Value_Dyn_Alias; function Get_Value_Dyn_Alias_Voff (Val : Value_Acc) return Net is diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads index 2b4571c23..d71a78172 100644 --- a/src/synth/synth-vhdl_context.ads +++ b/src/synth/synth-vhdl_context.ads @@ -17,6 +17,7 @@ -- along with this program. If not, see <gnu.org/licenses>. with Types; use Types; +with Areapools; with Elab.Vhdl_Context; use Elab.Vhdl_Context; with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; @@ -114,7 +115,9 @@ package Synth.Vhdl_Context is Ptyp : Type_Acc; Voff : Net; Eoff : Uns32; - Typ : Type_Acc) return Valtyp; + Typ : Type_Acc; + Pool : Areapools.Areapool_Acc) + return Valtyp; function Get_Value_Dyn_Alias_Voff (Val : Value_Acc) return Net; private diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index 6bf730e35..2a4b792a6 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -419,7 +419,9 @@ package body Synth.Vhdl_Decls is Wid := Get_Value_Wire (Val.Val); if Is_Subprg then if Is_Static (Init.Val) then - Phi_Assign_Static (Wid, Get_Memtyp (Init)); + -- FIXME: use global pool for shared variables ? + Phi_Assign_Static + (Wid, Unshare (Get_Memtyp (Init), Wireval_Pool'Access)); else Phi_Assign_Net (Ctxt, Wid, Get_Net (Ctxt, Init), 0); end if; @@ -489,6 +491,7 @@ package body Synth.Vhdl_Decls is Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off, Dyn); pragma Assert (Dyn.Voff = No_Net); + Typ := Unshare (Typ, Instance_Pool); if Base.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the -- bits for the alias. @@ -497,11 +500,12 @@ package body Synth.Vhdl_Decls is Get_Value_Net (Base.Val), Off.Net_Off, Typ.W), Typ); else - Res := Create_Value_Alias (Base, Off, Typ); + Res := Create_Value_Alias (Base, Off, Typ, Expr_Pool'Access); end if; if Obj_Typ /= null then Res := Synth_Subtype_Conversion (Syn_Inst, Res, Obj_Typ, True, Decl); end if; + Res := Unshare (Res, Instance_Pool); Create_Object (Syn_Inst, Decl, Res); end Synth_Object_Alias_Declaration; diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb index ef685b3f7..5d97528dd 100644 --- a/src/synth/synth-vhdl_eval.adb +++ b/src/synth/synth-vhdl_eval.adb @@ -584,6 +584,7 @@ package body Synth.Vhdl_Eval is Iir_Index32 (Get_Bound_Length (Right.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_St : Type_Acc; Res : Memtyp; @@ -591,8 +592,9 @@ package body Synth.Vhdl_Eval is Check_Matching_Bounds (Le_Typ, Re_Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (Get_Uarray_Index (Res_Typ).Drange, L_Len + R_Len); + El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ)); Res_St := Create_Onedimensional_Array_Subtype - (Res_Typ, Bnd, Le_Typ); + (Res_Typ, Bnd, El_Typ); Res := Create_Memory (Res_St); if Left.Typ.Sz > 0 then Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz); @@ -607,6 +609,7 @@ package body Synth.Vhdl_Eval is Rlen : constant Iir_Index32 := Iir_Index32 (Get_Bound_Length (Right.Typ)); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_St : Type_Acc; Res : Memtyp; @@ -614,8 +617,9 @@ package body Synth.Vhdl_Eval is Check_Matching_Bounds (Left.Typ, Re_Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (Get_Uarray_Index (Res_Typ).Drange, 1 + Rlen); + El_Typ := Unshare_Type (Re_Typ, Get_Array_Element (Res_Typ)); Res_St := Create_Onedimensional_Array_Subtype - (Res_Typ, Bnd, Re_Typ); + (Res_Typ, Bnd, El_Typ); Res := Create_Memory (Res_St); Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz); Copy_Memory (Res.Mem + Left.Typ.Sz, @@ -627,6 +631,7 @@ package body Synth.Vhdl_Eval is Llen : constant Iir_Index32 := Iir_Index32 (Get_Bound_Length (Left.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_St : Type_Acc; Res : Memtyp; @@ -634,8 +639,9 @@ package body Synth.Vhdl_Eval is Check_Matching_Bounds (Le_Typ, Right.Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (Get_Uarray_Index (Res_Typ).Drange, Llen + 1); + El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ)); Res_St := Create_Onedimensional_Array_Subtype - (Res_Typ, Bnd, Le_Typ); + (Res_Typ, Bnd, El_Typ); Res := Create_Memory (Res_St); Copy_Memory (Res.Mem, Left.Mem, Left.Typ.Sz); Copy_Memory (Res.Mem + Left.Typ.Sz, @@ -644,7 +650,8 @@ package body Synth.Vhdl_Eval is end; when Iir_Predefined_Element_Element_Concat => declare - El_Typ : constant Type_Acc := Left.Typ; + Le_Typ : constant Type_Acc := Left.Typ; + El_Typ : Type_Acc; Bnd : Bound_Type; Res_St : Type_Acc; Res : Memtyp; @@ -652,6 +659,7 @@ package body Synth.Vhdl_Eval is Check_Matching_Bounds (Left.Typ, Right.Typ, Expr); Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (Get_Uarray_Index (Res_Typ).Drange, 2); + El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Res_Typ)); Res_St := Create_Onedimensional_Array_Subtype (Res_Typ, Bnd, El_Typ); Res := Create_Memory (Res_St); diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index 6f33ff209..58599b109 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -503,7 +503,8 @@ package body Synth.Vhdl_Expr is return Create_Value_Net (Get_Value_Net (Val.Val), Ntype); when Value_Alias => return Create_Value_Alias - ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype); + ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype, + Current_Pool); when Value_Const => return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); when Value_Memory => @@ -684,7 +685,7 @@ package body Synth.Vhdl_Expr is Get_Subtype_Object (Syn_Inst, Get_Type (Name)); Res : Valtyp; begin - Res := Create_Value_Memory (Typ); + Res := Create_Value_Memory (Typ, Current_Pool); Write_Discrete (Res, Int64 (Get_Enum_Pos (Name))); return Res; end; @@ -700,9 +701,11 @@ package body Synth.Vhdl_Expr is | Iir_Kind_Dereference => declare Val : Valtyp; + Obj : Memtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); - return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + Obj := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + return Create_Value_Memory (Obj); end; when others => Error_Kind ("synth_name", Name); @@ -2014,7 +2017,8 @@ package body Synth.Vhdl_Expr is -- returns 0. return Create_Value_Memtyp (Create_Memory_Zero (Res_Typ)); elsif Is_Static (Val.Val) then - Res := Create_Value_Memory (Res_Typ); + -- TODO: why a copy ? + Res := Create_Value_Memory (Res_Typ, Current_Pool); Copy_Memory (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Offs.Mem_Off, @@ -2035,7 +2039,7 @@ package body Synth.Vhdl_Expr is declare Res : Valtyp; begin - Res := Create_Value_Memory (Expr_Type); + Res := Create_Value_Memory (Expr_Type, Current_Pool); Write_Discrete (Res, Get_Value (Expr)); return Res; end; @@ -2185,22 +2189,26 @@ package body Synth.Vhdl_Expr is return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => declare + Acc_Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); T : Type_Acc; Acc : Heap_Index; begin T := Synth_Subtype_Indication (Syn_Inst, Get_Subtype_Indication (Expr)); - Acc := Allocate_By_Type (T); + Acc := Allocate_By_Type (Acc_Typ, T); return Create_Value_Access (Acc, Expr_Type); end; when Iir_Kind_Allocator_By_Expression => declare + Acc_Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); V : Valtyp; Acc : Heap_Index; begin V := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); - Acc := Allocate_By_Value (V); + Acc := Allocate_By_Value (Acc_Typ, V); return Create_Value_Access (Acc, Expr_Type); end; when Iir_Kind_Stable_Attribute => diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index 78952cf5c..16ba47006 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -145,6 +145,7 @@ package body Synth.Vhdl_Oper is when Type_Vector => if Res.Abound.Dir = Dir_Downto and then Res.Abound.Right = 0 + and then not Res.Is_Global then -- Normalized range return Res; @@ -954,6 +955,7 @@ package body Synth.Vhdl_Oper is declare L : constant Net := Get_Net (Ctxt, Left); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_Typ : Type_Acc; N : Net; @@ -966,14 +968,16 @@ package body Synth.Vhdl_Oper is Get_Index_Type (Get_Type (Expr), 0), Iir_Index32 (Get_Bound_Length (Left.Typ) + 1)); + El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Expr_Typ)); Res_Typ := Create_Onedimensional_Array_Subtype - (Left_Typ, Bnd, Le_Typ); + (Expr_Typ, Bnd, El_Typ); return Create_Value_Net (N, Res_Typ); end; when Iir_Predefined_Element_Array_Concat => declare R : constant Net := Get_Net (Ctxt, Right); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_Typ : Type_Acc; N : Net; @@ -986,12 +990,14 @@ package body Synth.Vhdl_Oper is Get_Index_Type (Get_Type (Expr), 0), Iir_Index32 (Get_Bound_Length (Right.Typ) + 1)); + El_Typ := Unshare_Type (Re_Typ, Get_Array_Element (Expr_Typ)); Res_Typ := Create_Onedimensional_Array_Subtype - (Right_Typ, Bnd, Re_Typ); + (Expr_Typ, Bnd, El_Typ); return Create_Value_Net (N, Res_Typ); end; when Iir_Predefined_Element_Element_Concat => declare + El_Typ : Type_Acc; N : Net; Bnd : Bound_Type; Res_Typ : Type_Acc; @@ -1002,8 +1008,9 @@ package body Synth.Vhdl_Oper is Set_Location (N, Expr); Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2); + El_Typ := Unshare_Type (Left.Typ, Get_Array_Element (Expr_Typ)); Res_Typ := Create_Onedimensional_Array_Subtype - (Expr_Typ, Bnd, Left.Typ); + (Expr_Typ, Bnd, El_Typ); return Create_Value_Net (N, Res_Typ); end; when Iir_Predefined_Array_Array_Concat => @@ -1012,6 +1019,7 @@ package body Synth.Vhdl_Oper is Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); L : constant Net := Get_Net (Ctxt, Left); R : constant Net := Get_Net (Ctxt, Right); + El_Typ : Type_Acc; Bnd : Bound_Type; Res_Typ : Type_Acc; N : Net; @@ -1025,8 +1033,9 @@ package body Synth.Vhdl_Oper is Iir_Index32 (Get_Bound_Length (Left.Typ) + Get_Bound_Length (Right.Typ))); + El_Typ := Unshare_Type (Le_Typ, Get_Array_Element (Expr_Typ)); Res_Typ := Create_Onedimensional_Array_Subtype - (Expr_Typ, Bnd, Le_Typ); + (Expr_Typ, Bnd, El_Typ); return Create_Value_Net (N, Res_Typ); end; when Iir_Predefined_Integer_Plus => diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 8cef43807..dcd7cd06d 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -68,6 +68,8 @@ package body Synth.Vhdl_Stmts is procedure Set_Location (N : Net; Loc : Node) renames Synth.Source.Set_Location; + Proc_Pool : aliased Areapools.Areapool; + function Synth_Waveform (Syn_Inst : Synth_Instance_Acc; Wf : Node; Targ_Type : Type_Acc) return Valtyp @@ -253,8 +255,8 @@ package body Synth.Vhdl_Stmts is if Dest_Off /= (0, 0) and then Dest_Dyn.Voff /= No_Net then raise Internal_Error; end if; - Dest_Base := Elab.Vhdl_Heap.Synth_Dereference - (Read_Access (Dest_Base)); + Dest_Base := Create_Value_Memory + (Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Dest_Base))); Dest_Typ := Dest_Base.Typ; when others => @@ -409,7 +411,7 @@ package body Synth.Vhdl_Stmts is declare Res : Valtyp; begin - Res := Create_Value_Memory (Typ); + Res := Create_Value_Memory (Typ, Current_Pool); -- Need to reverse offsets. Copy_Memory (Res.Val.Mem, @@ -445,7 +447,7 @@ package body Synth.Vhdl_Stmts is declare Res : Valtyp; begin - Res := Create_Value_Memory (Typ); + Res := Create_Value_Memory (Typ, Current_Pool); Copy_Memory (Res.Val.Mem, Val.Val.Mem + El_Typ.Offs.Mem_Off, El_Typ.Typ.Sz); return Res; @@ -539,6 +541,7 @@ package body Synth.Vhdl_Stmts is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); W : Wire_Id; V : Valtyp; + M : Memtyp; begin if Targ = No_Valtyp then -- There was an error. @@ -559,7 +562,9 @@ package body Synth.Vhdl_Stmts is and then V.Typ.Sz = Targ.Typ.Sz then pragma Assert (Off = No_Value_Offsets); - Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); + M := Unshare (Get_Memtyp (V), Wireval_Pool'Access); + M.Typ := Unshare (M.Typ, Wireval_Pool'Access); + Phi_Assign_Static (W, M); else if V.Typ.W = 0 then -- Forget about null wires. @@ -764,9 +769,11 @@ package body Synth.Vhdl_Stmts is procedure Synth_Variable_Assignment (Inst : Synth_Instance_Acc; Stmt : Node) is + Marker : Mark_Type; Targ : Target_Info; Val : Valtyp; begin + Mark_Expr_Pool (Marker); Targ := Synth_Target (Inst, Get_Target (Stmt)); Val := Synth_Expression_With_Type (Inst, Get_Expression (Stmt), Targ.Targ_Type); @@ -775,6 +782,7 @@ package body Synth.Vhdl_Stmts is return; end if; Synth_Assignment (Inst, Targ, Val, Stmt); + Release_Expr_Pool (Marker); end Synth_Variable_Assignment; procedure Synth_Conditional_Variable_Assignment @@ -782,6 +790,7 @@ package body Synth.Vhdl_Stmts is is Ctxt : constant Context_Acc := Get_Build (Inst); Target : constant Node := Get_Target (Stmt); + Marker : Mark_Type; Targ_Type : Type_Acc; Cond : Node; Ce : Node; @@ -790,6 +799,7 @@ package body Synth.Vhdl_Stmts is First : Valtyp; Cond_Tri : Tri_State_Type; begin + Mark_Expr_Pool (Marker); Targ_Type := Get_Subtype_Object (Inst, Get_Type (Target)); First := No_Valtyp; Last := No_Net; @@ -853,6 +863,7 @@ package body Synth.Vhdl_Stmts is Ce := Get_Chain (Ce); end loop; Synth_Assignment (Inst, Target, First, Stmt); + Release_Expr_Pool (Marker); end Synth_Conditional_Variable_Assignment; procedure Synth_If_Statement (C : in out Seq_Context; Stmt : Node) @@ -1826,7 +1837,8 @@ package body Synth.Vhdl_Stmts is if Info.Off = No_Value_Offsets then return Info.Obj; else - return Create_Value_Alias (Info.Obj, Info.Off, Info.Targ_Type); + return Create_Value_Alias + (Info.Obj, Info.Off, Info.Targ_Type, Instance_Pool); end if; when Target_Aggregate => raise Internal_Error; @@ -1836,7 +1848,8 @@ package body Synth.Vhdl_Stmts is Info.Mem_Dyn.Pfx_Typ, Info.Mem_Dyn.Voff, Info.Mem_Doff, - Info.Targ_Type); + Info.Targ_Type, + Instance_Pool); end case; end Info_To_Valtyp; @@ -1844,6 +1857,7 @@ package body Synth.Vhdl_Stmts is Caller_Inst : Synth_Instance_Acc; Init : Association_Iterator_Init) is + Marker : Mark_Type; Inter : Node; Inter_Type : Type_Acc; Assoc : Node; @@ -1852,6 +1866,8 @@ package body Synth.Vhdl_Stmts is Iterator : Association_Iterator; Info : Target_Info; begin + Mark_Expr_Pool (Marker); + Set_Instance_Const (Subprg_Inst, True); -- Process in INTER order. @@ -1887,17 +1903,21 @@ package body Synth.Vhdl_Stmts is Actual := Get_Actual (Assoc); Info := Synth_Target (Caller_Inst, Actual); if Is_Copyback_Parameter (Inter) then + -- For the copy back: keep info of formal. Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info)); end if; if Info.Kind /= Target_Memory and then Is_Static (Info.Obj.Val) then - Val := Create_Value_Memory (Info.Targ_Type); + -- FIXME: the subtype conversion will copy the value, so + -- allocate here in current_pool ? + Val := Create_Value_Memory (Info.Targ_Type, Instance_Pool); Copy_Memory (Val.Val.Mem, Info.Obj.Val.Mem + Info.Off.Mem_Off, Info.Targ_Type.Sz); else Val := Synth_Read (Caller_Inst, Info, Assoc); + Val := Unshare (Val, Instance_Pool); end if; when Iir_Kind_Interface_Signal_Declaration => -- Always pass by reference (use an alias). @@ -1907,7 +1927,7 @@ package body Synth.Vhdl_Stmts is raise Internal_Error; end if; Val := Create_Value_Alias - (Info.Obj, Info.Off, Info.Targ_Type); + (Info.Obj, Info.Off, Info.Targ_Type, Instance_Pool); when Iir_Kind_Interface_File_Declaration => Actual := Get_Actual (Assoc); Info := Synth_Target (Caller_Inst, Actual); @@ -1929,10 +1949,12 @@ package body Synth.Vhdl_Stmts is -- Always passed by value Val := Synth_Subtype_Conversion (Subprg_Inst, Val, Inter_Type, True, Assoc); + Val := Unshare (Val, Instance_Pool); else -- Use default value ? null; end if; + Val.Typ := Unshare (Val.Typ, Instance_Pool); when Iir_Kind_Interface_Signal_Declaration => -- LRM08 4.2.2.3 Signal parameters -- If an actual signal is associated with a signal parameter @@ -1954,7 +1976,6 @@ package body Synth.Vhdl_Stmts is (+Actual, "scalar subtype of actual is not compatible with " & "signal formal interface"); - Val := No_Valtyp; end if; end if; if Get_Mode (Inter) in Iir_Out_Modes then @@ -1964,7 +1985,6 @@ package body Synth.Vhdl_Stmts is (+Actual, "signal formal interface scalar subtype is not " & "compatible with of actual subtype"); - Val := No_Valtyp; end if; end if; else @@ -1973,6 +1993,10 @@ package body Synth.Vhdl_Stmts is -- types. Val := Synth_Subtype_Conversion (Subprg_Inst, Val, Inter_Type, True, Assoc); + Val := Unshare (Val, Instance_Pool); + end if; + if Val.Typ /= null then + Val.Typ := Unshare (Val.Typ, Instance_Pool); end if; when Iir_Kind_Interface_File_Declaration => null; @@ -1999,7 +2023,7 @@ package body Synth.Vhdl_Stmts is -- Arguments are passed by copy. if Is_Static (Val.Val) or else Get_Mode (Inter) = Iir_In_Mode then - Val := Unshare (Val, Current_Pool); + Val := Unshare (Val, Instance_Pool); else -- Will be changed to a wire. null; @@ -2012,6 +2036,7 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Interface_Quantity_Declaration => raise Internal_Error; end case; + Release_Expr_Pool (Marker); end loop; end Synth_Subprogram_Associations; @@ -2312,6 +2337,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); Area_Mark : Areapools.Mark_Type; + Ret_Typ : Type_Acc; Res : Valtyp; Sub_Inst : Synth_Instance_Acc; begin @@ -2352,6 +2378,14 @@ package body Synth.Vhdl_Stmts is end if; Free_Instance (Sub_Inst); + + if Res /= No_Valtyp then + -- Protect return value from being deallocated + Res := Unshare (Res, Expr_Pool'Access); + Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Imp)); + Res.Typ := Unshare_Type (Res.Typ, Ret_Typ); + end if; + Areapools.Release (Area_Mark, Instance_Pool.all); return Res; @@ -2789,13 +2823,17 @@ package body Synth.Vhdl_Stmts is It_Type : constant Node := Get_Declaration_Type (Iterator); It_Rng : Type_Acc; begin + Create_Object_Marker (Inst, Stmt, Instance_Pool); + if It_Type /= Null_Node then Synth_Subtype_Indication (Inst, It_Type); end if; -- Initial value. It_Rng := Get_Subtype_Object (Inst, Get_Type (Iterator)); + Current_Pool := Instance_Pool; Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); + Current_Pool := Expr_Pool'Access; Create_Object (Inst, Iterator, Val); end Init_For_Loop_Statement; @@ -2811,6 +2849,7 @@ package body Synth.Vhdl_Stmts is if It_Type /= Null_Node then Destroy_Object (D, It_Type); end if; + Destroy_Marker (D, Stmt, Instance_Pool); Destroy_Finish (D); end Finish_For_Loop_Statement; @@ -3027,10 +3066,13 @@ package body Synth.Vhdl_Stmts is use Simple_IO; Rep_Expr : constant Node := Get_Report_Expression (Stmt); Sev_Expr : constant Node := Get_Severity_Expression (Stmt); + Marker : Mark_Type; Rep : Valtyp; Sev : Valtyp; Sev_V : Natural; begin + Mark_Expr_Pool (Marker); + if Rep_Expr /= Null_Node then Rep := Synth_Expression_With_Basetype (Syn_Inst, Rep_Expr); if Rep = No_Valtyp then @@ -3077,6 +3119,8 @@ package body Synth.Vhdl_Stmts is Put_Line_Err (Value_To_String (Rep)); end if; + Release_Expr_Pool (Marker); + if Sev_V >= Flags.Severity_Level then Error_Msg_Synth (+Stmt, "error due to assertion failure"); Elab.Debugger.Debug_Error (Syn_Inst, Stmt); @@ -3287,8 +3331,6 @@ package body Synth.Vhdl_Stmts is end loop; end Synth_Sequential_Statements; - Proc_Pool : aliased Areapools.Areapool; - -- Synthesis of statements of a non-sensitized process. procedure Synth_Process_Sequential_Statements (C : in out Seq_Context; Proc : Node) @@ -3385,6 +3427,7 @@ package body Synth.Vhdl_Stmts is Finalize_Assignment (Ctxt, C.W_En); Free_Wire (C.W_En); + Release (Empty_Marker, Wireval_Pool); end Synth_Process_Statement; function Synth_User_Function_Call @@ -3554,6 +3597,8 @@ package body Synth.Vhdl_Stmts is Clk : Net; Clk_Inst : Instance; begin + Instance_Pool := Proc_Pool'Access; + -- create init net, clock net Init := Build_Const_UB32 (Ctxt, 1, Uns32 (Nbr_States)); Set_Location (Init, Stmt); @@ -3604,6 +3649,8 @@ package body Synth.Vhdl_Stmts is end if; Connect (Get_Input (Get_Net_Parent (States), 1), Next_States); + + Instance_Pool := null; end Synth_Psl_Dff; function Synth_Psl_Final @@ -3823,23 +3870,29 @@ package body Synth.Vhdl_Stmts is is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); begin + Instance_Pool := Process_Pool'Access; + case Get_Kind (Stmt) is when Iir_Kind_Concurrent_Simple_Signal_Assignment => Push_Phi; Synth_Simple_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); + Areapools.Release (Areapools.Empty_Marker, Wireval_Pool); when Iir_Kind_Concurrent_Conditional_Signal_Assignment => Push_Phi; Synth_Conditional_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); + Areapools.Release (Areapools.Empty_Marker, Wireval_Pool); when Iir_Kind_Concurrent_Selected_Signal_Assignment => Push_Phi; Synth_Selected_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); + Areapools.Release (Areapools.Empty_Marker, Wireval_Pool); when Iir_Kind_Concurrent_Procedure_Call_Statement => Push_Phi; Synth_Procedure_Call (Syn_Inst, Stmt); Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); + Areapools.Release (Areapools.Empty_Marker, Wireval_Pool); when Iir_Kinds_Process_Statement => Synth_Process_Statement (Syn_Inst, Stmt); when Iir_Kind_If_Generate_Statement => @@ -3895,6 +3948,9 @@ package body Synth.Vhdl_Stmts is when others => Error_Kind ("synth_concurrent_statement", Stmt); end case; + + pragma Assert (Areapools.Is_Empty (Process_Pool)); + Instance_Pool := null; end Synth_Concurrent_Statement; procedure Synth_Concurrent_Statements |