diff options
| author | Tristan Gingold <tgingold@free.fr> | 2021-11-01 19:50:19 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2021-11-01 21:11:10 +0100 |
| commit | 86fd1ab3079b50c5b7234db2cedf3d1e8c0f081b (patch) | |
| tree | e34bdcf719bdc08cb22a65e04ad67b57b0c06879 /src | |
| parent | 74043fa1aa40c375c7f299e6b5f1b6ea9150580e (diff) | |
| download | ghdl-86fd1ab3079b50c5b7234db2cedf3d1e8c0f081b.tar.gz ghdl-86fd1ab3079b50c5b7234db2cedf3d1e8c0f081b.tar.bz2 ghdl-86fd1ab3079b50c5b7234db2cedf3d1e8c0f081b.zip | |
synth: do full elaboration before synthesis
Diffstat (limited to 'src')
61 files changed, 5349 insertions, 2038 deletions
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 6266e984c..bde8fa62b 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -46,9 +46,12 @@ with Netlists.Disp_Verilog; with Netlists.Disp_Dot; with Netlists.Errors; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Insts; + with Synthesis; with Synth.Disp_Vhdl; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Synth.Vhdl_Context; with Synth.Flags; use Synth.Flags; package body Ghdlsynth is @@ -244,7 +247,6 @@ package body Ghdlsynth is function Ghdl_Synth_Configure (Init : Boolean; Cmd : Command_Synth; Args : Argument_List) return Node is - use Vhdl.Configuration; use Errorout; E_Opt : Integer; Opt_Arg : Natural; @@ -383,14 +385,6 @@ package body Ghdlsynth is end if; end; end if; - - -- Annotate all units. - Vhdl.Annotations.Initialize_Annotate; - Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); - for I in Design_Units.First .. Design_Units.Last loop - Vhdl.Annotations.Annotate (Design_Units.Table (I)); - end loop; - return Config; end Ghdl_Synth_Configure; @@ -471,7 +465,9 @@ package body Ghdlsynth is return No_Module; end if; - Synthesis.Synth_Design (Config, Cmd.Top_Encoding, Res, Inst); + Inst := Elab.Vhdl_Insts.Elab_Top_Unit (Get_Library_Unit (Config)); + + Res := Synthesis.Synth_Design (Config, Inst, Cmd.Top_Encoding); if Res = No_Module then return No_Module; end if; @@ -517,9 +513,15 @@ package body Ghdlsynth is end if; end if; - Netlists.Errors.Initialize; + Inst := Elab.Vhdl_Insts.Elab_Top_Unit (Get_Library_Unit (Config)); + + if Errorout.Nbr_Errors > 0 then + Res := No_Module; + else + Netlists.Errors.Initialize; + Res := Synthesis.Synth_Design (Config, Inst, Cmd.Top_Encoding); + end if; - Synthesis.Synth_Design (Config, Cmd.Top_Encoding, Res, Inst); if Res = No_Module then if Cmd.Expect_Failure then return; diff --git a/src/synth/synth-debugger.adb b/src/synth/elab-debugger.adb index 187412cc4..9121cc3a9 100644 --- a/src/synth/synth-debugger.adb +++ b/src/synth/elab-debugger.adb @@ -18,7 +18,7 @@ with Types; use Types; -package body Synth.Debugger is +package body Elab.Debugger is procedure Debug_Init (Top : Node) is begin null; @@ -38,4 +38,4 @@ package body Synth.Debugger is begin null; end Debug_Error; -end Synth.Debugger; +end Elab.Debugger; diff --git a/src/synth/synth-debugger.ads b/src/synth/elab-debugger.ads index 329bab3e2..2b6a79b32 100644 --- a/src/synth/synth-debugger.ads +++ b/src/synth/elab-debugger.ads @@ -18,9 +18,9 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; -package Synth.Debugger is +package Elab.Debugger is -- If true, debugging is enabled: -- * call Debug_Break() before executing the next sequential statement -- * call Debug_Leave when a frame is destroyed. @@ -34,4 +34,4 @@ package Synth.Debugger is -- To be called in case of execution error, like: -- * index out of bounds. procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node); -end Synth.Debugger; +end Elab.Debugger; diff --git a/src/synth/synth-debugger__on.adb b/src/synth/elab-debugger__on.adb index d0e342e1e..608edbb07 100644 --- a/src/synth/synth-debugger__on.adb +++ b/src/synth/elab-debugger__on.adb @@ -34,12 +34,14 @@ with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk; with Vhdl.Parse; with Vhdl.Utils; use Vhdl.Utils; -with Synth. Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; --- with Synth.Environment; use Synth.Environment; -with Synth.Flags; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Context.Debug; use Elab.Vhdl_Context.Debug; + +package body Elab.Debugger is + Flag_Enabled : Boolean := False; -package body Synth.Debugger is Current_Instance : Synth_Instance_Acc; Current_Loc : Node; @@ -440,6 +442,8 @@ package body Synth.Debugger is Put ("net"); when Value_Wire => Put ("wire"); + when Value_Signal => + Put ("signal"); when Value_File => Put ("file"); when Value_Const => @@ -600,13 +604,12 @@ package body Synth.Debugger is loop case Get_Kind (Decl) is when Iir_Kind_Procedure_Body - | Iir_Kind_Function_Body => + | Iir_Kind_Function_Body + | Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Generate_Statement_Body => Decls := Get_Declaration_Chain (Decl); exit; - when Iir_Kind_Process_Statement - | Iir_Kind_Sensitized_Process_Statement => - Put_Line ("processes have no parameters"); - return; when Iir_Kind_While_Loop_Statement | Iir_Kind_If_Statement | Iir_Kind_For_Loop_Statement @@ -619,6 +622,13 @@ package body Synth.Debugger is Disp_Declaration_Objects (Current_Instance, Decls); end Info_Locals_Proc; + procedure Info_Instance_Proc (Line : String) + is + pragma Unreferenced (Line); + begin + Debug_Synth_Instance (Current_Instance); + end Info_Instance_Proc; + function Walk_Files (Cb : Walk_Cb) return Walk_Status is Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain; @@ -939,10 +949,16 @@ package body Synth.Debugger is Disp_Current_Lines; end List_Proc; + Menu_Info_Instance : aliased Menu_Entry := + (Kind => Menu_Command, + Name => new String'("inst*ance"), + Next => null, -- Menu_Info_Tree'Access, + Proc => Info_Instance_Proc'Access); + Menu_Info_Locals : aliased Menu_Entry := (Kind => Menu_Command, Name => new String'("locals"), - Next => null, -- Menu_Info_Tree'Access, + Next => Menu_Info_Instance'Access, Proc => Info_Locals_Proc'Access); Menu_Info_Params : aliased Menu_Entry := @@ -1230,6 +1246,8 @@ package body Synth.Debugger is procedure Debug_Init (Top : Node) is begin + Flag_Enabled := True; + Current_Instance := null; Current_Loc := Top; @@ -1269,10 +1287,10 @@ package body Synth.Debugger is procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node) is begin - if Flags.Flag_Debug_Enable then + if Flag_Enabled then Current_Instance := Inst; Current_Loc := Expr; Debug (Reason_Error); end if; end Debug_Error; -end Synth.Debugger; +end Elab.Debugger; diff --git a/src/synth/synth-memtype.adb b/src/synth/elab-memtype.adb index 7c8943abd..382378c1c 100644 --- a/src/synth/synth-memtype.adb +++ b/src/synth/elab-memtype.adb @@ -19,7 +19,7 @@ with System; use System; with System.Storage_Elements; -package body Synth.Memtype is +package body Elab.Memtype is function "+" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr is @@ -114,4 +114,4 @@ package body Synth.Memtype is return V; end Read_Fp64; -end Synth.Memtype; +end Elab.Memtype; diff --git a/src/synth/synth-memtype.ads b/src/synth/elab-memtype.ads index ee6f61c38..2fc088d5e 100644 --- a/src/synth/synth-memtype.ads +++ b/src/synth/elab-memtype.ads @@ -23,7 +23,7 @@ with Types; use Types; with Grt.Types; use Grt.Types; -package Synth.Memtype is +package Elab.Memtype is type Memory_Element is mod 2**8; type Memory_Array is array (Size_Type range <>) of Memory_Element; @@ -55,4 +55,4 @@ package Synth.Memtype is procedure Write_Fp64 (Mem : Memory_Ptr; Val : Fp64); function Read_Fp64 (Mem : Memory_Ptr) return Fp64; -end Synth.Memtype; +end Elab.Memtype; diff --git a/src/synth/elab-vhdl_context-debug.adb b/src/synth/elab-vhdl_context-debug.adb new file mode 100644 index 000000000..13f615558 --- /dev/null +++ b/src/synth/elab-vhdl_context-debug.adb @@ -0,0 +1,73 @@ +-- Synthesis context. +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +with Types; use Types; +with Simple_IO; use Simple_IO; +with Utils_IO; use Utils_IO; + +with Vhdl.Errors; +with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug; + +package body Elab.Vhdl_Context.Debug is + procedure Debug_Synth_Instance (Inst : Synth_Instance_Acc) is + begin + Put_Line ("instance for: " + & Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst))); + for I in Inst.Objects'Range loop + Put_Uns32 (Uns32 (I)); + Put (": "); + case Inst.Objects (I).Kind is + when Obj_None => + Put_Line ("none"); + when Obj_Object => + Put ("object"); + Put (": "); + Debug_Valtyp (Inst.Objects (I).Obj); + when Obj_Subtype => + Put ("subtype"); + Put (": "); + Debug_Typ (Inst.Objects (I).T_Typ); + when Obj_Instance => + Put ("instance"); + New_Line; + end case; + end loop; + end Debug_Synth_Instance; + + procedure Debug_Elab_Tree_1 (Inst : Synth_Instance_Acc; Level : Natural) is + begin + Put_Indent (Level); + if Inst = null then + Put_Line ("*null*"); + return; + end if; + + Put_Line (Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst))); + + for I in Inst.Objects'Range loop + if Inst.Objects (I).Kind = Obj_Instance then + Debug_Elab_Tree_1 (Inst.Objects (I).I_Inst, Level + 1); + end if; + end loop; + end Debug_Elab_Tree_1; + + procedure Debug_Elab_Tree (Inst : Synth_Instance_Acc) is + begin + Debug_Elab_Tree_1 (Inst, 0); + end Debug_Elab_Tree; +end Elab.Vhdl_Context.Debug; diff --git a/src/synth/elab-vhdl_context-debug.ads b/src/synth/elab-vhdl_context-debug.ads new file mode 100644 index 000000000..edc057fd3 --- /dev/null +++ b/src/synth/elab-vhdl_context-debug.ads @@ -0,0 +1,22 @@ +-- Synthesis context. +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +package Elab.Vhdl_Context.Debug is + procedure Debug_Synth_Instance (Inst : Synth_Instance_Acc); + procedure Debug_Elab_Tree (Inst : Synth_Instance_Acc); +end Elab.Vhdl_Context.Debug; diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb new file mode 100644 index 000000000..7235ef04d --- /dev/null +++ b/src/synth/elab-vhdl_context.adb @@ -0,0 +1,514 @@ +-- 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 <gnu.org/licenses>. + +with Ada.Unchecked_Deallocation; + +with Types; use Types; +with Tables; + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; + +package body Elab.Vhdl_Context is + + Sig_Nbr : Uns32 := 0; + + package Inst_Tables is new Tables + (Table_Component_Type => Synth_Instance_Acc, + Table_Index_Type => Instance_Id_Type, + Table_Low_Bound => First_Instance_Id, + Table_Initial => 16); + + function Get_Instance_Id (Inst : Synth_Instance_Acc) + return Instance_Id_Type is + begin + return Inst.Id; + end Get_Instance_Id; + + procedure Make_Root_Instance is + begin + -- Allow multiple elaborations + -- pragma Assert (Root_Instance = null); + + Root_Instance := + new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects, + Is_Const => False, + Is_Error => False, + Id => Inst_Tables.Last + 1, + Block_Scope => Global_Info, + Up_Block => null, + Uninst_Scope => null, + Source_Scope => Null_Node, + Config => Null_Node, + Extra_Units => null, + Extra_Link => null, + Elab_Objects => 0, + Objects => (others => (Kind => Obj_None))); + Inst_Tables.Append (Root_Instance); + end Make_Root_Instance; + + procedure Free_Base_Instance is + begin + -- TODO: really free. + null; + end Free_Base_Instance; + + function Make_Elab_Instance + (Parent : Synth_Instance_Acc; Blk : Node; Config : Node) + 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, + Id => Inst_Tables.Last + 1, + Block_Scope => Scope, + Up_Block => Parent, + Uninst_Scope => null, + Source_Scope => Blk, + Config => Config, + Extra_Units => null, + Extra_Link => null, + Elab_Objects => 0, + Objects => (others => + (Kind => Obj_None))); + Inst_Tables.Append (Res); + return Res; + end Make_Elab_Instance; + + procedure Free_Elab_Instance (Synth_Inst : in out Synth_Instance_Acc) + is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Synth_Instance_Type, Synth_Instance_Acc); + Id : constant Instance_Id_Type := Synth_Inst.Id; + begin + Deallocate (Synth_Inst); + if Id = Inst_Tables.Last then + Inst_Tables.Decrement_Last; + else + Inst_Tables.Table (Id) := null; + end if; + end Free_Elab_Instance; + + function Make_Elab_Generate_Instance + (Parent : Synth_Instance_Acc; Blk : Node; Config : Node; Len : Natural) + return Synth_Instance_Acc + is + Info : constant Sim_Info_Acc := Get_Info (Blk); + Res : Synth_Instance_Acc; + begin + Res := new Synth_Instance_Type'(Max_Objs => Object_Slot_Type (Len), + Is_Const => False, + Is_Error => False, + Id => Inst_Tables.Last + 1, + Block_Scope => Info, + Up_Block => Parent, + Uninst_Scope => null, + Source_Scope => Blk, + Config => Config, + Extra_Units => null, + Extra_Link => null, + Elab_Objects => 0, + Objects => (others => + (Kind => Obj_None))); + Inst_Tables.Append (Res); + return Res; + end Make_Elab_Generate_Instance; + + function Get_Generate_Sub_Instance + (Parent : Synth_Instance_Acc; Idx : Positive) return Synth_Instance_Acc is + begin + return Parent.Objects (Object_Slot_Type (Idx)).I_Inst; + end Get_Generate_Sub_Instance; + + procedure Set_Generate_Sub_Instance + (Parent : Synth_Instance_Acc; Idx : Positive; Child : Synth_Instance_Acc) + is + begin + Parent.Objects (Object_Slot_Type (Idx)) := (Obj_Instance, Child); + end Set_Generate_Sub_Instance; + + 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_Source_Scope (Inst : Synth_Instance_Acc) return Node is + begin + return Inst.Source_Scope; + end Get_Source_Scope; + + 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 Set_Instance_Config (Inst : Synth_Instance_Acc; Config : Node) is + begin + pragma Assert (Inst.Config = Null_Node); + Inst.Config := Config; + end Set_Instance_Config; + + function Get_Instance_Config (Inst : Synth_Instance_Acc) return Node is + begin + return Inst.Config; + end Get_Instance_Config; + + procedure Add_Extra_Instance (Inst : Synth_Instance_Acc; + Extra : Synth_Instance_Acc) is + begin + pragma Assert (Extra.Extra_Link = null); + Extra.Extra_Link := Inst.Extra_Units; + Inst.Extra_Units := Extra; + end Add_Extra_Instance; + + function Get_First_Extra_Instance (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc is + begin + return Inst.Extra_Units; + end Get_First_Extra_Instance; + + function Get_Next_Extra_Instance (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc is + begin + return Inst.Extra_Link; + end Get_Next_Extra_Instance; + + 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_Signal (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Typ : Type_Acc; + Init : Value_Acc) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Vt : Valtyp; + begin + Create_Object (Syn_Inst, Info.Slot, 1); + Vt := (Typ, Create_Value_Signal (Sig_Nbr, Init)); + Sig_Nbr := Sig_Nbr + 1; + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); + end Create_Signal; + + procedure Replace_Signal + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Obj : Obj_Type renames Syn_Inst.Objects (Info.Slot); + begin + pragma Assert (Obj.Kind = Obj_Object); + pragma Assert (Obj.Obj.Typ = Vt.Typ); + pragma Assert (Obj.Obj.Val.Kind = Value_Signal); + + Obj.Obj := Vt; + + -- TODO: free old signal ? + end Replace_Signal; + + procedure Mutate_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Obj : Obj_Type renames Syn_Inst.Objects (Info.Slot); + begin + pragma Assert (Obj.Kind = Obj_Object); + pragma Assert (Obj.Obj.Typ = Vt.Typ); + + Obj.Obj := Vt; + end Mutate_Object; + + procedure Create_Sub_Instance (Syn_Inst : Synth_Instance_Acc; + Stmt : Node; + Sub_Inst : Synth_Instance_Acc) + is + Info : constant Sim_Info_Acc := Get_Info (Stmt); + begin + Create_Object (Syn_Inst, Info.Inst_Slot, 1); + pragma Assert (Syn_Inst.Objects (Info.Inst_Slot).Kind = Obj_None); + Syn_Inst.Objects (Info.Inst_Slot) := (Kind => Obj_Instance, + I_Inst => Sub_Inst); + end Create_Sub_Instance; + + procedure Create_Component_Instance (Syn_Inst : Synth_Instance_Acc; + Sub_Inst : Synth_Instance_Acc) + is + Slot : constant Object_Slot_Type := Syn_Inst.Max_Objs; + begin + pragma Assert (Slot > 0); + pragma Assert (Syn_Inst.Objects (Slot).Kind = Obj_None); + Create_Object (Syn_Inst, Slot, 1); + Syn_Inst.Objects (Slot) := (Kind => Obj_Instance, + I_Inst => Sub_Inst); + end Create_Component_Instance; + + 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; + + function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; + Pkg : Node) + return Synth_Instance_Acc + is + Syn_Inst : Synth_Instance_Acc; + begin + Syn_Inst := Make_Elab_Instance (Parent_Inst, Pkg, Null_Node); + if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then + -- Global package. + Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True); + else + -- Local package: check elaboration order. + Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False); + end if; + return Syn_Inst; + end Create_Package_Instance; + + function Get_Sub_Instance + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) return Synth_Instance_Acc + is + Info : constant Sim_Info_Acc := Get_Info (Stmt); + begin + return Syn_Inst.Objects (Info.Inst_Slot).I_Inst; + end Get_Sub_Instance; + + function Get_Component_Instance + (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_Acc + is + Slot : constant Object_Slot_Type := Syn_Inst.Max_Objs; + begin + return Syn_Inst.Objects (Slot).I_Inst; + end Get_Component_Instance; + + 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; + + 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; +end Elab.Vhdl_Context; diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads new file mode 100644 index 000000000..2fc483c7f --- /dev/null +++ b/src/synth/elab-vhdl_context.ads @@ -0,0 +1,222 @@ +-- 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 <gnu.org/licenses>. + +with Vhdl.Annotations; use Vhdl.Annotations; +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + +package Elab.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; + + Root_Instance : Synth_Instance_Acc; + + -- Unique per instance id. Used to create parallel tables. + type Instance_Id_Type is new Natural; + First_Instance_Id : constant Instance_Id_Type := 1; + + function Get_Instance_Id (Inst : Synth_Instance_Acc) + return Instance_Id_Type; + pragma Inline (Get_Instance_Id); + + function Get_Instance_By_Scope + (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) + return Synth_Instance_Acc; + + -- Create the root instance (which contains the packages). + -- Assign ROOT_INSTANCE. + procedure Make_Root_Instance; + + -- Free the first instance. + procedure Free_Base_Instance; + + -- Create and free the corresponding synth instance. + function Make_Elab_Instance + (Parent : Synth_Instance_Acc; Blk : Node; Config : Node) + return Synth_Instance_Acc; + + procedure Free_Elab_Instance (Synth_Inst : in out Synth_Instance_Acc); + + function Make_Elab_Generate_Instance + (Parent : Synth_Instance_Acc; Blk : Node; Config : Node; Len : Natural) + return Synth_Instance_Acc; + + function Get_Generate_Sub_Instance + (Parent : Synth_Instance_Acc; Idx : Positive) return Synth_Instance_Acc; + procedure Set_Generate_Sub_Instance + (Parent : Synth_Instance_Acc; Idx : Positive; Child : 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_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 Set_Instance_Config (Inst : Synth_Instance_Acc; Config : Node); + function Get_Instance_Config (Inst : Synth_Instance_Acc) return Node; + + -- Add/Get extra instances. + -- Those instances are verification units. + procedure Add_Extra_Instance (Inst : Synth_Instance_Acc; + Extra : Synth_Instance_Acc); + function Get_First_Extra_Instance (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc; + function Get_Next_Extra_Instance (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc; + + procedure Create_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + + procedure Create_Signal (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Typ : Type_Acc; + Init : Value_Acc); + + -- Create a sub instance: either a direct entity instantiation, or + -- a component instantiation. + procedure Create_Sub_Instance (Syn_Inst : Synth_Instance_Acc; + Stmt : Node; + Sub_Inst : Synth_Instance_Acc); + + -- Create a sub instance for a component. + procedure Create_Component_Instance (Syn_Inst : Synth_Instance_Acc; + Sub_Inst : Synth_Instance_Acc); + + procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc; + Is_Global : Boolean); + + function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; + Pkg : Node) + return Synth_Instance_Acc; + + 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 Replace_Signal + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + procedure Mutate_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + + procedure Destroy_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node); + + -- Get the value of OBJ. + function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node) + return Valtyp; + + 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; + + function Get_Sub_Instance + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) return Synth_Instance_Acc; + function Get_Component_Instance + (Syn_Inst : Synth_Instance_Acc) return Synth_Instance_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 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; + + Id : Instance_Id_Type; + + -- 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; + + -- Block configuration (unless the instance is for a package). + Config : Node; + + -- Chain of verification units that applies to this one. + Extra_Units : Synth_Instance_Acc; + Extra_Link : Synth_Instance_Acc; + + Elab_Objects : Object_Slot_Type; + + -- Instance for synthesis. + Objects : Objects_Array (1 .. Max_Objs); + end record; +end Elab.Vhdl_Context; diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb new file mode 100644 index 000000000..6c4091afd --- /dev/null +++ b/src/synth/elab-vhdl_decls.adb @@ -0,0 +1,361 @@ +-- Create declarations for synthesis. +-- 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 <gnu.org/licenses>. + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; + +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Files; +with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; +with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; + +package body Elab.Vhdl_Decls is + procedure Elab_Subprogram_Declaration + (Syn_Inst : Synth_Instance_Acc; Subprg : Node) + is + Inter : Node; + begin + if Is_Second_Subprogram_Specification (Subprg) then + -- Already handled. + return; + end if; + + Inter := Get_Interface_Declaration_Chain (Subprg); + while Inter /= Null_Node loop + Elab_Declaration_Type (Syn_Inst, Inter); + Inter := Get_Chain (Inter); + end loop; + end Elab_Subprogram_Declaration; + + procedure Elab_Constant_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Last_Type : in out Node) + is + Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl); + First_Decl : Node; + Decl_Type : Node; + Val : Valtyp; + Obj_Type : Type_Acc; + begin + Elab_Declaration_Type (Syn_Inst, Decl); + if Deferred_Decl = Null_Node + or else Get_Deferred_Declaration_Flag (Decl) + then + -- Create the object (except for full declaration of a + -- deferred constant). + Create_Object (Syn_Inst, Decl, No_Valtyp); + end if; + -- Initialize the value (except for a deferred declaration). + if Get_Deferred_Declaration_Flag (Decl) then + return; + end if; + if Deferred_Decl = Null_Node then + -- A normal constant declaration + First_Decl := Decl; + else + -- The full declaration of a deferred constant. + First_Decl := Deferred_Decl; + end if; + pragma Assert (First_Decl /= Null_Node); + + -- Use the type of the declaration. The type of the constant may + -- be derived from the value. + -- FIXME: what about multiple declarations ? + Decl_Type := Get_Subtype_Indication (Decl); + if Decl_Type = Null_Node then + Decl_Type := Last_Type; + else + if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then + -- Type mark. + Decl_Type := Get_Type (Get_Named_Entity (Decl_Type)); + end if; + Last_Type := Decl_Type; + end if; + Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type); + Val := Exec_Expression_With_Type + (Syn_Inst, Get_Default_Value (Decl), Obj_Type); + if Val = No_Valtyp then + Set_Error (Syn_Inst); + return; + end if; + Val := Exec_Subtype_Conversion (Val, Obj_Type, True, Decl); + Create_Object_Force (Syn_Inst, First_Decl, Val); + end Elab_Constant_Declaration; + + procedure Elab_Signal_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) + is + Def : constant Iir := Get_Default_Value (Decl); + Init : Valtyp; + Obj_Typ : Type_Acc; + begin + Elab_Declaration_Type (Syn_Inst, Decl); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + + if Is_Valid (Def) then + Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); + Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl); + else + Init := No_Valtyp; + end if; + Create_Signal (Syn_Inst, Decl, Obj_Typ, Init.Val); + end Elab_Signal_Declaration; + + procedure Elab_Variable_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) + is + Def : constant Node := Get_Default_Value (Decl); + Decl_Type : constant Node := Get_Type (Decl); + Init : Valtyp; + Obj_Typ : Type_Acc; + begin + Elab_Declaration_Type (Syn_Inst, Decl); + if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then + Error_Msg_Elab (+Decl, "protected type not supported"); + return; + end if; + Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type); + + if Is_Valid (Def) then + Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); + Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl); + else + Init := No_Valtyp; + end if; + Create_Object (Syn_Inst, Decl, Init); + end Elab_Variable_Declaration; + + procedure Elab_File_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) + is + F : File_Index; + Res : Valtyp; + Obj_Typ : Type_Acc; + begin + F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + Res := Create_Value_File (Obj_Typ, F); + Create_Object (Syn_Inst, Decl, Res); + end Elab_File_Declaration; + + procedure Elab_Attribute_Specification + (Syn_Inst : Synth_Instance_Acc; Spec : Node) + is + Attr_Decl : constant Node := + Get_Named_Entity (Get_Attribute_Designator (Spec)); + Value : Node; + Val : Valtyp; + Val_Type : Type_Acc; + begin + Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl)); + Value := Get_Attribute_Value_Spec_Chain (Spec); + while Value /= Null_Iir loop + -- 2. The expression is evaluated to determine the value + -- of the attribute. + -- It is an error if the value of the expression does not + -- belong to the subtype of the attribute; if the + -- attribute is of an array type, then an implicit + -- subtype conversion is first performed on the value, + -- unless the attribute's subtype indication denotes an + -- unconstrained array type. + Val := Exec_Expression_With_Type + (Syn_Inst, Get_Expression (Spec), Val_Type); + -- Check_Constraints (Instance, Val, Attr_Type, Decl); + + -- 3. A new instance of the designated attribute is created + -- and associated with each of the affected items. + -- + -- 4. Each new attribute instance is assigned the value of + -- the expression. + Create_Object (Syn_Inst, Value, Val); + -- Unshare (Val, Instance_Pool); + + Value := Get_Spec_Chain (Value); + end loop; + end Elab_Attribute_Specification; + + procedure Elab_Object_Alias_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Atype : constant Node := Get_Declaration_Type (Decl); + Off : Value_Offsets; + Res : Valtyp; + Obj_Typ : Type_Acc; + Base : Valtyp; + Typ : Type_Acc; + begin + -- Subtype indication may not be present. + if Atype /= Null_Node then + Synth_Subtype_Indication (Syn_Inst, Atype); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Atype); + else + Obj_Typ := null; + end if; + + Exec_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off); + Res := Create_Value_Alias (Base, Off, Typ); + if Obj_Typ /= null then + Res := Exec_Subtype_Conversion (Res, Obj_Typ, True, Decl); + end if; + Create_Object (Syn_Inst, Decl, Res); + end Elab_Object_Alias_Declaration; + + procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Last_Type : in out Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration => + Elab_Variable_Declaration (Syn_Inst, Decl); + -- when Iir_Kind_Interface_Variable_Declaration => + -- -- Ignore default value. + -- Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); + -- Create_Var_Wire (Syn_Inst, Decl, No_Valtyp); + when Iir_Kind_Constant_Declaration => + Elab_Constant_Declaration (Syn_Inst, Decl, Last_Type); + when Iir_Kind_Signal_Declaration => + Elab_Signal_Declaration (Syn_Inst, Decl); + when Iir_Kind_Object_Alias_Declaration => + Elab_Object_Alias_Declaration (Syn_Inst, Decl); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + Elab_Subprogram_Declaration (Syn_Inst, Decl); + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + null; + when Iir_Kind_Non_Object_Alias_Declaration => + null; + when Iir_Kind_Attribute_Declaration => + -- Nothing to do: the type is a type_mark, not a subtype + -- indication. + null; + when Iir_Kind_Attribute_Specification => + Elab_Attribute_Specification (Syn_Inst, Decl); + when Iir_Kind_Type_Declaration => + Elab_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); + when Iir_Kind_Anonymous_Type_Declaration => + Elab_Anonymous_Type_Definition + (Syn_Inst, Get_Type_Definition (Decl), + Get_Subtype_Definition (Decl)); + when Iir_Kind_Subtype_Declaration => + Elab_Declaration_Type (Syn_Inst, Decl); + when Iir_Kind_Component_Declaration => + null; + when Iir_Kind_File_Declaration => + Elab_File_Declaration (Syn_Inst, Decl); + when Iir_Kind_Protected_Type_Body => + null; + when Iir_Kind_Psl_Default_Clock => + -- Ignored; directly used by PSL directives. + null; + when Iir_Kind_Use_Clause => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Signal_Attribute_Declaration => + -- Not supported by synthesis. + null; + when others => + Vhdl.Errors.Error_Kind ("elab_declaration", Decl); + end case; + end Elab_Declaration; + + procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Iir) + is + Decl : Node; + Last_Type : Node; + begin + Last_Type := Null_Node; + Decl := Decls; + while Is_Valid (Decl) loop + Elab_Declaration (Syn_Inst, Decl, Last_Type); + + exit when Is_Error (Syn_Inst); + + Decl := Get_Chain (Decl); + end loop; + end Elab_Declarations; + + procedure Finalize_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean) + is + pragma Unreferenced (Syn_Inst); + begin + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration => + null; + when Iir_Kind_Constant_Declaration => + null; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration => + pragma Assert (not Is_Subprg); + null; + when Iir_Kind_Object_Alias_Declaration => + null; + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + null; + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + null; + when Iir_Kind_Non_Object_Alias_Declaration => + null; + when Iir_Kind_Attribute_Declaration => + null; + when Iir_Kind_Attribute_Specification => + null; + when Iir_Kind_Type_Declaration => + null; + when Iir_Kind_Anonymous_Type_Declaration => + null; + when Iir_Kind_Subtype_Declaration => + null; + when Iir_Kind_Component_Declaration => + null; + when Iir_Kind_File_Declaration => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Psl_Default_Clock => + -- Ignored; directly used by PSL directives. + null; + when Iir_Kind_Signal_Attribute_Declaration => + -- Not supported by synthesis. + null; + when others => + Vhdl.Errors.Error_Kind ("finalize_declaration", Decl); + end case; + end Finalize_Declaration; + + procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Iir; + Is_Subprg : Boolean := False) + is + Decl : Iir; + begin + Decl := Decls; + while Is_Valid (Decl) loop + Finalize_Declaration (Syn_Inst, Decl, Is_Subprg); + + Decl := Get_Chain (Decl); + end loop; + end Finalize_Declarations; +end Elab.Vhdl_Decls; diff --git a/src/synth/elab-vhdl_decls.ads b/src/synth/elab-vhdl_decls.ads new file mode 100644 index 000000000..5937e1f58 --- /dev/null +++ b/src/synth/elab-vhdl_decls.ads @@ -0,0 +1,40 @@ +-- Create declarations for synthesis. +-- 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 <gnu.org/licenses>. + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +package Elab.Vhdl_Decls is + procedure Elab_Subprogram_Declaration + (Syn_Inst : Synth_Instance_Acc; Subprg : Node); + + procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Last_Type : in out Node); + + procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Iir); + + procedure Finalize_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Iir; + Is_Subprg : Boolean); + procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Iir; + Is_Subprg : Boolean := False); + +end Elab.Vhdl_Decls; diff --git a/src/synth/elab-vhdl_errors.adb b/src/synth/elab-vhdl_errors.adb new file mode 100644 index 000000000..827f73a17 --- /dev/null +++ b/src/synth/elab-vhdl_errors.adb @@ -0,0 +1,58 @@ +-- Error handling for synthesis. +-- 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 <gnu.org/licenses>. + +package body Elab.Vhdl_Errors is + procedure Error_Msg_Elab (Loc : Location_Type; + Msg : String; + Arg1 : Earg_Type) is + begin + Report_Msg (Msgid_Error, Errorout.Elaboration, + +Loc, Msg, (1 => Arg1)); + end Error_Msg_Elab; + + procedure Error_Msg_Elab (Loc : Location_Type; + Msg : String; + Args : Earg_Arr := No_Eargs) is + begin + Report_Msg (Msgid_Error, Errorout.Elaboration, + +Loc, Msg, Args); + end Error_Msg_Elab; + + -- procedure Warning_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Arg1 : Earg_Type) is + -- begin + -- Report_Msg (Msgid_Warning, Errorout.Elaboration, + -- +Loc, Msg, (1 => Arg1)); + -- end Warning_Msg_Synth; + + -- procedure Warning_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Args : Earg_Arr := No_Eargs) is + -- begin + -- Report_Msg (Msgid_Warning, Errorout.Elaboration, +Loc, Msg, Args); + -- end Warning_Msg_Synth; + + -- procedure Info_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Args : Earg_Arr := No_Eargs) is + -- begin + -- Report_Msg (Msgid_Note, Errorout.Elaboration, +Loc, Msg, Args); + -- end Info_Msg_Synth; + +end Elab.Vhdl_Errors; diff --git a/src/synth/elab-vhdl_errors.ads b/src/synth/elab-vhdl_errors.ads new file mode 100644 index 000000000..d4cd19a24 --- /dev/null +++ b/src/synth/elab-vhdl_errors.ads @@ -0,0 +1,38 @@ +-- Error handling for synthesis. +-- 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 <gnu.org/licenses>. + +with Types; use Types; +with Errorout; use Errorout; + +package Elab.Vhdl_Errors is + procedure Error_Msg_Elab (Loc : Location_Type; + Msg : String; + Arg1 : Earg_Type); + procedure Error_Msg_Elab (Loc : Location_Type; + Msg : String; + Args : Earg_Arr := No_Eargs); + -- procedure Warning_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Arg1 : Earg_Type); + -- procedure Warning_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Args : Earg_Arr := No_Eargs); + -- procedure Info_Msg_Synth (Loc : Location_Type; + -- Msg : String; + -- Args : Earg_Arr := No_Eargs); +end Elab.Vhdl_Errors; diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb new file mode 100644 index 000000000..35a92c39d --- /dev/null +++ b/src/synth/elab-vhdl_expr.adb @@ -0,0 +1,1402 @@ +-- Expressions synthesis. +-- 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 <gnu.org/licenses>. + +with Name_Table; +with Std_Names; +with Str_Table; +with Errorout; use Errorout; + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Evaluation; use Vhdl.Evaluation; +with Vhdl.Annotations; use Vhdl.Annotations; + +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; +with Elab.Debugger; + +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; +with Synth.Vhdl_Aggr; + +with Grt.Types; +with Grt.To_Strings; + +package body Elab.Vhdl_Expr is + function Get_Value_Memtyp (V : Valtyp) return Memtyp is + begin + case V.Val.Kind is + when Value_Memory => + return (V.Typ, V.Val.Mem); + when Value_Const => + return Get_Memtyp (V); + when Value_Alias => + declare + Res : Memtyp; + begin + Res := Get_Value_Memtyp ((V.Val.A_Typ, V.Val.A_Obj)); + return (V.Typ, Res.Mem + V.Val.A_Off.Mem_Off); + end; + when others => + raise Internal_Error; + end case; + end Get_Value_Memtyp; + + function Get_Static_Discrete (V : Valtyp) return Int64 is + begin + case V.Val.Kind is + when Value_Memory => + return Read_Discrete (V); + when Value_Const => + return Read_Discrete (Get_Memtyp (V)); + when others => + raise Internal_Error; + end case; + end Get_Static_Discrete; + + function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; + Atype : Node; + Dim : Dim_Type) return Bound_Type + is + Info : constant Sim_Info_Acc := Get_Info (Atype); + begin + if Info = null then + pragma Assert (Get_Type_Declarator (Atype) = Null_Node); + declare + Index_Type : constant Node := + Get_Index_Type (Atype, Natural (Dim - 1)); + begin + return Synth_Bounds_From_Range (Syn_Inst, Index_Type); + end; + else + declare + Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); + begin + case Bnds.Kind is + when Type_Vector => + pragma Assert (Dim = 1); + return Bnds.Vbound; + when Type_Array => + return Bnds.Abounds.D (Dim); + when others => + raise Internal_Error; + end case; + end; + end if; + end Synth_Array_Bounds; + + function Synth_Bounds_From_Length (Atype : Node; Len : Int32) + return Bound_Type + is + Rng : constant Node := Get_Range_Constraint (Atype); + Limit : Int32; + begin + Limit := Int32 (Eval_Pos (Get_Left_Limit (Rng))); + case Get_Direction (Rng) is + when Dir_To => + return (Dir => Dir_To, + Left => Limit, + Right => Limit + Len - 1, + Len => Uns32 (Len)); + when Dir_Downto => + return (Dir => Dir_Downto, + Left => Limit, + Right => Limit - Len + 1, + Len => Uns32 (Len)); + end case; + end Synth_Bounds_From_Length; + + function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp + is + Aggr_Type : constant Node := Get_Type (Aggr); + pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); + El_Type : constant Node := Get_Element_Subtype (Aggr_Type); + El_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, El_Type); + Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); + Last : constant Natural := Flist_Last (Els); + Bnd : Bound_Type; + Bnds : Bound_Array_Acc; + Res_Type : Type_Acc; + Val : Valtyp; + Res : Valtyp; + begin + -- Allocate the result. + Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); + pragma Assert (Bnd.Len = Uns32 (Last + 1)); + + if El_Typ.Kind in Type_Nets then + Res_Type := Create_Vector_Type (Bnd, El_Typ); + else + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res_Type := Create_Array_Type (Bnds, El_Typ); + end if; + + Res := Create_Value_Memory (Res_Type); + + for I in Flist_First .. Last loop + -- Elements are supposed to be static, so no need for enable. + Val := Exec_Expression_With_Type + (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); + pragma Assert (Is_Static (Val.Val)); + Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); + end loop; + + return Res; + end Synth_Simple_Aggregate; + + -- Change the bounds of VAL. + function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is + begin + case Val.Val.Kind is + when Value_Alias => + return Create_Value_Alias + ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype); + when Value_Const => + return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); + when Value_Memory => + return (Ntype, Val.Val); + when others => + raise Internal_Error; + end case; + end Reshape_Value; + + function Exec_Subtype_Conversion (Vt : Valtyp; + Dtype : Type_Acc; + Bounds : Boolean; + Loc : Node) + return Valtyp + is + Vtype : constant Type_Acc := Vt.Typ; + begin + if Vt = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + if Dtype = Vtype then + return Vt; + end if; + + case Dtype.Kind is + when Type_Bit => + pragma Assert (Vtype.Kind = Type_Bit); + return Vt; + when Type_Logic => + pragma Assert (Vtype.Kind = Type_Logic); + return Vt; + when Type_Discrete => + pragma Assert (Vtype.Kind in Type_All_Discrete); + case Vt.Val.Kind is + when Value_Net + | Value_Wire + | Value_Alias => + raise Internal_Error; + when Value_Const => + return Exec_Subtype_Conversion + ((Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc); + when Value_Memory => + -- Check for overflow. + declare + Val : constant Int64 := Read_Discrete (Vt); + begin + if not In_Range (Dtype.Drange, Val) then + Error_Msg_Elab (+Loc, "value out of range"); + return No_Valtyp; + end if; + return Create_Value_Discrete (Val, Dtype); + end; + when others => + raise Internal_Error; + end case; + when Type_Float => + pragma Assert (Vtype.Kind = Type_Float); + -- TODO: check range + return Vt; + when Type_Vector => + pragma Assert (Vtype.Kind = Type_Vector + or Vtype.Kind = Type_Slice); + if Dtype.W /= Vtype.W then + Error_Msg_Elab + (+Loc, "mismatching vector length; got %v, expect %v", + (+Vtype.W, +Dtype.W)); + return No_Valtyp; + end if; + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; + end if; + when Type_Slice => + -- TODO: check width + return Vt; + when Type_Array => + pragma Assert (Vtype.Kind = Type_Array); + -- Check bounds. + for I in Vtype.Abounds.D'Range loop + if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then + Error_Msg_Elab (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; + end if; + when Type_Unbounded_Array => + pragma Assert (Vtype.Kind = Type_Array); + return Vt; + when Type_Unbounded_Vector => + pragma Assert (Vtype.Kind = Type_Vector + or else Vtype.Kind = Type_Slice); + return Vt; + when Type_Record => + pragma Assert (Vtype.Kind = Type_Record); + -- TODO: handle elements. + return Vt; + when Type_Unbounded_Record => + pragma Assert (Vtype.Kind = Type_Record); + return Vt; + when Type_Access => + return Vt; + when Type_File + | Type_Protected => + -- No conversion expected. + -- As the subtype is identical, it is already handled by the + -- above check. + raise Internal_Error; + end case; + end Exec_Subtype_Conversion; + + function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp + is + Param : constant Node := Get_Parameter (Attr); + Etype : constant Node := Get_Type (Attr); + Btype : constant Node := Get_Base_Type (Etype); + V : Valtyp; + Dtype : Type_Acc; + begin + -- The value is supposed to be static. + V := Exec_Expression (Syn_Inst, Param); + if V = No_Valtyp then + return No_Valtyp; + end if; + + Dtype := Get_Subtype_Object (Syn_Inst, Etype); + if not Is_Static (V.Val) then + Error_Msg_Elab (+Attr, "parameter of 'value must be static"); + return No_Valtyp; + end if; + + declare + Str : constant String := Value_To_String (V); + Res_N : Node; + Val : Int64; + begin + case Get_Kind (Btype) is + when Iir_Kind_Enumeration_Type_Definition => + Res_N := Eval_Value_Attribute (Str, Etype, Attr); + Val := Int64 (Get_Enum_Pos (Res_N)); + Free_Iir (Res_N); + when Iir_Kind_Integer_Type_Definition => + Val := Int64'Value (Str); + when others => + Error_Msg_Elab (+Attr, "unhandled type for 'value"); + return No_Valtyp; + end case; + return Create_Value_Discrete (Val, Dtype); + end; + end Synth_Value_Attribute; + + function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) + return String + is + use Grt.Types; + begin + case Get_Kind (Expr_Type) is + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Floating_Subtype_Definition => + declare + Str : String (1 .. 24); + Last : Natural; + begin + Grt.To_Strings.To_String + (Str, Last, Ghdl_F64 (Read_Fp64 (Val))); + return Str (Str'First .. Last); + end; + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => + declare + Str : String (1 .. 21); + First : Natural; + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); + return Str (First .. Str'Last); + end; + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + declare + Lits : constant Iir_Flist := + Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); + begin + return Name_Table.Image + (Get_Identifier + (Get_Nth_Element (Lits, Natural (Read_Discrete (Val))))); + end; + when Iir_Kind_Physical_Type_Definition + | Iir_Kind_Physical_Subtype_Definition => + declare + Str : String (1 .. 21); + First : Natural; + Id : constant Name_Id := + Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); + return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); + end; + when others => + Error_Kind ("execute_image_attribute", Expr_Type); + end case; + end Synth_Image_Attribute_Str; + + function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp + is + Len : constant Natural := Str'Length; + Bnd : Bound_Array_Acc; + Typ : Type_Acc; + Res : Valtyp; + begin + Bnd := Create_Bound_Array (1); + Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), + Len => Uns32 (Len)); + Typ := Create_Array_Type (Bnd, Styp.Uarr_El); + + Res := Create_Value_Memory (Typ); + for I in Str'Range loop + Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), + Character'Pos (Str (I))); + end loop; + return Res; + end String_To_Valtyp; + + function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp + is + Param : constant Node := Get_Parameter (Attr); + Etype : constant Node := Get_Type (Attr); + V : Valtyp; + Dtype : Type_Acc; + begin + -- The parameter is expected to be static. + V := Exec_Expression (Syn_Inst, Param); + if V = No_Valtyp then + return No_Valtyp; + end if; + Dtype := Get_Subtype_Object (Syn_Inst, Etype); + if not Is_Static (V.Val) then + Error_Msg_Elab (+Attr, "parameter of 'image must be static"); + return No_Valtyp; + end if; + + Strip_Const (V); + return String_To_Valtyp + (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); + end Synth_Image_Attribute; + + function Synth_Instance_Name_Attribute + (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp + is + Atype : constant Node := Get_Type (Attr); + Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); + Name : constant Path_Instance_Name_Type := + Get_Path_Instance_Name_Suffix (Attr); + begin + -- Return a truncated name, as the prefix is not completly known. + return String_To_Valtyp (Name.Suffix, Atyp); + end Synth_Instance_Name_Attribute; + + -- Convert index IDX in PFX to an offset. + -- SYN_INST and LOC are used in case of error. + function Index_To_Offset + (Syn_Inst : Synth_Instance_Acc; Bnd : Bound_Type; Idx : Int64; Loc : Node) + return Value_Offsets + is + Res : Value_Offsets; + begin + if not In_Bounds (Bnd, Int32 (Idx)) then + Error_Msg_Elab (+Loc, "index not within bounds"); + Elab.Debugger.Debug_Error (Syn_Inst, Loc); + return (0, 0); + end if; + + -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. + case Bnd.Dir is + when Dir_To => + Res.Net_Off := Uns32 (Bnd.Right - Int32 (Idx)); + Res.Mem_Off := Size_Type (Int32 (Idx) - Bnd.Left); + when Dir_Downto => + Res.Net_Off := Uns32 (Int32 (Idx) - Bnd.Right); + Res.Mem_Off := Size_Type (Bnd.Left - Int32 (Idx)); + end case; + + return Res; + end Index_To_Offset; + + -- Return the bounds of a one dimensional array/vector type and the + -- width of the element. + procedure Get_Onedimensional_Array_Bounds + (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is + begin + case Typ.Kind is + when Type_Vector => + El_Typ := Typ.Vec_El; + Bnd := Typ.Vbound; + when Type_Array => + El_Typ := Typ.Arr_El; + Bnd := Typ.Abounds.D (1); + when others => + raise Internal_Error; + end case; + end Get_Onedimensional_Array_Bounds; + + function Create_Onedimensional_Array_Subtype + (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc + is + Res : Type_Acc; + Bnds : Bound_Array_Acc; + begin + case Btyp.Kind is + when Type_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Vec_El); + when Type_Unbounded_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); + when Type_Array => + pragma Assert (Btyp.Abounds.Ndim = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Arr_El); + when Type_Unbounded_Array => + pragma Assert (Btyp.Uarr_Ndim = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Uarr_El); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Onedimensional_Array_Subtype; + + procedure Exec_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + Off : out Value_Offsets) + is + Indexes : constant Iir_Flist := Get_Index_List (Name); + El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); + Idx_Expr : Node; + Idx_Val : Valtyp; + Bnd : Bound_Type; + Stride : Uns32; + Idx_Off : Value_Offsets; + begin + Off := (0, 0); + + Stride := 1; + for I in reverse Flist_First .. Flist_Last (Indexes) loop + Idx_Expr := Get_Nth_Element (Indexes, I); + + -- Use the base type as the subtype of the index is not synth-ed. + Idx_Val := Exec_Expression_With_Basetype (Syn_Inst, Idx_Expr); + if Idx_Val = No_Valtyp then + -- Propagate errorc + Off := (0, 0); + return; + end if; + + Strip_Const (Idx_Val); + + Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); + + pragma Assert (Is_Static (Idx_Val.Val)); + + Idx_Off := Index_To_Offset (Syn_Inst, Bnd, + Get_Static_Discrete (Idx_Val), Name); + Off.Net_Off := Off.Net_Off + Idx_Off.Net_Off * Stride * El_Typ.W; + Off.Mem_Off := Off.Mem_Off + + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; + + Stride := Stride * Bnd.Len; + end loop; + end Exec_Indexed_Name; + + procedure Exec_Slice_Const_Suffix (Syn_Inst: Synth_Instance_Acc; + Expr : Node; + Name : Node; + Pfx_Bnd : Bound_Type; + L, R : Int64; + Dir : Direction_Type; + El_Typ : Type_Acc; + Res_Bnd : out Bound_Type; + Off : out Value_Offsets) + is + Is_Null : Boolean; + Len : Uns32; + begin + if Pfx_Bnd.Dir /= Dir then + Error_Msg_Elab (+Name, "direction mismatch in slice"); + Off := (0, 0); + if Dir = Dir_To then + Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); + else + Res_Bnd := (Dir => Dir_Downto, Left => 0, Right => 1, Len => 0); + end if; + return; + end if; + + -- Might be a null slice. + case Pfx_Bnd.Dir is + when Dir_To => + Is_Null := L > R; + when Dir_Downto => + Is_Null := L < R; + end case; + if Is_Null then + Len := 0; + Off := (0, 0); + else + if not In_Bounds (Pfx_Bnd, Int32 (L)) + or else not In_Bounds (Pfx_Bnd, Int32 (R)) + then + Error_Msg_Elab (+Name, "index not within bounds"); + Elab.Debugger.Debug_Error (Syn_Inst, Expr); + Off := (0, 0); + return; + end if; + + case Pfx_Bnd.Dir is + when Dir_To => + Len := Uns32 (R - L + 1); + Off.Net_Off := Uns32 (Pfx_Bnd.Right - Int32 (R)) * El_Typ.W; + Off.Mem_Off := Size_Type (Int32 (L) - Pfx_Bnd.Left) * El_Typ.Sz; + when Dir_Downto => + Len := Uns32 (L - R + 1); + Off.Net_Off := Uns32 (Int32 (R) - Pfx_Bnd.Right) * El_Typ.W; + Off.Mem_Off := Size_Type (Pfx_Bnd.Left - Int32 (L)) * El_Typ.Sz; + end case; + end if; + Res_Bnd := (Dir => Pfx_Bnd.Dir, + Len => Len, + Left => Int32 (L), + Right => Int32 (R)); + end Exec_Slice_Const_Suffix; + + procedure Exec_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; + Res_Bnd : out Bound_Type; + Off : out Value_Offsets) + is + Expr : constant Node := Get_Suffix (Name); + Left, Right : Valtyp; + Dir : Direction_Type; + begin + Off := (0, 0); + + case Get_Kind (Expr) is + when Iir_Kind_Range_Expression => + -- As the range may be dynamic, cannot use synth_discrete_range. + Left := Exec_Expression_With_Basetype + (Syn_Inst, Get_Left_Limit (Expr)); + Right := Exec_Expression_With_Basetype + (Syn_Inst, Get_Right_Limit (Expr)); + Dir := Get_Direction (Expr); + + when Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kinds_Denoting_Name => + declare + Rng : Discrete_Range_Type; + begin + Synth_Discrete_Range (Syn_Inst, Expr, Rng); + Exec_Slice_Const_Suffix (Syn_Inst, Expr, + Name, Pfx_Bnd, + Rng.Left, Rng.Right, Rng.Dir, + El_Typ, Res_Bnd, Off); + return; + end; + when others => + Error_Msg_Elab + (+Expr, "only range expression supported for slices"); + Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); + return; + end case; + + pragma Assert (Is_Static (Left.Val)); + pragma Assert (Is_Static (Right.Val)); + Exec_Slice_Const_Suffix (Syn_Inst, Expr, + Name, Pfx_Bnd, + Get_Static_Discrete (Left), + Get_Static_Discrete (Right), + Dir, + El_Typ, Res_Bnd, Off); + end Exec_Slice_Suffix; + + function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Valtyp is + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + return Exec_Name (Syn_Inst, Get_Named_Entity (Name)); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Interface_File_Declaration => + return Get_Value (Syn_Inst, Name); + when Iir_Kind_Enumeration_Literal => + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + Res : Valtyp; + begin + Res := Create_Value_Memory (Typ); + Write_Discrete (Res, Int64 (Get_Enum_Pos (Name))); + return Res; + end; + when Iir_Kind_Unit_Declaration => + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + begin + return Create_Value_Discrete + (Vhdl.Evaluation.Get_Physical_Value (Name), Typ); + end; + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Val : Valtyp; + begin + Val := Exec_Expression (Syn_Inst, Get_Prefix (Name)); + return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + end; + when others => + Error_Kind ("synth_name", Name); + end case; + end Exec_Name; + + procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Pfx : Node; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; + Dest_Off : out Value_Offsets) is + begin + case Get_Kind (Pfx) is + when Iir_Kind_Simple_Name => + Exec_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), + Dest_Base, Dest_Typ, Dest_Off); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Object_Alias_Declaration => + declare + Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx); + begin + Dest_Typ := Targ.Typ; + + if Targ.Val.Kind = Value_Alias then + -- Replace alias by the aliased name. + Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); + Dest_Off := Targ.Val.A_Off; + else + Dest_Base := Targ; + Dest_Off := (0, 0); + end if; + end; + + when Iir_Kind_Indexed_Name => + declare + Off : Value_Offsets; + begin + Exec_Assignment_Prefix + (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); + Strip_Const (Dest_Base); + Exec_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Off); + + Dest_Off := Dest_Off + Off; + Dest_Typ := Get_Array_Element (Dest_Typ); + end; + + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Pfx)); + begin + Exec_Assignment_Prefix + (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); + Dest_Off.Net_Off := + Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff; + Dest_Off.Mem_Off := + Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff; + + Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; + end; + + when Iir_Kind_Slice_Name => + declare + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; + Res_Bnd : Bound_Type; + Sl_Off : Value_Offsets; + begin + Exec_Assignment_Prefix + (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); + Strip_Const (Dest_Base); + + Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); + Exec_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Off); + + -- Fixed slice. + Dest_Typ := Create_Onedimensional_Array_Subtype + (Dest_Typ, Res_Bnd); + Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off; + Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off; + end; + + when others => + Error_Kind ("exec_assignment_prefix", Pfx); + end case; + end Exec_Assignment_Prefix; + + -- Return the type of EXPR without evaluating it. + function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Type_Acc is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Object_Declaration => + declare + Val : constant Valtyp := Get_Value (Syn_Inst, Expr); + begin + return Val.Typ; + end; + when Iir_Kind_Simple_Name => + return Exec_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr)); + when Iir_Kind_Slice_Name => + declare + Pfx_Typ : Type_Acc; + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; + Res_Bnd : Bound_Type; + Sl_Off : Value_Offsets; + begin + Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); + Exec_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Off); + return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd); + end; + when Iir_Kind_Indexed_Name => + declare + Pfx_Typ : Type_Acc; + begin + Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + return Get_Array_Element (Pfx_Typ); + end; + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Expr)); + Pfx_Typ : Type_Acc; + begin + Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + return Pfx_Typ.Rec.E (Idx + 1).Typ; + end; + + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Val : Valtyp; + Res : Valtyp; + begin + -- Maybe do not dereference it if its type is known ? + Val := Exec_Expression (Syn_Inst, Get_Prefix (Expr)); + Res := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + return Res.Typ; + end; + + when Iir_Kind_String_Literal8 => + -- TODO: the value should be computed (once) and its type + -- returned. + return Synth_Subtype_Indication (Syn_Inst, Get_Type (Expr)); + + when others => + Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr); + end case; + return null; + end Exec_Type_Of_Object; + + function Exec_Type_Conversion + (Syn_Inst : Synth_Instance_Acc; Conv : Node) return Valtyp + is + Expr : constant Node := Get_Expression (Conv); + Conv_Type : constant Node := Get_Type (Conv); + Conv_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Conv_Type); + Val : Valtyp; + begin + Val := Exec_Expression_With_Basetype (Syn_Inst, Expr); + if Val = No_Valtyp then + return No_Valtyp; + end if; + Strip_Const (Val); + case Get_Kind (Conv_Type) is + when Iir_Kind_Integer_Subtype_Definition => + if Val.Typ.Kind = Type_Discrete then + -- Int to int. + return Val; + elsif Val.Typ.Kind = Type_Float then + return Create_Value_Discrete + (Int64 (Read_Fp64 (Val)), Conv_Typ); + else + Error_Msg_Elab (+Conv, "unhandled type conversion (to int)"); + return No_Valtyp; + end if; + when Iir_Kind_Floating_Subtype_Definition => + if Is_Static (Val.Val) then + return Create_Value_Float + (Fp64 (Read_Discrete (Val)), Conv_Typ); + else + Error_Msg_Elab (+Conv, "unhandled type conversion (to float)"); + return No_Valtyp; + end if; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + case Conv_Typ.Kind is + when Type_Vector + | Type_Unbounded_Vector => + return Val; + when others => + Error_Msg_Elab + (+Conv, "unhandled type conversion (to array)"); + return No_Valtyp; + end case; + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + pragma Assert (Get_Base_Type (Get_Type (Expr)) + = Get_Base_Type (Conv_Type)); + return Val; + when others => + Error_Msg_Elab (+Conv, "unhandled type conversion"); + return No_Valtyp; + end case; + end Exec_Type_Conversion; + + function Error_Ieee_Operator (Imp : Node; Loc : Node) return Boolean + is + use Std_Names; + Parent : constant Iir := Get_Parent (Imp); + begin + if Get_Kind (Parent) = Iir_Kind_Package_Declaration + and then (Get_Identifier + (Get_Library (Get_Design_File (Get_Design_Unit (Parent)))) + = Name_Ieee) + then + case Get_Identifier (Parent) is + when Name_Std_Logic_1164 + | Name_Std_Logic_Arith + | Name_Std_Logic_Signed + | Name_Std_Logic_Unsigned + | Name_Std_Logic_Misc + | Name_Numeric_Std + | Name_Numeric_Bit + | Name_Math_Real => + Error_Msg_Elab + (+Loc, "unhandled predefined IEEE operator %i", +Imp); + Error_Msg_Elab + (+Imp, " declared here"); + return True; + when others => + -- ieee 2008 packages are handled like regular packages. + null; + end case; + end if; + + return False; + end Error_Ieee_Operator; + + function Synth_String_Literal + (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) + return Valtyp + is + pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); + Id : constant String8_Id := Get_String8_Id (Str); + + Str_Type : constant Node := Get_Type (Str); + El_Type : Type_Acc; + Bounds : Bound_Type; + Bnds : Bound_Array_Acc; + Res_Type : Type_Acc; + Res : Valtyp; + Pos : Nat8; + begin + case Str_Typ.Kind is + when Type_Vector => + Bounds := Str_Typ.Vbound; + when Type_Array => + Bounds := Str_Typ.Abounds.D (1); + when Type_Unbounded_Vector + | Type_Unbounded_Array => + Bounds := Synth_Bounds_From_Length + (Get_Index_Type (Str_Type, 0), Get_String_Length (Str)); + when others => + raise Internal_Error; + end case; + + El_Type := Get_Subtype_Object (Syn_Inst, Get_Element_Subtype (Str_Type)); + if El_Type.Kind in Type_Nets then + Res_Type := Create_Vector_Type (Bounds, El_Type); + else + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bounds; + Res_Type := Create_Array_Type (Bnds, El_Type); + end if; + Res := Create_Value_Memory (Res_Type); + + -- Only U8 are handled. + pragma Assert (El_Type.Sz = 1); + + -- From left to right. + for I in 1 .. Bounds.Len loop + -- FIXME: use literal from type ?? + Pos := Str_Table.Element_String8 (Id, Pos32 (I)); + Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos)); + end loop; + + return Res; + end Synth_String_Literal; + + -- Return the left bound if the direction of the range is LEFT_DIR. + function Synth_Low_High_Type_Attribute + (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type) + return Valtyp + is + Typ : Type_Acc; + R : Int64; + begin + Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Prefix (Expr))); + pragma Assert (Typ.Kind = Type_Discrete); + if Typ.Drange.Dir = Left_Dir then + R := Typ.Drange.Left; + else + R := Typ.Drange.Right; + end if; + return Create_Value_Discrete (R, Typ); + end Synth_Low_High_Type_Attribute; + + function Exec_Short_Circuit (Syn_Inst : Synth_Instance_Acc; + Val : Int64; + Left_Expr : Node; + Right_Expr : Node; + Typ : Type_Acc) return Valtyp + is + Left : Valtyp; + Right : Valtyp; + begin + Left := Exec_Expression_With_Type (Syn_Inst, Left_Expr, Typ); + if Left = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + pragma Assert (Is_Static (Left.Val)); + if Get_Static_Discrete (Left) = Val then + -- Short-circuit when the left operand determines the result. + return Create_Value_Discrete (Val, Typ); + end if; + + Strip_Const (Left); + Right := Exec_Expression_With_Type (Syn_Inst, Right_Expr, Typ); + if Right = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + Strip_Const (Right); + + pragma Assert (Is_Static (Right.Val)); + if Get_Static_Discrete (Right) = Val then + -- If the right operand can determine the result, return it. + return Create_Value_Discrete (Val, Typ); + end if; + + -- Return a static value if both operands are static. + -- Note: we know the value of left if it is not constant. + return Create_Value_Discrete (Get_Static_Discrete (Right), Typ); + end Exec_Short_Circuit; + + function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; + Expr : Node; + Expr_Type : Type_Acc) return Valtyp is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Dyadic_Operator => + declare + Imp : constant Node := Get_Implementation (Expr); + Def : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); + begin + -- Specially handle short-circuit operators. + case Def is + when Iir_Predefined_Boolean_And => + return Exec_Short_Circuit + (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), + Boolean_Type); + when Iir_Predefined_Boolean_Or => + return Exec_Short_Circuit + (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), + Boolean_Type); + when Iir_Predefined_Bit_And => + return Exec_Short_Circuit + (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), + Bit_Type); + when Iir_Predefined_Bit_Or => + return Exec_Short_Circuit + (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), + Bit_Type); + when Iir_Predefined_None => + if Error_Ieee_Operator (Imp, Expr) then + return No_Valtyp; + else + return Synth_User_Operator + (Syn_Inst, Get_Left (Expr), Get_Right (Expr), Expr); + end if; + when others => + return Synth_Dyadic_Operation + (Syn_Inst, Imp, + Get_Left (Expr), Get_Right (Expr), Expr); + end case; + end; + when Iir_Kinds_Monadic_Operator => + declare + Imp : constant Node := Get_Implementation (Expr); + Def : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); + begin + if Def = Iir_Predefined_None then + if Error_Ieee_Operator (Imp, Expr) then + return No_Valtyp; + else + return Synth_User_Operator + (Syn_Inst, Get_Operand (Expr), Null_Node, Expr); + end if; + else + return Synth_Monadic_Operation + (Syn_Inst, Imp, Get_Operand (Expr), Expr); + end if; + end; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Interface_Signal_Declaration -- For PSL. + | Iir_Kind_Signal_Declaration -- For PSL. + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Res : Valtyp; + begin + Res := Exec_Name (Syn_Inst, Expr); + if Res.Val.Kind = Value_Signal then + Vhdl_Errors.Error_Msg_Elab + (+Expr, "cannot use signal value during elaboration"); + return No_Valtyp; + end if; + if Res.Typ /= null + and then Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory + then + -- This is a null object. As nothing can be done about it, + -- returns 0. + return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ)); + end if; + return Res; + end; + when Iir_Kind_Reference_Name => + -- Only used for anonymous signals in internal association. + return Exec_Expression_With_Type + (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + raise Internal_Error; + -- declare + -- Base : Valtyp; + -- Typ : Type_Acc; + -- Off : Value_Offsets; + -- Res : Valtyp; + + -- Dyn : Dyn_Name; + -- begin + -- Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Dyn); + -- if Dyn.Voff = No_Net and then Is_Static (Base.Val) then + -- Res := Create_Value_Memory (Typ); + -- Copy_Memory + -- (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); + -- return Res; + -- end if; + -- return Synth_Read_Memory + -- (Syn_Inst, Base, Typ, Off.Net_Off, Dyn, Expr); + -- end; + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Expr)); + Pfx : constant Node := Get_Prefix (Expr); + Res_Typ : Type_Acc; + Val : Valtyp; + Res : Valtyp; + begin + Val := Exec_Expression (Syn_Inst, Pfx); + Strip_Const (Val); + Res_Typ := Val.Typ.Rec.E (Idx + 1).Typ; + if Res_Typ.W = 0 and then Val.Val.Kind /= Value_Memory then + -- This is a null object. As nothing can be done about it, + -- returns 0. + return Create_Value_Memtyp (Create_Memory_Zero (Res_Typ)); + end if; + pragma Assert (Is_Static (Val.Val)); + Res := Create_Value_Memory (Res_Typ); + Copy_Memory + (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff, + Res_Typ.Sz); + return Res; + end; + when Iir_Kind_Character_Literal => + return Exec_Expression_With_Type + (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); + when Iir_Kind_Integer_Literal => + declare + Res : Valtyp; + begin + Res := Create_Value_Memory (Expr_Type); + Write_Discrete (Res, Get_Value (Expr)); + return Res; + end; + when Iir_Kind_Floating_Point_Literal => + return Create_Value_Float (Get_Fp_Value (Expr), Expr_Type); + when Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal => + return Create_Value_Discrete + (Get_Physical_Value (Expr), Expr_Type); + when Iir_Kind_String_Literal8 => + return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + when Iir_Kind_Enumeration_Literal => + return Exec_Name (Syn_Inst, Expr); + when Iir_Kind_Type_Conversion => + return Exec_Type_Conversion (Syn_Inst, Expr); + when Iir_Kind_Qualified_Expression => + return Exec_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), + Get_Subtype_Object (Syn_Inst, Get_Type (Get_Type_Mark (Expr)))); + when Iir_Kind_Function_Call => + declare + Imp : constant Node := Get_Implementation (Expr); + begin + case Get_Implicit_Definition (Imp) is + when Iir_Predefined_Pure_Functions + | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators => + return Synth_Operator_Function_Call (Syn_Inst, Expr); + when Iir_Predefined_None => + return Synth_User_Function_Call (Syn_Inst, Expr); + when others => + return Synth_Predefined_Function_Call (Syn_Inst, Expr); + end case; + end; + when Iir_Kind_Aggregate => + return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); + when Iir_Kind_Simple_Aggregate => + return Synth_Simple_Aggregate (Syn_Inst, Expr); + when Iir_Kind_Parenthesis_Expression => + return Exec_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), Expr_Type); + when Iir_Kind_Left_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Left), Expr_Type); + end; + when Iir_Kind_Right_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Right), Expr_Type); + end; + when Iir_Kind_High_Array_Attribute => + declare + B : Bound_Type; + V : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := B.Right; + when Dir_Downto => + V := B.Left; + end case; + return Create_Value_Discrete (Int64 (V), Expr_Type); + end; + when Iir_Kind_Low_Array_Attribute => + declare + B : Bound_Type; + V : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := B.Left; + when Dir_Downto => + V := B.Right; + end case; + return Create_Value_Discrete (Int64 (V), Expr_Type); + end; + when Iir_Kind_Length_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Len), Expr_Type); + end; + when Iir_Kind_Ascending_Array_Attribute => + declare + B : Bound_Type; + V : Int64; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := 1; + when Dir_Downto => + V := 0; + end case; + return Create_Value_Discrete (V, Expr_Type); + end; + + when Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute => + declare + Param : constant Node := Get_Parameter (Expr); + V : Valtyp; + Dtype : Type_Acc; + begin + V := Exec_Expression (Syn_Inst, Param); + Dtype := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); + -- FIXME: to be generalized. Not always as simple as a + -- subtype conversion. + return Exec_Subtype_Conversion (V, Dtype, False, Expr); + end; + when Iir_Kind_Low_Type_Attribute => + return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_To); + when Iir_Kind_High_Type_Attribute => + return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); + when Iir_Kind_Value_Attribute => + return Synth_Value_Attribute (Syn_Inst, Expr); + when Iir_Kind_Image_Attribute => + return Synth_Image_Attribute (Syn_Inst, Expr); + when Iir_Kind_Instance_Name_Attribute => + return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + when Iir_Kind_Null_Literal => + return Create_Value_Access (Null_Heap_Index, Expr_Type); + when Iir_Kind_Allocator_By_Subtype => + declare + T : Type_Acc; + Acc : Heap_Index; + begin + T := Synth_Subtype_Indication + (Syn_Inst, Get_Subtype_Indication (Expr)); + Acc := Allocate_By_Type (T); + return Create_Value_Access (Acc, Expr_Type); + end; + when Iir_Kind_Allocator_By_Expression => + declare + V : Valtyp; + Acc : Heap_Index; + begin + V := Exec_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); + Acc := Allocate_By_Value (V); + return Create_Value_Access (Acc, Expr_Type); + end; + when Iir_Kind_Stable_Attribute => + Error_Msg_Elab (+Expr, "signal attribute not supported"); + return No_Valtyp; + when Iir_Kind_Overflow_Literal => + Error_Msg_Elab (+Expr, "out of bound expression"); + return No_Valtyp; + when others => + Error_Kind ("exec_expression_with_type", Expr); + end case; + end Exec_Expression_With_Type; + + function Exec_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Valtyp + is + Etype : Node; + begin + Etype := Get_Type (Expr); + + case Get_Kind (Expr) is + when Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Integer_Literal => + -- The type of this attribute is the type of the index, which is + -- not synthesized as atype (only as an index). + -- For integer_literal, the type is not really needed, and it + -- may be created by static evaluation of an array attribute. + Etype := Get_Base_Type (Etype); + when others => + null; + end case; + + return Exec_Expression_With_Type + (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Etype)); + end Exec_Expression; + + function Exec_Expression_With_Basetype + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp + is + Basetype : Type_Acc; + begin + Basetype := Get_Subtype_Object + (Syn_Inst, Get_Base_Type (Get_Type (Expr))); + return Exec_Expression_With_Type (Syn_Inst, Expr, Basetype); + end Exec_Expression_With_Basetype; +end Elab.Vhdl_Expr; diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads new file mode 100644 index 000000000..2eac33f1c --- /dev/null +++ b/src/synth/elab-vhdl_expr.ads @@ -0,0 +1,80 @@ +-- Expressions synthesis. +-- 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 <gnu.org/licenses>. + +with Types; use Types; + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + +package Elab.Vhdl_Expr is + -- For a static value V, return the value. + function Get_Static_Discrete (V : Valtyp) return Int64; + + -- Return the memory (as a memtyp) of static value V. + function Get_Value_Memtyp (V : Valtyp) return Memtyp; + + -- Return the bounds of a one dimensional array/vector type and the + -- width of the element. + procedure Get_Onedimensional_Array_Bounds + (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc); + + -- Create an array subtype from bound BND. + function Create_Onedimensional_Array_Subtype + (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc; + + -- Return the type of EXPR without evaluating it. + function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Type_Acc; + + procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; + Pfx : Node; + Dest_Base : out Valtyp; + Dest_Typ : out Type_Acc; + Dest_Off : out Value_Offsets); + + function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Valtyp; + + -- Synthesize EXPR. The expression must be self-constrained. + -- If EN is not No_Net, the execution is controlled by EN. This is used + -- for assertions and checks. + function Exec_Expression + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; + + -- Same as Synth_Expression, but the expression may be constrained by + -- EXPR_TYPE. + function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; + Expr : Node; + Expr_Type : Type_Acc) return Valtyp; + + -- Use base type of EXPR to synthesize EXPR. Useful when the type of + -- EXPR is defined by itself or a range. + function Exec_Expression_With_Basetype (Syn_Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp; + + -- Subtype conversion. + function Exec_Subtype_Conversion (Vt : Valtyp; + Dtype : Type_Acc; + Bounds : Boolean; + Loc : Node) + return Valtyp; + +end Elab.Vhdl_Expr; diff --git a/src/synth/synth-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index 2300ff9f9..2e00265f6 100644 --- a/src/synth/synth-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -20,16 +20,18 @@ with Types; use Types; with Files_Map; with Name_Table; +with Vhdl.Errors; use Vhdl.Errors; + with Grt.Types; use Grt.Types; with Grt.Files_Operations; use Grt.Files_Operations; with Grt.Stdio; -with Synth.Memtype; use Synth.Memtype; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; -with Synth.Errors; use Synth.Errors; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; +with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; -package body Synth.Vhdl_Files is +package body Elab.Vhdl_Files is -- Variables to store the search path. Current_Unit : Node := Null_Node; @@ -45,7 +47,7 @@ package body Synth.Vhdl_Files is procedure File_Error (Loc : Node; Status : Op_Status) is begin pragma Assert (Status /= Op_Ok); - Error_Msg_Synth (+Loc, "file operation failed"); + Error_Msg_Elab (+Loc, "file operation failed"); raise File_Execution_Error; end File_Error; @@ -211,10 +213,10 @@ package body Synth.Vhdl_Files is return F; end if; - File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name); + File_Name := Exec_Expression_With_Basetype (Syn_Inst, External_Name); if Open_Kind /= Null_Node then - Mode := Synth_Expression (Syn_Inst, Open_Kind); + Mode := Exec_Expression (Syn_Inst, Open_Kind); File_Mode := Ghdl_I32 (Read_Discrete (Mode)); else case Get_Mode (Decl) is @@ -240,7 +242,7 @@ package body Synth.Vhdl_Files is if Status /= Op_Ok then if Status = Op_Name_Error then - Error_Msg_Synth + Error_Msg_Elab (+Decl, "cannot open file: " & C_Name (1 .. C_Name_Len)); Set_Error (Syn_Inst); else @@ -251,7 +253,7 @@ package body Synth.Vhdl_Files is return F; end Elaborate_File_Declaration; - function Endfile (F : File_Index; Loc : Syn_Src) return Boolean + function Endfile (F : File_Index; Loc : Node) return Boolean is Status : Op_Status; begin @@ -298,7 +300,7 @@ package body Synth.Vhdl_Files is if Status /= Op_Ok then if Status = Op_Name_Error then - Error_Msg_Synth + Error_Msg_Elab (+Loc, "cannot open file: " & C_Name (1 .. C_Name_Len)); raise File_Execution_Error; else @@ -413,4 +415,4 @@ package body Synth.Vhdl_Files is File_Read_Value (File, (Value.Typ, Value.Val.Mem), Loc); end Synth_File_Read; -end Synth.Vhdl_Files; +end Elab.Vhdl_Files; diff --git a/src/synth/synth-vhdl_files.ads b/src/synth/elab-vhdl_files.ads index 1d373664e..7987e0ccf 100644 --- a/src/synth/synth-vhdl_files.ads +++ b/src/synth/elab-vhdl_files.ads @@ -18,11 +18,10 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Source; use Synth.Source; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; -package Synth.Vhdl_Files is +package Elab.Vhdl_Files is -- Raised in case of un-recoverable error. File_Execution_Error : exception; @@ -33,7 +32,7 @@ package Synth.Vhdl_Files is function Elaborate_File_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) return File_Index; - function Endfile (F : File_Index; Loc : Syn_Src) return Boolean; + function Endfile (F : File_Index; Loc : Node) return Boolean; procedure Synth_File_Open (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); @@ -45,4 +44,4 @@ package Synth.Vhdl_Files is procedure Synth_File_Read (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node); -end Synth.Vhdl_Files; +end Elab.Vhdl_Files; diff --git a/src/synth/synth-vhdl_heap.adb b/src/synth/elab-vhdl_heap.adb index 6ab9af3e5..a6027bfef 100644 --- a/src/synth/synth-vhdl_heap.adb +++ b/src/synth/elab-vhdl_heap.adb @@ -19,10 +19,9 @@ with Types; use Types; with Tables; +with Elab.Memtype; use Elab.Memtype; -with Synth.Memtype; use Synth.Memtype; - -package body Synth.Vhdl_Heap is +package body Elab.Vhdl_Heap is package Heap_Table is new Tables (Table_Component_Type => Valtyp, @@ -91,4 +90,4 @@ package body Synth.Vhdl_Heap is Free (Heap_Table.Table (Idx)); end Synth_Deallocate; -end Synth.Vhdl_Heap; +end Elab.Vhdl_Heap; diff --git a/src/synth/synth-vhdl_heap.ads b/src/synth/elab-vhdl_heap.ads index 0e1928b26..e6c9db777 100644 --- a/src/synth/synth-vhdl_heap.ads +++ b/src/synth/elab-vhdl_heap.ads @@ -16,10 +16,10 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; -package Synth.Vhdl_Heap is +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; @@ -27,4 +27,4 @@ package Synth.Vhdl_Heap is function Synth_Dereference (Idx : Heap_Index) return Valtyp; procedure Synth_Deallocate (Idx : Heap_Index); -end Synth.Vhdl_Heap; +end Elab.Vhdl_Heap; diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb new file mode 100644 index 000000000..e5fc5e97b --- /dev/null +++ b/src/synth/elab-vhdl_insts.adb @@ -0,0 +1,673 @@ +-- Design elaboration +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +with Types; use Types; +with Libraries; + +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Std_Package; +with Vhdl.Annotations; +with Vhdl.Configuration; use Vhdl.Configuration; +with Vhdl.Errors; use Vhdl.Errors; + +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Decls; use Elab.Vhdl_Decls; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Stmts; use Elab.Vhdl_Stmts; +with Elab.Vhdl_Files; +with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; +with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; + +package body Elab.Vhdl_Insts is + procedure Elab_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc) + is + use Vhdl.Std_Package; + begin + Create_Subtype_Object + (Syn_Inst, Convertible_Integer_Type_Definition, + Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition)); + Create_Subtype_Object + (Syn_Inst, Convertible_Real_Type_Definition, + Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition)); + end Elab_Convertible_Declarations; + + procedure Elab_Generics_Association (Sub_Inst : Synth_Instance_Acc; + Syn_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node) + is + Inter : Node; + Inter_Type : Type_Acc; + Assoc : Node; + Assoc_Inter : Node; + Actual : Node; + Val : Valtyp; + begin + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Is_Valid (Assoc) loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is + when Iir_Kind_Interface_Constant_Declaration => + Elab_Declaration_Type (Sub_Inst, Inter); + Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); + + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_Open => + Actual := Get_Default_Value (Inter); + Val := Exec_Expression_With_Type + (Sub_Inst, Actual, Inter_Type); + when Iir_Kind_Association_Element_By_Expression => + Actual := Get_Actual (Assoc); + Val := Exec_Expression_With_Type + (Syn_Inst, Actual, Inter_Type); + when others => + raise Internal_Error; + end case; + + Val := Exec_Subtype_Conversion (Val, Inter_Type, True, Assoc); + + if Val = No_Valtyp then + Set_Error (Sub_Inst); + elsif not Is_Static (Val.Val) then + Error_Msg_Elab + (+Assoc, "value of generic %i must be static", +Inter); + Val := No_Valtyp; + Set_Error (Sub_Inst); + end if; + + Create_Object (Sub_Inst, Inter, Val); + + when Iir_Kind_Interface_Package_Declaration => + declare + Actual : constant Iir := + Strip_Denoting_Name (Get_Actual (Assoc)); + Pkg_Inst : Synth_Instance_Acc; + begin + Pkg_Inst := Get_Package_Object (Sub_Inst, Actual); + Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst); + end; + + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Quantity_Declaration + | Iir_Kind_Interface_Terminal_Declaration => + raise Internal_Error; + + when Iir_Kinds_Interface_Subprogram_Declaration + | Iir_Kind_Interface_Type_Declaration => + raise Internal_Error; + end case; + + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Elab_Generics_Association; + + procedure Elab_Package_Declaration + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + Syn_Inst : Synth_Instance_Acc; + begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + + Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg); + + Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); + if Pkg = Vhdl.Std_Package.Standard_Package then + Elab_Convertible_Declarations (Syn_Inst); + end if; + end Elab_Package_Declaration; + + procedure Elab_Package_Body + (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node) + is + Pkg_Inst : Synth_Instance_Acc; + begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + + Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg); + + Elab_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); + end Elab_Package_Body; + + procedure Elab_Package_Instantiation + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + Bod : constant Node := Get_Instance_Package_Body (Pkg); + Sub_Inst : Synth_Instance_Acc; + begin + Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg); + + Elab_Generics_Association + (Sub_Inst, Parent_Inst, + Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg)); + + Elab_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); + + if Bod /= Null_Node then + -- Macro expanded package instantiation. + raise Internal_Error; + else + -- Shared body + declare + Uninst : constant Node := Get_Uninstantiated_Package_Decl (Pkg); + Uninst_Bod : constant Node := Get_Package_Body (Uninst); + begin + Set_Uninstantiated_Scope (Sub_Inst, Uninst); + -- Synth declarations of (optional) body. + if Uninst_Bod /= Null_Node then + Elab_Declarations + (Sub_Inst, Get_Declaration_Chain (Uninst_Bod)); + end if; + end; + end if; + end Elab_Package_Instantiation; + + procedure Elab_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node) + is + Dep_List : constant Node_List := Get_Dependence_List (Unit); + Dep_It : List_Iterator; + Dep : Node; + Dep_Unit : Node; + begin + Dep_It := List_Iterate (Dep_List); + while Is_Valid (Dep_It) loop + Dep := Get_Element (Dep_It); + if Get_Kind (Dep) = Iir_Kind_Design_Unit + and then not Get_Elab_Flag (Dep) + then + Set_Elab_Flag (Dep, True); + Elab_Dependencies (Parent_Inst, Dep); + Dep_Unit := Get_Library_Unit (Dep); + case Iir_Kinds_Library_Unit (Get_Kind (Dep_Unit)) is + when Iir_Kind_Entity_Declaration => + null; + when Iir_Kind_Configuration_Declaration => + null; + when Iir_Kind_Context_Declaration => + null; + when Iir_Kind_Package_Declaration => + declare + Bod : constant Node := Get_Package_Body (Dep_Unit); + Bod_Unit : Node; + begin + Elab_Package_Declaration (Parent_Inst, Dep_Unit); + -- Do not try to elaborate math_real body: there are + -- functions with loop. Currently, try create signals, + -- which is not possible during package elaboration. + if Bod /= Null_Node then + Bod_Unit := Get_Design_Unit (Bod); + Elab_Dependencies (Parent_Inst, Bod_Unit); + Elab_Package_Body (Parent_Inst, Dep_Unit, Bod); + end if; + end; + when Iir_Kind_Package_Instantiation_Declaration => + Elab_Package_Instantiation (Parent_Inst, Dep_Unit); + when Iir_Kind_Package_Body => + null; + when Iir_Kind_Architecture_Body => + null; + when Iir_Kinds_Verification_Unit => + null; + end case; + end if; + Next (Dep_It); + end loop; + end Elab_Dependencies; + + procedure Apply_Block_Configuration (Cfg : Node; Blk : Node) + is + Item : Node; + begin + -- Be sure CFG applies to BLK. + pragma Assert (Get_Block_From_Block_Specification + (Get_Block_Specification (Cfg)) = Blk); + + -- Clear_Instantiation_Configuration (Blk); + + Item := Get_Configuration_Item_Chain (Cfg); + while Item /= Null_Node loop + case Get_Kind (Item) is + when Iir_Kind_Component_Configuration => + declare + List : constant Iir_Flist := + Get_Instantiation_List (Item); + El : Node; + Inst : Node; + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Inst := Get_Named_Entity (El); + pragma Assert + (Get_Kind (Inst) + = Iir_Kind_Component_Instantiation_Statement); + pragma Assert + (Get_Component_Configuration (Inst) = Null_Node); + Set_Component_Configuration (Inst, Item); + end loop; + end; + when Iir_Kind_Block_Configuration => + declare + Sub_Blk : constant Node := Get_Block_From_Block_Specification + (Get_Block_Specification (Item)); + begin + case Get_Kind (Sub_Blk) is + when Iir_Kind_Generate_Statement_Body => + -- Linked chain. + Set_Prev_Block_Configuration + (Item, Get_Generate_Block_Configuration (Sub_Blk)); + Set_Generate_Block_Configuration (Sub_Blk, Item); + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (Sub_Blk, Item); + when others => + Vhdl.Errors.Error_Kind + ("apply_block_configuration(blk)", Sub_Blk); + end case; + end; + when others => + Vhdl.Errors.Error_Kind ("apply_block_configuration", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Apply_Block_Configuration; + + function Elab_Port_Association_Type (Sub_Inst : Synth_Instance_Acc; + Syn_Inst : Synth_Instance_Acc; + Inter : Node; + Assoc : Node) return Type_Acc is + begin + if not Is_Fully_Constrained_Type (Get_Type (Inter)) then + -- TODO + -- Find the association for this interface + -- * if individual assoc: get type + -- * if whole assoc: get type from object. + if Assoc = Null_Node then + raise Internal_Error; + end if; + case Get_Kind (Assoc) is + when Iir_Kinds_Association_Element_By_Actual => + return Exec_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); + when others => + raise Internal_Error; + end case; + else + Elab_Declaration_Type (Sub_Inst, Inter); + return Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); + end if; + end Elab_Port_Association_Type; + + procedure Elab_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc; + Syn_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node) + is + Inter : Node; + Assoc : Node; + Assoc_Inter : Node; + Inter_Typ : Type_Acc; + begin + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Is_Valid (Assoc) loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + if Get_Whole_Association_Flag (Assoc) then + Inter_Typ := Elab_Port_Association_Type + (Sub_Inst, Syn_Inst, Inter, Assoc); + Create_Signal (Sub_Inst, Inter, Inter_Typ, null); + end if; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Elab_Ports_Association_Type; + + procedure Elab_Verification_Unit + (Syn_Inst : Synth_Instance_Acc; Unit : Node) + is + Unit_Inst : Synth_Instance_Acc; + Item : Node; + Last_Type : Node; + begin + Unit_Inst := Make_Elab_Instance (Syn_Inst, Unit, Config => Null_Node); + Add_Extra_Instance (Syn_Inst, Unit_Inst); + + Apply_Block_Configuration + (Get_Verification_Block_Configuration (Unit), Unit); + + Last_Type := Null_Node; + Item := Get_Vunit_Item_Chain (Unit); + while Item /= Null_Node loop + case Get_Kind (Item) is + when Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Declaration => + null; + when Iir_Kind_Psl_Assert_Directive + | Iir_Kind_Psl_Assume_Directive + | Iir_Kind_Psl_Cover_Directive + | Iir_Kind_Psl_Restrict_Directive => + null; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Attribute_Specification => + Elab_Declaration (Unit_Inst, Item, Last_Type); + when Iir_Kinds_Concurrent_Signal_Assignment + | Iir_Kinds_Process_Statement + | Iir_Kinds_Generate_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Component_Instantiation_Statement => + Elab_Concurrent_Statement (Unit_Inst, Item); + when others => + Error_Kind ("elab_vunit_declaration", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Elab_Verification_Unit; + + procedure Elab_Verification_Units + (Syn_Inst : Synth_Instance_Acc; Parent : Node) + is + Unit : Node; + begin + Unit := Get_Bound_Vunit_Chain (Parent); + while Unit /= Null_Node loop + Elab_Verification_Unit (Syn_Inst, Unit); + Unit := Get_Bound_Vunit_Chain (Unit); + end loop; + end Elab_Verification_Units; + + procedure Elab_Instance_Body (Syn_Inst : Synth_Instance_Acc; + Entity : Node; + Arch : Node; + Config : Node) is + begin + Apply_Block_Configuration (Config, Arch); + + Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); + Elab_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); + + Elab_Verification_Units (Syn_Inst, Entity); + + Elab_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + Elab_Concurrent_Statements + (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); + + Elab_Verification_Units (Syn_Inst, Arch); + end Elab_Instance_Body; + + procedure Elab_Direct_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; + Stmt : Node; + Entity : Node; + Arch : Node; + Config : Node) + is + Sub_Inst : Synth_Instance_Acc; + begin + -- Elaborate generic + map aspect + Sub_Inst := Make_Elab_Instance (Syn_Inst, Arch, Config); + + Create_Sub_Instance (Syn_Inst, Stmt, Sub_Inst); + + Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity)); + Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch)); + + + Elab_Generics_Association (Sub_Inst, Syn_Inst, + Get_Generic_Chain (Entity), + Get_Generic_Map_Aspect_Chain (Stmt)); + + -- Elaborate port types. + Elab_Ports_Association_Type (Sub_Inst, Syn_Inst, + Get_Port_Chain (Entity), + Get_Port_Map_Aspect_Chain (Stmt)); + + if Is_Error (Sub_Inst) then + -- TODO: Free it? + return; + end if; + + -- Recurse. + Elab_Instance_Body (Sub_Inst, Entity, Arch, Config); + end Elab_Direct_Instantiation_Statement; + + procedure Elab_Component_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) + is + Component : constant Node := + Get_Named_Entity (Get_Instantiated_Unit (Stmt)); + Config : constant Node := Get_Component_Configuration (Stmt); + Bind : constant Node := Get_Binding_Indication (Config); + Aspect : Iir; + Comp_Inst : Synth_Instance_Acc; + + Ent : Node; + Arch : Node; + Sub_Config : Node; + Sub_Inst : Synth_Instance_Acc; + begin + -- 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); + + Elab_Generics_Association (Comp_Inst, Syn_Inst, + Get_Generic_Chain (Component), + Get_Generic_Map_Aspect_Chain (Stmt)); + + -- Create objects for the inputs and the outputs of the component, + -- assign inputs (that's nets) and create wires for outputs. + declare + Assoc : Node; + Assoc_Inter : Node; + Inter : Node; + Inter_Typ : Type_Acc; + begin + Assoc := Get_Port_Map_Aspect_Chain (Stmt); + Assoc_Inter := Get_Port_Chain (Component); + while Is_Valid (Assoc) loop + if Get_Whole_Association_Flag (Assoc) then + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + + Inter_Typ := Elab_Port_Association_Type + (Comp_Inst, Syn_Inst, Inter, Assoc); + + Create_Signal (Comp_Inst, Assoc_Inter, Inter_Typ, null); + end if; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end; + + Set_Component_Configuration (Stmt, Null_Node); + + if Bind = Null_Iir then + -- No association. + return; + end if; + + Aspect := Get_Entity_Aspect (Bind); + + -- Extract entity/architecture instantiated by the component. + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + Ent := Get_Entity (Aspect); + Arch := Get_Architecture (Aspect); + when others => + Vhdl.Errors.Error_Kind + ("Elab_Component_Instantiation_Statement(2)", Aspect); + end case; + + if Get_Kind (Ent) = Iir_Kind_Foreign_Module then + -- TODO. + raise Internal_Error; + end if; + + if Arch = Null_Node then + Arch := Libraries.Get_Latest_Architecture (Ent); + else + Arch := Get_Named_Entity (Arch); + end if; + Sub_Config := Get_Library_Unit + (Get_Default_Configuration_Declaration (Arch)); + Sub_Config := Get_Block_Configuration (Sub_Config); + + Elab_Dependencies (Root_Instance, Get_Design_Unit (Ent)); + Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch)); + + -- Elaborate generic + map aspect for the entity instance. + Sub_Inst := Make_Elab_Instance (Comp_Inst, Arch, Sub_Config); + Create_Component_Instance (Comp_Inst, Sub_Inst); + + Elab_Generics_Association (Sub_Inst, Comp_Inst, + Get_Generic_Chain (Ent), + Get_Generic_Map_Aspect_Chain (Bind)); + + Elab_Ports_Association_Type (Sub_Inst, Comp_Inst, + Get_Port_Chain (Ent), + Get_Port_Map_Aspect_Chain (Bind)); + + -- Recurse. + -- TODO: factorize with direct instantiation + Elab_Instance_Body (Sub_Inst, Ent, Arch, Sub_Config); + end Elab_Component_Instantiation_Statement; + + procedure Elab_Design_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) + is + Aspect : constant Iir := Get_Instantiated_Unit (Stmt); + Arch : Node; + Ent : Node; + Config : Node; + begin + -- Load configured entity + architecture + case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is + when Iir_Kind_Entity_Aspect_Entity => + Arch := Get_Architecture (Aspect); + if Arch = Null_Node then + Arch := Libraries.Get_Latest_Architecture (Get_Entity (Aspect)); + else + Arch := Strip_Denoting_Name (Arch); + end if; + Config := Get_Library_Unit + (Get_Default_Configuration_Declaration (Arch)); + when Iir_Kind_Entity_Aspect_Configuration => + Config := Get_Configuration (Aspect); + Arch := Get_Block_Specification (Get_Block_Configuration (Config)); + when Iir_Kind_Entity_Aspect_Open => + return; + end case; + Config := Get_Block_Configuration (Config); + Ent := Get_Entity (Arch); + + Elab_Direct_Instantiation_Statement + (Syn_Inst, Stmt, Ent, Arch, Config); + end Elab_Design_Instantiation_Statement; + + function Elab_Top_Unit (Config : Node) return Synth_Instance_Acc + is + Arch : Node; + Entity : Node; + Inter : Node; + Top_Inst : Synth_Instance_Acc; + begin + Arch := Get_Named_Entity + (Get_Block_Specification (Get_Block_Configuration (Config))); + Entity := Get_Entity (Arch); + + -- Annotate units. + Vhdl.Annotations.Flag_Synthesis := True; + Vhdl.Annotations.Initialize_Annotate; + Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit); + for I in Design_Units.First .. Design_Units.Last loop + Vhdl.Annotations.Annotate (Design_Units.Table (I)); + end loop; + + Elab.Vhdl_Objtypes.Init; + + -- Start elaboration. + Make_Root_Instance; + + Top_Inst := Make_Elab_Instance (Root_Instance, Arch, Null_Node); + + -- Save the current architecture, so that files can be open using a + -- path relative to the architecture filename. + Elab.Vhdl_Files.Set_Design_Unit (Arch); + + Elab_Dependencies (Root_Instance, Get_Design_Unit (Entity)); + Elab_Dependencies (Root_Instance, Get_Design_Unit (Arch)); + + -- Compute generics. + Inter := Get_Generic_Chain (Entity); + while Is_Valid (Inter) loop + Elab_Declaration_Type (Top_Inst, Inter); + declare + Val : Valtyp; + Inter_Typ : Type_Acc; + begin + Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter)); + Val := Exec_Expression_With_Type + (Top_Inst, Get_Default_Value (Inter), Inter_Typ); + pragma Assert (Is_Static (Val.Val)); + Create_Object (Top_Inst, Inter, Val); + end; + Inter := Get_Chain (Inter); + end loop; + + -- Elaborate port types. + -- FIXME: what about unconstrained ports ? Get the type from the + -- association. + Inter := Get_Port_Chain (Entity); + while Is_Valid (Inter) loop + if not Is_Fully_Constrained_Type (Get_Type (Inter)) then + -- TODO + raise Internal_Error; + end if; + declare + Inter_Typ : Type_Acc; + begin + Elab_Declaration_Type (Top_Inst, Inter); + Inter_Typ := Get_Subtype_Object (Top_Inst, Get_Type (Inter)); + Create_Signal (Top_Inst, Inter, Inter_Typ, null); + end; + Inter := Get_Chain (Inter); + end loop; + + Elab_Instance_Body + (Top_Inst, Entity, Arch, Get_Block_Configuration (Config)); + + -- Clear elab_flag + for I in Design_Units.First .. Design_Units.Last loop + Set_Elab_Flag (Design_Units.Table (I), False); + end loop; + + return Top_Inst; + end Elab_Top_Unit; + +end Elab.Vhdl_Insts; diff --git a/src/synth/elab-vhdl_insts.ads b/src/synth/elab-vhdl_insts.ads new file mode 100644 index 000000000..3c34fa4ed --- /dev/null +++ b/src/synth/elab-vhdl_insts.ads @@ -0,0 +1,36 @@ +-- Design elaboration +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +package Elab.Vhdl_Insts is + function Elab_Top_Unit (Config : Node) return Synth_Instance_Acc; + + procedure Elab_Component_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node); + procedure Elab_Design_Instantiation_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node); + + -- Apply block configuration CFG to BLK. + -- Must be done before synthesis of BLK. + -- The synthesis of BLK will clear all configuration of it. + procedure Apply_Block_Configuration (Cfg : Node; Blk : Node); + +end Elab.Vhdl_Insts; diff --git a/src/synth/synth-objtypes.adb b/src/synth/elab-vhdl_objtypes.adb index 036c4151d..da223b4a2 100644 --- a/src/synth/synth-objtypes.adb +++ b/src/synth/elab-vhdl_objtypes.adb @@ -21,7 +21,7 @@ with System; use System; with Mutils; use Mutils; -package body Synth.Objtypes is +package body Elab.Vhdl_Objtypes is function To_Bound_Array_Acc is new Ada.Unchecked_Conversion (System.Address, Bound_Array_Acc); @@ -117,10 +117,10 @@ package body Synth.Objtypes is end case; end Are_Types_Equal; - function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Uns32 is Lo, Hi : Int64; - W : Width; + W : Uns32; begin case Rng.Dir is when Dir_To => @@ -135,19 +135,19 @@ package body Synth.Objtypes is W := 0; elsif Lo >= 0 then -- Positive. - W := Width (Clog2 (Uns64 (Hi) + 1)); + W := Uns32 (Clog2 (Uns64 (Hi) + 1)); elsif Lo = Int64'First then -- Handle possible overflow. W := 64; elsif Hi < 0 then -- Negative only. - W := Width (Clog2 (Uns64 (-Lo))) + 1; + W := Uns32 (Clog2 (Uns64 (-Lo))) + 1; else declare - Wl : constant Width := Width (Clog2 (Uns64 (-Lo))); - Wh : constant Width := Width (Clog2 (Uns64 (Hi) + 1)); + Wl : constant Uns32 := Uns32 (Clog2 (Uns64 (-Lo))); + Wh : constant Uns32 := Uns32 (Clog2 (Uns64 (Hi) + 1)); begin - W := Width'Max (Wl, Wh) + 1; + W := Uns32'Max (Wl, Wh) + 1; end; end if; return W; @@ -173,6 +173,15 @@ package body Synth.Objtypes is end case; end In_Range; + function Build_Discrete_Range_Type + (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type is + begin + return (Dir => Dir, + Left => L, + Right => R, + Is_Signed => L < 0 or R < 0); + end Build_Discrete_Range_Type; + function Create_Bit_Type return Type_Acc is subtype Bit_Type_Type is Type_Type (Type_Bit); @@ -199,7 +208,7 @@ package body Synth.Objtypes is function Create_Discrete_Type (Rng : Discrete_Range_Type; Sz : Size_Type; - W : Width) + W : Uns32) return Type_Acc is subtype Discrete_Type_Type is Type_Type (Type_Discrete); @@ -266,7 +275,7 @@ package body Synth.Objtypes is Slice_El => El_Type))); end Create_Slice_Type; - function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) + function Create_Vec_Type_By_Length (Len : Uns32; El : Type_Acc) return Type_Acc is begin return Create_Vector_Type ((Dir => Dir_Downto, @@ -433,13 +442,12 @@ package body Synth.Objtypes is return (Off + Mask) and not Mask; end Align; - function Create_Record_Type (Els : Rec_El_Array_Acc) - return Type_Acc + function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc is subtype Record_Type_Type is Type_Type (Type_Record); function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); Is_Synth : Boolean; - W : Width; + W : Uns32; Al : Palign_Type; Sz : Size_Type; begin @@ -539,7 +547,7 @@ package body Synth.Objtypes is return Iir_Index32 (Typ.Vbound.Len); when Type_Array => declare - Len : Width; + Len : Uns32; begin Len := 1; for I in Typ.Abounds.D'Range loop @@ -552,13 +560,13 @@ package body Synth.Objtypes is end case; end Get_Array_Flat_Length; - function Get_Type_Width (Atype : Type_Acc) return Width is + function Get_Type_Width (Atype : Type_Acc) return Uns32 is begin pragma Assert (Atype.Kind /= Type_Unbounded_Array); return Atype.W; end Get_Type_Width; - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width is + function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32 is begin case T.Kind is when Type_Vector => @@ -773,4 +781,4 @@ package body Synth.Objtypes is Bit0 := (Bit_Type, To_Memory_Ptr (Bit0_Mem'Address)); Bit1 := (Bit_Type, To_Memory_Ptr (Bit1_Mem'Address)); end Init; -end Synth.Objtypes; +end Elab.Vhdl_Objtypes; diff --git a/src/synth/synth-objtypes.ads b/src/synth/elab-vhdl_objtypes.ads index 91c26327e..46f088dfd 100644 --- a/src/synth/synth-objtypes.ads +++ b/src/synth/elab-vhdl_objtypes.ads @@ -19,15 +19,13 @@ with Types; use Types; with Areapools; use Areapools; -with Netlists; use Netlists; - with Grt.Types; use Grt.Types; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; with Vhdl.Nodes; use Vhdl.Nodes; -package Synth.Objtypes is +package Elab.Vhdl_Objtypes is type Discrete_Range_Type is record -- An integer range. Dir : Direction_Type; @@ -40,7 +38,10 @@ package Synth.Objtypes is end record; -- Return the width of RNG. - function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width; + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Uns32; + + function Build_Discrete_Range_Type + (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type; type Float_Range_Type is record Dir : Direction_Type; @@ -52,7 +53,7 @@ package Synth.Objtypes is Dir : Direction_Type; Left : Int32; Right : Int32; - Len : Width; + Len : Uns32; end record; type Bound_Array_Type is array (Dim_Type range <>) of Bound_Type; @@ -129,7 +130,7 @@ package Synth.Objtypes is -- type with 1 element, a null vector, or a null array). -- For non synthesizable types (like files or protected type), just -- use 32. - W : Width; + W : Uns32; case Kind is when Type_Bit @@ -194,11 +195,11 @@ package Synth.Objtypes is -- Types. function Create_Discrete_Type (Rng : Discrete_Range_Type; Sz : Size_Type; - W : Width) + W : Uns32) return Type_Acc; function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc; - function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) + function Create_Vec_Type_By_Length (Len : Uns32; El : Type_Acc) return Type_Acc; function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) return Type_Acc; @@ -247,11 +248,11 @@ package Synth.Objtypes is function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32; -- Return length of dimension DIM of type T. - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width; + function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32; function Is_Matching_Bounds (L, R : Type_Acc) return Boolean; - function Get_Type_Width (Atype : Type_Acc) return Width; + function Get_Type_Width (Atype : Type_Acc) return Uns32; -- Low-level functions @@ -293,4 +294,4 @@ package Synth.Objtypes is -- Also set by init. Bit0 : Memtyp; Bit1 : Memtyp; -end Synth.Objtypes; +end Elab.Vhdl_Objtypes; diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb new file mode 100644 index 000000000..d3667b0e4 --- /dev/null +++ b/src/synth/elab-vhdl_stmts.adb @@ -0,0 +1,231 @@ +-- Elaborate statements +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +with Types; use Types; + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; + +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Decls; use Elab.Vhdl_Decls; +with Elab.Vhdl_Insts; use Elab.Vhdl_Insts; +with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; + +package body Elab.Vhdl_Stmts is + function Elab_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc; + Bod : Node; + Config : Node; + Iterator : Node := Null_Node; + Iterator_Val : Valtyp := No_Valtyp) + return Synth_Instance_Acc + is + Decls_Chain : constant Node := Get_Declaration_Chain (Bod); + Bod_Inst : Synth_Instance_Acc; + begin + Bod_Inst := Make_Elab_Instance (Syn_Inst, Bod, Config); + + if Iterator /= Null_Node then + -- Add the iterator (for for-generate). + Create_Object (Bod_Inst, Iterator, Iterator_Val); + end if; + + Elab_Declarations (Bod_Inst, Decls_Chain); + + Elab_Concurrent_Statements + (Bod_Inst, Get_Concurrent_Statement_Chain (Bod)); + + return Bod_Inst; + end Elab_Generate_Statement_Body; + + procedure Elab_For_Generate_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) + is + Iterator : constant Node := Get_Parameter_Specification (Stmt); + Bod : constant Node := Get_Generate_Statement_Body (Stmt); + Configs : constant Node := Get_Generate_Block_Configuration (Bod); + It_Type : constant Node := Get_Declaration_Type (Iterator); + Gen_Inst : Synth_Instance_Acc; + Sub_Inst : Synth_Instance_Acc; + Config : Node; + It_Rng : Type_Acc; + Val : Valtyp; + Ival : Valtyp; + Len : Uns32; + begin + if It_Type /= Null_Node then + Synth_Subtype_Indication (Syn_Inst, It_Type); + end if; + + -- 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); + + Gen_Inst := Make_Elab_Generate_Instance + (Syn_Inst, Stmt, Configs, Natural (Len)); + + Create_Sub_Instance (Syn_Inst, Stmt, Gen_Inst); + + for I in 1 .. Len loop + -- Find and apply the config block. + declare + Spec : Node; + begin + Config := Configs; + while Config /= Null_Node loop + Spec := Get_Block_Specification (Config); + case Get_Kind (Spec) is + when Iir_Kind_Simple_Name => + exit; + when others => + Error_Kind ("elab_for_generate_statement", Spec); + end case; + Config := Get_Prev_Block_Configuration (Config); + end loop; + Apply_Block_Configuration (Config, Bod); + end; + + -- Create a copy of the current iterator value for the generate + -- block. + Ival := Create_Value_Discrete (Read_Discrete (Val), It_Rng); + + Sub_Inst := Elab_Generate_Statement_Body + (Syn_Inst, Bod, Config, Iterator, Ival); + Set_Generate_Sub_Instance (Gen_Inst, Positive (I), Sub_Inst); + + Update_Index (It_Rng.Drange, Val); + end loop; + end Elab_For_Generate_Statement; + + procedure Elab_If_Generate_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) + is + Gen : Node; + Bod : Node; + Icond : Node; + Cond : Valtyp; + Config : Node; + Sub_Inst : Synth_Instance_Acc; + begin + Gen := Stmt; + + loop + Icond := Get_Condition (Gen); + if Icond /= Null_Node then + Cond := Exec_Expression (Syn_Inst, Icond); + Strip_Const (Cond); + else + -- It is the else generate. + Cond := No_Valtyp; + end if; + if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then + Bod := Get_Generate_Statement_Body (Gen); + Config := Get_Generate_Block_Configuration (Bod); + + Apply_Block_Configuration (Config, Bod); + Sub_Inst := Elab_Generate_Statement_Body (Syn_Inst, Bod, Config); + Create_Sub_Instance (Syn_Inst, Bod, Sub_Inst); + return; + end if; + Gen := Get_Generate_Else_Clause (Gen); + exit when Gen = Null_Node; + end loop; + + -- Not generated. + Create_Sub_Instance (Syn_Inst, Stmt, null); + end Elab_If_Generate_Statement; + + procedure Elab_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node) + is + Blk_Inst : Synth_Instance_Acc; + begin + -- No support for guard or header. + if Get_Block_Header (Blk) /= Null_Node + or else Get_Guard_Decl (Blk) /= Null_Node + then + raise Internal_Error; + end if; + + Apply_Block_Configuration + (Get_Block_Block_Configuration (Blk), Blk); + + Blk_Inst := Make_Elab_Instance (Syn_Inst, Blk, Null_Iir); + Create_Sub_Instance (Syn_Inst, Blk, Blk_Inst); + + Elab_Declarations (Blk_Inst, Get_Declaration_Chain (Blk)); + Elab_Concurrent_Statements + (Blk_Inst, Get_Concurrent_Statement_Chain (Blk)); + end Elab_Block_Statement; + + procedure Elab_Concurrent_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is + begin + case Get_Kind (Stmt) is + when Iir_Kinds_Process_Statement => + null; + when Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Restrict_Directive + | Iir_Kind_Psl_Assume_Directive + | Iir_Kind_Psl_Assert_Directive + | Iir_Kind_Psl_Cover_Directive + | Iir_Kind_Psl_Declaration => + null; + when Iir_Kind_Component_Instantiation_Statement => + if Is_Component_Instantiation (Stmt) then + Elab_Component_Instantiation_Statement (Syn_Inst, Stmt); + else + Elab_Design_Instantiation_Statement (Syn_Inst, Stmt); + end if; + + when Iir_Kind_For_Generate_Statement => + Elab_For_Generate_Statement (Syn_Inst, Stmt); + + when Iir_Kind_If_Generate_Statement => + Elab_If_Generate_Statement (Syn_Inst, Stmt); + + when Iir_Kind_Block_Statement => + Elab_Block_Statement (Syn_Inst, Stmt); + + when others => + Error_Kind ("elab_concurrent_statement", Stmt); + end case; + end Elab_Concurrent_Statement; + + procedure Elab_Concurrent_Statements + (Syn_Inst : Synth_Instance_Acc; Chain : Node) + is + Stmt : Node; + begin + if Chain = Null_Node then + return; + end if; + + Stmt := Chain; + while Stmt /= Null_Node loop + Elab_Concurrent_Statement (Syn_Inst, Stmt); + Stmt := Get_Chain (Stmt); + end loop; + end Elab_Concurrent_Statements; +end Elab.Vhdl_Stmts; diff --git a/src/synth/elab-vhdl_stmts.ads b/src/synth/elab-vhdl_stmts.ads new file mode 100644 index 000000000..4678b092a --- /dev/null +++ b/src/synth/elab-vhdl_stmts.ads @@ -0,0 +1,29 @@ +-- Elaborate statements +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +package Elab.Vhdl_Stmts is + procedure Elab_Concurrent_Statement + (Syn_Inst : Synth_Instance_Acc; Stmt : Node); + + procedure Elab_Concurrent_Statements + (Syn_Inst : Synth_Instance_Acc; Chain : Node); +end Elab.Vhdl_Stmts; diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb new file mode 100644 index 000000000..1238bec39 --- /dev/null +++ b/src/synth/elab-vhdl_types.adb @@ -0,0 +1,562 @@ +-- Create declarations for synthesis. +-- 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 <gnu.org/licenses>. + +with Types; use Types; +with Mutils; use Mutils; + +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Std_Package; +with Vhdl.Ieee.Std_Logic_1164; +with Vhdl.Evaluation; +with Vhdl.Errors; use Vhdl.Errors; + +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; +with Elab.Vhdl_Decls; +with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; + +package body Elab.Vhdl_Types is + function Synth_Discrete_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type + is + L, R : Valtyp; + Lval, Rval : Int64; + begin + -- Static values. + L := Exec_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); + R := Exec_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng)); + Strip_Const (L); + Strip_Const (R); + + if not (Is_Static (L.Val) and Is_Static (R.Val)) then + Error_Msg_Elab (+Rng, "limits of range are not constant"); + Set_Error (Syn_Inst); + return (Dir => Get_Direction (Rng), + Left => 0, + Right => 0, + Is_Signed => False); + end if; + + Lval := Read_Discrete (L); + Rval := Read_Discrete (R); + return Build_Discrete_Range_Type (Lval, Rval, Get_Direction (Rng)); + end Synth_Discrete_Range_Expression; + + function Synth_Float_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type + is + L, R : Valtyp; + begin + -- Static values (so no enable). + L := Exec_Expression (Syn_Inst, Get_Left_Limit (Rng)); + R := Exec_Expression (Syn_Inst, Get_Right_Limit (Rng)); + return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R)); + end Synth_Float_Range_Expression; + + function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Bound_Type + is + Prefix_Name : constant Iir := Get_Prefix (Attr); + Prefix : constant Iir := Strip_Denoting_Name (Prefix_Name); + Dim : constant Natural := + Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr); + Typ : Type_Acc; + Val : Valtyp; + begin + -- Prefix is an array object or an array subtype. + if Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then + -- TODO: does this cover all the cases ? + Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix)); + else + Val := Exec_Name (Syn_Inst, Prefix_Name); + Typ := Val.Typ; + end if; + + return Get_Array_Bound (Typ, Dim_Type (Dim)); + end Synth_Array_Attribute; + + procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; + Bound : Node; + Rng : out Discrete_Range_Type) is + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound); + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + if Get_Type_Declarator (Bound) /= Null_Node then + declare + Typ : Type_Acc; + begin + -- This is a named subtype, so it has been evaluated. + Typ := Get_Subtype_Object (Syn_Inst, Bound); + Rng := Typ.Drange; + end; + else + Synth_Discrete_Range + (Syn_Inst, Get_Range_Constraint (Bound), Rng); + end if; + when Iir_Kind_Range_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Bound); + Rng := Build_Discrete_Range_Type + (Int64 (B.Left), Int64 (B.Right), B.Dir); + end; + when Iir_Kind_Reverse_Range_Array_Attribute => + declare + B : Bound_Type; + T : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Bound); + -- Reverse + case B.Dir is + when Dir_To => + B.Dir := Dir_Downto; + when Dir_Downto => + B.Dir := Dir_To; + end case; + T := B.Right; + B.Right := B.Left; + B.Left := T; + + Rng := Build_Discrete_Range_Type + (Int64 (B.Left), Int64 (B.Right), B.Dir); + end; + when Iir_Kinds_Denoting_Name => + -- A discrete subtype name. + Synth_Discrete_Range + (Syn_Inst, Get_Subtype_Indication (Get_Named_Entity (Bound)), + Rng); + when others => + Error_Kind ("synth_discrete_range", Bound); + end case; + end Synth_Discrete_Range; + + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; + Atype : Node) return Bound_Type + is + Rng : Discrete_Range_Type; + begin + Synth_Discrete_Range (Syn_Inst, Atype, Rng); + return (Dir => Rng.Dir, + Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), + Len => Get_Range_Length (Rng)); + end Synth_Bounds_From_Range; + + procedure Synth_Subtype_Indication_If_Anonymous + (Syn_Inst : Synth_Instance_Acc; Atype : Node) is + begin + if Get_Type_Declarator (Atype) = Null_Node then + Synth_Subtype_Indication (Syn_Inst, Atype); + end if; + end Synth_Subtype_Indication_If_Anonymous; + + function Synth_Subtype_Indication_If_Anonymous + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is + begin + if Get_Type_Declarator (Atype) = Null_Node then + return Synth_Subtype_Indication (Syn_Inst, Atype); + else + return Get_Subtype_Object (Syn_Inst, Atype); + end if; + end Synth_Subtype_Indication_If_Anonymous; + + function Synth_Array_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc + is + El_Type : constant Node := Get_Element_Subtype (Def); + Ndims : constant Natural := Get_Nbr_Dimensions (Def); + El_Typ : Type_Acc; + Typ : Type_Acc; + begin + Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); + El_Typ := Get_Subtype_Object (Syn_Inst, El_Type); + + if El_Typ.Kind in Type_Nets and then Ndims = 1 then + Typ := Create_Unbounded_Vector (El_Typ); + else + Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ); + end if; + return Typ; + end Synth_Array_Type_Definition; + + function Synth_Record_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc + is + El_List : constant Node_Flist := Get_Elements_Declaration_List (Def); + Rec_Els : Rec_El_Array_Acc; + El : Node; + El_Type : Node; + El_Typ : Type_Acc; + begin + Rec_Els := Create_Rec_El_Array + (Iir_Index32 (Get_Nbr_Elements (El_List))); + + for I in Flist_First .. Flist_Last (El_List) loop + El := Get_Nth_Element (El_List, I); + El_Type := Get_Type (El); + El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); + Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ; + end loop; + + if not Is_Fully_Constrained_Type (Def) then + return Create_Unbounded_Record (Rec_Els); + else + return Create_Record_Type (Rec_Els); + end if; + end Synth_Record_Type_Definition; + + function Synth_Access_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc + is + Des_Type : constant Node := Get_Designated_Type (Def); + Des_Typ : Type_Acc; + Typ : Type_Acc; + begin + Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type); + Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type); + + Typ := Create_Access_Type (Des_Typ); + return Typ; + end Synth_Access_Type_Definition; + + function Synth_File_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc + is + File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def)); + File_Typ : Type_Acc; + Typ : Type_Acc; + Sig : String_Acc; + begin + File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); + + if Get_Text_File_Flag (Def) + or else + Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition + then + Sig := null; + else + declare + Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2); + Off : Natural := Sig_Str'First; + begin + Get_File_Signature (File_Type, Sig_Str, Off); + Sig_Str (Off + 0) := '.'; + Sig_Str (Off + 1) := ASCII.NUL; + Sig := new String'(Sig_Str); + end; + end if; + + Typ := Create_File_Type (File_Typ); + Typ.File_Signature := Sig; + + return Typ; + end Synth_File_Type_Definition; + + function Scalar_Size_To_Size (Def : Node) return Size_Type is + begin + case Get_Scalar_Size (Def) is + when Scalar_8 => + return 1; + when Scalar_16 => + return 2; + when Scalar_32 => + return 4; + when Scalar_64 => + return 8; + end case; + end Scalar_Size_To_Size; + + procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) + is + Typ : Type_Acc; + begin + case Get_Kind (Def) is + when Iir_Kind_Enumeration_Type_Definition => + if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type + or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type + then + Typ := Logic_Type; + elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then + Typ := Boolean_Type; + elsif Def = Vhdl.Std_Package.Bit_Type_Definition then + Typ := Bit_Type; + else + declare + Nbr_El : constant Natural := + Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)); + Rng : Discrete_Range_Type; + W : Uns32; + begin + W := Uns32 (Clog2 (Uns64 (Nbr_El))); + Rng := (Dir => Dir_To, + Is_Signed => False, + Left => 0, + Right => Int64 (Nbr_El - 1)); + Typ := Create_Discrete_Type + (Rng, Scalar_Size_To_Size (Def), W); + end; + end if; + when Iir_Kind_Array_Type_Definition => + Typ := Synth_Array_Type_Definition (Syn_Inst, Def); + when Iir_Kind_Access_Type_Definition => + Typ := Synth_Access_Type_Definition (Syn_Inst, Def); + when Iir_Kind_File_Type_Definition => + Typ := Synth_File_Type_Definition (Syn_Inst, Def); + when Iir_Kind_Record_Type_Definition => + Typ := Synth_Record_Type_Definition (Syn_Inst, Def); + when Iir_Kind_Protected_Type_Declaration => + -- TODO... + Elab.Vhdl_Decls.Elab_Declarations + (Syn_Inst, Get_Declaration_Chain (Def)); + when others => + Vhdl.Errors.Error_Kind ("synth_type_definition", Def); + end case; + if Typ /= null then + Create_Subtype_Object (Syn_Inst, Def, Typ); + end if; + end Elab_Type_Definition; + + procedure Elab_Anonymous_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node) + is + Typ : Type_Acc; + begin + case Get_Kind (Def) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Physical_Type_Definition => + declare + Cst : constant Node := Get_Range_Constraint (St); + L, R : Int64; + Rng : Discrete_Range_Type; + W : Uns32; + begin + L := Get_Value (Get_Left_Limit (Cst)); + R := Get_Value (Get_Right_Limit (Cst)); + Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst)); + W := Discrete_Range_Width (Rng); + Typ := Create_Discrete_Type + (Rng, Scalar_Size_To_Size (Def), W); + end; + when Iir_Kind_Floating_Type_Definition => + declare + Cst : constant Node := Get_Range_Constraint (St); + L, R : Fp64; + Rng : Float_Range_Type; + begin + L := Get_Fp_Value (Get_Left_Limit (Cst)); + R := Get_Fp_Value (Get_Right_Limit (Cst)); + Rng := (Get_Direction (Cst), L, R); + Typ := Create_Float_Type (Rng); + end; + when Iir_Kind_Array_Type_Definition => + Typ := Synth_Array_Type_Definition (Syn_Inst, Def); + when others => + Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def); + end case; + Create_Subtype_Object (Syn_Inst, Def, Typ); + end Elab_Anonymous_Type_Definition; + + function Synth_Discrete_Range_Constraint + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type + is + Res : Discrete_Range_Type; + begin + Synth_Discrete_Range (Syn_Inst, Rng, Res); + return Res; + end Synth_Discrete_Range_Constraint; + + function Synth_Float_Range_Constraint + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is + begin + case Get_Kind (Rng) is + when Iir_Kind_Range_Expression => + -- FIXME: check range. + return Synth_Float_Range_Expression (Syn_Inst, Rng); + when others => + Vhdl.Errors.Error_Kind ("synth_float_range_constraint", Rng); + end case; + end Synth_Float_Range_Constraint; + + function Has_Element_Subtype_Indication (Atype : Node) return Boolean is + begin + return Get_Array_Element_Constraint (Atype) /= Null_Node + or else + (Get_Resolution_Indication (Atype) /= Null_Node + and then + (Get_Kind (Get_Resolution_Indication (Atype)) + = Iir_Kind_Array_Element_Resolution)); + end Has_Element_Subtype_Indication; + + function Synth_Array_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc + is + El_Type : constant Node := Get_Element_Subtype (Atype); + St_Indexes : constant Node_Flist := Get_Index_Subtype_List (Atype); + Ptype : Node; + St_El : Node; + Btyp : Type_Acc; + Etyp : Type_Acc; + Bnds : Bound_Array_Acc; + begin + -- VHDL08 + if Has_Element_Subtype_Indication (Atype) then + -- This subtype has created a new anonymous subtype for the + -- element. + Synth_Subtype_Indication (Syn_Inst, El_Type); + end if; + + if not Get_Index_Constraint_Flag (Atype) then + Ptype := Get_Type (Get_Subtype_Type_Mark (Atype)); + if Get_Element_Subtype (Ptype) = Get_Element_Subtype (Atype) then + -- That's an alias. + -- FIXME: maybe a resolution function was added? + -- FIXME: also handle resolution added in element subtype. + return Get_Subtype_Object (Syn_Inst, Ptype); + end if; + end if; + + Btyp := Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); + case Btyp.Kind is + when Type_Unbounded_Vector => + if Get_Index_Constraint_Flag (Atype) then + St_El := Get_Index_Type (St_Indexes, 0); + return Create_Vector_Type + (Synth_Bounds_From_Range (Syn_Inst, St_El), Btyp.Uvec_El); + else + -- An alias. + -- Handle vhdl08 definition of std_logic_vector from + -- std_ulogic_vector. + return Btyp; + end if; + when Type_Unbounded_Array => + -- FIXME: partially constrained arrays, subtype in indexes... + Etyp := Get_Subtype_Object (Syn_Inst, El_Type); + if Get_Index_Constraint_Flag (Atype) then + Bnds := Create_Bound_Array + (Dim_Type (Get_Nbr_Elements (St_Indexes))); + for I in Flist_First .. Flist_Last (St_Indexes) loop + St_El := Get_Index_Type (St_Indexes, I); + Bnds.D (Dim_Type (I + 1)) := + Synth_Bounds_From_Range (Syn_Inst, St_El); + end loop; + return Create_Array_Type (Bnds, Etyp); + else + raise Internal_Error; + end if; + when others => + raise Internal_Error; + end case; + end Synth_Array_Subtype_Indication; + + function Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is + begin + -- TODO: handle aliases directly. + case Get_Kind (Atype) is + when Iir_Kind_Array_Subtype_Definition => + return Synth_Array_Subtype_Indication (Syn_Inst, Atype); + when Iir_Kind_Record_Subtype_Definition => + return Synth_Record_Type_Definition (Syn_Inst, Atype); + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + declare + Btype : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); + Rng : Discrete_Range_Type; + W : Uns32; + begin + if Btype.Kind in Type_Nets then + -- A subtype of a bit/logic type is still a bit/logic. + -- FIXME: bounds. + return Btype; + else + Rng := Synth_Discrete_Range_Constraint + (Syn_Inst, Get_Range_Constraint (Atype)); + W := Discrete_Range_Width (Rng); + return Create_Discrete_Type (Rng, Btype.Sz, W); + end if; + end; + when Iir_Kind_Floating_Subtype_Definition => + declare + Rng : Float_Range_Type; + begin + Rng := Synth_Float_Range_Constraint + (Syn_Inst, Get_Range_Constraint (Atype)); + return Create_Float_Type (Rng); + end; + when others => + Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype); + end case; + end Synth_Subtype_Indication; + + procedure Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) + is + Typ : Type_Acc; + begin + Typ := Synth_Subtype_Indication (Syn_Inst, Atype); + Create_Subtype_Object (Syn_Inst, Atype, Typ); + end Synth_Subtype_Indication; + + function Get_Declaration_Type (Decl : Node) return Node + is + Ind : constant Node := Get_Subtype_Indication (Decl); + Atype : Node; + begin + if Get_Is_Ref (Decl) or else Ind = Null_Iir then + -- A secondary declaration in a list. + return Null_Node; + end if; + Atype := Ind; + loop + case Get_Kind (Atype) is + when Iir_Kinds_Denoting_Name => + Atype := Get_Named_Entity (Atype); + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Type_Declaration => + -- Type already declared, so already handled. + return Null_Node; + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + return Atype; + when others => + Vhdl.Errors.Error_Kind ("get_declaration_type", Atype); + end case; + end loop; + end Get_Declaration_Type; + + procedure Elab_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Atype : constant Node := Get_Declaration_Type (Decl); + begin + if Atype = Null_Node then + -- Already elaborated. + return; + end if; + Synth_Subtype_Indication (Syn_Inst, Atype); + end Elab_Declaration_Type; +end Elab.Vhdl_Types; diff --git a/src/synth/elab-vhdl_types.ads b/src/synth/elab-vhdl_types.ads new file mode 100644 index 000000000..30ee6e0ae --- /dev/null +++ b/src/synth/elab-vhdl_types.ads @@ -0,0 +1,62 @@ +-- Create declarations for synthesis. +-- 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 <gnu.org/licenses>. + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; + +package Elab.Vhdl_Types is + -- Get the type of DECL iff it is standalone (not an already existing + -- subtype). + function Get_Declaration_Type (Decl : Node) return Node; + + -- True if the element subtype indication of ATYPE needs to be created. + function Has_Element_Subtype_Indication (Atype : Node) return Boolean; + + function Synth_Discrete_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type; + function Synth_Float_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type; + + function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Bound_Type; + + procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; + Bound : Node; + Rng : out Discrete_Range_Type); + + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; + Atype : Node) return Bound_Type; + + function Synth_Array_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; + + procedure Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node); + function Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; + + procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node); + procedure Elab_Anonymous_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node); + + -- Elaborate the type of DECL. + procedure Elab_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node); +end Elab.Vhdl_Types; diff --git a/src/synth/synth-values-debug.adb b/src/synth/elab-vhdl_values-debug.adb index a6f887f08..8792fe292 100644 --- a/src/synth/synth-values-debug.adb +++ b/src/synth/elab-vhdl_values-debug.adb @@ -21,9 +21,7 @@ with Utils_IO; use Utils_IO; with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Debug; - -package body Synth.Values.Debug is +package body Elab.Vhdl_Values.Debug is procedure Put_Dir (Dir : Direction_Type) is begin case Dir is @@ -41,7 +39,7 @@ package body Synth.Values.Debug is Put_Dir (Bnd.Dir); Put (' '); Put_Int32 (Bnd.Right); - Put (" ["); + Put (" [l="); Put_Uns32 (Bnd.Len); Put (']'); end Debug_Bound; @@ -55,8 +53,9 @@ package body Synth.Values.Debug is when Type_Vector => Put ("vector ("); Debug_Bound (T.Vbound); - Put (") of "); + Put (") of ["); Debug_Typ1 (T.Vec_El); + Put ("]"); when Type_Array => Put ("arr ("); for I in 1 .. T.Abounds.Ndim loop @@ -105,7 +104,7 @@ package body Synth.Values.Debug is Put (" sz="); Put_Uns32 (Uns32 (T.Sz)); Put (" w="); - Put_Uns32 (Uns32 (T.W)); + Put_Uns32 (T.W); end Debug_Typ1; procedure Debug_Typ (T : Type_Acc) is @@ -183,16 +182,27 @@ package body Synth.Values.Debug is | Value_Const => Debug_Memtyp (Get_Memtyp (V)); when Value_Net => - Put_Line (" net"); + Put ("net "); + Put_Uns32 (V.Val.N); + Put (' '); + Debug_Typ1 (V.Typ); + New_Line; + when Value_Signal => + Put ("signal "); + Debug_Typ1 (V.Typ); + New_Line; when Value_Wire => - Put (" wire"); - Put_Wire_Id (V.Val.W); + Put ("wire "); + Put_Uns32 (V.Val.N); New_Line; when Value_File => Put_Line ("a file"); when Value_Alias => - Put_Line ("an alias"); + Put ("an alias: "); + Debug_Typ1 (V.Typ); + Put (" of "); + Debug_Valtyp ((V.Typ, V.Val.A_Obj)); end case; end Debug_Valtyp; -end Synth.Values.Debug; +end Elab.Vhdl_Values.Debug; diff --git a/src/synth/synth-values-debug.ads b/src/synth/elab-vhdl_values-debug.ads index 38e7ce23d..6972a1b3e 100644 --- a/src/synth/synth-values-debug.ads +++ b/src/synth/elab-vhdl_values-debug.ads @@ -16,8 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -package Synth.Values.Debug is +package Elab.Vhdl_Values.Debug is procedure Debug_Valtyp (V : Valtyp); procedure Debug_Memtyp (M : Memtyp); procedure Debug_Typ (T : Type_Acc); -end Synth.Values.Debug; +end Elab.Vhdl_Values.Debug; diff --git a/src/synth/synth-values.adb b/src/synth/elab-vhdl_values.adb index 6f89876b6..90e72f223 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -21,9 +21,7 @@ with System; with Grt.Types; use Grt.Types; -with Vhdl.Nodes; use Vhdl.Nodes; - -package body Synth.Values is +package body Elab.Vhdl_Values is function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); @@ -33,7 +31,8 @@ package body Synth.Values is when Value_Memory => return True; when Value_Net - | Value_Wire => + | Value_Wire + | Value_Signal => return False; when Value_File => return True; @@ -44,29 +43,6 @@ package body Synth.Values is end case; end Is_Static; - function Is_Static_Val (Val : Value_Acc) return Boolean is - begin - case Val.Kind is - when Value_Memory => - return True; - when Value_Net => - return False; - when Value_Wire => - if Get_Kind (Val.W) = Wire_Variable then - return Is_Static_Wire (Val.W); - else - -- A signal does not have static values. - return False; - end if; - when Value_File => - return True; - when Value_Const => - return True; - when Value_Alias => - return Is_Static_Val (Val.A_Obj); - end case; - end Is_Static_Val; - function Strip_Alias_Const (V : Value_Acc) return Value_Acc is Res : Value_Acc; @@ -108,38 +84,34 @@ package body Synth.Values is return (Mt.Typ, Res); end Create_Value_Memtyp; - function Create_Value_Wire (W : Wire_Id) return Value_Acc + function Create_Value_Wire (S : Uns32) return Value_Acc is - subtype Value_Type_Wire is Value_Type (Values.Value_Wire); + subtype Value_Type_Wire is Value_Type (Value_Wire); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Wire); begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Wire, - W => W))); - end Create_Value_Wire; - - function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp - is - pragma Assert (Wtype /= null); - begin - return (Wtype, Create_Value_Wire (W)); + return To_Value_Acc + (Alloc (Current_Pool, (Kind => Value_Wire, N => S))); end Create_Value_Wire; - function Create_Value_Net (N : Net) return Value_Acc + function Create_Value_Net (S : Uns32) return Value_Acc is subtype Value_Type_Net is Value_Type (Value_Net); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Net); begin return To_Value_Acc - (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => N))); + (Alloc (Current_Pool, Value_Type_Net'(Kind => Value_Net, N => S))); end Create_Value_Net; - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp + function Create_Value_Signal (S : Uns32; Init : Value_Acc) return Value_Acc is - pragma Assert (Ntype /= null); + subtype Value_Type_Signal is Value_Type (Value_Signal); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Signal); begin - return (Ntype, Create_Value_Net (N)); - end Create_Value_Net; + return To_Value_Acc + (Alloc (Current_Pool, Value_Type_Signal'(Kind => Value_Signal, + S => S, + Init => Init))); + end Create_Value_Signal; function Create_Value_Memory (Vtype : Type_Acc) return Valtyp is @@ -201,7 +173,7 @@ package body Synth.Values is return Iir_Index32 (Typ.Vbound.Len); when Type_Array => declare - Len : Width; + Len : Uns32; begin Len := 1; for I in Typ.Abounds.D'Range loop @@ -230,8 +202,7 @@ package body Synth.Values is return (Typ, Val); end Create_Value_Alias; - function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Create_Value_Const (Val : Value_Acc; Loc : Node) return Value_Acc is subtype Value_Type_Const is Value_Type (Value_Const); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Const); @@ -241,11 +212,10 @@ package body Synth.Values is (Kind => Value_Const, C_Val => Val, C_Loc => Loc, - C_Net => No_Net))); + C_Net => 0))); end Create_Value_Const; - function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) - return Valtyp is + function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp is begin return (Val.Typ, Create_Value_Const (Val.Val, Loc)); end Create_Value_Const; @@ -276,11 +246,13 @@ package body Synth.Values is Res.Val.Mem (I - 1) := Src.Val.Mem (I - 1); end loop; when Value_Net => - Res := Create_Value_Net (Src.Val.N, Src.Typ); + Res := (Src.Typ, Create_Value_Net (Src.Val.S)); when Value_Wire => - Res := Create_Value_Wire (Src.Val.W, Src.Typ); + Res := (Src.Typ, Create_Value_Wire (Src.Val.S)); when Value_File => Res := Create_Value_File (Src.Typ, Src.Val.File); + when Value_Signal => + raise Internal_Error; when Value_Const => raise Internal_Error; when Value_Alias => @@ -493,7 +465,8 @@ package body Synth.Values is begin case V.Val.Kind is when Value_Net - | Value_Wire => + | Value_Wire + | Value_Signal => raise Internal_Error; when Value_Memory => return (V.Typ, V.Val.Mem); @@ -510,4 +483,18 @@ package body Synth.Values is raise Internal_Error; end case; end Get_Memtyp; -end Synth.Values; + + procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp) + is + T : Int64; + begin + T := Read_Discrete (V); + case Rng.Dir is + when Dir_To => + T := T + 1; + when Dir_Downto => + T := T - 1; + end case; + Write_Discrete (V, T); + end Update_Index; +end Elab.Vhdl_Values; diff --git a/src/synth/synth-values.ads b/src/synth/elab-vhdl_values.ads index f5db25da6..047f294ba 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -23,14 +23,12 @@ with Areapools; use Areapools; with Grt.Files_Operations; -with Netlists; use Netlists; +with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Memtype; use Synth.Memtype; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; -with Synth.Source; use Synth.Source; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Memtype; use Elab.Memtype; -package Synth.Values is +package Elab.Vhdl_Values is -- Values is how signals and variables are decomposed. This is similar to -- values in simulation, but simplified (no need to handle files, -- accesses...) @@ -44,6 +42,8 @@ package Synth.Values is -- into a net. Value_Wire, + Value_Signal, + -- Any kind of constant value, raw stored in memory. Value_Memory, @@ -69,18 +69,20 @@ package Synth.Values is type Value_Type (Kind : Value_Kind) is record case Kind is - when Value_Net => - N : Net; - when Value_Wire => - W : Wire_Id; + when Value_Net + | Value_Wire => + N : Uns32; + when Value_Signal => + S : Uns32; + Init : Value_Acc; when Value_Memory => Mem : Memory_Ptr; when Value_File => File : File_Index; when Value_Const => C_Val : Value_Acc; - C_Loc : Syn_Src; - C_Net : Net; + C_Loc : Node; + C_Net : Uns32; when Value_Alias => A_Obj : Value_Acc; A_Typ : Type_Acc; -- The type of A_Obj. @@ -105,19 +107,17 @@ package Synth.Values is -- True if VAL is static, ie contains neither nets nor wires. function Is_Static (Val : Value_Acc) return Boolean; - -- Can also return true for nets and wires. - -- Use Get_Static_Discrete to get the value. - function Is_Static_Val (Val : Value_Acc) return Boolean; - function Is_Equal (L, R : Valtyp) return Boolean; function Create_Value_Memtyp (Mt : Memtyp) return Valtyp; -- Create a Value_Net. - function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; + function Create_Value_Net (S : Uns32) return Value_Acc; + + -- Create a Value_Wire. + function Create_Value_Wire (S : Uns32) return Value_Acc; - -- Create a Value_Wire. For a bit wire, RNG must be null. - function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; + function Create_Value_Signal (S : Uns32; Init : Value_Acc) return Value_Acc; function Create_Value_Memory (Vtype : Type_Acc) return Valtyp; function Create_Value_Memory (Mt : Memtyp) return Valtyp; @@ -138,8 +138,7 @@ package Synth.Values is function Create_Value_Alias (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; - function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) - return Valtyp; + function Create_Value_Const (Val : Valtyp; Loc : Node) return Valtyp; -- If VAL is a const, replace it by its value. procedure Strip_Const (Vt : in out Valtyp); @@ -173,4 +172,7 @@ package Synth.Values is function Read_Fp64 (Vt : Valtyp) return Fp64; procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp); -end Synth.Values; + + procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp); + +end Elab.Vhdl_Values; diff --git a/src/synth/elab.ads b/src/synth/elab.ads new file mode 100644 index 000000000..8d05336de --- /dev/null +++ b/src/synth/elab.ads @@ -0,0 +1,21 @@ +-- Elaboration root namespace. +-- Copyright (C) 2021 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 <gnu.org/licenses>. + +package Elab is + pragma Pure; +end Elab; diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index c920e0ae5..bc1642c07 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -27,11 +27,11 @@ with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; + with Netlists.Iterators; use Netlists.Iterators; with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl; -with Synth.Objtypes; use Synth.Objtypes; - package body Synth.Disp_Vhdl is procedure Disp_Signal (Desc : Port_Desc) is begin diff --git a/src/synth/synth-disp_vhdl.ads b/src/synth/synth-disp_vhdl.ads index 39706a085..0bfac8068 100644 --- a/src/synth/synth-disp_vhdl.ads +++ b/src/synth/synth-disp_vhdl.ads @@ -17,8 +17,8 @@ -- along with this program. If not, see <gnu.org/licenses>. with Netlists; use Netlists; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; with Vhdl.Nodes; use Vhdl.Nodes; -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-ieee-numeric_std.adb b/src/synth/synth-ieee-numeric_std.adb index fd260a59b..0697a7697 100644 --- a/src/synth/synth-ieee-numeric_std.adb +++ b/src/synth/synth-ieee-numeric_std.adb @@ -18,7 +18,8 @@ with Types_Utils; use Types_Utils; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; + with Synth.Errors; use Synth.Errors; with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; diff --git a/src/synth/synth-ieee-numeric_std.ads b/src/synth/synth-ieee-numeric_std.ads index bad079b76..b3bc9a632 100644 --- a/src/synth/synth-ieee-numeric_std.ads +++ b/src/synth/synth-ieee-numeric_std.ads @@ -18,7 +18,7 @@ with Types; use Types; -with Synth.Objtypes; use Synth.Objtypes; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Synth.Source; use Synth.Source; package Synth.Ieee.Numeric_Std is diff --git a/src/synth/synth-ieee-std_logic_1164.ads b/src/synth/synth-ieee-std_logic_1164.ads index c3670882f..33a298f81 100644 --- a/src/synth/synth-ieee-std_logic_1164.ads +++ b/src/synth/synth-ieee-std_logic_1164.ads @@ -18,7 +18,7 @@ with Types; use Types; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; package Synth.Ieee.Std_Logic_1164 is diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index 5eba9c8fb..cc52cd0f4 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -24,17 +24,18 @@ with Grt.Types; use Grt.Types; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Files; + with Netlists; use Netlists; -with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; with Synth.Source; use Synth.Source; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Oper; with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; with Synth.Ieee.Numeric_Std; use Synth.Ieee.Numeric_Std; -with Synth.Vhdl_Files; -with Synth.Values; use Synth.Values; package body Synth.Static_Oper is -- As log2(3m) is directly referenced, the program must be linked with -lm @@ -852,7 +853,7 @@ package body Synth.Static_Oper is declare Res : Boolean; begin - Res := Synth.Vhdl_Files.Endfile (Param1.Val.File, Expr); + Res := Elab.Vhdl_Files.Endfile (Param1.Val.File, Expr); return Create_Memory_U8 (Boolean'Pos (Res), Boolean_Type); end; diff --git a/src/synth/synth-static_oper.ads b/src/synth/synth-static_oper.ads index 3178c6448..797b73de6 100644 --- a/src/synth/synth-static_oper.ads +++ b/src/synth/synth-static_oper.ads @@ -16,8 +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 Synth.Objtypes; use Synth.Objtypes; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Vhdl.Nodes; use Vhdl.Nodes; diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb index fe7e95058..6ba9fda0d 100644 --- a/src/synth/synth-vhdl_aggr.adb +++ b/src/synth/synth-vhdl_aggr.adb @@ -26,11 +26,12 @@ with Netlists.Builders; use Netlists.Builders; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; + with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; -with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; -with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Aggr is type Stride_Array is array (Dim_Type range <>) of Nat32; diff --git a/src/synth/synth-vhdl_aggr.ads b/src/synth/synth-vhdl_aggr.ads index 822c0705d..97e3030fe 100644 --- a/src/synth/synth-vhdl_aggr.ads +++ b/src/synth/synth-vhdl_aggr.ads @@ -18,9 +18,9 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; package Synth.Vhdl_Aggr is -- Aggr_Type is the type from the context. diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 4b32b7efd..a01ad9db0 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -16,37 +16,36 @@ -- 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_Deallocation; - +with Ada.Unchecked_Conversion; +with Tables; with Types_Utils; use Types_Utils; -with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Utils; - with Netlists.Folds; use Netlists.Folds; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Netlists.Locations; package body Synth.Vhdl_Context is - function Make_Base_Instance (Base : Base_Instance_Acc) - return Synth_Instance_Acc + package Extra_Tables is new Tables + (Table_Component_Type => Extra_Vhdl_Instance_Type, + Table_Index_Type => Instance_Id_Type, + Table_Low_Bound => First_Instance_Id, + Table_Initial => 16); + + procedure Set_Extra (Inst : Synth_Instance_Acc; + Extra : Extra_Vhdl_Instance_Type) is - Res : Synth_Instance_Acc; + Id : constant Instance_Id_Type := Get_Instance_Id (Inst); begin - 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; + while Id > Extra_Tables.Last loop + Extra_Tables.Append ((Base => null, Name => No_Sname)); + end loop; + Extra_Tables.Table (Id) := Extra; + end Set_Extra; + + procedure Make_Base_Instance (Base : Base_Instance_Acc) is + begin + Set_Extra (Root_Instance, (Base => Base, Name => No_Sname)); end Make_Base_Instance; procedure Free_Base_Instance is @@ -55,54 +54,62 @@ package body Synth.Vhdl_Context is null; end Free_Base_Instance; + function Get_Instance_Extra (Inst : Synth_Instance_Acc) + return Extra_Vhdl_Instance_Type is + begin + return Extra_Tables.Table (Get_Instance_Id (Inst)); + end Get_Instance_Extra; + + procedure Set_Extra (Inst : Synth_Instance_Acc; + Base : Base_Instance_Acc; + Name : Sname := No_Sname) is + begin + Set_Extra (Inst, (Base => Base, Name => Name)); + end Set_Extra; + + procedure Set_Extra (Inst : Synth_Instance_Acc; + Parent : Synth_Instance_Acc; + Name : Sname := No_Sname) is + begin + Set_Extra (Inst, (Base => Get_Instance_Extra (Parent).Base, + Name => Name)); + end Set_Extra; + 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))); + Res := Make_Elab_Instance (Parent, Blk, Null_Node); + Set_Extra (Res, Parent, Name); return Res; end Make_Instance; procedure Set_Instance_Base (Inst : Synth_Instance_Acc; + Base : Base_Instance_Acc) is + begin + Extra_Tables.Table (Get_Instance_Id (Inst)).Base := Base; + end Set_Instance_Base; + + procedure Set_Instance_Base (Inst : Synth_Instance_Acc; Base : Synth_Instance_Acc) is begin - Inst.Base := Base.Base; + Set_Instance_Base (Inst, Get_Instance_Extra (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); + procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc) is begin - Deallocate (Synth_Inst); + if Get_Instance_Id (Synth_Inst) = Extra_Tables.Last then + Extra_Tables.Decrement_Last; + end if; + Free_Elab_Instance (Synth_Inst); end Free_Instance; procedure Set_Instance_Module (Inst : Synth_Instance_Acc; M : Module) is - Prev_Base : constant Base_Instance_Acc := Inst.Base; + Prev_Base : constant Base_Instance_Acc := Get_Instance_Extra (Inst).Base; Base : Base_Instance_Acc; Self_Inst : Instance; begin @@ -114,184 +121,42 @@ package body Synth.Vhdl_Context is Self_Inst := Create_Self_Instance (M); pragma Unreferenced (Self_Inst); - Inst.Base := Base; + Set_Instance_Base (Inst, 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; + return Extra_Tables.Table (Get_Instance_Id (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; + return Extra_Tables.Table (Get_Instance_Id (Inst)).Base.Top_Module; end Get_Top_Module; function Get_Sname (Inst : Synth_Instance_Acc) return Sname is begin - return Inst.Name; + return Extra_Tables.Table (Get_Instance_Id (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) + return Netlists.Builders.Context_Acc 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); + Id : constant Instance_Id_Type := Get_Instance_Id (Inst); + Base : Base_Instance_Acc; 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); + if Id > Extra_Tables.Last then + -- Not yet built. + return null; 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"); + Base := Extra_Tables.Table (Id).Base; + if Base = null then + return null; end if; - Syn_Inst.Objects (Slot) := (Kind => Obj_None); - Syn_Inst.Elab_Objects := Slot - 1; - end Destroy_Object; + + return Base.Builder; + end Get_Build; procedure Create_Wire_Object (Syn_Inst : Synth_Instance_Acc; Kind : Wire_Kind; @@ -312,81 +177,6 @@ package body Synth.Vhdl_Context is 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; @@ -529,19 +319,75 @@ package body Synth.Vhdl_Context is return Get_Partial_Memtyp_Net (Ctxt, Val, 0, Val.Typ.W); end Get_Memtyp_Net; + function To_Net is new Ada.Unchecked_Conversion (Uns32, Net); + function To_Uns32 is new Ada.Unchecked_Conversion (Net, Uns32); + + function Get_Value_Net (Val : Value_Acc) return Net is + begin + return To_Net (Val.N); + end Get_Value_Net; + + procedure Set_Value_Net (Val : Value_Acc; N : Net) is + begin + Val.N := To_Uns32 (N); + end Set_Value_Net; + + function Get_Value_Wire (Val : Value_Acc) return Wire_Id + is + function To_Wire_Id is new Ada.Unchecked_Conversion (Uns32, Wire_Id); + begin + return To_Wire_Id (Val.N); + end Get_Value_Wire; + + procedure Set_Value_Wire (Val : Value_Acc; W : Wire_Id) + is + function To_Uns32 is new Ada.Unchecked_Conversion (Wire_Id, Uns32); + begin + Val.N := To_Uns32 (W); + end Set_Value_Wire; + + function Create_Value_Wire (W : Wire_Id) return Value_Acc + is + function To_Uns32 is new Ada.Unchecked_Conversion (Wire_Id, Uns32); + begin + return Create_Value_Wire (To_Uns32 (W)); + end Create_Value_Wire; + + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp + is + pragma Assert (Wtype /= null); + begin + return (Wtype, Create_Value_Wire (W)); + end Create_Value_Wire; + + function Create_Value_Net (N : Net) return Value_Acc + is + function To_Uns32 is new Ada.Unchecked_Conversion (Net, Uns32); + begin + return Create_Value_Net (To_Uns32 (N)); + end Create_Value_Net; + + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp + is + pragma Assert (Ntype /= null); + begin + return (Ntype, Create_Value_Net (N)); + end Create_Value_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); + return Get_Current_Value (Ctxt, Get_Value_Wire (Val.Val)); when Value_Net => - return Val.Val.N; + return Get_Value_Net (Val.Val); 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); + Res := Get_Current_Value + (Ctxt, Get_Value_Wire (Val.Val.A_Obj)); return Build2_Extract (Ctxt, Res, Val.Val.A_Off.Net_Off, Val.Typ.W); else @@ -550,16 +396,51 @@ package body Synth.Vhdl_Context is 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; + declare + N : Net; + begin + N := To_Net (Val.Val.C_Net); + if N = No_Net then + N := Get_Net (Ctxt, (Val.Typ, Val.Val.C_Val)); + Val.Val.C_Net := To_Uns32 (N); + Locations.Set_Location (Get_Net_Parent (N), + Get_Location (Val.Val.C_Loc)); + end if; + return N; + end; when Value_Memory => return Get_Memtyp_Net (Ctxt, Get_Memtyp (Val)); when others => raise Internal_Error; end case; end Get_Net; + + function Is_Static_Val (Val : Value_Acc) return Boolean is + begin + case Val.Kind is + when Value_Memory => + return True; + when Value_Net + | Value_Signal => + return False; + when Value_Wire => + declare + W : constant Wire_Id := Get_Value_Wire (Val); + begin + if Get_Kind (W) = Wire_Variable then + return Is_Static_Wire (W); + else + -- A signal does not have static values. + return False; + end if; + end; + when Value_File => + return True; + when Value_Const => + return True; + when Value_Alias => + return Is_Static_Val (Val.A_Obj); + end case; + end Is_Static_Val; + end Synth.Vhdl_Context; diff --git a/src/synth/synth-vhdl_context.ads b/src/synth/synth-vhdl_context.ads index 2329c4c0d..df3e83d6a 100644 --- a/src/synth/synth-vhdl_context.ads +++ b/src/synth/synth-vhdl_context.ads @@ -18,52 +18,49 @@ with Types; use Types; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; -with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; -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 (Base : Base_Instance_Acc) - return Synth_Instance_Acc; + -- Create the root instance. + procedure Make_Base_Instance (Base : Base_Instance_Acc); -- Free the first instance. procedure Free_Base_Instance; - -- Create and free the corresponding synth instance. + -- Create a synth instance. + procedure Set_Extra (Inst : Synth_Instance_Acc; + Base : Base_Instance_Acc; + Name : Sname := No_Sname); + + procedure Set_Extra (Inst :Synth_Instance_Acc; + Parent : Synth_Instance_Acc; + Name : Sname := No_Sname); + function Make_Instance (Parent : Synth_Instance_Acc; Blk : Node; Name : Sname := No_Sname) return Synth_Instance_Acc; + procedure Free_Instance (Synth_Inst : in out 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); @@ -79,45 +76,12 @@ package Synth.Vhdl_Context is -- 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; @@ -125,74 +89,29 @@ package Synth.Vhdl_Context is (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; + -- Can also return true for nets and wires. + -- Use Get_Static_Discrete to get the value. + function Is_Static_Val (Val : Value_Acc) return Boolean; - -- Return the type for DECL (a subtype indication). - function Get_Subtype_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc; + function Get_Value_Net (Val : Value_Acc) return Net; + pragma Inline (Get_Value_Net); + procedure Set_Value_Net (Val : Value_Acc; N : Net); + pragma Inline (Set_Value_Net); + function Get_Value_Wire (Val : Value_Acc) return Wire_Id; + pragma Inline (Get_Value_Wire); + procedure Set_Value_Wire (Val : Value_Acc; W : Wire_Id); + pragma Inline (Set_Value_Wire); - -- Return the scope of the parent of BLK. Deals with architecture bodies. - function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc; + -- Create a Value_Net. + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; - procedure Set_Uninstantiated_Scope - (Syn_Inst : Synth_Instance_Acc; Bod : Node); + -- Create a Value_Wire. For a bit wire, RNG must be null. + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; 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 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; - + type Extra_Vhdl_Instance_Type is record 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/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index e2d130631..8b54c94bd 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -17,7 +17,6 @@ -- along with this program. If not, see <gnu.org/licenses>. with Types; use Types; -with Mutils; use Mutils; with Std_Names; with Netlists.Builders; use Netlists.Builders; @@ -28,45 +27,49 @@ with Netlists.Gates; with Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; -with Vhdl.Ieee.Std_Logic_1164; + +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Decls; use Elab.Vhdl_Decls; +with Elab.Vhdl_Files; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Stmts; with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; -with Synth.Vhdl_Files; -with Synth.Values; use Synth.Values; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Decls is - procedure Create_Var_Wire - (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Valtyp) + function Create_Var_Wire (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Kind : Wire_Kind; + Init : Valtyp) return Valtyp is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Vt : constant Valtyp := Get_Value (Syn_Inst, Decl); Value : Net; Ival : Net; W : Width; Name : Sname; + Wid : Wire_Id; begin - case Vt.Val.Kind is - when Value_Wire => - -- FIXME: get the width directly from the wire ? - W := Get_Type_Width (Vt.Typ); - Name := New_Sname_User (Get_Identifier (Decl), - Get_Sname (Syn_Inst)); - if Init /= No_Valtyp then - Ival := Get_Net (Ctxt, Init); - pragma Assert (Get_Width (Ival) = W); - Value := Build_Isignal (Ctxt, Name, Ival); - else - Value := Build_Signal (Ctxt, Name, W); - end if; - Set_Location (Value, Decl); - Set_Wire_Gate (Vt.Val.W, Value); - when others => - raise Internal_Error; - end case; + Wid := Alloc_Wire (Kind, (Decl, Init.Typ)); + + -- FIXME: get the width directly from the wire ? + W := Get_Type_Width (Init.Typ); + Name := New_Sname_User (Get_Identifier (Decl), + Get_Sname (Syn_Inst)); + if Init.Val /= null then + Ival := Get_Net (Ctxt, Init); + pragma Assert (Get_Width (Ival) = W); + Value := Build_Isignal (Ctxt, Name, Ival); + else + Value := Build_Signal (Ctxt, Name, W); + end if; + Set_Location (Value, Decl); + + Set_Wire_Gate (Wid, Value); + return Create_Value_Wire (Wid, Init.Typ); end Create_Var_Wire; function Type_To_Param_Type (Atype : Node) return Param_Type @@ -119,403 +122,6 @@ package body Synth.Vhdl_Decls is return Pv; end Memtyp_To_Pval; - procedure Synth_Subtype_Indication_If_Anonymous - (Syn_Inst : Synth_Instance_Acc; Atype : Node) is - begin - if Get_Type_Declarator (Atype) = Null_Node then - Synth_Subtype_Indication (Syn_Inst, Atype); - end if; - end Synth_Subtype_Indication_If_Anonymous; - - function Synth_Subtype_Indication_If_Anonymous - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is - begin - if Get_Type_Declarator (Atype) = Null_Node then - return Synth_Subtype_Indication (Syn_Inst, Atype); - else - return Get_Subtype_Object (Syn_Inst, Atype); - end if; - end Synth_Subtype_Indication_If_Anonymous; - - function Synth_Array_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - El_Type : constant Node := Get_Element_Subtype (Def); - Ndims : constant Natural := Get_Nbr_Dimensions (Def); - El_Typ : Type_Acc; - Typ : Type_Acc; - begin - Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); - El_Typ := Get_Subtype_Object (Syn_Inst, El_Type); - - if El_Typ.Kind in Type_Nets and then Ndims = 1 then - Typ := Create_Unbounded_Vector (El_Typ); - else - Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ); - end if; - return Typ; - end Synth_Array_Type_Definition; - - function Synth_Record_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - El_List : constant Node_Flist := Get_Elements_Declaration_List (Def); - Rec_Els : Rec_El_Array_Acc; - El : Node; - El_Type : Node; - El_Typ : Type_Acc; - begin - Rec_Els := Create_Rec_El_Array - (Iir_Index32 (Get_Nbr_Elements (El_List))); - - for I in Flist_First .. Flist_Last (El_List) loop - El := Get_Nth_Element (El_List, I); - El_Type := Get_Type (El); - El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); - Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ; - end loop; - - if not Is_Fully_Constrained_Type (Def) then - return Create_Unbounded_Record (Rec_Els); - else - return Create_Record_Type (Rec_Els); - end if; - end Synth_Record_Type_Definition; - - function Synth_Access_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - Des_Type : constant Node := Get_Designated_Type (Def); - Des_Typ : Type_Acc; - Typ : Type_Acc; - begin - Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type); - Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type); - - Typ := Create_Access_Type (Des_Typ); - return Typ; - end Synth_Access_Type_Definition; - - function Synth_File_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def)); - File_Typ : Type_Acc; - Typ : Type_Acc; - Sig : String_Acc; - begin - File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); - - if Get_Text_File_Flag (Def) - or else - Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition - then - Sig := null; - else - declare - Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2); - Off : Natural := Sig_Str'First; - begin - Get_File_Signature (File_Type, Sig_Str, Off); - Sig_Str (Off + 0) := '.'; - Sig_Str (Off + 1) := ASCII.NUL; - Sig := new String'(Sig_Str); - end; - end if; - - Typ := Create_File_Type (File_Typ); - Typ.File_Signature := Sig; - - return Typ; - end Synth_File_Type_Definition; - - function Scalar_Size_To_Size (Def : Node) return Size_Type is - begin - case Get_Scalar_Size (Def) is - when Scalar_8 => - return 1; - when Scalar_16 => - return 2; - when Scalar_32 => - return 4; - when Scalar_64 => - return 8; - end case; - end Scalar_Size_To_Size; - - procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) - is - Typ : Type_Acc; - begin - case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition => - if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type - or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type - then - Typ := Logic_Type; - elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then - Typ := Boolean_Type; - elsif Def = Vhdl.Std_Package.Bit_Type_Definition then - Typ := Bit_Type; - else - declare - Nbr_El : constant Natural := - Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)); - Rng : Discrete_Range_Type; - W : Width; - begin - W := Uns32 (Clog2 (Uns64 (Nbr_El))); - Rng := (Dir => Dir_To, - Is_Signed => False, - Left => 0, - Right => Int64 (Nbr_El - 1)); - Typ := Create_Discrete_Type - (Rng, Scalar_Size_To_Size (Def), W); - end; - end if; - when Iir_Kind_Array_Type_Definition => - Typ := Synth_Array_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Access_Type_Definition => - Typ := Synth_Access_Type_Definition (Syn_Inst, Def); - when Iir_Kind_File_Type_Definition => - Typ := Synth_File_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Record_Type_Definition => - Typ := Synth_Record_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Protected_Type_Declaration => - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Def)); - when others => - Vhdl.Errors.Error_Kind ("synth_type_definition", Def); - end case; - if Typ /= null then - Create_Subtype_Object (Syn_Inst, Def, Typ); - end if; - end Synth_Type_Definition; - - procedure Synth_Anonymous_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node) - is - Typ : Type_Acc; - begin - case Get_Kind (Def) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Physical_Type_Definition => - declare - Cst : constant Node := Get_Range_Constraint (St); - L, R : Int64; - Rng : Discrete_Range_Type; - W : Width; - begin - L := Get_Value (Get_Left_Limit (Cst)); - R := Get_Value (Get_Right_Limit (Cst)); - Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst)); - W := Discrete_Range_Width (Rng); - Typ := Create_Discrete_Type - (Rng, Scalar_Size_To_Size (Def), W); - end; - when Iir_Kind_Floating_Type_Definition => - declare - Cst : constant Node := Get_Range_Constraint (St); - L, R : Fp64; - Rng : Float_Range_Type; - begin - L := Get_Fp_Value (Get_Left_Limit (Cst)); - R := Get_Fp_Value (Get_Right_Limit (Cst)); - Rng := (Get_Direction (Cst), L, R); - Typ := Create_Float_Type (Rng); - end; - when Iir_Kind_Array_Type_Definition => - Typ := Synth_Array_Type_Definition (Syn_Inst, Def); - when others => - Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def); - end case; - Create_Subtype_Object (Syn_Inst, Def, Typ); - end Synth_Anonymous_Type_Definition; - - function Synth_Discrete_Range_Constraint - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type - is - Res : Discrete_Range_Type; - begin - Synth_Discrete_Range (Syn_Inst, Rng, Res); - return Res; - end Synth_Discrete_Range_Constraint; - - function Synth_Float_Range_Constraint - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is - begin - case Get_Kind (Rng) is - when Iir_Kind_Range_Expression => - -- FIXME: check range. - return Synth_Float_Range_Expression (Syn_Inst, Rng); - when others => - Vhdl.Errors.Error_Kind ("synth_float_range_constraint", Rng); - end case; - end Synth_Float_Range_Constraint; - - function Has_Element_Subtype_Indication (Atype : Node) return Boolean is - begin - return Get_Array_Element_Constraint (Atype) /= Null_Node - or else - (Get_Resolution_Indication (Atype) /= Null_Node - and then - (Get_Kind (Get_Resolution_Indication (Atype)) - = Iir_Kind_Array_Element_Resolution)); - end Has_Element_Subtype_Indication; - - function Synth_Array_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc - is - El_Type : constant Node := Get_Element_Subtype (Atype); - St_Indexes : constant Node_Flist := Get_Index_Subtype_List (Atype); - Ptype : Node; - St_El : Node; - Btyp : Type_Acc; - Etyp : Type_Acc; - Bnds : Bound_Array_Acc; - begin - -- VHDL08 - if Has_Element_Subtype_Indication (Atype) then - -- This subtype has created a new anonymous subtype for the - -- element. - Synth_Subtype_Indication (Syn_Inst, El_Type); - end if; - - if not Get_Index_Constraint_Flag (Atype) then - Ptype := Get_Type (Get_Subtype_Type_Mark (Atype)); - if Get_Element_Subtype (Ptype) = Get_Element_Subtype (Atype) then - -- That's an alias. - -- FIXME: maybe a resolution function was added? - -- FIXME: also handle resolution added in element subtype. - return Get_Subtype_Object (Syn_Inst, Ptype); - end if; - end if; - - Btyp := Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); - case Btyp.Kind is - when Type_Unbounded_Vector => - if Get_Index_Constraint_Flag (Atype) then - St_El := Get_Index_Type (St_Indexes, 0); - return Create_Vector_Type - (Synth_Bounds_From_Range (Syn_Inst, St_El), Btyp.Uvec_El); - else - -- An alias. - -- Handle vhdl08 definition of std_logic_vector from - -- std_ulogic_vector. - return Btyp; - end if; - when Type_Unbounded_Array => - -- FIXME: partially constrained arrays, subtype in indexes... - Etyp := Get_Subtype_Object (Syn_Inst, El_Type); - if Get_Index_Constraint_Flag (Atype) then - Bnds := Create_Bound_Array - (Dim_Type (Get_Nbr_Elements (St_Indexes))); - for I in Flist_First .. Flist_Last (St_Indexes) loop - St_El := Get_Index_Type (St_Indexes, I); - Bnds.D (Dim_Type (I + 1)) := - Synth_Bounds_From_Range (Syn_Inst, St_El); - end loop; - return Create_Array_Type (Bnds, Etyp); - else - raise Internal_Error; - end if; - when others => - raise Internal_Error; - end case; - end Synth_Array_Subtype_Indication; - - function Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is - begin - -- TODO: handle aliases directly. - case Get_Kind (Atype) is - when Iir_Kind_Array_Subtype_Definition => - return Synth_Array_Subtype_Indication (Syn_Inst, Atype); - when Iir_Kind_Record_Subtype_Definition => - return Synth_Record_Type_Definition (Syn_Inst, Atype); - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - declare - Btype : constant Type_Acc := - Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); - Rng : Discrete_Range_Type; - W : Width; - begin - if Btype.Kind in Type_Nets then - -- A subtype of a bit/logic type is still a bit/logic. - -- FIXME: bounds. - return Btype; - else - Rng := Synth_Discrete_Range_Constraint - (Syn_Inst, Get_Range_Constraint (Atype)); - W := Discrete_Range_Width (Rng); - return Create_Discrete_Type (Rng, Btype.Sz, W); - end if; - end; - when Iir_Kind_Floating_Subtype_Definition => - declare - Rng : Float_Range_Type; - begin - Rng := Synth_Float_Range_Constraint - (Syn_Inst, Get_Range_Constraint (Atype)); - return Create_Float_Type (Rng); - end; - when others => - Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype); - end case; - end Synth_Subtype_Indication; - - procedure Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) - is - Typ : Type_Acc; - begin - Typ := Synth_Subtype_Indication (Syn_Inst, Atype); - Create_Subtype_Object (Syn_Inst, Atype, Typ); - end Synth_Subtype_Indication; - - function Get_Declaration_Type (Decl : Node) return Node - is - Ind : constant Node := Get_Subtype_Indication (Decl); - Atype : Node; - begin - if Get_Is_Ref (Decl) or else Ind = Null_Iir then - -- A secondary declaration in a list. - return Null_Node; - end if; - Atype := Ind; - loop - case Get_Kind (Atype) is - when Iir_Kinds_Denoting_Name => - Atype := Get_Named_Entity (Atype); - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Type_Declaration => - -- Type already declared, so already handled. - return Null_Node; - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - return Atype; - when others => - Vhdl.Errors.Error_Kind ("get_declaration_type", Atype); - end case; - end loop; - end Get_Declaration_Type; - - procedure Synth_Declaration_Type - (Syn_Inst : Synth_Instance_Acc; Decl : Node) - is - Atype : constant Node := Get_Declaration_Type (Decl); - begin - if Atype = Null_Node then - return; - end if; - Synth_Subtype_Indication (Syn_Inst, Atype); - end Synth_Declaration_Type; - procedure Synth_Constant_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean; @@ -529,7 +135,7 @@ package body Synth.Vhdl_Decls is Cst : Valtyp; Obj_Type : Type_Acc; begin - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); if Deferred_Decl = Null_Node or else Get_Deferred_Declaration_Flag (Decl) then @@ -616,7 +222,7 @@ package body Synth.Vhdl_Decls is | Iir_Kind_Interface_Signal_Declaration => V := Get_Value (Syn_Inst, Obj); pragma Assert (V.Val.Kind = Value_Wire); - Inst := Get_Net_Parent (Get_Wire_Gate (V.Val.W)); + Inst := Get_Net_Parent (Get_Wire_Gate (Get_Value_Wire (V.Val))); when Iir_Kind_Component_Instantiation_Statement => -- TODO return; @@ -667,59 +273,30 @@ package body Synth.Vhdl_Decls is Create_Object (Syn_Inst, Value, Val); -- Unshare (Val, Instance_Pool); - if not Get_Instance_Const (Syn_Inst) then - Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val); - end if; - Value := Get_Spec_Chain (Value); end loop; end Synth_Attribute_Specification; - procedure Synth_Subprogram_Declaration - (Syn_Inst : Synth_Instance_Acc; Subprg : Node) + procedure Synth_Concurrent_Attribute_Specification + (Syn_Inst : Synth_Instance_Acc; Spec : Node) is - Inter : Node; + Attr_Decl : constant Node := + Get_Named_Entity (Get_Attribute_Designator (Spec)); + Value : Node; + Val : Valtyp; begin - if Is_Second_Subprogram_Specification (Subprg) then - -- Already handled. + if Get_Instance_Const (Syn_Inst) then return; end if; - Inter := Get_Interface_Declaration_Chain (Subprg); - while Inter /= Null_Node loop - Synth_Declaration_Type (Syn_Inst, Inter); - Inter := Get_Chain (Inter); - end loop; - end Synth_Subprogram_Declaration; - - procedure Synth_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc) - is - use Vhdl.Std_Package; - begin - Create_Subtype_Object - (Syn_Inst, Convertible_Integer_Type_Definition, - Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition)); - Create_Subtype_Object - (Syn_Inst, Convertible_Real_Type_Definition, - Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition)); - end Synth_Convertible_Declarations; + Value := Get_Attribute_Value_Spec_Chain (Spec); + while Value /= Null_Iir loop + Val := Get_Value (Syn_Inst, Value); + Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val); - function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; - Pkg : Node) - return Synth_Instance_Acc - is - Syn_Inst : Synth_Instance_Acc; - begin - Syn_Inst := Make_Instance (Parent_Inst, Pkg); - if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then - -- Global package. - Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True); - else - -- Local package: check elaboration order. - Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False); - end if; - return Syn_Inst; - end Create_Package_Instance; + Value := Get_Spec_Chain (Value); + end loop; + end Synth_Concurrent_Attribute_Specification; procedure Synth_Package_Declaration (Parent_Inst : Synth_Instance_Acc; Pkg : Node) @@ -731,12 +308,10 @@ package body Synth.Vhdl_Decls is return; end if; - Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg); + Syn_Inst := Get_Package_Object (Parent_Inst, Pkg); + Set_Extra (Syn_Inst, Parent_Inst, No_Sname); - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); - if Pkg = Vhdl.Std_Package.Standard_Package then - Synth_Convertible_Declarations (Syn_Inst); - end if; + Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); end Synth_Package_Declaration; procedure Synth_Package_Body @@ -751,97 +326,18 @@ package body Synth.Vhdl_Decls is Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg); - Synth_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); + Synth_Concurrent_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); end Synth_Package_Body; - procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node) - is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Inter : Node; - Inter_Type : Type_Acc; - Assoc : Node; - Assoc_Inter : Node; - Actual : Node; - Val : Valtyp; - begin - Assoc := Assoc_Chain; - Assoc_Inter := Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is - when Iir_Kind_Interface_Constant_Declaration => - Synth_Declaration_Type (Sub_Inst, Inter); - Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); - - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_Open => - Actual := Get_Default_Value (Inter); - Val := Synth_Expression_With_Type - (Sub_Inst, Actual, Inter_Type); - when Iir_Kind_Association_Element_By_Expression => - Actual := Get_Actual (Assoc); - Val := Synth_Expression_With_Type - (Syn_Inst, Actual, Inter_Type); - when others => - raise Internal_Error; - end case; - - Val := Synth_Subtype_Conversion - (Ctxt, Val, Inter_Type, True, Assoc); - - if Val = No_Valtyp then - Set_Error (Sub_Inst); - elsif not Is_Static (Val.Val) then - Error_Msg_Synth - (+Assoc, "value of generic %i must be static", +Inter); - Val := No_Valtyp; - Set_Error (Sub_Inst); - end if; - - Create_Object (Sub_Inst, Inter, Val); - - when Iir_Kind_Interface_Package_Declaration => - declare - Actual : constant Iir := - Strip_Denoting_Name (Get_Actual (Assoc)); - Pkg_Inst : Synth_Instance_Acc; - begin - Pkg_Inst := Get_Package_Object (Sub_Inst, Actual); - Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst); - end; - - when Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_Quantity_Declaration - | Iir_Kind_Interface_Terminal_Declaration => - raise Internal_Error; - - when Iir_Kinds_Interface_Subprogram_Declaration - | Iir_Kind_Interface_Type_Declaration => - raise Internal_Error; - end case; - - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - end Synth_Generics_Association; - procedure Synth_Package_Instantiation (Parent_Inst : Synth_Instance_Acc; Pkg : Node) is Bod : constant Node := Get_Instance_Package_Body (Pkg); Sub_Inst : Synth_Instance_Acc; begin - Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg); - - Synth_Generics_Association - (Sub_Inst, Parent_Inst, - Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg)); + Sub_Inst := Get_Package_Object (Parent_Inst, Pkg); - Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); + Synth_Concurrent_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); if Bod /= Null_Node then -- Macro expanded package instantiation. @@ -855,7 +351,7 @@ package body Synth.Vhdl_Decls is Set_Uninstantiated_Scope (Sub_Inst, Uninst); -- Synth declarations of (optional) body. if Uninst_Bod /= Null_Node then - Synth_Declarations + Synth_Concurrent_Declarations (Sub_Inst, Get_Declaration_Chain (Uninst_Bod)); end if; end; @@ -870,10 +366,11 @@ package body Synth.Vhdl_Decls is Def : constant Node := Get_Default_Value (Decl); Decl_Type : constant Node := Get_Type (Decl); Init : Valtyp; + Val : Valtyp; Obj_Typ : Type_Acc; Wid : Wire_Id; begin - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then Error_Msg_Synth (+Decl, "protected type variable is not synthesizable"); @@ -910,9 +407,9 @@ package body Synth.Vhdl_Decls is Init := Unshare (Init, Current_Pool); Create_Object (Syn_Inst, Decl, Init); else - Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); - Create_Var_Wire (Syn_Inst, Decl, Init); - Wid := Get_Value (Syn_Inst, Decl).Val.W; + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init); + Create_Object (Syn_Inst, Decl, Val); + Wid := Get_Value_Wire (Val.Val); if Is_Subprg then if Is_Static (Init.Val) then Phi_Assign_Static (Wid, Get_Memtyp (Init)); @@ -924,36 +421,39 @@ package body Synth.Vhdl_Decls is end if; end Synth_Variable_Declaration; + procedure Synth_Shared_Variable_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) + is + Init : Valtyp; + Val : Valtyp; + begin + Init := Get_Value (Syn_Inst, Decl); + + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init); + Mutate_Object (Syn_Inst, Decl, Val); + end Synth_Shared_Variable_Declaration; + procedure Synth_Signal_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Def : constant Iir := Get_Default_Value (Decl); - -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + Prev : Valtyp; Init : Valtyp; - Obj_Typ : Type_Acc; + Val : Valtyp; begin - Synth_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Get_Parent (Decl)) = Iir_Kind_Package_Declaration then Error_Msg_Synth (+Decl, "signals in packages are not supported"); - -- Avoid elaboration error. - Create_Object (Syn_Inst, Decl, No_Valtyp); return; end if; - Create_Wire_Object (Syn_Inst, Wire_Signal, Decl); - if Is_Valid (Def) then - Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); - Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); - Init := Synth_Subtype_Conversion (Ctxt, Init, Obj_Typ, False, Decl); - if not Is_Static (Init.Val) then - Error_Msg_Synth (+Decl, "signals cannot be used in default value " - & "of a signal"); - end if; + Prev := Get_Value (Syn_Inst, Decl); + if Prev.Val.Init = null then + Init := (Prev.Typ, null); else - Init := No_Valtyp; + Init := (Prev.Typ, Prev.Val.Init); end if; - Create_Var_Wire (Syn_Inst, Decl, Init); + + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Signal, Init); + Replace_Signal (Syn_Inst, Decl, Val); end Synth_Signal_Declaration; procedure Synth_Object_Alias_Declaration @@ -983,7 +483,8 @@ package body Synth.Vhdl_Decls is -- Object is a net if it is not writable. Extract the -- bits for the alias. Res := Create_Value_Net - (Build2_Extract (Ctxt, Base.Val.N, Off.Net_Off, Typ.W), + (Build2_Extract (Ctxt, + Get_Value_Net (Base.Val), Off.Net_Off, Typ.W), Typ); else Res := Create_Value_Alias (Base, Off, Typ); @@ -994,6 +495,36 @@ package body Synth.Vhdl_Decls is Create_Object (Syn_Inst, Decl, Res); end Synth_Object_Alias_Declaration; + procedure Synth_Concurrent_Object_Alias_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Val : Valtyp; + Aval : Valtyp; + Obj : Value_Acc; + Base : Node; + begin + Val := Get_Value (Syn_Inst, Decl); + pragma Assert (Val.Val.Kind = Value_Alias); + Obj := Val.Val.A_Obj; + if Obj.Kind = Value_Signal then + -- A signal must have been changed to a wire or a net, but the + -- aliases have not been updated. Update here. + Base := Get_Base_Name (Get_Name (Decl)); + Aval := Synth_Expression (Syn_Inst, Base); + + if Aval.Val.Kind = Value_Net then + -- Object is a net if it is not writable. Extract the + -- bits for the alias. + Aval := Create_Value_Net + (Build2_Extract (Get_Build (Syn_Inst), Get_Value_Net (Aval.Val), + Val.Val.A_Off.Net_Off, Val.Typ.W), + Val.Typ); + Val.Val.A_Off := (0, 0); + end if; + Val.Val.A_Obj := Aval.Val; + end if; + end Synth_Concurrent_Object_Alias_Declaration; + procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean; @@ -1004,8 +535,15 @@ package body Synth.Vhdl_Decls is Synth_Variable_Declaration (Syn_Inst, Decl, Is_Subprg); when Iir_Kind_Interface_Variable_Declaration => -- Ignore default value. - Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); - Create_Var_Wire (Syn_Inst, Decl, No_Valtyp); + declare + Val : Valtyp; + Obj_Typ : Type_Acc; + begin + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + Val := Create_Var_Wire + (Syn_Inst, Decl, Wire_Variable, (Obj_Typ, null)); + Create_Object (Syn_Inst, Decl, Val); + end; when Iir_Kind_Constant_Declaration => Synth_Constant_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type); when Iir_Kind_Signal_Declaration => @@ -1015,7 +553,7 @@ package body Synth.Vhdl_Decls is Synth_Object_Alias_Declaration (Syn_Inst, Decl); when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => - Synth_Subprogram_Declaration (Syn_Inst, Decl); + Elab_Subprogram_Declaration (Syn_Inst, Decl); when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => null; @@ -1028,13 +566,13 @@ package body Synth.Vhdl_Decls is when Iir_Kind_Attribute_Specification => Synth_Attribute_Specification (Syn_Inst, Decl); when Iir_Kind_Type_Declaration => - Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); + Elab_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); when Iir_Kind_Anonymous_Type_Declaration => - Synth_Anonymous_Type_Definition + Elab_Anonymous_Type_Definition (Syn_Inst, Get_Type_Definition (Decl), Get_Subtype_Definition (Decl)); when Iir_Kind_Subtype_Declaration => - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); when Iir_Kind_Component_Declaration => null; when Iir_Kind_File_Declaration => @@ -1043,7 +581,7 @@ package body Synth.Vhdl_Decls is Res : Valtyp; Obj_Typ : Type_Acc; begin - F := Synth.Vhdl_Files.Elaborate_File_Declaration + F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl); Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); Res := Create_Value_File (Obj_Typ, F); @@ -1067,7 +605,7 @@ package body Synth.Vhdl_Decls is end Synth_Declaration; procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False) is Decl : Node; @@ -1093,6 +631,7 @@ package body Synth.Vhdl_Decls is Gate : Instance; Drv : Net; Def_Val : Net; + W : Wire_Id; begin Vt := Get_Value (Syn_Inst, Decl); if Vt = No_Valtyp then @@ -1105,9 +644,11 @@ package body Synth.Vhdl_Decls is return; end if; - Finalize_Assignment (Get_Build (Syn_Inst), Vt.Val.W); + W := Get_Value_Wire (Vt.Val); + + Finalize_Assignment (Get_Build (Syn_Inst), W); - Gate_Net := Get_Wire_Gate (Vt.Val.W); + Gate_Net := Get_Wire_Gate (W); Gate := Get_Net_Parent (Gate_Net); case Get_Id (Gate) is when Id_Signal @@ -1147,7 +688,7 @@ package body Synth.Vhdl_Decls is Connect (Get_Input (Gate, 0), Def_Val); end if; - Free_Wire (Vt.Val.W); + Free_Wire (W); end Finalize_Signal; procedure Finalize_Declaration @@ -1203,10 +744,10 @@ package body Synth.Vhdl_Decls is end Finalize_Declaration; procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False) is - Decl : Iir; + Decl : Node; begin Decl := Decls; while Is_Valid (Decl) loop @@ -1215,4 +756,50 @@ package body Synth.Vhdl_Decls is Decl := Get_Chain (Decl); end loop; end Finalize_Declarations; + + procedure Synth_Concurrent_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Signal_Declaration => + Synth_Signal_Declaration (Syn_Inst, Decl); + when Iir_Kind_Variable_Declaration => + Synth_Shared_Variable_Declaration (Syn_Inst, Decl); + when Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Configuration_Specification + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Use_Clause => + -- Fully handled during elaboration. + null; + when Iir_Kind_Object_Alias_Declaration => + Synth_Concurrent_Object_Alias_Declaration (Syn_Inst, Decl); + when Iir_Kind_Attribute_Specification => + Synth_Concurrent_Attribute_Specification (Syn_Inst, Decl); + when others => + Vhdl.Errors.Error_Kind ("synth_concurrent_declaration", Decl); + end case; + end Synth_Concurrent_Declaration; + + procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Node) + is + Decl : Node; + begin + Decl := Decls; + while Decl /= Null_Node loop + Synth_Concurrent_Declaration (Syn_Inst, Decl); + Decl := Get_Chain (Decl); + end loop; + end Synth_Concurrent_Declarations; end Synth.Vhdl_Decls; diff --git a/src/synth/synth-vhdl_decls.ads b/src/synth/synth-vhdl_decls.ads index fa1569430..5ad59853e 100644 --- a/src/synth/synth-vhdl_decls.ads +++ b/src/synth/synth-vhdl_decls.ads @@ -18,9 +18,10 @@ with Vhdl.Nodes; use Vhdl.Nodes; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; + with Netlists; use Netlists; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; -with Synth.Objtypes; use Synth.Objtypes; package Synth.Vhdl_Decls is -- Return the Param_Type for ATYPE. @@ -29,23 +30,7 @@ package Synth.Vhdl_Decls is -- Convert MT to a Pval. function Memtyp_To_Pval (Mt : Memtyp) return Pval; - -- Get the type of DECL iff it is standalone (not an already existing - -- subtype). - function Get_Declaration_Type (Decl : Node) return Node; - - -- True if the element subtype indication of ATYPE needs to be created. - function Has_Element_Subtype_Indication (Atype : Node) return Boolean; - - function Synth_Array_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; - - procedure Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node); - function Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; - - -- Elaborate the type of DECL. - procedure Synth_Declaration_Type + procedure Synth_Object_Alias_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node); procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; @@ -54,14 +39,19 @@ package Synth.Vhdl_Decls is Last_Type : in out Node); procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False); + procedure Synth_Concurrent_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node); + procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Node); + procedure Finalize_Declaration (Syn_Inst : Synth_Instance_Acc; - Decl : Iir; + Decl : Node; Is_Subprg : Boolean); procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False); procedure Synth_Package_Declaration @@ -69,11 +59,6 @@ package Synth.Vhdl_Decls is procedure Synth_Package_Body (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node); - procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node); - procedure Synth_Package_Instantiation (Parent_Inst : Synth_Instance_Acc; Pkg : Node); end Synth.Vhdl_Decls; diff --git a/src/synth/synth-vhdl_environment.ads b/src/synth/synth-vhdl_environment.ads index e9bf6129f..1a65b2a07 100644 --- a/src/synth/synth-vhdl_environment.ads +++ b/src/synth/synth-vhdl_environment.ads @@ -23,10 +23,10 @@ with Netlists.Builders; with Vhdl.Nodes; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; + with Synth.Environment; with Synth.Environment.Debug; -with Synth.Objtypes; use Synth.Objtypes; --- with Synth_Vhdl.Context; package Synth.Vhdl_Environment is @@ -52,7 +52,7 @@ package Synth.Vhdl_Environment is package Env is new Synth.Environment (Decl_Type => Decl_Type, - Static_Type => Standard.Synth.Objtypes.Memtyp, + Static_Type => Elab.Vhdl_Objtypes.Memtyp, Get_Width => Get_Bitwidth, Is_Equal => Is_Equal, Static_To_Net => Memtyp_To_Net, diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index 1b0030b2c..2717d5eec 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -39,15 +39,17 @@ with Netlists.Folds; use Netlists.Folds; with Netlists.Utils; use Netlists.Utils; with Netlists.Locations; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Debugger; + with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Environment; -with Synth.Vhdl_Decls; with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; -with Synth.Vhdl_Heap; use Synth.Vhdl_Heap; -with Synth.Debugger; with Synth.Vhdl_Aggr; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Grt.Types; with Grt.To_Strings; @@ -67,7 +69,8 @@ package body Synth.Vhdl_Expr is when Value_Const => return Get_Memtyp (V); when Value_Wire => - return Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W); + return Synth.Vhdl_Environment.Env.Get_Static_Wire + (Get_Value_Wire (V.Val)); when Value_Alias => declare Res : Memtyp; @@ -89,7 +92,8 @@ package body Synth.Vhdl_Expr is return Read_Discrete (Get_Memtyp (V)); when Value_Wire => return Read_Discrete - (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W)); + (Synth.Vhdl_Environment.Env.Get_Static_Wire + (Get_Value_Wire (V.Val))); when others => raise Internal_Error; end case; @@ -107,15 +111,19 @@ package body Synth.Vhdl_Expr is | Value_Memory => return Read_Discrete (Get_Memtyp (V)) >= 0; when Value_Net => - N := V.Val.N; + N := Get_Value_Net (V.Val); when Value_Wire => - if Get_Kind (V.Val.W) = Wire_Variable - and then Is_Static_Wire (V.Val.W) - then - return Read_Discrete (Get_Static_Wire (V.Val.W)) >= 0; - else - return False; - end if; + declare + W : constant Wire_Id := Get_Value_Wire (V.Val); + begin + if Get_Kind (W) = Wire_Variable + and then Is_Static_Wire (W) + then + return Read_Discrete (Get_Static_Wire (W)) >= 0; + else + return False; + end if; + end; when others => raise Internal_Error; end case; @@ -429,206 +437,6 @@ package body Synth.Vhdl_Expr is N := Arr (Arr'First); end Concat_Array; - function Build_Discrete_Range_Type - (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type is - begin - return (Dir => Dir, - Left => L, - Right => R, - Is_Signed => L < 0 or R < 0); - end Build_Discrete_Range_Type; - - function Synth_Discrete_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type - is - L, R : Valtyp; - Lval, Rval : Int64; - begin - -- Static values. - L := Synth_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); - R := Synth_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng)); - Strip_Const (L); - Strip_Const (R); - - if not (Is_Static (L.Val) and Is_Static (R.Val)) then - Error_Msg_Synth (+Rng, "limits of range are not constant"); - Set_Error (Syn_Inst); - return (Dir => Get_Direction (Rng), - Left => 0, - Right => 0, - Is_Signed => False); - end if; - - Lval := Read_Discrete (L); - Rval := Read_Discrete (R); - return Build_Discrete_Range_Type (Lval, Rval, Get_Direction (Rng)); - end Synth_Discrete_Range_Expression; - - function Synth_Float_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type - is - L, R : Valtyp; - begin - -- Static values (so no enable). - L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); - R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); - return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R)); - end Synth_Float_Range_Expression; - - -- Return the type of EXPR without evaluating it. - function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) - return Type_Acc is - begin - case Get_Kind (Expr) is - when Iir_Kinds_Object_Declaration => - declare - Val : constant Valtyp := Get_Value (Syn_Inst, Expr); - begin - return Val.Typ; - end; - when Iir_Kind_Simple_Name => - return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr)); - when Iir_Kind_Slice_Name => - declare - Pfx_Typ : Type_Acc; - Pfx_Bnd : Bound_Type; - El_Typ : Type_Acc; - Res_Bnd : Bound_Type; - Sl_Voff : Net; - Sl_Off : Value_Offsets; - begin - Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); - Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); - Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, - Res_Bnd, Sl_Voff, Sl_Off); - - if Sl_Voff /= No_Net then - raise Internal_Error; - end if; - return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd); - end; - when Iir_Kind_Indexed_Name => - declare - Pfx_Typ : Type_Acc; - begin - Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); - return Get_Array_Element (Pfx_Typ); - end; - when Iir_Kind_Selected_Element => - declare - Idx : constant Iir_Index32 := - Get_Element_Position (Get_Named_Entity (Expr)); - Pfx_Typ : Type_Acc; - begin - Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); - return Pfx_Typ.Rec.E (Idx + 1).Typ; - end; - - when Iir_Kind_Implicit_Dereference - | Iir_Kind_Dereference => - declare - Val : Valtyp; - Res : Valtyp; - begin - -- Maybe do not dereference it if its type is known ? - Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); - Res := Vhdl_Heap.Synth_Dereference (Read_Access (Val)); - return Res.Typ; - end; - - when Iir_Kind_String_Literal8 => - -- TODO: the value should be computed (once) and its type - -- returned. - return Synth.Vhdl_Decls.Synth_Subtype_Indication - (Syn_Inst, Get_Type (Expr)); - - when others => - Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr); - end case; - return null; - end Synth_Type_Of_Object; - - function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Bound_Type - is - Prefix_Name : constant Iir := Get_Prefix (Attr); - Prefix : constant Iir := Strip_Denoting_Name (Prefix_Name); - Dim : constant Natural := - Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr); - Typ : Type_Acc; - Val : Valtyp; - begin - -- Prefix is an array object or an array subtype. - if Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then - -- TODO: does this cover all the cases ? - Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix)); - else - Val := Synth_Expression_With_Basetype (Syn_Inst, Prefix_Name); - Typ := Val.Typ; - end if; - - return Get_Array_Bound (Typ, Dim_Type (Dim)); - end Synth_Array_Attribute; - - procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; - Bound : Node; - Rng : out Discrete_Range_Type) is - begin - case Get_Kind (Bound) is - when Iir_Kind_Range_Expression => - Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound); - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - if Get_Type_Declarator (Bound) /= Null_Node then - declare - Typ : Type_Acc; - begin - -- This is a named subtype, so it has been evaluated. - Typ := Get_Subtype_Object (Syn_Inst, Bound); - Rng := Typ.Drange; - end; - else - Synth_Discrete_Range - (Syn_Inst, Get_Range_Constraint (Bound), Rng); - end if; - when Iir_Kind_Range_Array_Attribute => - declare - B : Bound_Type; - begin - B := Synth_Array_Attribute (Syn_Inst, Bound); - Rng := Build_Discrete_Range_Type - (Int64 (B.Left), Int64 (B.Right), B.Dir); - end; - when Iir_Kind_Reverse_Range_Array_Attribute => - declare - B : Bound_Type; - T : Int32; - begin - B := Synth_Array_Attribute (Syn_Inst, Bound); - -- Reverse - case B.Dir is - when Dir_To => - B.Dir := Dir_Downto; - when Dir_Downto => - B.Dir := Dir_To; - end case; - T := B.Right; - B.Right := B.Left; - B.Left := T; - - Rng := Build_Discrete_Range_Type - (Int64 (B.Left), Int64 (B.Right), B.Dir); - end; - when Iir_Kinds_Denoting_Name => - -- A discrete subtype name. - Synth_Discrete_Range - (Syn_Inst, Get_Subtype_Indication (Get_Named_Entity (Bound)), - Rng); - when others => - Error_Kind ("synth_discrete_range", Bound); - end case; - end Synth_Discrete_Range; - function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; Atype : Node; Dim : Dim_Type) return Bound_Type @@ -660,17 +468,6 @@ package body Synth.Vhdl_Expr is end if; end Synth_Array_Bounds; - function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; - Atype : Node) return Bound_Type - is - Rng : Discrete_Range_Type; - begin - Synth_Discrete_Range (Syn_Inst, Atype, Rng); - return (Dir => Rng.Dir, - Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), - Len => Get_Range_Length (Rng)); - end Synth_Bounds_From_Range; - function Synth_Bounds_From_Length (Atype : Node; Len : Int32) return Bound_Type is @@ -737,9 +534,9 @@ package body Synth.Vhdl_Expr is begin case Val.Val.Kind is when Value_Wire => - return Create_Value_Wire (Val.Val.W, Ntype); + return Create_Value_Wire (Get_Value_Wire (Val.Val), Ntype); when Value_Net => - return Create_Value_Net (Val.Val.N, Ntype); + 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); @@ -884,6 +681,18 @@ package body Synth.Vhdl_Expr is end case; end Synth_Subtype_Conversion; + function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc; + Vt : Valtyp; + Dtype : Type_Acc; + Bounds : Boolean; + Loc : Source.Syn_Src) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + begin + return Synth_Subtype_Conversion (Ctxt, Vt, Dtype, Bounds, Loc); + end Synth_Subtype_Conversion; + function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp is @@ -1076,7 +885,7 @@ package body Synth.Vhdl_Expr is Val : Valtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); - return Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); end; when others => Error_Kind ("synth_name", Name); @@ -1093,7 +902,7 @@ package body Synth.Vhdl_Expr is begin if not In_Bounds (Bnd, Int32 (Idx)) then Error_Msg_Synth (+Loc, "index not within bounds"); - Synth.Debugger.Debug_Error (Syn_Inst, Loc); + Elab.Debugger.Debug_Error (Syn_Inst, Loc); return (0, 0); end if; @@ -1522,7 +1331,7 @@ package body Synth.Vhdl_Expr is or else not In_Bounds (Pfx_Bnd, Int32 (R)) then Error_Msg_Synth (+Name, "index not within bounds"); - Synth.Debugger.Debug_Error (Syn_Inst, Expr); + Elab.Debugger.Debug_Error (Syn_Inst, Expr); Off := (0, 0); return; end if; @@ -2247,7 +2056,7 @@ package body Synth.Vhdl_Expr is and then Get_Static_Discrete (Left) = Val then -- Short-circuit when the left operand determines the result. - return Create_Value_Discrete (Val, Boolean_Type); + return Create_Value_Discrete (Val, Typ); end if; Strip_Const (Left); @@ -2262,21 +2071,21 @@ package body Synth.Vhdl_Expr is and then Get_Static_Discrete (Right) = Val then -- If the right operand can determine the result, return it. - return Create_Value_Discrete (Val, Boolean_Type); + return Create_Value_Discrete (Val, Typ); end if; -- Return a static value if both operands are static. -- Note: we know the value of left if it is not constant. if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then Val := Get_Static_Discrete (Right); - return Create_Value_Discrete (Val, Boolean_Type); + return Create_Value_Discrete (Val, Typ); end if; -- Non-static result. N := Build_Dyadic (Ctxt, Id, Get_Net (Ctxt, Left), Get_Net (Ctxt, Right)); Set_Location (N, Expr); - return Create_Value_Net (N, Boolean_Type); + return Create_Value_Net (N, Typ); end Synth_Short_Circuit; function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; @@ -2353,13 +2162,16 @@ package body Synth.Vhdl_Expr is | Iir_Kind_Selected_Name | Iir_Kind_Interface_Signal_Declaration -- For PSL. | Iir_Kind_Signal_Declaration -- For PSL. + | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => declare Res : Valtyp; begin Res := Synth_Name (Syn_Inst, Expr); - if Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory then + if Res.Typ /= null + and then Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory + then -- This is a null object. As nothing can be done about it, -- returns 0. return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ)); @@ -2565,7 +2377,7 @@ package body Synth.Vhdl_Expr is T : Type_Acc; Acc : Heap_Index; begin - T := Synth.Vhdl_Decls.Synth_Subtype_Indication + T := Synth_Subtype_Indication (Syn_Inst, Get_Subtype_Indication (Expr)); Acc := Allocate_By_Type (T); return Create_Value_Access (Acc, Expr_Type); diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads index c6726732e..7081aef95 100644 --- a/src/synth/synth-vhdl_expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -23,13 +23,14 @@ with Types; use Types; with PSL.Types; with Vhdl.Nodes; use Vhdl.Nodes; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Synth.Source; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; package Synth.Vhdl_Expr is -- Perform a subtype conversion. Check constraints. @@ -40,6 +41,13 @@ package Synth.Vhdl_Expr is Loc : Source.Syn_Src) return Valtyp; + function Synth_Subtype_Conversion (Syn_Inst : Synth_Instance_Acc; + Vt : Valtyp; + Dtype : Type_Acc; + Bounds : Boolean; + Loc : Source.Syn_Src) + return Valtyp; + -- For a static value V, return the value. function Get_Static_Discrete (V : Valtyp) return Int64; @@ -93,24 +101,10 @@ package Synth.Vhdl_Expr is function Synth_PSL_Expression (Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net; - function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; - Atype : Node) return Bound_Type; - function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; Atype : Node; Dim : Dim_Type) return Bound_Type; - function Build_Discrete_Range_Type - (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type; - function Synth_Discrete_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type; - function Synth_Float_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type; - - procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; - Bound : Node; - Rng : out Discrete_Range_Type); - procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Bnd : Bound_Type; @@ -127,13 +121,7 @@ package Synth.Vhdl_Expr is Voff : out Net; Off : out Value_Offsets); - -- Return the type of EXPR (an object) without evaluating it (except when - -- needed, like bounds of a slice). - function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) - return Type_Acc; - -- Conversion to logic vector. - type Digit_Index is new Natural; type Logvec_Array is array (Digit_Index range <>) of Logic_32; type Logvec_Array_Acc is access Logvec_Array; diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index 1297c71b9..5394834ab 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -21,7 +21,6 @@ with GNAT.SHA1; with Types; use Types; with Types_Utils; use Types_Utils; with Name_Table; -with Libraries; with Hash; use Hash; with Dyn_Tables; with Interning; @@ -34,24 +33,27 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Concats; with Netlists.Folds; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Errors; with Vhdl.Ieee.Math_Real; -with Synth.Memtype; use Synth.Memtype; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Files; +with Elab.Debugger; + with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Source; use Synth.Source; -with Synth.Debugger; -with Synth.Vhdl_Files; with Synth.Errors; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Insts is - Root_Instance : Synth_Instance_Acc; + Global_Base_Instance : Base_Instance_Acc; function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is begin @@ -202,6 +204,7 @@ package body Synth.Vhdl_Insts is Hash_Const (C, Val.A_Obj, Typ); when Value_Net | Value_Wire + | Value_Signal | Value_File => raise Internal_Error; end case; @@ -335,35 +338,6 @@ package body Synth.Vhdl_Insts is return New_Sname_User (Get_Encoded_Name_Id (Decl, Enc), No_Sname); end Create_Inter_Name; - procedure Copy_Object_Subtype (Syn_Inst : Synth_Instance_Acc; - Inter_Type : Node; - Proto_Inst : Synth_Instance_Acc) - is - Inter_Typ : Type_Acc; - begin - case Get_Kind (Inter_Type) is - when Iir_Kind_Array_Subtype_Definition => - if Synth.Vhdl_Decls.Has_Element_Subtype_Indication (Inter_Type) - then - Copy_Object_Subtype - (Syn_Inst, Get_Element_Subtype (Inter_Type), Proto_Inst); - end if; - when others => - null; - end case; - Inter_Typ := Get_Subtype_Object (Proto_Inst, Inter_Type); - Create_Subtype_Object (Syn_Inst, Inter_Type, Inter_Typ); - end Copy_Object_Subtype; - - procedure Build_Object_Subtype (Syn_Inst : Synth_Instance_Acc; - Inter : Node; - Proto_Inst : Synth_Instance_Acc) is - begin - if Get_Declaration_Type (Inter) /= Null_Node then - Copy_Object_Subtype (Syn_Inst, Get_Type (Inter), Proto_Inst); - end if; - end Build_Object_Subtype; - -- Return the number of ports for a type. A record type create one -- port per immediate subelement. Sub-records are not expanded. function Count_Nbr_Ports (Typ : Type_Acc) return Port_Nbr is @@ -442,8 +416,6 @@ package body Synth.Vhdl_Insts is is Decl : constant Node := Params.Decl; Arch : constant Node := Params.Arch; - Imp : Node; - Syn_Inst : Synth_Instance_Acc; Inter : Node; Inter_Typ : Type_Acc; Nbr_Inputs : Port_Nbr; @@ -453,28 +425,10 @@ package body Synth.Vhdl_Insts is Val : Valtyp; Id : Module_Id; begin - if Get_Kind (Params.Decl) = Iir_Kind_Component_Declaration then - pragma Assert (Params.Arch = Null_Node); - pragma Assert (Params.Config = Null_Node); - Imp := Params.Decl; - else - pragma Assert - (Get_Kind (Params.Config) = Iir_Kind_Block_Configuration); - Imp := Params.Arch; - end if; - - -- Create the instance. - Syn_Inst := Make_Instance (Root_Instance, Imp, No_Sname); - -- Copy values for generics. Inter := Get_Generic_Chain (Decl); Nbr_Params := 0; while Inter /= Null_Node loop - -- Bounds or range of the type. - Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst); - - -- Object. - Create_Object (Syn_Inst, Inter, Get_Value (Params.Syn_Inst, Inter)); Nbr_Params := Nbr_Params + 1; Inter := Get_Chain (Inter); end loop; @@ -484,12 +438,6 @@ package body Synth.Vhdl_Insts is Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop - -- Copy the type from PARAMS if needed. The subtype indication of - -- the port may reference objects that aren't anymore reachable - -- (particularly if it is a port of a component). So the subtype - -- cannot be regularly elaborated. - -- Also, for unconstrained subtypes, we need the constraint. - Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst); Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ; case Mode_To_Port_Kind (Get_Mode (Inter)) is @@ -501,7 +449,7 @@ package body Synth.Vhdl_Insts is Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Nbr_Outputs := Nbr_Outputs + Count_Nbr_Ports (Inter_Typ); end case; - Create_Object (Syn_Inst, Inter, Val); + Replace_Signal (Params.Syn_Inst, Inter, Val); Inter := Get_Chain (Inter); end loop; @@ -552,7 +500,7 @@ package body Synth.Vhdl_Insts is Nbr_Outputs := 0; while Is_Valid (Inter) loop Pkind := Mode_To_Port_Kind (Get_Mode (Inter)); - Vt := Get_Value (Syn_Inst, Inter); + Vt := Get_Value (Params.Syn_Inst, Inter); case Pkind is when Port_In => @@ -572,10 +520,12 @@ package body Synth.Vhdl_Insts is Set_Ports_Desc (Cur_Module, Inports, Outports); end; + Set_Extra (Params.Syn_Inst, Global_Base_Instance, No_Sname); + return Inst_Object'(Decl => Decl, Arch => Arch, Config => Params.Config, - Syn_Inst => Syn_Inst, + Syn_Inst => Params.Syn_Inst, M => Cur_Module, Encoding => Params.Encoding); end Build; @@ -980,92 +930,18 @@ package body Synth.Vhdl_Insts is end if; end Synth_Instantiate_Module; - function Synth_Port_Association_Type (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter : Node; - Assoc : Node) return Type_Acc is - begin - if not Is_Fully_Constrained_Type (Get_Type (Inter)) then - -- TODO - -- Find the association for this interface - -- * if individual assoc: get type - -- * if whole assoc: get type from object. - if Assoc = Null_Node then - raise Internal_Error; - end if; - case Get_Kind (Assoc) is - when Iir_Kinds_Association_Element_By_Actual => - return Synth_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); - when others => - raise Internal_Error; - end case; - else - Synth_Declaration_Type (Sub_Inst, Inter); - return Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); - end if; - end Synth_Port_Association_Type; - - procedure Synth_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node) - is - Inter : Node; - Assoc : Node; - Assoc_Inter : Node; - Val : Valtyp; - Inter_Typ : Type_Acc; - begin - Assoc := Assoc_Chain; - Assoc_Inter := Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - if Get_Whole_Association_Flag (Assoc) then - Inter_Typ := Synth_Port_Association_Type - (Sub_Inst, Syn_Inst, Inter, Assoc); - case Mode_To_Port_Kind (Get_Mode (Inter)) is - when Port_In => - Val := Create_Value_Net (No_Net, Inter_Typ); - when Port_Out - | Port_Inout => - Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); - end case; - Create_Object (Sub_Inst, Inter, Val); - end if; - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - end Synth_Ports_Association_Type; - procedure Synth_Direct_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node; + Sub_Inst : Synth_Instance_Acc; Ent : Node; Arch : Node; Config : Node) is - Sub_Inst : Synth_Instance_Acc; Inst_Obj : Inst_Object; Inst : Instance; Enc : Name_Encoding; begin - -- Elaborate generic + map aspect - Sub_Inst := Make_Instance - (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname)); - - Synth_Generics_Association (Sub_Inst, Syn_Inst, - Get_Generic_Chain (Ent), - Get_Generic_Map_Aspect_Chain (Stmt)); - - -- Elaborate port types. - Synth_Ports_Association_Type (Sub_Inst, Syn_Inst, - Get_Port_Chain (Ent), - Get_Port_Map_Aspect_Chain (Stmt)); - - if Is_Error (Sub_Inst) then - -- TODO: Free it? - return; - end if; - if Arch /= Null_Node then -- For whiteboxes: append parameters or/and hash. Enc := Name_Hash; @@ -1085,8 +961,8 @@ package body Synth.Vhdl_Insts is Syn_Inst => Sub_Inst, Encoding => Enc)); - -- TODO: free sub_inst. + -- Do the instantiation. Inst := New_Instance (Get_Instance_Module (Syn_Inst), Inst_Obj.M, @@ -1104,43 +980,26 @@ package body Synth.Vhdl_Insts is procedure Synth_Design_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is - Aspect : constant Iir := Get_Instantiated_Unit (Stmt); - Arch : Node; - Ent : Node; - Config : Node; + Sub_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Syn_Inst, Stmt); + Arch : constant Node := Get_Source_Scope (Sub_Inst); + Ent : constant Node := Get_Entity (Arch); + Config : constant Node := Get_Instance_Config (Sub_Inst); begin - -- Load configured entity + architecture - case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is - when Iir_Kind_Entity_Aspect_Entity => - Arch := Get_Architecture (Aspect); - if Arch = Null_Node then - Arch := Libraries.Get_Latest_Architecture (Get_Entity (Aspect)); - else - Arch := Strip_Denoting_Name (Arch); - end if; - Config := Get_Library_Unit - (Get_Default_Configuration_Declaration (Arch)); - when Iir_Kind_Entity_Aspect_Configuration => - Config := Get_Configuration (Aspect); - Arch := Get_Block_Specification (Get_Block_Configuration (Config)); - when Iir_Kind_Entity_Aspect_Open => - return; - end case; - Config := Get_Block_Configuration (Config); - Ent := Get_Entity (Arch); - Synth_Direct_Instantiation_Statement - (Syn_Inst, Stmt, Ent, Arch, Config); + (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config); end Synth_Design_Instantiation_Statement; procedure Synth_Blackbox_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is + Sub_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Syn_Inst, Stmt); Comp : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); begin Synth_Direct_Instantiation_Statement - (Syn_Inst, Stmt, Comp, Null_Node, Null_Node); + (Syn_Inst, Stmt, Sub_Inst, Comp, Null_Node, Null_Node); end Synth_Blackbox_Instantiation_Statement; procedure Create_Component_Wire (Ctxt : Context_Acc; @@ -1155,12 +1014,13 @@ package body Synth.Vhdl_Insts is case Val.Val.Kind is when Value_Wire => -- Create a gate for the output, so that it could be read. - Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Bit_Type)); + Set_Value_Wire + (Val.Val, Alloc_Wire (Wire_Output, (Inter, Bit_Type))); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); Set_Location (Value, Loc); - Set_Wire_Gate (Val.Val.W, Value); + Set_Wire_Gate (Get_Value_Wire (Val.Val), Value); when others => raise Internal_Error; end case; @@ -1170,12 +1030,13 @@ package body Synth.Vhdl_Insts is (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Comp_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Syn_Inst, Stmt); + Config : constant Node := Get_Instance_Config (Comp_Inst); Component : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); - Config : constant Node := Get_Component_Configuration (Stmt); Bind : constant Node := Get_Binding_Indication (Config); Aspect : constant Node := Get_Entity_Aspect (Bind); - Comp_Inst : Synth_Instance_Acc; Ent : Node; Arch : Node; @@ -1185,7 +1046,6 @@ package body Synth.Vhdl_Insts is Inst : Instance; Inst_Name : Sname; begin - pragma Assert (Get_Component_Configuration (Stmt) /= Null_Node); pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity); Push_Phi; @@ -1193,15 +1053,7 @@ package body Synth.Vhdl_Insts is Inst_Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); - -- Create the sub-instance for the component - -- Elaborate generic + map aspect - Comp_Inst := Make_Instance - (Syn_Inst, Component, - New_Sname_User (Get_Identifier (Component), No_Sname)); - - Synth_Generics_Association (Comp_Inst, Syn_Inst, - Get_Generic_Chain (Component), - Get_Generic_Map_Aspect_Chain (Stmt)); + Set_Extra (Comp_Inst, Syn_Inst, Inst_Name); -- Create objects for the inputs and the outputs of the component, -- assign inputs (that's nets) and create wires for outputs. @@ -1218,9 +1070,8 @@ package body Synth.Vhdl_Insts is while Is_Valid (Assoc) loop if Get_Whole_Association_Flag (Assoc) then Inter := Get_Association_Interface (Assoc, Assoc_Inter); - - Inter_Typ := Synth_Port_Association_Type - (Comp_Inst, Syn_Inst, Inter, Assoc); + Val := Get_Value (Comp_Inst, Inter); + Inter_Typ := Val.Typ; case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => @@ -1234,46 +1085,25 @@ package body Synth.Vhdl_Insts is (Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name, Assoc); end case; - Create_Object (Comp_Inst, Assoc_Inter, Val); + Replace_Signal (Comp_Inst, Assoc_Inter, Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end; - -- Extract entity/architecture instantiated by the component. - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - Ent := Get_Entity (Aspect); - Arch := Get_Architecture (Aspect); - when others => - Vhdl.Errors.Error_Kind - ("Synth_Component_Instantiation_Statement(2)", Aspect); - end case; + Sub_Inst := Get_Component_Instance (Comp_Inst); + Arch := Get_Source_Scope (Sub_Inst); + Ent := Get_Entity (Arch); + Sub_Config := Get_Instance_Config (Sub_Inst); if Get_Kind (Ent) = Iir_Kind_Foreign_Module then -- TODO. raise Internal_Error; end if; - if Arch = Null_Node then - Arch := Libraries.Get_Latest_Architecture (Ent); - else - Arch := Get_Named_Entity (Arch); - end if; - Sub_Config := Get_Library_Unit - (Get_Default_Configuration_Declaration (Arch)); - Sub_Config := Get_Block_Configuration (Sub_Config); - -- Elaborate generic + map aspect for the entity instance. - Sub_Inst := Make_Instance - (Comp_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname)); - Synth_Generics_Association (Sub_Inst, Comp_Inst, - Get_Generic_Chain (Ent), - Get_Generic_Map_Aspect_Chain (Bind)); - - Synth_Ports_Association_Type (Sub_Inst, Comp_Inst, - Get_Port_Chain (Ent), - Get_Port_Map_Aspect_Chain (Bind)); + Set_Extra (Sub_Inst, + Comp_Inst, New_Sname_User (Get_Identifier (Ent), No_Sname)); -- Search if corresponding module has already been used. -- If not create a new module @@ -1387,17 +1217,13 @@ package body Synth.Vhdl_Insts is procedure Synth_Top_Entity (Base : Base_Instance_Acc; Design_Unit : Node; Encoding : Name_Encoding; - Inst : out Synth_Instance_Acc) + Syn_Inst : Synth_Instance_Acc) is Lib_Unit : constant Node := Get_Library_Unit (Design_Unit); Arch : Node; Entity : Node; Config : Node; - Syn_Inst : Synth_Instance_Acc; - Inter : Node; - Inter_Typ : Type_Acc; Inst_Obj : Inst_Object; - Val : Valtyp; begin -- Extract architecture from design. case Get_Kind (Lib_Unit) is @@ -1414,60 +1240,22 @@ package body Synth.Vhdl_Insts is end case; Entity := Get_Entity (Arch); - Root_Instance := Make_Base_Instance (Base); + Make_Base_Instance (Base); + + Global_Base_Instance := Base; Insts_Interning.Init; if Flags.Flag_Debug_Init then - Synth.Debugger.Debug_Init (Arch); + Elab.Debugger.Debug_Init (Arch); end if; -- Dependencies first. Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity)); Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); - Syn_Inst := Make_Instance - (Root_Instance, Arch, - New_Sname_User (Get_Identifier (Entity), No_Sname)); - - -- Compute generics. - Inter := Get_Generic_Chain (Entity); - while Is_Valid (Inter) loop - Synth_Declaration_Type (Syn_Inst, Inter); - declare - Val : Valtyp; - Inter_Typ : Type_Acc; - begin - Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); - Val := Synth_Expression_With_Type - (Syn_Inst, Get_Default_Value (Inter), Inter_Typ); - pragma Assert (Is_Static (Val.Val)); - Create_Object (Syn_Inst, Inter, Val); - end; - Inter := Get_Chain (Inter); - end loop; - - -- Elaborate port types. - -- FIXME: what about unconstrained ports ? Get the type from the - -- association. - Inter := Get_Port_Chain (Entity); - while Is_Valid (Inter) loop - if not Is_Fully_Constrained_Type (Get_Type (Inter)) then - -- TODO - raise Internal_Error; - end if; - Synth_Declaration_Type (Syn_Inst, Inter); - Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); - case Mode_To_Port_Kind (Get_Mode (Inter)) is - when Port_In => - Val := Create_Value_Net (No_Net, Inter_Typ); - when Port_Out - | Port_Inout => - Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); - end case; - Create_Object (Syn_Inst, Inter, Val); - Inter := Get_Chain (Inter); - end loop; + Set_Extra + (Syn_Inst, Base, New_Sname_User (Get_Identifier (Entity), No_Sname)); -- Search if corresponding module has already been used. -- If not create a new module @@ -1480,16 +1268,20 @@ package body Synth.Vhdl_Insts is Config => Get_Block_Configuration (Config), Syn_Inst => Syn_Inst, Encoding => Encoding)); - Inst := Inst_Obj.Syn_Inst; + pragma Unreferenced (Inst_Obj); end Synth_Top_Entity; procedure Create_Input_Wire (Syn_Inst : Synth_Instance_Acc; Self_Inst : Instance; Idx : in out Port_Idx; - Val : Valtyp) is + Val : Valtyp) + is + N : Net; begin pragma Assert (Val.Val.Kind = Value_Net); - Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Val.Val.N); + N := Get_Value_Net (Val.Val); + Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, N); + Set_Value_Net (Val.Val, N); end Create_Input_Wire; procedure Create_Output_Wire (Syn_Inst : Synth_Instance_Acc; @@ -1511,7 +1303,7 @@ package body Synth.Vhdl_Insts is pragma Assert (Val.Val.Kind = Value_Wire); -- Create a gate for the output, so that it could be read. - Val.Val.W := Alloc_Wire (Wire_Output, (Inter, Val.Typ)); + Set_Value_Wire (Val.Val, Alloc_Wire (Wire_Output, (Inter, Val.Typ))); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); if Default /= Null_Node then @@ -1548,76 +1340,21 @@ package body Synth.Vhdl_Insts is Vout := Value; end if; Set_Location (Value, Inter); - Set_Wire_Gate (Val.Val.W, Value); + Set_Wire_Gate (Get_Value_Wire (Val.Val), Value); Inst_Input_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Vout); end Create_Output_Wire; - procedure Apply_Block_Configuration (Cfg : Node; Blk : Node) - is - Item : Node; - begin - -- Be sure CFG applies to BLK. - pragma Assert (Get_Block_From_Block_Specification - (Get_Block_Specification (Cfg)) = Blk); - - -- Clear_Instantiation_Configuration (Blk); - - Item := Get_Configuration_Item_Chain (Cfg); - while Item /= Null_Node loop - case Get_Kind (Item) is - when Iir_Kind_Component_Configuration => - declare - List : constant Iir_Flist := - Get_Instantiation_List (Item); - El : Node; - Inst : Node; - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Inst := Get_Named_Entity (El); - pragma Assert - (Get_Kind (Inst) - = Iir_Kind_Component_Instantiation_Statement); - pragma Assert - (Get_Component_Configuration (Inst) = Null_Node); - Set_Component_Configuration (Inst, Item); - end loop; - end; - when Iir_Kind_Block_Configuration => - declare - Sub_Blk : constant Node := Get_Block_From_Block_Specification - (Get_Block_Specification (Item)); - begin - case Get_Kind (Sub_Blk) is - when Iir_Kind_Generate_Statement_Body => - -- Linked chain. - Set_Prev_Block_Configuration - (Item, Get_Generate_Block_Configuration (Sub_Blk)); - Set_Generate_Block_Configuration (Sub_Blk, Item); - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (Sub_Blk, Item); - when others => - Vhdl.Errors.Error_Kind - ("apply_block_configuration(blk)", Sub_Blk); - end case; - end; - when others => - Vhdl.Errors.Error_Kind ("apply_block_configuration", Item); - end case; - Item := Get_Chain (Item); - end loop; - end Apply_Block_Configuration; - - procedure Synth_Verification_Units - (Syn_Inst : Synth_Instance_Acc; Parent : Node) + procedure Synth_Verification_Units (Syn_Inst : Synth_Instance_Acc) is + Extra : Synth_Instance_Acc; Unit : Node; begin - Unit := Get_Bound_Vunit_Chain (Parent); - while Unit /= Null_Node loop - Synth_Verification_Unit (Syn_Inst, Unit); - Unit := Get_Bound_Vunit_Chain (Unit); + Extra := Get_First_Extra_Instance (Syn_Inst); + while Extra /= null loop + Unit := Get_Source_Scope (Extra); + Synth_Verification_Unit (Extra, Unit, Syn_Inst); + Extra := Get_Next_Extra_Instance (Syn_Inst); end loop; end Synth_Verification_Units; @@ -1643,7 +1380,7 @@ package body Synth.Vhdl_Insts is -- Save the current architecture, so that files can be open using a -- path relative to the architecture filename. - Synth.Vhdl_Files.Set_Design_Unit (Arch); + Elab.Vhdl_Files.Set_Design_Unit (Arch); Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); @@ -1671,9 +1408,9 @@ package body Synth.Vhdl_Insts is -- Apply configuration. -- FIXME: what about inner block configuration ? pragma Assert (Get_Kind (Inst.Config) = Iir_Kind_Block_Configuration); - Apply_Block_Configuration (Inst.Config, Arch); - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); + -- Entity + Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); if not Is_Error (Syn_Inst) then Synth_Concurrent_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); @@ -1683,8 +1420,10 @@ package body Synth.Vhdl_Insts is Synth_Attribute_Values (Syn_Inst, Entity); end if; + -- Architecture if not Is_Error (Syn_Inst) then - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + Synth_Concurrent_Declarations + (Syn_Inst, Get_Declaration_Chain (Arch)); end if; if not Is_Error (Syn_Inst) then Synth_Concurrent_Statements @@ -1695,13 +1434,12 @@ package body Synth.Vhdl_Insts is Synth_Attribute_Values (Syn_Inst, Arch); end if; + -- Vunits if not Is_Error (Syn_Inst) then - Synth_Verification_Units (Syn_Inst, Entity); - end if; - if not Is_Error (Syn_Inst) then - Synth_Verification_Units (Syn_Inst, Arch); + Synth_Verification_Units (Syn_Inst); end if; + -- Finalize Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity)); diff --git a/src/synth/synth-vhdl_insts.ads b/src/synth/synth-vhdl_insts.ads index c280475a6..ae7fd715d 100644 --- a/src/synth/synth-vhdl_insts.ads +++ b/src/synth/synth-vhdl_insts.ads @@ -16,10 +16,11 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + 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.Vhdl_Insts is @@ -27,16 +28,11 @@ package Synth.Vhdl_Insts is procedure Synth_Top_Entity (Base : Base_Instance_Acc; Design_Unit : Node; Encoding : Name_Encoding; - Inst : out Synth_Instance_Acc); + Syn_Inst : Synth_Instance_Acc); -- Synthesize the top entity and all the sub-modules. procedure Synth_All_Instances; - -- Apply block configuration CFG to BLK. - -- Must be done before synthesis of BLK. - -- The synthesis of BLK will clear all configuration of it. - procedure Apply_Block_Configuration (Cfg : Node; Blk : Node); - procedure Synth_Design_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node); procedure Synth_Blackbox_Instantiation_Statement diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index d7d73bcec..c576f2fee 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -32,12 +32,15 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; with Netlists.Utils; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; + with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Source; with Synth.Static_Oper; use Synth.Static_Oper; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Oper is procedure Set_Location (N : Net; Loc : Node) diff --git a/src/synth/synth-vhdl_oper.ads b/src/synth/synth-vhdl_oper.ads index 7efa711d9..3ae73df3d 100644 --- a/src/synth/synth-vhdl_oper.ads +++ b/src/synth/synth-vhdl_oper.ads @@ -18,9 +18,9 @@ with Vhdl.Nodes; use Vhdl.Nodes; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; package Synth.Vhdl_Oper is function Synth_Predefined_Function_Call diff --git a/src/synth/synth-vhdl_static_proc.adb b/src/synth/synth-vhdl_static_proc.adb index 462896451..5dc31318b 100644 --- a/src/synth/synth-vhdl_static_proc.adb +++ b/src/synth/synth-vhdl_static_proc.adb @@ -18,10 +18,11 @@ with Vhdl.Errors; use Vhdl.Errors; -with Synth.Values; use Synth.Values; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Heap; +with Elab.Vhdl_Files; use Elab.Vhdl_Files; + with Synth.Errors; use Synth.Errors; -with Synth.Vhdl_Files; use Synth.Vhdl_Files; -with Synth.Vhdl_Heap; package body Synth.Vhdl_Static_Proc is @@ -33,7 +34,7 @@ package body Synth.Vhdl_Static_Proc is begin Val := Read_Access (Param); if Val /= Null_Heap_Index then - Synth.Vhdl_Heap.Synth_Deallocate (Val); + Elab.Vhdl_Heap.Synth_Deallocate (Val); Write_Access (Param.Val.Mem, Null_Heap_Index); end if; end Synth_Deallocate; diff --git a/src/synth/synth-vhdl_static_proc.ads b/src/synth/synth-vhdl_static_proc.ads index 4fceb6c9d..c7bedbcce 100644 --- a/src/synth/synth-vhdl_static_proc.ads +++ b/src/synth/synth-vhdl_static_proc.ads @@ -16,7 +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 Synth.Vhdl_Context; use Synth.Vhdl_Context; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + with Vhdl.Nodes; use Vhdl.Nodes; package Synth.Vhdl_Static_Proc is diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 81394abdb..989942244 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -41,16 +41,20 @@ with PSL.Nodes; with PSL.Subsets; with PSL.NFAs; -with Synth.Memtype; use Synth.Memtype; +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Heap; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Expr; +with Elab.Debugger; + with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Insts; use Synth.Vhdl_Insts; with Synth.Source; with Synth.Vhdl_Static_Proc; -with Synth.Vhdl_Heap; with Synth.Flags; -with Synth.Debugger; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; @@ -244,7 +248,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 := Vhdl_Heap.Synth_Dereference (Read_Access (Dest_Base)); + Dest_Base := Elab.Vhdl_Heap.Synth_Dereference + (Read_Access (Dest_Base)); Dest_Typ := Dest_Base.Typ; when others => @@ -320,7 +325,7 @@ package body Synth.Vhdl_Stmts is while Choice /= Null_Node loop pragma Assert (Get_Kind (Choice) = Iir_Kind_Choice_By_None); El := Get_Associated_Expr (Choice); - El_Typ := Synth_Type_Of_Object (Syn_Inst, El); + El_Typ := Elab.Vhdl_Expr.Exec_Type_Of_Object (Syn_Inst, El); Bnd := Get_Array_Bound (El_Typ, 1); Len := Len + Bnd.Len; Choice := Get_Chain (Choice); @@ -487,6 +492,7 @@ package body Synth.Vhdl_Stmts is is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); V : Valtyp; + W : Wire_Id; begin V := Synth_Subtype_Conversion (Ctxt, Val, Target.Targ_Type, False, Loc); pragma Unreferenced (Val); @@ -507,19 +513,19 @@ package body Synth.Vhdl_Stmts is end if; if Target.Obj.Val.Kind = Value_Wire then + W := Get_Value_Wire (Target.Obj.Val); if Is_Static (V.Val) and then V.Typ.Sz = Target.Obj.Typ.Sz then pragma Assert (Target.Off = (0, 0)); - Phi_Assign_Static - (Target.Obj.Val.W, Unshare (Get_Memtyp (V))); + Phi_Assign_Static (W, Unshare (Get_Memtyp (V))); else if V.Typ.W = 0 then -- Forget about null wires. return; end if; - Phi_Assign_Net (Ctxt, Target.Obj.Val.W, - Get_Net (Ctxt, V), Target.Off.Net_Off); + Phi_Assign_Net + (Ctxt, W, Get_Net (Ctxt, V), Target.Off.Net_Off); end if; else if not Is_Static (V.Val) then @@ -535,16 +541,16 @@ package body Synth.Vhdl_Stmts is when Target_Memory => declare Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + W : constant Wire_Id := Get_Value_Wire (Target.Mem_Obj.Val); N : Net; begin N := Get_Current_Assign_Value - (Ctxt, Target.Mem_Obj.Val.W, + (Ctxt, W, Target.Mem_Dyn.Pfx_Off.Net_Off, Target.Mem_Dyn.Pfx_Typ.W); N := Build_Dyn_Insert (Ctxt, N, Get_Net (Ctxt, V), Target.Mem_Dyn.Voff, Target.Mem_Doff); Set_Location (N, Loc); - Phi_Assign_Net (Ctxt, Target.Mem_Obj.Val.W, N, - Target.Mem_Dyn.Pfx_Off.Net_Off); + Phi_Assign_Net (Ctxt, W, N, Target.Mem_Dyn.Pfx_Off.Net_Off); end; end case; end Synth_Assignment; @@ -1910,6 +1916,7 @@ package body Synth.Vhdl_Stmts is Assoc_Inter : Node; Val : Valtyp; Nbr_Inout : Natural; + W : Wire_Id; begin Nbr_Inout := 0; pragma Assert (Init.Kind = Association_Function); @@ -1928,8 +1935,9 @@ package body Synth.Vhdl_Stmts is -- Free wire used for out/inout interface variables. if Val.Val.Kind = Value_Wire then - Phi_Discard_Wires (Val.Val.W, No_Wire_Id); - Free_Wire (Val.Val.W); + W := Get_Value_Wire (Val.Val); + Phi_Discard_Wires (W, No_Wire_Id); + Free_Wire (W); end if; end if; @@ -2136,8 +2144,10 @@ package body Synth.Vhdl_Stmts is Areapools.Mark (Area_Mark, Instance_Pool.all); Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp)); - Sub_Inst := Make_Instance (Up_Inst, Bod, New_Internal_Name (Ctxt)); - Set_Instance_Base (Sub_Inst, Syn_Inst); + Sub_Inst := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node); + if Ctxt /= null then + Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); + end if; Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); @@ -2145,7 +2155,7 @@ package body Synth.Vhdl_Stmts is Res := No_Valtyp; else if not Is_Func then - if Get_Purity_State (Imp) /= Pure then + if Ctxt /= null and then Get_Purity_State (Imp) /= Pure then Set_Instance_Const (Sub_Inst, False); end if; end if; @@ -2164,8 +2174,8 @@ package body Synth.Vhdl_Stmts is Set_Error (Syn_Inst); end if; - if Debugger.Flag_Need_Debug then - Debugger.Debug_Leave (Sub_Inst); + if Elab.Debugger.Flag_Need_Debug then + Elab.Debugger.Debug_Leave (Sub_Inst); end if; Free_Instance (Sub_Inst); @@ -2214,7 +2224,11 @@ package body Synth.Vhdl_Stmts is Sub_Inst : Synth_Instance_Acc; begin Areapools.Mark (Area_Mark, Instance_Pool.all); - Sub_Inst := Make_Instance (Syn_Inst, Imp, New_Internal_Name (Ctxt)); + Sub_Inst := Make_Elab_Instance (Syn_Inst, Imp, Null_Node); + + if Ctxt /= null then + Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt)); + end if; Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); @@ -2247,20 +2261,6 @@ package body Synth.Vhdl_Stmts is end case; end Synth_Procedure_Call; - procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp) - is - T : Int64; - begin - T := Read_Discrete (V); - case Rng.Dir is - when Dir_To => - T := T + 1; - when Dir_Downto => - T := T - 1; - end case; - Write_Discrete (V, T); - end Update_Index; - -- Return True iff WID is a static wire and its value is V. function Is_Static_Bit (Wid : Wire_Id; V : Ghdl_U8) return Boolean is @@ -2876,6 +2876,7 @@ package body Synth.Vhdl_Stmts is if Sev_V >= Flags.Severity_Level then Error_Msg_Synth (+Stmt, "error due to assertion failure"); + Elab.Debugger.Debug_Error (Syn_Inst, Stmt); end if; end Synth_Static_Report; @@ -2962,8 +2963,8 @@ package body Synth.Vhdl_Stmts is & Natural'Image (Line)); end; end if; - if Synth.Debugger.Flag_Need_Debug then - Synth.Debugger.Debug_Break (C.Inst, Stmt); + if Elab.Debugger.Flag_Need_Debug then + Elab.Debugger.Debug_Break (C.Inst, Stmt); end if; case Get_Kind (Stmt) is @@ -3205,34 +3206,25 @@ package body Synth.Vhdl_Stmts is is use Areapools; Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; - Blk_Inst : Synth_Instance_Acc; + Blk_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Syn_Inst, Blk); + Decls_Chain : constant Node := Get_Declaration_Chain (Blk); Blk_Sname : Sname; M : Areapools.Mark_Type; begin - -- No support for guard or header. - if Get_Block_Header (Blk) /= Null_Node - or else Get_Guard_Decl (Blk) /= Null_Node - then - raise Internal_Error; - end if; - - Apply_Block_Configuration - (Get_Block_Block_Configuration (Blk), Blk); - Blk_Sname := New_Sname_User (Get_Identifier (Blk), Get_Sname (Syn_Inst)); - Blk_Inst := Make_Instance (Syn_Inst, Blk, Blk_Sname); + Set_Extra (Blk_Inst, Syn_Inst, Blk_Sname); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; - Synth_Declarations (Blk_Inst, Get_Declaration_Chain (Blk)); + Synth_Concurrent_Declarations (Blk_Inst, Decls_Chain); Synth_Concurrent_Statements (Blk_Inst, Get_Concurrent_Statement_Chain (Blk)); Synth_Attribute_Values (Blk_Inst, Blk); - Finalize_Declarations (Blk_Inst, Get_Declaration_Chain (Blk)); + Finalize_Declarations (Blk_Inst, Decls_Chain); - Free_Instance (Blk_Inst); Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Block_Statement; @@ -3514,37 +3506,25 @@ package body Synth.Vhdl_Stmts is end Synth_Psl_Assert_Directive; procedure Synth_Generate_Statement_Body - (Syn_Inst : Synth_Instance_Acc; - Bod : Node; - Name : Sname; - Iterator : Node := Null_Node; - Iterator_Val : Valtyp := No_Valtyp) + (Syn_Inst : Synth_Instance_Acc; Bod : Node) is use Areapools; Decls_Chain : constant Node := Get_Declaration_Chain (Bod); Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; - Bod_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin - Bod_Inst := Make_Instance (Syn_Inst, Bod, Name); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; - if Iterator /= Null_Node then - -- Add the iterator (for for-generate). - Create_Object (Bod_Inst, Iterator, Iterator_Val); - end if; - - Synth_Declarations (Bod_Inst, Decls_Chain); + Synth_Concurrent_Declarations (Syn_Inst, Decls_Chain); Synth_Concurrent_Statements - (Bod_Inst, Get_Concurrent_Statement_Chain (Bod)); + (Syn_Inst, Get_Concurrent_Statement_Chain (Bod)); - Synth_Attribute_Values (Bod_Inst, Bod); + Synth_Attribute_Values (Syn_Inst, Bod); - Finalize_Declarations (Bod_Inst, Decls_Chain); + Finalize_Declarations (Syn_Inst, Decls_Chain); - Free_Instance (Bod_Inst); Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Generate_Statement_Body; @@ -3552,34 +3532,17 @@ package body Synth.Vhdl_Stmts is procedure Synth_If_Generate_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is - Gen : Node; - Bod : Node; - Icond : Node; - Cond : Valtyp; + Sub_Inst : Synth_Instance_Acc; Name : Sname; - Config : Node; begin - Gen := Stmt; + Sub_Inst := Get_Sub_Instance (Syn_Inst, Stmt); + if Sub_Inst = null then + return; + end if; + Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); - loop - Icond := Get_Condition (Gen); - if Icond /= Null_Node then - Cond := Synth_Expression (Syn_Inst, Icond); - Strip_Const (Cond); - else - -- It is the else generate. - Cond := No_Valtyp; - end if; - if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then - Bod := Get_Generate_Statement_Body (Gen); - Config := Get_Generate_Block_Configuration (Bod); - Apply_Block_Configuration (Config, Bod); - Synth_Generate_Statement_Body (Syn_Inst, Bod, Name); - exit; - end if; - Gen := Get_Generate_Else_Clause (Gen); - exit when Gen = Null_Node; - end loop; + Set_Extra (Sub_Inst, Syn_Inst, Name); + Synth_Generate_Statement_Body (Sub_Inst, Get_Source_Scope (Sub_Inst)); end Synth_If_Generate_Statement; procedure Synth_For_Generate_Statement @@ -3587,48 +3550,26 @@ package body Synth.Vhdl_Stmts is is Iterator : constant Node := Get_Parameter_Specification (Stmt); Bod : constant Node := Get_Generate_Statement_Body (Stmt); - Configs : constant Node := Get_Generate_Block_Configuration (Bod); - It_Type : constant Node := Get_Declaration_Type (Iterator); - Config : Node; It_Rng : Type_Acc; - Val : Valtyp; + Sub_Inst : Synth_Instance_Acc; + Gen_Inst : Synth_Instance_Acc; Name : Sname; Lname : Sname; begin - if It_Type /= Null_Node then - Synth_Subtype_Indication (Syn_Inst, It_Type); - end if; - - -- Initial value. It_Rng := Get_Subtype_Object (Syn_Inst, Get_Type (Iterator)); - Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); + Gen_Inst := Get_Sub_Instance (Syn_Inst, Stmt); Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); + Set_Extra (Gen_Inst, Syn_Inst, Name); - while In_Range (It_Rng.Drange, Read_Discrete (Val)) loop - -- Find and apply the config block. - declare - Spec : Node; - begin - Config := Configs; - while Config /= Null_Node loop - Spec := Get_Block_Specification (Config); - case Get_Kind (Spec) is - when Iir_Kind_Simple_Name => - exit; - when others => - Error_Kind ("synth_for_generate_statement", Spec); - end case; - Config := Get_Prev_Block_Configuration (Config); - end loop; - Apply_Block_Configuration (Config, Bod); - end; - + for I in 1 .. Get_Range_Length (It_Rng.Drange) loop -- FIXME: get position ? - Lname := New_Sname_Version (Uns32 (Read_Discrete (Val)), Name); + Lname := New_Sname_Version (Uns32 (I), Name); + + Sub_Inst := Get_Generate_Sub_Instance (Gen_Inst, Positive (I)); + Set_Extra (Sub_Inst, Gen_Inst, Lname); - Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val); - Update_Index (It_Rng.Drange, Val); + Synth_Generate_Statement_Body (Sub_Inst, Bod); end loop; end Synth_For_Generate_Statement; @@ -3663,10 +3604,14 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Component_Instantiation_Statement => if Is_Component_Instantiation (Stmt) then declare + Comp_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Syn_Inst, Stmt); Comp_Config : constant Node := - Get_Component_Configuration (Stmt); + Get_Instance_Config (Comp_Inst); begin - if Get_Binding_Indication (Comp_Config) = Null_Node then + if Comp_Config = Null_Node + or else Get_Binding_Indication (Comp_Config) = Null_Node + then -- Not bound. Synth_Blackbox_Instantiation_Statement (Syn_Inst, Stmt); else @@ -3766,7 +3711,7 @@ package body Synth.Vhdl_Stmts is N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W); Set_Location (N, Val); - Add_Conc_Assign (Base.Val.W, N, 0); + Add_Conc_Assign (Get_Value_Wire (Base.Val), N, 0); end; end Synth_Attribute_Formal; @@ -3803,27 +3748,22 @@ package body Synth.Vhdl_Stmts is end loop; end Synth_Attribute_Values; - procedure Synth_Verification_Unit - (Syn_Inst : Synth_Instance_Acc; Unit : Node) + procedure Synth_Verification_Unit (Syn_Inst : Synth_Instance_Acc; + Unit : Node; + Parent_Inst : Synth_Instance_Acc) is use Areapools; Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; - Unit_Inst : Synth_Instance_Acc; Unit_Sname : Sname; M : Areapools.Mark_Type; Item : Node; - Last_Type : Node; begin Unit_Sname := New_Sname_User (Get_Identifier (Unit), Get_Sname (Syn_Inst)); - Unit_Inst := Make_Instance (Syn_Inst, Unit, Unit_Sname); + Set_Extra (Syn_Inst, Parent_Inst, Unit_Sname); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; - Apply_Block_Configuration - (Get_Verification_Block_Configuration (Unit), Unit); - - Last_Type := Null_Node; Item := Get_Vunit_Item_Chain (Unit); while Item /= Null_Node loop case Get_Kind (Item) is @@ -3831,13 +3771,13 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Psl_Declaration => null; when Iir_Kind_Psl_Assert_Directive => - Synth_Psl_Assert_Directive (Unit_Inst, Item); + Synth_Psl_Assert_Directive (Syn_Inst, Item); when Iir_Kind_Psl_Assume_Directive => - Synth_Psl_Assume_Directive (Unit_Inst, Item); + Synth_Psl_Assume_Directive (Syn_Inst, Item); when Iir_Kind_Psl_Restrict_Directive => - Synth_Psl_Restrict_Directive (Unit_Inst, Item); + Synth_Psl_Restrict_Directive (Syn_Inst, Item); when Iir_Kind_Psl_Cover_Directive => - Synth_Psl_Cover_Directive (Unit_Inst, Item); + Synth_Psl_Cover_Directive (Syn_Inst, Item); when Iir_Kind_Signal_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Function_Declaration @@ -3846,21 +3786,21 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Procedure_Body | Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification => - Synth_Declaration (Unit_Inst, Item, False, Last_Type); + Synth_Concurrent_Declaration (Syn_Inst, Item); when Iir_Kinds_Concurrent_Signal_Assignment | Iir_Kinds_Process_Statement | Iir_Kinds_Generate_Statement | Iir_Kind_Block_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Component_Instantiation_Statement => - Synth_Concurrent_Statement (Unit_Inst, Item); + Synth_Concurrent_Statement (Syn_Inst, Item); when others => Error_Kind ("synth_verification_unit", Item); end case; Item := Get_Chain (Item); end loop; - Synth_Attribute_Values (Unit_Inst, Unit); + Synth_Attribute_Values (Syn_Inst, Unit); -- Finalize Item := Get_Vunit_Item_Chain (Unit); @@ -3888,14 +3828,13 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Procedure_Body | Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification => - Finalize_Declaration (Unit_Inst, Item, False); + Finalize_Declaration (Syn_Inst, Item, False); when others => Error_Kind ("synth_verification_unit(2)", Item); end case; Item := Get_Chain (Item); end loop; - Free_Instance (Unit_Inst); Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Verification_Unit; diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index 9621a7c9f..a7a2c719c 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -19,11 +19,12 @@ with Types; use Types; with Vhdl.Nodes; use Vhdl.Nodes; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; + with Netlists; use Netlists; -with Synth.Objtypes; use Synth.Objtypes; -with Synth.Values; use Synth.Values; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; package Synth.Vhdl_Stmts is @@ -90,12 +91,9 @@ package Synth.Vhdl_Stmts is procedure Synth_Attribute_Values (Syn_Inst : Synth_Instance_Acc; Unit : Node); - procedure Synth_Verification_Unit - (Syn_Inst : Synth_Instance_Acc; Unit : Node); - - -- For iterators. - procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp); - + procedure Synth_Verification_Unit (Syn_Inst : Synth_Instance_Acc; + Unit : Node; + Parent_Inst : Synth_Instance_Acc); private -- There are 2 execution mode: -- * static: it is like simulation, all the inputs are known, neither diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index d10d431d5..57d20df13 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -23,12 +23,10 @@ with Netlists.Cleanup; with Netlists.Memories; with Netlists.Expands; -with Synth.Objtypes; -with Synth.Vhdl_Insts; use Synth.Vhdl_Insts; - +with Elab.Vhdl_Values.Debug; +pragma Unreferenced (Elab.Vhdl_Values.Debug); -with Synth.Values.Debug; -pragma Unreferenced (Synth.Values.Debug); +with Synth.Vhdl_Insts; use Synth.Vhdl_Insts; package body Synthesis is function Make_Base_Instance return Base_Instance_Acc @@ -47,17 +45,14 @@ package body Synthesis is return Base; end Make_Base_Instance; - procedure Synth_Design (Design : Node; - Encoding : Name_Encoding; - M : out Module; - Inst : out Synth_Instance_Acc) + function Synth_Design (Design : Iir; + Inst : Synth_Instance_Acc; + Encoding : Name_Encoding) return Module is Base : Base_Instance_Acc; begin Base := Make_Base_Instance; - Synth.Objtypes.Init; - case Iir_Kinds_Design_Unit (Get_Kind (Design)) is when Iir_Kind_Foreign_Module => if Synth_Top_Foreign = null then @@ -71,11 +66,10 @@ package body Synthesis is Synth.Vhdl_Insts.Synth_All_Instances; if Errorout.Nbr_Errors > 0 then - M := No_Module; - return; + return No_Module; end if; - M := Base.Top_Module; + return Base.Top_Module; end Synth_Design; procedure Instance_Passes (Ctxt : Context_Acc; M : Module) is diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads index 59688832e..30523c21d 100644 --- a/src/synth/synthesis.ads +++ b/src/synth/synthesis.ads @@ -22,15 +22,15 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + with Synth.Context; use Synth.Context; -with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Flags; use Synth.Flags; package Synthesis is - procedure Synth_Design (Design : Iir; - Encoding : Name_Encoding; - M : out Module; - Inst : out Synth_Instance_Acc); + function Synth_Design (Design : Iir; + Inst : Synth_Instance_Acc; + Encoding : Name_Encoding) return Module; -- Run cleanup/memory extraction/expand passes on M. procedure Instance_Passes (Ctxt : Context_Acc; M : Module); diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb index fae87203a..9daa19abc 100644 --- a/src/vhdl/vhdl-annotations.adb +++ b/src/vhdl/vhdl-annotations.adb @@ -122,6 +122,22 @@ package body Vhdl.Annotations is Create_Object_Info (Block_Info, Quantity, Kind_Quantity); end Add_Quantity_Info; + function Create_Block_Info (Block_Info : Sim_Info_Acc; Blk : Iir) + return Sim_Info_Acc + is + Info : Sim_Info_Acc; + begin + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; + + Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Blk, + Inst_Slot => Block_Info.Nbr_Objects, + Nbr_Objects => 0, + Nbr_Instances => 0); + Set_Info (Blk, Info); + return Info; + end Create_Block_Info; + -- If EXPR has not a literal value, create one. -- This is necessary for subtype bounds. procedure Annotate_Range_Expression @@ -244,10 +260,8 @@ package body Vhdl.Annotations is end if; end if; Set_Info (Def, Info); - if not Flag_Synthesis then - Annotate_Range_Expression - (Block_Info, Get_Range_Constraint (Def)); - end if; + Annotate_Range_Expression + (Block_Info, Get_Range_Constraint (Def)); end; end if; @@ -556,15 +570,19 @@ package body Vhdl.Annotations is is Info : Sim_Info_Acc; begin + Info := new Sim_Info_Type'(Kind => Kind_Block, Ref => Comp, - Inst_Slot => Invalid_Instance_Slot, + Inst_Slot => Invalid_Object_Slot, Nbr_Objects => 0, Nbr_Instances => 1); -- For the instance. Set_Info (Comp, Info); Annotate_Interface_List (Info, Get_Generic_Chain (Comp), True); Annotate_Interface_List (Info, Get_Port_Chain (Comp), True); + + -- Last slot is used for the instance. + Info.Nbr_Objects := Info.Nbr_Objects + 1; end Annotate_Component_Declaration; -- For package declaration or package instantiation declaration. @@ -905,14 +923,7 @@ package body Vhdl.Annotations is Header : Iir_Block_Header; Guard : Iir; begin - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Block, - Inst_Slot => Block_Info.Nbr_Instances, - Nbr_Objects => 0, - Nbr_Instances => 0); - Set_Info (Block, Info); - - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + Info := Create_Block_Info (Block_Info, Block); Guard := Get_Guard_Decl (Block); if Guard /= Null_Iir then @@ -933,14 +944,7 @@ package body Vhdl.Annotations is is Info : Sim_Info_Acc; begin - Info := new Sim_Info_Type'(Kind => Kind_Block, - Ref => Bod, - Inst_Slot => Block_Info.Nbr_Instances, - Nbr_Objects => 0, - Nbr_Instances => 0); - Set_Info (Bod, Info); - - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; + Info := Create_Block_Info (Block_Info, Bod); if It /= Null_Iir then Create_Object_Info (Info, It); @@ -953,10 +957,17 @@ package body Vhdl.Annotations is procedure Annotate_If_Generate_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) is + Info : Sim_Info_Acc; Clause : Iir; begin + Info := Create_Block_Info (Block_Info, Stmt); + pragma Unreferenced (Info); + Clause := Stmt; while Clause /= Null_Iir loop + -- Use the same slot as the if-generate statement. + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects - 1; + Annotate_Generate_Statement_Body (Block_Info, Get_Generate_Statement_Body (Clause), Null_Iir); Clause := Get_Generate_Else_Clause (Clause); @@ -967,12 +978,15 @@ package body Vhdl.Annotations is (Block_Info : Sim_Info_Acc; Stmt : Iir) is Param : constant Iir := Get_Parameter_Specification (Stmt); + Info : Sim_Info_Acc; begin -- Elaborate the subtype in the current block. Annotate_Declaration_Type (Block_Info, Param); + Info := Create_Block_Info (Block_Info, Stmt); + Annotate_Generate_Statement_Body - (Block_Info, Get_Generate_Statement_Body (Stmt), Param); + (Info, Get_Generate_Statement_Body (Stmt), Param); end Annotate_For_Generate_Statement; procedure Annotate_Case_Generate_Statement @@ -996,13 +1010,13 @@ package body Vhdl.Annotations is Info: Sim_Info_Acc; begin -- Add a slot just to put the instance. + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; Info := new Sim_Info_Type'(Kind => Kind_Block, Ref => Stmt, - Inst_Slot => Block_Info.Nbr_Instances, + Inst_Slot => Block_Info.Nbr_Objects, Nbr_Objects => 0, Nbr_Instances => 1); Set_Info (Stmt, Info); - Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; end Annotate_Component_Instantiation_Statement; procedure Annotate_Process_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) @@ -1089,7 +1103,7 @@ package body Vhdl.Annotations is begin Entity_Info := new Sim_Info_Type'(Kind => Kind_Block, Ref => Decl, - Inst_Slot => Invalid_Instance_Slot, + Inst_Slot => Invalid_Object_Slot, Nbr_Objects => 0, Nbr_Instances => 0); Set_Info (Decl, Entity_Info); @@ -1130,7 +1144,7 @@ package body Vhdl.Annotations is begin Vunit_Info := new Sim_Info_Type'(Kind => Kind_Block, Ref => Decl, - Inst_Slot => Invalid_Instance_Slot, + Inst_Slot => Invalid_Object_Slot, Nbr_Objects => 0, Nbr_Instances => 0); Set_Info (Decl, Vunit_Info); @@ -1259,7 +1273,7 @@ package body Vhdl.Annotations is new Sim_Info_Type'(Kind => Kind_Block, Ref => El, Nbr_Objects => 0, - Inst_Slot => Invalid_Instance_Slot, + Inst_Slot => Invalid_Object_Slot, Nbr_Instances => 0); Annotate_Package_Declaration (Global_Info, El); -- These types are not in std.standard! @@ -1366,7 +1380,7 @@ package body Vhdl.Annotations is case Info.Kind is when Kind_Block => Put ("inst_slot:" - & Instance_Slot_Type'Image (Info.Inst_Slot)); + & Object_Slot_Type'Image (Info.Inst_Slot)); Put_Line (", nbr instance:" & Instance_Slot_Type'Image (Info.Nbr_Instances)); when others => diff --git a/src/vhdl/vhdl-annotations.ads b/src/vhdl/vhdl-annotations.ads index 2f698cf16..34fa26e12 100644 --- a/src/vhdl/vhdl-annotations.ads +++ b/src/vhdl/vhdl-annotations.ads @@ -92,7 +92,7 @@ package Vhdl.Annotations is case Kind is when Kind_Block => -- Slot number in the parent (for blocks). - Inst_Slot : Instance_Slot_Type; + Inst_Slot : Object_Slot_Type; -- Number of children (blocks, generate, instantiation). Nbr_Instances : Instance_Slot_Type; |