From a677e3cc38d1f5e3813bc1e5bd424ee0b59319ed Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 16 Apr 2021 06:42:48 +0200 Subject: synth: rename synth-context to synth-vhdl_context --- src/synth/synth-aggr.ads | 2 +- src/synth/synth-context.adb | 562 ----------------------------------- src/synth/synth-context.ads | 205 ------------- src/synth/synth-debugger.ads | 2 +- src/synth/synth-decls.ads | 2 +- src/synth/synth-disp_vhdl.ads | 2 +- src/synth/synth-environment.adb | 14 +- src/synth/synth-expr.ads | 2 +- src/synth/synth-files_operations.ads | 2 +- src/synth/synth-insts.ads | 2 +- src/synth/synth-oper.ads | 2 +- src/synth/synth-static_oper.ads | 2 +- src/synth/synth-static_proc.ads | 2 +- src/synth/synth-stmts.ads | 2 +- src/synth/synth-vhdl_context.adb | 562 +++++++++++++++++++++++++++++++++++ src/synth/synth-vhdl_context.ads | 205 +++++++++++++ src/synth/synthesis.ads | 2 +- 17 files changed, 786 insertions(+), 786 deletions(-) delete mode 100644 src/synth/synth-context.adb delete mode 100644 src/synth/synth-context.ads create mode 100644 src/synth/synth-vhdl_context.adb create mode 100644 src/synth/synth-vhdl_context.ads (limited to 'src/synth') diff --git a/src/synth/synth-aggr.ads b/src/synth/synth-aggr.ads index 41e99d932..d37cd8afe 100644 --- a/src/synth/synth-aggr.ads +++ b/src/synth/synth-aggr.ads @@ -20,7 +20,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Aggr is -- Aggr_Type is the type from the context. diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb deleted file mode 100644 index 4fa3e9ca6..000000000 --- a/src/synth/synth-context.adb +++ /dev/null @@ -1,562 +0,0 @@ --- Synthesis context. --- Copyright (C) 2017 Tristan Gingold --- --- This file is part of GHDL. --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 2 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . - -with Ada.Unchecked_Deallocation; - -with Name_Table; use Name_Table; -with Types_Utils; use Types_Utils; - -with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Utils; - -with Netlists.Folds; use Netlists.Folds; - -with Synth.Expr; use Synth.Expr; -with Netlists.Locations; - -package body Synth.Context is - function Make_Base_Instance return Synth_Instance_Acc - is - Base : Base_Instance_Acc; - Top_Module : Module; - Res : Synth_Instance_Acc; - Ctxt : Context_Acc; - begin - Top_Module := - New_Design (New_Sname_Artificial (Get_Identifier ("top"), No_Sname)); - Ctxt := Build_Builders (Top_Module); - - Base := new Base_Instance_Type'(Builder => Ctxt, - Top_Module => Top_Module, - Cur_Module => No_Module); - - Res := new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects, - Is_Const => False, - Is_Error => False, - Base => Base, - Name => No_Sname, - Block_Scope => Global_Info, - Up_Block => null, - Uninst_Scope => null, - Source_Scope => Null_Node, - Elab_Objects => 0, - Objects => (others => - (Kind => Obj_None))); - return Res; - end Make_Base_Instance; - - procedure Free_Base_Instance is - begin - -- TODO: really free. - null; - end Free_Base_Instance; - - function Make_Instance (Parent : Synth_Instance_Acc; - Blk : Node; - Name : Sname := No_Sname) - return Synth_Instance_Acc - is - Info : constant Sim_Info_Acc := Get_Info (Blk); - Scope : Sim_Info_Acc; - Res : Synth_Instance_Acc; - begin - if Get_Kind (Blk) = Iir_Kind_Architecture_Body then - -- Architectures are extensions of entities. - Scope := Get_Info (Vhdl.Utils.Get_Entity (Blk)); - else - Scope := Info; - end if; - - Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects, - Is_Const => False, - Is_Error => False, - Base => Parent.Base, - Name => Name, - Block_Scope => Scope, - Up_Block => Parent, - Uninst_Scope => null, - Source_Scope => Blk, - Elab_Objects => 0, - Objects => (others => - (Kind => Obj_None))); - return Res; - end Make_Instance; - - procedure Set_Instance_Base (Inst : Synth_Instance_Acc; - Base : Synth_Instance_Acc) is - begin - Inst.Base := Base.Base; - end Set_Instance_Base; - - procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc) - is - procedure Deallocate is new Ada.Unchecked_Deallocation - (Synth_Instance_Type, Synth_Instance_Acc); - begin - Deallocate (Synth_Inst); - end Free_Instance; - - procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module) - is - Prev_Base : constant Base_Instance_Acc := Inst.Base; - Base : Base_Instance_Acc; - Self_Inst : Instance; - begin - Base := new Base_Instance_Type'(Builder => Prev_Base.Builder, - Top_Module => Prev_Base.Top_Module, - Cur_Module => M); - Builders.Set_Parent (Base.Builder, M); - - Self_Inst := Create_Self_Instance (M); - pragma Unreferenced (Self_Inst); - - Inst.Base := Base; - end Set_Instance_Module; - - function Is_Error (Inst : Synth_Instance_Acc) return Boolean is - begin - return Inst.Is_Error; - end Is_Error; - - procedure Set_Error (Inst : Synth_Instance_Acc) is - begin - Inst.Is_Error := True; - end Set_Error; - - function Get_Instance_Module (Inst : Synth_Instance_Acc) return Module is - begin - return Inst.Base.Cur_Module; - end Get_Instance_Module; - - function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node is - begin - return Inst.Source_Scope; - end Get_Source_Scope; - - function Get_Top_Module (Inst : Synth_Instance_Acc) return Module is - begin - return Inst.Base.Top_Module; - end Get_Top_Module; - - function Get_Sname (Inst : Synth_Instance_Acc) return Sname is - begin - return Inst.Name; - end Get_Sname; - - function Get_Build (Inst : Synth_Instance_Acc) - return Netlists.Builders.Context_Acc is - begin - return Inst.Base.Builder; - end Get_Build; - - function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean is - begin - return Inst.Is_Const; - end Get_Instance_Const; - - function Check_Set_Instance_Const (Inst : Synth_Instance_Acc) - return Boolean is - begin - for I in 1 .. Inst.Elab_Objects loop - if Inst.Objects (I).Kind /= Obj_Subtype then - return False; - end if; - end loop; - return True; - end Check_Set_Instance_Const; - - procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean) is - begin - pragma Assert (not Val or else Check_Set_Instance_Const (Inst)); - Inst.Is_Const := Val; - end Set_Instance_Const; - - procedure Create_Object (Syn_Inst : Synth_Instance_Acc; - Slot : Object_Slot_Type; - Num : Object_Slot_Type := 1) is - begin - -- Check elaboration order. - -- Note: this is not done for package since objects from package are - -- commons (same scope), and package annotation order can be different - -- from package elaboration order (eg: body). - if Slot /= Syn_Inst.Elab_Objects + 1 - or else Syn_Inst.Objects (Slot).Kind /= Obj_None - then - Error_Msg_Elab ("synth: bad elaboration order of objects"); - raise Internal_Error; - end if; - Syn_Inst.Elab_Objects := Slot + Num - 1; - end Create_Object; - - procedure Create_Object_Force - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - begin - pragma Assert - (Syn_Inst.Objects (Info.Slot).Kind = Obj_None - or else Vt = (null, null) - or else Syn_Inst.Objects (Info.Slot) = (Kind => Obj_Object, - Obj => No_Valtyp)); - Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); - end Create_Object_Force; - - procedure Create_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - begin - Create_Object (Syn_Inst, Info.Slot, 1); - Create_Object_Force (Syn_Inst, Decl, Vt); - end Create_Object; - - procedure Create_Subtype_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc) - is - pragma Assert (Typ /= null); - Info : constant Sim_Info_Acc := Get_Info (Decl); - begin - Create_Object (Syn_Inst, Info.Slot, 1); - pragma Assert (Syn_Inst.Objects (Info.Slot).Kind = Obj_None); - Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Subtype, T_Typ => Typ); - end Create_Subtype_Object; - - procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; - Decl : Node; - Inst : Synth_Instance_Acc; - Is_Global : Boolean) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - begin - if Is_Global then - pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot).Kind = Obj_None); - pragma Assert (Syn_Inst.Up_Block = null); - null; - else - pragma Assert (Syn_Inst.Up_Block /= null); - Create_Object (Syn_Inst, Info.Slot, 1); - end if; - Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance, - I_Inst => Inst); - end Create_Package_Object; - - procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc; - Decl : Node; - Inst : Synth_Instance_Acc) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - begin - pragma Assert (Syn_Inst.Up_Block /= null); - Create_Object (Syn_Inst, Info.Pkg_Slot, 1); - Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance, - I_Inst => Inst); - end Create_Package_Interface; - - function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc) - return Synth_Instance_Acc - is - Parent : Synth_Instance_Acc; - begin - Parent := Get_Instance_By_Scope (Syn_Inst, Info.Pkg_Parent); - return Parent.Objects (Info.Pkg_Slot).I_Inst; - end Get_Package_Object; - - function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc is - begin - return Get_Package_Object (Syn_Inst, Get_Info (Pkg)); - end Get_Package_Object; - - procedure Set_Uninstantiated_Scope - (Syn_Inst : Synth_Instance_Acc; Bod : Node) is - begin - Syn_Inst.Uninst_Scope := Get_Info (Bod); - end Set_Uninstantiated_Scope; - - procedure Destroy_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - Slot : constant Object_Slot_Type := Info.Slot; - begin - if Slot /= Syn_Inst.Elab_Objects - or else Info.Obj_Scope /= Syn_Inst.Block_Scope - then - Error_Msg_Elab ("synth: bad destroy order"); - end if; - Syn_Inst.Objects (Slot) := (Kind => Obj_None); - Syn_Inst.Elab_Objects := Slot - 1; - end Destroy_Object; - - procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc; - Kind : Wire_Kind; - Obj : Node) - is - Obj_Type : constant Node := Get_Type (Obj); - Otyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Obj_Type); - Val : Valtyp; - Wid : Wire_Id; - begin - if Kind = Wire_None then - Wid := No_Wire_Id; - else - Wid := Alloc_Wire (Kind, Otyp, Obj); - end if; - Val := Create_Value_Wire (Wid, Otyp); - - Create_Object (Syn_Inst, Obj, Val); - end Create_Wire_Object; - - function Get_Instance_By_Scope - (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) - return Synth_Instance_Acc is - begin - case Scope.Kind is - when Kind_Block - | Kind_Frame - | Kind_Process => - declare - Current : Synth_Instance_Acc; - begin - Current := Syn_Inst; - while Current /= null loop - if Current.Block_Scope = Scope then - return Current; - end if; - Current := Current.Up_Block; - end loop; - raise Internal_Error; - end; - when Kind_Package => - if Scope.Pkg_Parent = null then - -- This is a scope for an uninstantiated package. - declare - Current : Synth_Instance_Acc; - begin - Current := Syn_Inst; - while Current /= null loop - if Current.Uninst_Scope = Scope then - return Current; - end if; - Current := Current.Up_Block; - end loop; - raise Internal_Error; - end; - else - -- Instantiated package. - return Get_Package_Object (Syn_Inst, Scope); - end if; - when others => - raise Internal_Error; - end case; - end Get_Instance_By_Scope; - - function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc - is - Parent : Node; - begin - Parent := Get_Parent (Blk); - if Get_Kind (Parent) = Iir_Kind_Architecture_Body then - Parent := Vhdl.Utils.Get_Entity (Parent); - end if; - return Get_Info (Parent); - end Get_Parent_Scope; - - function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node) - return Valtyp - is - Info : constant Sim_Info_Acc := Get_Info (Obj); - Obj_Inst : Synth_Instance_Acc; - begin - Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); - return Obj_Inst.Objects (Info.Slot).Obj; - end Get_Value; - - function Get_Subtype_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - Obj_Inst : Synth_Instance_Acc; - begin - Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); - return Obj_Inst.Objects (Info.Slot).T_Typ; - end Get_Subtype_Object; - - -- Set Is_0 to True iff VEC is 000... - -- Set Is_X to True iff VEC is XXX... - procedure Is_Full (Vec : Logvec_Array; - Is_0 : out Boolean; - Is_X : out Boolean; - Is_Z : out Boolean) - is - Val : Uns32; - Zx : Uns32; - begin - Val := Vec (0).Val; - Zx := Vec (0).Zx; - Is_0 := False; - Is_X := False; - Is_Z := False; - if Val = 0 and Zx = 0 then - Is_0 := True; - elsif Zx = not 0 then - if Val = not 0 then - Is_X := True; - elsif Val = 0 then - Is_Z := True; - else - return; - end if; - else - return; - end if; - - for I in 1 .. Vec'Last loop - if Vec (I).Val /= Val or else Vec (I).Zx /= Zx then - -- Clear flags. - Is_0 := False; - Is_X := False; - Is_Z := False; - return; - end if; - end loop; - end Is_Full; - - procedure Value2net (Ctxt : Context_Acc; - Val : Memtyp; - Off : Uns32; - W : Width; - Vec : in out Logvec_Array; - Res : out Net) - is - Vec_Off : Uns32; - Has_Zx : Boolean; - Inst : Instance; - Is_0, Is_X, Is_Z : Boolean; - begin - -- First convert to logvec. - Has_Zx := False; - Vec_Off := 0; - Value2logvec (Val, Off, W, Vec, Vec_Off, Has_Zx); - pragma Assert (Vec_Off = W); - - -- Then convert logvec to net. - if W = 0 then - -- For null range (like the null string literal "") - Res := Build_Const_UB32 (Ctxt, 0, 0); - elsif W <= 32 then - -- 32 bit result. - if not Has_Zx then - Res := Build_Const_UB32 (Ctxt, Vec (0).Val, W); - elsif Vec (0).Val = 0 and then Sext (Vec (0).Zx, Natural (W)) = not 0 - then - Res := Build_Const_Z (Ctxt, W); - else - Res := Build_Const_UL32 (Ctxt, Vec (0).Val, Vec (0).Zx, W); - end if; - return; - else - Is_Full (Vec, Is_0, Is_X, Is_Z); - if Is_0 then - Res := Build_Const_UB32 (Ctxt, 0, W); - elsif Is_X then - Res := Build_Const_X (Ctxt, W); - elsif Is_Z then - Res := Build_Const_Z (Ctxt, W); - elsif not Has_Zx then - Inst := Build_Const_Bit (Ctxt, W); - for I in Vec'Range loop - Set_Param_Uns32 (Inst, Param_Idx (I), Vec (I).Val); - end loop; - Res := Get_Output (Inst, 0); - else - Inst := Build_Const_Log (Ctxt, W); - for I in Vec'Range loop - Set_Param_Uns32 (Inst, Param_Idx (2 * I), Vec (I).Val); - Set_Param_Uns32 (Inst, Param_Idx (2 * I + 1), Vec (I).Zx); - end loop; - Res := Get_Output (Inst, 0); - end if; - end if; - end Value2net; - - function Get_Partial_Memtyp_Net - (Ctxt : Context_Acc; Val : Memtyp; Off : Uns32; Wd : Width) return Net - is - Nd : constant Digit_Index := Digit_Index ((Wd + 31) / 32); - Res : Net; - begin - if Nd > 64 then - declare - Vecp : Logvec_Array_Acc; - begin - Vecp := new Logvec_Array'(0 .. Nd - 1 => (0, 0)); - Value2net (Ctxt, Val, Off, Wd, Vecp.all, Res); - Free_Logvec_Array (Vecp); - return Res; - end; - else - declare - Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0)); - begin - Value2net (Ctxt, Val, Off, Wd, Vec, Res); - return Res; - end; - end if; - end Get_Partial_Memtyp_Net; - - function Get_Memtyp_Net (Ctxt : Context_Acc; Val : Memtyp) return Net is - begin - return Get_Partial_Memtyp_Net (Ctxt, Val, 0, Val.Typ.W); - end Get_Memtyp_Net; - - function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net is - begin - case Val.Val.Kind is - when Value_Wire => - return Get_Current_Value (Ctxt, Val.Val.W); - when Value_Net => - return Val.Val.N; - when Value_Alias => - declare - Res : Net; - begin - if Val.Val.A_Obj.Kind = Value_Wire then - Res := Get_Current_Value (Ctxt, Val.Val.A_Obj.W); - return Build2_Extract - (Ctxt, Res, Val.Val.A_Off.Net_Off, Val.Typ.W); - else - pragma Assert (Val.Val.A_Off.Net_Off = 0); - return Get_Net (Ctxt, (Val.Typ, Val.Val.A_Obj)); - end if; - end; - when Value_Const => - if Val.Val.C_Net = No_Net then - Val.Val.C_Net := Get_Net (Ctxt, (Val.Typ, Val.Val.C_Val)); - Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net), - Get_Location (Val.Val.C_Loc)); - end if; - return Val.Val.C_Net; - when Value_Memory => - return Get_Memtyp_Net (Ctxt, Get_Memtyp (Val)); - when others => - raise Internal_Error; - end case; - end Get_Net; -end Synth.Context; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads deleted file mode 100644 index a2952eca0..000000000 --- a/src/synth/synth-context.ads +++ /dev/null @@ -1,205 +0,0 @@ --- Synthesis context. --- Copyright (C) 2017 Tristan Gingold --- --- This file is part of GHDL. --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 2 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . - -with Types; use Types; - -with Netlists; use Netlists; -with Netlists.Builders; use Netlists.Builders; - -with Vhdl.Annotations; use Vhdl.Annotations; -with Vhdl.Nodes; use Vhdl.Nodes; - -with Synth.Environment; use Synth.Environment; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; - -package Synth.Context is - -- Values are stored into Synth_Instance, which is parallel to simulation - -- Block_Instance_Type. - - type Synth_Instance_Type (<>) is limited private; - type Synth_Instance_Acc is access Synth_Instance_Type; - - function Get_Instance_By_Scope - (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) - return Synth_Instance_Acc; - - -- Create the first instance. - function Make_Base_Instance return Synth_Instance_Acc; - - -- Free the first instance. - procedure Free_Base_Instance; - - -- Create and free the corresponding synth instance. - function Make_Instance (Parent : Synth_Instance_Acc; - Blk : Node; - Name : Sname := No_Sname) - return Synth_Instance_Acc; - - -- Only useful for subprograms: set the base (which can be different from - -- the parent). Ideally it should be part of Make_Instance, but in most - -- cases they are the same (except sometimes for subprograms). - procedure Set_Instance_Base (Inst : Synth_Instance_Acc; - Base : Synth_Instance_Acc); - procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc); - - function Is_Error (Inst : Synth_Instance_Acc) return Boolean; - pragma Inline (Is_Error); - - procedure Set_Error (Inst : Synth_Instance_Acc); - - function Get_Sname (Inst : Synth_Instance_Acc) return Sname; - pragma Inline (Get_Sname); - - function Get_Build (Inst : Synth_Instance_Acc) return Context_Acc; - pragma Inline (Get_Build); - - function Get_Top_Module (Inst : Synth_Instance_Acc) return Module; - - function Get_Instance_Module (Inst : Synth_Instance_Acc) return Module; - pragma Inline (Get_Instance_Module); - - -- Start the definition of module M (using INST). - procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module); - - function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean; - procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean); - - -- Get the corresponding source for the scope of the instance. - function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node; - - procedure Create_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); - - procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; - Decl : Node; - Inst : Synth_Instance_Acc; - Is_Global : Boolean); - - procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc; - Decl : Node; - Inst : Synth_Instance_Acc); - - procedure Create_Subtype_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc); - - -- Force the value of DECL, without checking for elaboration order. - -- It is for deferred constants. - procedure Create_Object_Force - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); - - procedure Destroy_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node); - - -- Build the value for object OBJ. - -- KIND must be Wire_Variable or Wire_Signal. - procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc; - Kind : Wire_Kind; - Obj : Node); - - -- Get the value of OBJ. - function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node) - return Valtyp; - - -- Get a net from a scalar/vector value. This will automatically create - -- a net for literals. - function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net; - function Get_Partial_Memtyp_Net - (Ctxt : Context_Acc; Val : Memtyp; Off : Uns32; Wd : Width) return Net; - function Get_Memtyp_Net (Ctxt : Context_Acc; Val : Memtyp) return Net; - - function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc; - - -- Return the type for DECL (a subtype indication). - function Get_Subtype_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc; - - -- Return the scope of the parent of BLK. Deals with architecture bodies. - function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc; - - procedure Set_Uninstantiated_Scope - (Syn_Inst : Synth_Instance_Acc; Bod : Node); -private - type Obj_Kind is - ( - Obj_None, - Obj_Object, - Obj_Subtype, - Obj_Instance - ); - - type Obj_Type (Kind : Obj_Kind := Obj_None) is record - case Kind is - when Obj_None => - null; - when Obj_Object => - Obj : Valtyp; - when Obj_Subtype => - T_Typ : Type_Acc; - when Obj_Instance => - I_Inst : Synth_Instance_Acc; - end case; - end record; - - type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type; - - type Base_Instance_Type is limited record - Builder : Context_Acc; - Top_Module : Module; - - Cur_Module : Module; - end record; - - type Base_Instance_Acc is access Base_Instance_Type; - - type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is limited record - Is_Const : Boolean; - - -- True if a fatal error has been detected that aborts the synthesis - -- of this instance. - Is_Error : Boolean; - - Base : Base_Instance_Acc; - - -- Name prefix for declarations. - Name : Sname; - - -- The corresponding info for this instance. - -- This is used for lookup. - Block_Scope : Sim_Info_Acc; - - -- The corresponding info the the uninstantiated specification of - -- an instantiated package. When an object is looked for from the - -- uninstantiated body, the scope of the uninstantiated specification - -- is used. And it is different from Block_Scope. - -- This is used for lookup of uninstantiated specification. - Uninst_Scope : Sim_Info_Acc; - - -- Instance of the parent scope. - Up_Block : Synth_Instance_Acc; - - -- Source construct corresponding to this instance/ - Source_Scope : Node; - - Elab_Objects : Object_Slot_Type; - - -- Instance for synthesis. - Objects : Objects_Array (1 .. Max_Objs); - end record; -end Synth.Context; diff --git a/src/synth/synth-debugger.ads b/src/synth/synth-debugger.ads index b330f4b78..329bab3e2 100644 --- a/src/synth/synth-debugger.ads +++ b/src/synth/synth-debugger.ads @@ -18,7 +18,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Debugger is -- If true, debugging is enabled: diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index c8a0bc0c7..d227bdbe1 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -19,7 +19,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Netlists; use Netlists; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Objtypes; use Synth.Objtypes; package Synth.Decls is diff --git a/src/synth/synth-disp_vhdl.ads b/src/synth/synth-disp_vhdl.ads index 8d1f98d48..39706a085 100644 --- a/src/synth/synth-disp_vhdl.ads +++ b/src/synth/synth-disp_vhdl.ads @@ -18,7 +18,7 @@ with Netlists; use Netlists; with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Disp_Vhdl is -- Disp ENT (like the original text) and its content as a wrapper. diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index 1091c1694..c791c5a2d 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -31,7 +31,7 @@ with Name_Table; with Synth.Flags; with Synth.Errors; use Synth.Errors; with Synth.Source; use Synth.Source; -with Synth.Context; +with Synth.Vhdl_Context; with Vhdl.Nodes; with Vhdl.Utils; @@ -397,7 +397,7 @@ package body Synth.Environment is raise Internal_Error; when True => -- Create a net. No inference to do. - Res := Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + Res := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); if Wire_Rec.Kind = Wire_Enable then Connect (Get_Input (Get_Net_Parent (Outport), 0), Res); else @@ -1154,7 +1154,7 @@ package body Synth.Environment is end case; if Asgn_Rec.Val.Is_Static = True then - return Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + return Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); end if; -- Cannot be empty. @@ -1217,7 +1217,7 @@ package body Synth.Environment is -- If the current value is static, just return it. if Get_Assign_Is_Static (First_Seq) then - return Context.Get_Partial_Memtyp_Net + return Vhdl_Context.Get_Partial_Memtyp_Net (Ctxt, Get_Assign_Static_Val (First_Seq), Off, Wd); end if; @@ -1305,7 +1305,7 @@ package body Synth.Environment is end if; if Get_Assign_Is_Static (Seq) then -- Extract from static value. - Append (Vec, Context.Get_Partial_Memtyp_Net + Append (Vec, Vhdl_Context.Get_Partial_Memtyp_Net (Ctxt, Get_Assign_Static_Val (Seq), Cur_Off, Cur_Wd)); exit; @@ -1418,7 +1418,7 @@ package body Synth.Environment is when Unknown => null; when True => - N (I) := Context.Get_Partial_Memtyp_Net + N (I) := Vhdl_Context.Get_Partial_Memtyp_Net (Ctxt, P (I).Val, Off, Wd); when False => if Get_Partial_Offset (P (I).Asgns) <= Off then @@ -1995,7 +1995,7 @@ package body Synth.Environment is N : Net; Pa : Partial_Assign; begin - N := Synth.Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); + N := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val); Pa := New_Partial_Assign (N, 0); Asgn_Rec.Val := (Is_Static => False, Asgns => Pa); end; diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 2d977c70c..8dac335c4 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -29,7 +29,7 @@ with Netlists.Builders; use Netlists.Builders; with Synth.Source; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Expr is -- Perform a subtype conversion. Check constraints. diff --git a/src/synth/synth-files_operations.ads b/src/synth/synth-files_operations.ads index 60d94ec4e..8d95a7cec 100644 --- a/src/synth/synth-files_operations.ads +++ b/src/synth/synth-files_operations.ads @@ -20,7 +20,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Source; use Synth.Source; with Synth.Values; use Synth.Values; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Files_Operations is -- Raised in case of un-recoverable error. diff --git a/src/synth/synth-insts.ads b/src/synth/synth-insts.ads index 650c56248..f0ac690e6 100644 --- a/src/synth/synth-insts.ads +++ b/src/synth/synth-insts.ads @@ -18,7 +18,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Flags; use Synth.Flags; package Synth.Insts is diff --git a/src/synth/synth-oper.ads b/src/synth/synth-oper.ads index 68e5af975..c3d84dec6 100644 --- a/src/synth/synth-oper.ads +++ b/src/synth/synth-oper.ads @@ -20,7 +20,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Oper is function Synth_Predefined_Function_Call diff --git a/src/synth/synth-static_oper.ads b/src/synth/synth-static_oper.ads index 93fcdd28b..3178c6448 100644 --- a/src/synth/synth-static_oper.ads +++ b/src/synth/synth-static_oper.ads @@ -17,7 +17,7 @@ -- along with this program. If not, see . with Synth.Objtypes; use Synth.Objtypes; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-static_proc.ads b/src/synth/synth-static_proc.ads index 516e50135..810918f36 100644 --- a/src/synth/synth-static_proc.ads +++ b/src/synth/synth-static_proc.ads @@ -16,7 +16,7 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Vhdl.Nodes; use Vhdl.Nodes; package Synth.Static_Proc is diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index 91dc62256..f240ca33e 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -23,7 +23,7 @@ with Netlists; use Netlists; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Environment; use Synth.Environment; package Synth.Stmts is diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb new file mode 100644 index 000000000..2a497ae0f --- /dev/null +++ b/src/synth/synth-vhdl_context.adb @@ -0,0 +1,562 @@ +-- Synthesis context. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +with Ada.Unchecked_Deallocation; + +with Name_Table; use Name_Table; +with Types_Utils; use Types_Utils; + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; + +with Netlists.Folds; use Netlists.Folds; + +with Synth.Expr; use Synth.Expr; +with Netlists.Locations; + +package body Synth.Vhdl_Context is + function Make_Base_Instance return Synth_Instance_Acc + is + Base : Base_Instance_Acc; + Top_Module : Module; + Res : Synth_Instance_Acc; + Ctxt : Context_Acc; + begin + Top_Module := + New_Design (New_Sname_Artificial (Get_Identifier ("top"), No_Sname)); + Ctxt := Build_Builders (Top_Module); + + Base := new Base_Instance_Type'(Builder => Ctxt, + Top_Module => Top_Module, + Cur_Module => No_Module); + + Res := new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects, + Is_Const => False, + Is_Error => False, + Base => Base, + Name => No_Sname, + Block_Scope => Global_Info, + Up_Block => null, + Uninst_Scope => null, + Source_Scope => Null_Node, + Elab_Objects => 0, + Objects => (others => + (Kind => Obj_None))); + return Res; + end Make_Base_Instance; + + procedure Free_Base_Instance is + begin + -- TODO: really free. + null; + end Free_Base_Instance; + + function Make_Instance (Parent : Synth_Instance_Acc; + Blk : Node; + Name : Sname := No_Sname) + return Synth_Instance_Acc + is + Info : constant Sim_Info_Acc := Get_Info (Blk); + Scope : Sim_Info_Acc; + Res : Synth_Instance_Acc; + begin + if Get_Kind (Blk) = Iir_Kind_Architecture_Body then + -- Architectures are extensions of entities. + Scope := Get_Info (Vhdl.Utils.Get_Entity (Blk)); + else + Scope := Info; + end if; + + Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects, + Is_Const => False, + Is_Error => False, + Base => Parent.Base, + Name => Name, + Block_Scope => Scope, + Up_Block => Parent, + Uninst_Scope => null, + Source_Scope => Blk, + Elab_Objects => 0, + Objects => (others => + (Kind => Obj_None))); + return Res; + end Make_Instance; + + procedure Set_Instance_Base (Inst : Synth_Instance_Acc; + Base : Synth_Instance_Acc) is + begin + Inst.Base := Base.Base; + end Set_Instance_Base; + + procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc) + is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Synth_Instance_Type, Synth_Instance_Acc); + begin + Deallocate (Synth_Inst); + end Free_Instance; + + procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module) + is + Prev_Base : constant Base_Instance_Acc := Inst.Base; + Base : Base_Instance_Acc; + Self_Inst : Instance; + begin + Base := new Base_Instance_Type'(Builder => Prev_Base.Builder, + Top_Module => Prev_Base.Top_Module, + Cur_Module => M); + Builders.Set_Parent (Base.Builder, M); + + Self_Inst := Create_Self_Instance (M); + pragma Unreferenced (Self_Inst); + + Inst.Base := Base; + end Set_Instance_Module; + + function Is_Error (Inst : Synth_Instance_Acc) return Boolean is + begin + return Inst.Is_Error; + end Is_Error; + + procedure Set_Error (Inst : Synth_Instance_Acc) is + begin + Inst.Is_Error := True; + end Set_Error; + + function Get_Instance_Module (Inst : Synth_Instance_Acc) return Module is + begin + return Inst.Base.Cur_Module; + end Get_Instance_Module; + + function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node is + begin + return Inst.Source_Scope; + end Get_Source_Scope; + + function Get_Top_Module (Inst : Synth_Instance_Acc) return Module is + begin + return Inst.Base.Top_Module; + end Get_Top_Module; + + function Get_Sname (Inst : Synth_Instance_Acc) return Sname is + begin + return Inst.Name; + end Get_Sname; + + function Get_Build (Inst : Synth_Instance_Acc) + return Netlists.Builders.Context_Acc is + begin + return Inst.Base.Builder; + end Get_Build; + + function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean is + begin + return Inst.Is_Const; + end Get_Instance_Const; + + function Check_Set_Instance_Const (Inst : Synth_Instance_Acc) + return Boolean is + begin + for I in 1 .. Inst.Elab_Objects loop + if Inst.Objects (I).Kind /= Obj_Subtype then + return False; + end if; + end loop; + return True; + end Check_Set_Instance_Const; + + procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean) is + begin + pragma Assert (not Val or else Check_Set_Instance_Const (Inst)); + Inst.Is_Const := Val; + end Set_Instance_Const; + + procedure Create_Object (Syn_Inst : Synth_Instance_Acc; + Slot : Object_Slot_Type; + Num : Object_Slot_Type := 1) is + begin + -- Check elaboration order. + -- Note: this is not done for package since objects from package are + -- commons (same scope), and package annotation order can be different + -- from package elaboration order (eg: body). + if Slot /= Syn_Inst.Elab_Objects + 1 + or else Syn_Inst.Objects (Slot).Kind /= Obj_None + then + Error_Msg_Elab ("synth: bad elaboration order of objects"); + raise Internal_Error; + end if; + Syn_Inst.Elab_Objects := Slot + Num - 1; + end Create_Object; + + procedure Create_Object_Force + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + pragma Assert + (Syn_Inst.Objects (Info.Slot).Kind = Obj_None + or else Vt = (null, null) + or else Syn_Inst.Objects (Info.Slot) = (Kind => Obj_Object, + Obj => No_Valtyp)); + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); + end Create_Object_Force; + + procedure Create_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + Create_Object (Syn_Inst, Info.Slot, 1); + Create_Object_Force (Syn_Inst, Decl, Vt); + end Create_Object; + + procedure Create_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc) + is + pragma Assert (Typ /= null); + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + Create_Object (Syn_Inst, Info.Slot, 1); + pragma Assert (Syn_Inst.Objects (Info.Slot).Kind = Obj_None); + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Subtype, T_Typ => Typ); + end Create_Subtype_Object; + + procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc; + Is_Global : Boolean) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + if Is_Global then + pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot).Kind = Obj_None); + pragma Assert (Syn_Inst.Up_Block = null); + null; + else + pragma Assert (Syn_Inst.Up_Block /= null); + Create_Object (Syn_Inst, Info.Slot, 1); + end if; + Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance, + I_Inst => Inst); + end Create_Package_Object; + + procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + pragma Assert (Syn_Inst.Up_Block /= null); + Create_Object (Syn_Inst, Info.Pkg_Slot, 1); + Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance, + I_Inst => Inst); + end Create_Package_Interface; + + function Get_Package_Object + (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc) + return Synth_Instance_Acc + is + Parent : Synth_Instance_Acc; + begin + Parent := Get_Instance_By_Scope (Syn_Inst, Info.Pkg_Parent); + return Parent.Objects (Info.Pkg_Slot).I_Inst; + end Get_Package_Object; + + function Get_Package_Object + (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc is + begin + return Get_Package_Object (Syn_Inst, Get_Info (Pkg)); + end Get_Package_Object; + + procedure Set_Uninstantiated_Scope + (Syn_Inst : Synth_Instance_Acc; Bod : Node) is + begin + Syn_Inst.Uninst_Scope := Get_Info (Bod); + end Set_Uninstantiated_Scope; + + procedure Destroy_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Slot : constant Object_Slot_Type := Info.Slot; + begin + if Slot /= Syn_Inst.Elab_Objects + or else Info.Obj_Scope /= Syn_Inst.Block_Scope + then + Error_Msg_Elab ("synth: bad destroy order"); + end if; + Syn_Inst.Objects (Slot) := (Kind => Obj_None); + Syn_Inst.Elab_Objects := Slot - 1; + end Destroy_Object; + + procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc; + Kind : Wire_Kind; + Obj : Node) + is + Obj_Type : constant Node := Get_Type (Obj); + Otyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Obj_Type); + Val : Valtyp; + Wid : Wire_Id; + begin + if Kind = Wire_None then + Wid := No_Wire_Id; + else + Wid := Alloc_Wire (Kind, Otyp, Obj); + end if; + Val := Create_Value_Wire (Wid, Otyp); + + Create_Object (Syn_Inst, Obj, Val); + end Create_Wire_Object; + + function Get_Instance_By_Scope + (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) + return Synth_Instance_Acc is + begin + case Scope.Kind is + when Kind_Block + | Kind_Frame + | Kind_Process => + declare + Current : Synth_Instance_Acc; + begin + Current := Syn_Inst; + while Current /= null loop + if Current.Block_Scope = Scope then + return Current; + end if; + Current := Current.Up_Block; + end loop; + raise Internal_Error; + end; + when Kind_Package => + if Scope.Pkg_Parent = null then + -- This is a scope for an uninstantiated package. + declare + Current : Synth_Instance_Acc; + begin + Current := Syn_Inst; + while Current /= null loop + if Current.Uninst_Scope = Scope then + return Current; + end if; + Current := Current.Up_Block; + end loop; + raise Internal_Error; + end; + else + -- Instantiated package. + return Get_Package_Object (Syn_Inst, Scope); + end if; + when others => + raise Internal_Error; + end case; + end Get_Instance_By_Scope; + + function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc + is + Parent : Node; + begin + Parent := Get_Parent (Blk); + if Get_Kind (Parent) = Iir_Kind_Architecture_Body then + Parent := Vhdl.Utils.Get_Entity (Parent); + end if; + return Get_Info (Parent); + end Get_Parent_Scope; + + function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node) + return Valtyp + is + Info : constant Sim_Info_Acc := Get_Info (Obj); + Obj_Inst : Synth_Instance_Acc; + begin + Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); + return Obj_Inst.Objects (Info.Slot).Obj; + end Get_Value; + + function Get_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Obj_Inst : Synth_Instance_Acc; + begin + Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); + return Obj_Inst.Objects (Info.Slot).T_Typ; + end Get_Subtype_Object; + + -- Set Is_0 to True iff VEC is 000... + -- Set Is_X to True iff VEC is XXX... + procedure Is_Full (Vec : Logvec_Array; + Is_0 : out Boolean; + Is_X : out Boolean; + Is_Z : out Boolean) + is + Val : Uns32; + Zx : Uns32; + begin + Val := Vec (0).Val; + Zx := Vec (0).Zx; + Is_0 := False; + Is_X := False; + Is_Z := False; + if Val = 0 and Zx = 0 then + Is_0 := True; + elsif Zx = not 0 then + if Val = not 0 then + Is_X := True; + elsif Val = 0 then + Is_Z := True; + else + return; + end if; + else + return; + end if; + + for I in 1 .. Vec'Last loop + if Vec (I).Val /= Val or else Vec (I).Zx /= Zx then + -- Clear flags. + Is_0 := False; + Is_X := False; + Is_Z := False; + return; + end if; + end loop; + end Is_Full; + + procedure Value2net (Ctxt : Context_Acc; + Val : Memtyp; + Off : Uns32; + W : Width; + Vec : in out Logvec_Array; + Res : out Net) + is + Vec_Off : Uns32; + Has_Zx : Boolean; + Inst : Instance; + Is_0, Is_X, Is_Z : Boolean; + begin + -- First convert to logvec. + Has_Zx := False; + Vec_Off := 0; + Value2logvec (Val, Off, W, Vec, Vec_Off, Has_Zx); + pragma Assert (Vec_Off = W); + + -- Then convert logvec to net. + if W = 0 then + -- For null range (like the null string literal "") + Res := Build_Const_UB32 (Ctxt, 0, 0); + elsif W <= 32 then + -- 32 bit result. + if not Has_Zx then + Res := Build_Const_UB32 (Ctxt, Vec (0).Val, W); + elsif Vec (0).Val = 0 and then Sext (Vec (0).Zx, Natural (W)) = not 0 + then + Res := Build_Const_Z (Ctxt, W); + else + Res := Build_Const_UL32 (Ctxt, Vec (0).Val, Vec (0).Zx, W); + end if; + return; + else + Is_Full (Vec, Is_0, Is_X, Is_Z); + if Is_0 then + Res := Build_Const_UB32 (Ctxt, 0, W); + elsif Is_X then + Res := Build_Const_X (Ctxt, W); + elsif Is_Z then + Res := Build_Const_Z (Ctxt, W); + elsif not Has_Zx then + Inst := Build_Const_Bit (Ctxt, W); + for I in Vec'Range loop + Set_Param_Uns32 (Inst, Param_Idx (I), Vec (I).Val); + end loop; + Res := Get_Output (Inst, 0); + else + Inst := Build_Const_Log (Ctxt, W); + for I in Vec'Range loop + Set_Param_Uns32 (Inst, Param_Idx (2 * I), Vec (I).Val); + Set_Param_Uns32 (Inst, Param_Idx (2 * I + 1), Vec (I).Zx); + end loop; + Res := Get_Output (Inst, 0); + end if; + end if; + end Value2net; + + function Get_Partial_Memtyp_Net + (Ctxt : Context_Acc; Val : Memtyp; Off : Uns32; Wd : Width) return Net + is + Nd : constant Digit_Index := Digit_Index ((Wd + 31) / 32); + Res : Net; + begin + if Nd > 64 then + declare + Vecp : Logvec_Array_Acc; + begin + Vecp := new Logvec_Array'(0 .. Nd - 1 => (0, 0)); + Value2net (Ctxt, Val, Off, Wd, Vecp.all, Res); + Free_Logvec_Array (Vecp); + return Res; + end; + else + declare + Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0)); + begin + Value2net (Ctxt, Val, Off, Wd, Vec, Res); + return Res; + end; + end if; + end Get_Partial_Memtyp_Net; + + function Get_Memtyp_Net (Ctxt : Context_Acc; Val : Memtyp) return Net is + begin + return Get_Partial_Memtyp_Net (Ctxt, Val, 0, Val.Typ.W); + end Get_Memtyp_Net; + + function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net is + begin + case Val.Val.Kind is + when Value_Wire => + return Get_Current_Value (Ctxt, Val.Val.W); + when Value_Net => + return Val.Val.N; + when Value_Alias => + declare + Res : Net; + begin + if Val.Val.A_Obj.Kind = Value_Wire then + Res := Get_Current_Value (Ctxt, Val.Val.A_Obj.W); + return Build2_Extract + (Ctxt, Res, Val.Val.A_Off.Net_Off, Val.Typ.W); + else + pragma Assert (Val.Val.A_Off.Net_Off = 0); + return Get_Net (Ctxt, (Val.Typ, Val.Val.A_Obj)); + end if; + end; + when Value_Const => + if Val.Val.C_Net = No_Net then + Val.Val.C_Net := Get_Net (Ctxt, (Val.Typ, Val.Val.C_Val)); + Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net), + Get_Location (Val.Val.C_Loc)); + end if; + return Val.Val.C_Net; + when Value_Memory => + return Get_Memtyp_Net (Ctxt, Get_Memtyp (Val)); + when others => + raise Internal_Error; + end case; + end Get_Net; +end Synth.Vhdl_Context; diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads new file mode 100644 index 000000000..35972409f --- /dev/null +++ b/src/synth/synth-vhdl_context.ads @@ -0,0 +1,205 @@ +-- Synthesis context. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +with Types; use Types; + +with Netlists; use Netlists; +with Netlists.Builders; use Netlists.Builders; + +with Vhdl.Annotations; use Vhdl.Annotations; +with Vhdl.Nodes; use Vhdl.Nodes; + +with Synth.Environment; use Synth.Environment; +with Synth.Objtypes; use Synth.Objtypes; +with Synth.Values; use Synth.Values; + +package Synth.Vhdl_Context is + -- Values are stored into Synth_Instance, which is parallel to simulation + -- Block_Instance_Type. + + type Synth_Instance_Type (<>) is limited private; + type Synth_Instance_Acc is access Synth_Instance_Type; + + function Get_Instance_By_Scope + (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) + return Synth_Instance_Acc; + + -- Create the first instance. + function Make_Base_Instance return Synth_Instance_Acc; + + -- Free the first instance. + procedure Free_Base_Instance; + + -- Create and free the corresponding synth instance. + function Make_Instance (Parent : Synth_Instance_Acc; + Blk : Node; + Name : Sname := No_Sname) + return Synth_Instance_Acc; + + -- Only useful for subprograms: set the base (which can be different from + -- the parent). Ideally it should be part of Make_Instance, but in most + -- cases they are the same (except sometimes for subprograms). + procedure Set_Instance_Base (Inst : Synth_Instance_Acc; + Base : Synth_Instance_Acc); + procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc); + + function Is_Error (Inst : Synth_Instance_Acc) return Boolean; + pragma Inline (Is_Error); + + procedure Set_Error (Inst : Synth_Instance_Acc); + + function Get_Sname (Inst : Synth_Instance_Acc) return Sname; + pragma Inline (Get_Sname); + + function Get_Build (Inst : Synth_Instance_Acc) return Context_Acc; + pragma Inline (Get_Build); + + function Get_Top_Module (Inst : Synth_Instance_Acc) return Module; + + function Get_Instance_Module (Inst : Synth_Instance_Acc) return Module; + pragma Inline (Get_Instance_Module); + + -- Start the definition of module M (using INST). + procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module); + + function Get_Instance_Const (Inst : Synth_Instance_Acc) return Boolean; + procedure Set_Instance_Const (Inst : Synth_Instance_Acc; Val : Boolean); + + -- Get the corresponding source for the scope of the instance. + function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node; + + procedure Create_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + + procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc; + Is_Global : Boolean); + + procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc); + + procedure Create_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc); + + -- Force the value of DECL, without checking for elaboration order. + -- It is for deferred constants. + procedure Create_Object_Force + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + + procedure Destroy_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node); + + -- Build the value for object OBJ. + -- KIND must be Wire_Variable or Wire_Signal. + procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc; + Kind : Wire_Kind; + Obj : Node); + + -- Get the value of OBJ. + function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node) + return Valtyp; + + -- Get a net from a scalar/vector value. This will automatically create + -- a net for literals. + function Get_Net (Ctxt : Context_Acc; Val : Valtyp) return Net; + function Get_Partial_Memtyp_Net + (Ctxt : Context_Acc; Val : Memtyp; Off : Uns32; Wd : Width) return Net; + function Get_Memtyp_Net (Ctxt : Context_Acc; Val : Memtyp) return Net; + + function Get_Package_Object + (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc; + + -- Return the type for DECL (a subtype indication). + function Get_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc; + + -- Return the scope of the parent of BLK. Deals with architecture bodies. + function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc; + + procedure Set_Uninstantiated_Scope + (Syn_Inst : Synth_Instance_Acc; Bod : Node); +private + type Obj_Kind is + ( + Obj_None, + Obj_Object, + Obj_Subtype, + Obj_Instance + ); + + type Obj_Type (Kind : Obj_Kind := Obj_None) is record + case Kind is + when Obj_None => + null; + when Obj_Object => + Obj : Valtyp; + when Obj_Subtype => + T_Typ : Type_Acc; + when Obj_Instance => + I_Inst : Synth_Instance_Acc; + end case; + end record; + + type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type; + + type Base_Instance_Type is limited record + Builder : Context_Acc; + Top_Module : Module; + + Cur_Module : Module; + end record; + + type Base_Instance_Acc is access Base_Instance_Type; + + type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is limited record + Is_Const : Boolean; + + -- True if a fatal error has been detected that aborts the synthesis + -- of this instance. + Is_Error : Boolean; + + Base : Base_Instance_Acc; + + -- Name prefix for declarations. + Name : Sname; + + -- The corresponding info for this instance. + -- This is used for lookup. + Block_Scope : Sim_Info_Acc; + + -- The corresponding info the the uninstantiated specification of + -- an instantiated package. When an object is looked for from the + -- uninstantiated body, the scope of the uninstantiated specification + -- is used. And it is different from Block_Scope. + -- This is used for lookup of uninstantiated specification. + Uninst_Scope : Sim_Info_Acc; + + -- Instance of the parent scope. + Up_Block : Synth_Instance_Acc; + + -- Source construct corresponding to this instance/ + Source_Scope : Node; + + Elab_Objects : Object_Slot_Type; + + -- Instance for synthesis. + Objects : Objects_Array (1 .. Max_Objs); + end record; +end Synth.Vhdl_Context; diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads index 9fb0b175a..e515f8002 100644 --- a/src/synth/synthesis.ads +++ b/src/synth/synthesis.ads @@ -20,7 +20,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Netlists; use Netlists; -with Synth.Context; use Synth.Context; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Flags; use Synth.Flags; package Synthesis is -- cgit v1.2.3