From 324ecaeb2351d190356f679e38166897666dd3e2 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 16 Jun 2019 09:04:12 +0200 Subject: synth: get rid of execution and elaboration. --- src/ghdldrv/ghdlsynth.adb | 8 +- src/synth/synth-context.adb | 331 +++++++++------ src/synth/synth-context.ads | 38 +- src/synth/synth-decls.adb | 198 ++++++++- src/synth/synth-decls.ads | 4 + src/synth/synth-expr.adb | 704 ++++++++++++++++++++------------ src/synth/synth-expr.ads | 18 +- src/synth/synth-stmts.adb | 80 ++-- src/synth/synth-types.adb | 14 +- src/synth/synth-values.adb | 232 ++++++++--- src/synth/synth-values.ads | 129 ++++-- src/synth/synthesis.adb | 50 +-- src/vhdl/simulate/simul-annotations.adb | 93 +++-- src/vhdl/simulate/simul-annotations.ads | 3 + 14 files changed, 1291 insertions(+), 611 deletions(-) (limited to 'src') diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index cec4a7056..f887279a7 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -21,11 +21,13 @@ with Ghdlcomp; with Ghdlmain; use Ghdlmain; with Ghdlsimul; +with Simul.Annotations; + with Libraries; with Flags; with Vhdl.Canon; -with Simul.Elaboration; +-- with Simul.Elaboration; with Synthesis; with Netlists.Dump; @@ -88,6 +90,8 @@ package body Ghdlsynth is end if; end loop; + Simul.Annotations.Flag_Synthesis := True; + Ghdlcomp.Hooks.Compile_Init.all (False); Flags.Flag_Elaborate_With_Outdated := False; Flags.Flag_Only_Elab_Warnings := True; @@ -114,7 +118,7 @@ package body Ghdlsynth is -- Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last)); - Simul.Elaboration.Elaborate_Design (Ghdlsimul.Get_Top_Config); + -- Simul.Elaboration.Elaborate_Design (Ghdlsimul.Get_Top_Config); return Synthesis.Synth_Design (Ghdlsimul.Get_Top_Config); -- Hooks.Run.all; diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 704e22975..c06f89f6b 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -21,15 +21,10 @@ with Ada.Unchecked_Deallocation; with Types; use Types; -with Grt.Types; use Grt.Types; +with Tables; with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Utils; - +with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; - -with Simul.Annotations; use Simul.Annotations; -with Simul.Execution; - with Netlists.Builders; use Netlists.Builders; with Synth.Types; use Synth.Types; @@ -37,18 +32,24 @@ with Synth.Errors; use Synth.Errors; with Synth.Expr; use Synth.Expr; package body Synth.Context is - function Make_Instance (Sim_Inst : Block_Instance_Acc) + package Packages_Table is new Tables + (Table_Component_Type => Synth_Instance_Acc, + Table_Index_Type => Instance_Id, + Table_Low_Bound => 1, + Table_Initial => 16); + + function Make_Instance (Parent : Synth_Instance_Acc; Info : Sim_Info_Acc) return Synth_Instance_Acc is Res : Synth_Instance_Acc; begin - Res := new Synth_Instance_Type'(Max_Objs => Sim_Inst.Max_Objs, + Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects, M => No_Module, Name => No_Sname, - Sim => Sim_Inst, - Objects => (others => <>)); - pragma Assert (Instance_Map (Sim_Inst.Id) = null); - Instance_Map (Sim_Inst.Id) := Res; + Block_Scope => Info, + Up_Block => Parent, + Elab_Objects => 0, + Objects => (others => null)); return Res; end Make_Instance; @@ -57,11 +58,17 @@ package body Synth.Context is procedure Deallocate is new Ada.Unchecked_Deallocation (Synth_Instance_Type, Synth_Instance_Acc); begin - Instance_Map (Synth_Inst.Sim.Id) := null; Deallocate (Synth_Inst); end Free_Instance; - function Alloc_Wire (Kind : Wire_Kind; Obj : Iir; Rng : Value_Range_Acc) + function Create_Value_Instance (Inst : Synth_Instance_Acc) + return Value_Acc is + begin + Packages_Table.Append (Inst); + return Create_Value_Instance (Packages_Table.Last); + end Create_Value_Instance; + + function Alloc_Wire (Kind : Wire_Kind; Obj : Iir; Bnd : Value_Bound_Acc) return Value_Acc is begin Wire_Id_Table.Append ((Kind => Kind, @@ -69,73 +76,147 @@ package body Synth.Context is Decl => Obj, Gate => No_Net, Cur_Assign => No_Assign)); - return Create_Value_Wire (Wire_Id_Table.Last, Rng); + return Create_Value_Wire (Wire_Id_Table.Last, Bnd); end Alloc_Wire; - function Alloc_Object - (Kind : Wire_Kind; Obj : Iir; Val : Iir_Value_Literal_Acc) - return Value_Acc + function Alloc_Object (Kind : Wire_Kind; + Syn_Inst : Synth_Instance_Acc; + Obj : Iir) + return Value_Acc is Obj_Type : constant Iir := Get_Type (Obj); - Btype : constant Iir := Get_Base_Type (Obj_Type); begin - case Get_Kind (Btype) is - when Iir_Kind_Enumeration_Type_Definition => + case Get_Kind (Obj_Type) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => declare - Info : constant Sim_Info_Acc := Get_Info (Btype); - Rng : Value_Range_Acc; + Info : constant Sim_Info_Acc := + Get_Info (Get_Base_Type (Obj_Type)); + Rng : Value_Bound_Acc; begin if Info.Kind = Kind_Bit_Type then Rng := null; else - Rng := Create_Range_Value ((Dir => Iir_Downto, - Len => Info.Width, - Left => Int32 (Info.Width - 1), - Right => 0)); + Rng := Create_Value_Bound + ((Dir => Iir_Downto, + Left => Int32 (Info.Width - 1), + Right => 0, + Len => Info.Width)); end if; return Alloc_Wire (Kind, Obj, Rng); end; - when Iir_Kind_Array_Type_Definition => - -- Well known array types. - if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type - or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type - then - return Alloc_Wire - (Kind, Obj, Bounds_To_Range (Val.Bounds.D (1))); - end if; - if Is_Bit_Type (Get_Element_Subtype (Btype)) - and then Vhdl.Utils.Get_Nbr_Dimensions (Btype) = 1 - then - -- A vector of bits. - return Alloc_Wire - (Kind, Obj, Bounds_To_Range (Val.Bounds.D (1))); - else - raise Internal_Error; - end if; + when Iir_Kind_Array_Subtype_Definition => + declare + El_Type : constant Node := Get_Element_Subtype (Obj_Type); + Bounds : Value_Bound_Acc; + begin + Bounds := Synth_Array_Bounds (Syn_Inst, Obj_Type, 0); + if Is_Bit_Type (El_Type) then + return Alloc_Wire (Kind, Obj, Bounds); + else + raise Internal_Error; + end if; + end; when others => raise Internal_Error; end case; end Alloc_Object; + 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) /= null + then + Error_Msg_Elab ("bad elaboration order"); + raise Internal_Error; + end if; + Syn_Inst.Elab_Objects := Slot + Num - 1; + end Create_Object; + + procedure Create_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Val : Value_Acc) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + Create_Object (Syn_Inst, Info.Slot, 1); + Syn_Inst.Objects (Info.Slot) := Val; + end Create_Object; + procedure Make_Object (Syn_Inst : Synth_Instance_Acc; Kind : Wire_Kind; Obj : Iir) is Otype : constant Iir := Get_Type (Obj); - Slot : constant Object_Slot_Type := Get_Info (Obj).Slot; Val : Value_Acc; begin - Val := Alloc_Object (Kind, Obj, Syn_Inst.Sim.Objects (Slot)); + Val := Alloc_Object (Kind, Syn_Inst, Obj); if Val = null then Error_Msg_Synth (+Obj, "%n is not supported", +Otype); return; end if; - pragma Assert (Syn_Inst.Objects (Slot) = null); - Syn_Inst.Objects (Slot) := Val; + Create_Object (Syn_Inst, Obj, Val); end Make_Object; - function Get_Net (Val : Value_Acc) return Net is + 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. + raise Internal_Error; + else + -- Instantiated package. + declare + Parent : Synth_Instance_Acc; + Inst : Instance_Id; + begin + Parent := Get_Instance_By_Scope (Syn_Inst, Scope.Pkg_Parent); + Inst := Parent.Objects (Scope.Pkg_Slot).Instance; + pragma Assert + (Inst in Packages_Table.First .. Packages_Table.Last); + return Packages_Table.Table (Inst); + end; + end if; + when others => + raise Internal_Error; + end case; + end Get_Instance_By_Scope; + + function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Iir) + return Value_Acc + 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); + end Get_Value; + + function Get_Net (Val : Value_Acc; Vtype : Node) return Net is begin case Val.Kind is when Value_Wire => @@ -144,48 +225,50 @@ package body Synth.Context is return Val.N; when Value_Mux2 => declare - Cond : constant Net := Get_Net (Val.M_Cond); + Cond : constant Net := + Get_Net (Val.M_Cond, + Vhdl.Std_Package.Boolean_Type_Definition); begin return Build_Mux2 (Ctxt => Build_Context, Sel => Cond, - I0 => Get_Net (Val.M_F), - I1 => Get_Net (Val.M_T)); + I0 => Get_Net (Val.M_F, Vtype), + I1 => Get_Net (Val.M_T, Vtype)); end; - when Value_Lit => - case Val.Lit.Kind is - when Iir_Value_E8 - | Iir_Value_B1 => - declare - Info : constant Sim_Info_Acc := - Get_Info (Get_Base_Type (Val.Lit_Type)); - begin - case Info.Kind is - when Kind_Bit_Type => - declare - V, Xz : Uns32; - begin - To_Logic (Val.Lit, V, Xz); - if Xz = 0 then - return Build_Const_UB32 - (Build_Context, V, 1); - else - return Build_Const_UL32 - (Build_Context, V, Xz, 1); - end if; - end; - when Kind_Enum_Type => - -- State machine. - return Build_Const_UB32 - (Build_Context, Uns32 (Val.Lit.E8), Info.Width); - when others => - raise Internal_Error; - end case; - end; - when Iir_Value_I64 => - if Val.Lit.I64 >= 0 then + when Value_Logic => + if Val.Log_Zx = 0 then + return Build_Const_UB32 + (Build_Context, Val.Log_Val, 1); + else + return Build_Const_UL32 + (Build_Context, Val.Log_Val, Val.Log_Zx, 1); + end if; + when Value_Discrete => + declare + Btype : constant Node := Get_Base_Type (Vtype); + Va : Uns32; + Zx : Uns32; + begin + if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then + From_Std_Logic (Val.Scal, Va, Zx); + if Zx = 0 then + return Build_Const_UB32 (Build_Context, Va, 1); + else + return Build_Const_UL32 (Build_Context, Va, Zx, 1); + end if; + elsif Btype = Vhdl.Std_Package.Boolean_Type_Definition + or else Btype = Vhdl.Std_Package.Bit_Type_Definition + then + From_Bit (Val.Scal, Va); + return Build_Const_UB32 (Build_Context, Va, 1); + elsif Get_Kind (Btype) = Iir_Kind_Enumeration_Type_Definition + then + return Build_Const_UB32 (Build_Context, Uns32 (Val.Scal), + Get_Info (Btype).Width); + else + if Val.Scal >= 0 then for I in 1 .. 32 loop - if Val.Lit.I64 < (2**I) then + if Val.Scal < (2**I) then return Build_Const_UB32 - (Build_Context, Uns32 (Val.Lit.I64), Width (I)); + (Build_Context, Uns32 (Val.Scal), Width (I)); end if; end loop; -- Need Uconst64 @@ -194,56 +277,38 @@ package body Synth.Context is -- Need Sconst32/Sconst64 raise Internal_Error; end if; - when Iir_Value_Array => - if Is_Vector_Type (Val.Lit_Type) then - if Val.Lit.Bounds.D (1).Length <= 32 then - declare - Len : constant Iir_Index32 := Val.Lit.Val_Array.Len; - R_Val, R_Xz : Uns32; - V, Xz : Uns32; - begin - R_Val := 0; - R_Xz := 0; - for I in 1 .. Len loop - To_Logic (Val.Lit.Val_Array.V (I), V, Xz); - R_Val := - R_Val or Shift_Left (V, Natural (Len - I)); - R_Xz := - R_Xz or Shift_Left (Xz, Natural (Len - I)); - end loop; - if R_Xz = 0 then - return Build_Const_UB32 - (Build_Context, R_Val, Uns32 (Len)); - else - return Build_Const_UL32 - (Build_Context, R_Val, R_Xz, Uns32 (Len)); - end if; - end; - else - -- Need Uconst64 / UconstBig - raise Internal_Error; - end if; + end if; + end; + when Value_Array => + if Val.Bounds.D (1).Len <= 32 then + declare + Len : constant Iir_Index32 := + Iir_Index32 (Val.Bounds.D (1).Len); + Etype : constant Node := Get_Element_Subtype (Vtype); + R_Val, R_Zx : Uns32; + V, Zx : Uns32; + begin + R_Val := 0; + R_Zx := 0; + for I in 1 .. Len loop + To_Logic (Val.Arr.V (I).Scal, Etype, V, Zx); + R_Val := R_Val or Shift_Left (V, Natural (Len - I)); + R_Zx := R_Zx or Shift_Left (Zx, Natural (Len - I)); + end loop; + if R_Zx = 0 then + return Build_Const_UB32 + (Build_Context, R_Val, Uns32 (Len)); else - raise Internal_Error; + return Build_Const_UL32 + (Build_Context, R_Val, R_Zx, Uns32 (Len)); end if; - when others => - raise Internal_Error; - end case; + end; + else + -- Need Uconst64 / UconstBig + raise Internal_Error; + end if; when others => raise Internal_Error; end case; end Get_Net; - - function Get_Value (Inst : Synth_Instance_Acc; Obj : Iir) return Value_Acc - is - Info : constant Sim_Info_Acc := Get_Info (Obj); - Sim_Inst : constant Block_Instance_Acc := - Simul.Execution.Get_Instance_By_Scope (Inst.Sim, Info.Obj_Scope); - Val : Value_Acc; - begin - Val := Instance_Map (Sim_Inst.Id).Objects (Info.Slot); - pragma Assert (Val /= null); - return Val; - end Get_Value; - end Synth.Context; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 1bc36301f..e09702e1d 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -20,7 +20,7 @@ with Synth.Environment; use Synth.Environment; with Synth.Values; use Synth.Values; -with Simul.Environments; use Simul.Environments; +with Simul.Annotations; use Simul.Annotations; with Netlists; use Netlists; with Netlists.Builders; with Vhdl.Nodes; use Vhdl.Nodes; @@ -30,6 +30,9 @@ package Synth.Context is -- Block_Instance_Type. type Objects_Array is array (Object_Slot_Type range <>) of Value_Acc; + type Synth_Instance_Type; + type Synth_Instance_Acc is access Synth_Instance_Type; + type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is record -- Module which owns gates created for this instance. M : Module; @@ -37,30 +40,41 @@ package Synth.Context is -- Name prefix for declarations. Name : Sname; - -- The corresponding instance from simulation. - Sim : Block_Instance_Acc; + -- The corresponding info for this instance. + Block_Scope : Sim_Info_Acc; + + -- Parent instance. + Up_Block : Synth_Instance_Acc; + + Elab_Objects : Object_Slot_Type; -- Instance for synthesis. Objects : Objects_Array (1 .. Max_Objs); end record; - type Synth_Instance_Acc is access Synth_Instance_Type; - type Instance_Map_Array is array (Block_Instance_Id range <>) of Synth_Instance_Acc; type Instance_Map_Array_Acc is access Instance_Map_Array; - -- Map between simulation instance and synthesis instance. - Instance_Map : Instance_Map_Array_Acc; + -- The instance corresponding to the global_info. It contains the global + -- packages. + Global_Instance : Synth_Instance_Acc; -- Global context. Build_Context : Netlists.Builders.Context_Acc; + function Get_Instance_By_Scope + (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc) + return Synth_Instance_Acc; + -- Create and free the corresponding synth instance. - function Make_Instance (Sim_Inst : Block_Instance_Acc) + function Make_Instance (Parent : Synth_Instance_Acc; Info : Sim_Info_Acc) return Synth_Instance_Acc; procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc); + procedure Create_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Val : Value_Acc); + -- Build the value for object OBJ. -- KIND must be Wire_Variable or Wire_Signal. procedure Make_Object (Syn_Inst : Synth_Instance_Acc; @@ -68,9 +82,13 @@ package Synth.Context is Obj : Iir); -- Get the value of OBJ. - function Get_Value (Inst : Synth_Instance_Acc; Obj : Iir) return Value_Acc; + function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Iir) + return Value_Acc; -- Get a net from a scalar/vector value. This will automatically create -- a net for literals. - function Get_Net (Val : Value_Acc) return Net; + function Get_Net (Val : Value_Acc; Vtype : Node) return Net; + + function Create_Value_Instance (Inst : Synth_Instance_Acc) + return Value_Acc; end Synth.Context; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 8352707e2..b9ce77fed 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -23,15 +23,19 @@ with Mutils; use Mutils; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; with Synth.Types; use Synth.Types; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; -with Simul.Environments; use Simul.Environments; +with Synth.Expr; use Synth.Expr; with Simul.Annotations; use Simul.Annotations; package body Synth.Decls is + procedure Synth_Anonymous_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node); + procedure Create_Var_Wire - (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Iir_Value_Literal_Acc) + (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Value_Acc) is Val : constant Value_Acc := Get_Value (Syn_Inst, Decl); Value : Net; @@ -45,7 +49,7 @@ package body Synth.Decls is W := Get_Width (Syn_Inst, Get_Type (Decl)); Name := New_Sname (Syn_Inst.Name, Get_Identifier (Decl)); if Init /= null then - Ival := Get_Net (Create_Value_Lit (Init, Get_Type (Decl))); + Ival := Get_Net (Init, Get_Type (Decl)); pragma Assert (Get_Width (Ival) = W); Value := Build_Isignal (Build_Context, Name, Ival); else @@ -88,18 +92,182 @@ package body Synth.Decls is end case; end Synth_Type_Definition; + function Synth_Range_Constraint + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc is + begin + case Get_Kind (Rng) is + when Iir_Kind_Range_Expression => + -- FIXME: check range. + return Synth_Range_Expression (Syn_Inst, Rng); + when others => + Error_Kind ("synth_range_constraint", Rng); + end case; + end Synth_Range_Constraint; + + procedure Synth_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) is + begin + case Get_Kind (Atype) is + when Iir_Kind_Array_Subtype_Definition => + -- LRM93 12.3.1.3 + -- The elaboration of an index constraint consists of the + -- declaration of each of the discrete ranges in the index + -- constraint in some order that is not defined by the language. + Synth_Anonymous_Subtype_Indication + (Syn_Inst, Get_Element_Subtype (Atype)); + declare + St_Indexes : constant Iir_Flist := + Get_Index_Subtype_List (Atype); + St_El : Iir; + Bnds : Value_Bound_Array_Acc; + begin + -- FIXME: partially constrained arrays, subtype in indexes... + Bnds := Create_Value_Bound_Array + (Iir_Index32 (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 (Iir_Index32 (I + 1)) := + Synth_Bounds_From_Range (Syn_Inst, St_El); + end loop; + Create_Object (Syn_Inst, Atype, + Create_Value_Bounds (Bnds)); + end; + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition => + declare + Val : Value_Acc; + begin + Val := Synth_Range_Constraint + (Syn_Inst, Get_Range_Constraint (Atype)); + Create_Object (Syn_Inst, Atype, Unshare (Val, Instance_Pool)); + end; + when Iir_Kind_Enumeration_Subtype_Definition => + null; + when others => + Error_Kind ("synth_subtype_indication", Atype); + end case; + end Synth_Subtype_Indication; + + procedure Synth_Anonymous_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) is + begin + if Atype = Null_Node + or else Get_Type_Declarator (Atype) /= Null_Node + then + return; + end if; + Synth_Subtype_Indication (Syn_Inst, Atype); + end Synth_Anonymous_Subtype_Indication; + + procedure Synth_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Ind : constant Node := Get_Subtype_Indication (Decl); + Atype : Node; + begin + if Ind = Null_Node then + -- No subtype indication; use the same type. + return; + 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 => + return; + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + Synth_Subtype_Indication (Syn_Inst, Atype); + return; + when others => + Error_Kind ("synth_declaration_type", Atype); + end case; + end loop; + end Synth_Declaration_Type; + + procedure Synth_Constant_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl); + First_Decl : Node; + Val : Value_Acc; + begin + if Deferred_Decl = Null_Node + or else Get_Deferred_Declaration_Flag (Decl) + then + -- Create the object (except for full declaration of a + -- deferred constant). + Synth_Declaration_Type (Syn_Inst, Decl); + Create_Object (Syn_Inst, Decl, null); + end if; + -- Initialize the value (except for a deferred declaration). + if Deferred_Decl = Null_Node then + First_Decl := Decl; + elsif not Get_Deferred_Declaration_Flag (Decl) then + First_Decl := Deferred_Decl; + else + First_Decl := Null_Node; + end if; + if First_Decl /= Null_Node then + Val := Synth_Expression_With_Type + (Syn_Inst, Get_Default_Value (Decl), Get_Type (Decl)); + Syn_Inst.Objects (Get_Info (First_Decl).Slot) := Val; + end if; + end Synth_Constant_Declaration; + + procedure Synth_Attribute_Specification + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Value : Iir_Attribute_Value; + Val : Value_Acc; + begin + Value := Get_Attribute_Value_Spec_Chain (Decl); + 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 := Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Decl), Get_Type (Value)); + -- 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 Synth_Attribute_Specification; + + procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is begin case Get_Kind (Decl) is when Iir_Kind_Variable_Declaration => + Synth_Declaration_Type (Syn_Inst, Decl); declare Def : constant Iir := Get_Default_Value (Decl); - Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - Init : Iir_Value_Literal_Acc; + -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + Init : Value_Acc; begin Make_Object (Syn_Inst, Wire_Variable, Decl); if Is_Valid (Def) then - Init := Syn_Inst.Sim.Objects (Slot); + -- TODO. + raise Internal_Error; else Init := null; end if; @@ -110,16 +278,19 @@ package body Synth.Decls is Make_Object (Syn_Inst, Wire_Variable, Decl); Create_Var_Wire (Syn_Inst, Decl, null); when Iir_Kind_Constant_Declaration => - null; + Synth_Constant_Declaration (Syn_Inst, Decl); when Iir_Kind_Signal_Declaration => + Synth_Declaration_Type (Syn_Inst, Decl); declare Def : constant Iir := Get_Default_Value (Decl); - Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - Init : Iir_Value_Literal_Acc; + -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + Init : Value_Acc; begin Make_Object (Syn_Inst, Wire_Signal, Decl); if Is_Valid (Def) then - Init := Syn_Inst.Sim.Objects (Slot + 1); + -- TODO. + raise Internal_Error; + -- Init := Syn_Inst.Sim.Objects (Slot + 1); else Init := null; end if; @@ -133,15 +304,16 @@ package body Synth.Decls is | Iir_Kind_Function_Body => 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 => - null; + Synth_Attribute_Specification (Syn_Inst, Decl); when Iir_Kind_Type_Declaration | Iir_Kind_Anonymous_Type_Declaration => Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); when Iir_Kind_Subtype_Declaration => - -- TODO - null; + Synth_Declaration_Type (Syn_Inst, Decl); when Iir_Kind_Component_Declaration => null; when Iir_Kind_File_Declaration => diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index 0fab14b39..0a5590b35 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -22,6 +22,10 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; package Synth.Decls is + -- Elaborate the type of DECL. + procedure Synth_Declaration_Type + (Syn_Inst : Synth_Instance_Acc; Decl : Node); + procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node); procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; Decls : Node); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index a14f7db32..60cd7cc71 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -21,12 +21,13 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Std_Names; +with Str_Table; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Std_Package; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; -with Simul.Execution; -with Grt.Types; use Grt.Types; +with Vhdl.Evaluation; use Vhdl.Evaluation; +with Simul.Annotations; use Simul.Annotations; with Synth.Errors; use Synth.Errors; with Synth.Types; use Synth.Types; @@ -38,21 +39,28 @@ with Netlists.Builders; use Netlists.Builders; package body Synth.Expr is function Is_Const (Val : Value_Acc) return Boolean is begin - return Val.Kind = Value_Lit; + case Val.Kind is + when Value_Logic + | Value_Discrete => + return True; + when Value_Net + | Value_Wire + | Value_Mux2 => + return False; + when others => + -- TODO. + raise Internal_Error; + end case; end Is_Const; function Get_Width (Val : Value_Acc) return Uns32 is begin case Val.Kind is - when Value_Lit => - if Is_Bit_Type (Val.Lit_Type) then - return 1; - else - raise Internal_Error; - end if; + when Value_Logic => + return 1; when Value_Wire | Value_Net => - return Get_Width (Get_Net (Val)); + return Get_Width (Get_Net (Val, Null_Node)); when others => raise Internal_Error; -- TODO end case; @@ -60,93 +68,89 @@ package body Synth.Expr is function Is_Logic (Val : Value_Acc) return Boolean is begin - if Val.Kind = Value_Lit then - case Val.Lit.Kind is - when Iir_Value_B1 => - return True; - when Iir_Value_E8 => - return Is_Bit_Type (Val.Lit_Type); - when others => - return False; - end case; - else - return False; - end if; + return Val.Kind = Value_Logic; end Is_Logic; - procedure To_Logic (Lit : Iir_Value_Literal_Acc; - Val : out Uns32; - Zx : out Uns32) is + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is begin - case Lit.Kind is - when Iir_Value_B1 => + case Enum is + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos => + Val := 0; Zx := 0; - Val := Ghdl_B1'Pos (Lit.B1); - when Iir_Value_E8 => - -- Std_logic. - case Lit.E8 is - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos => - Val := 0; - Zx := 0; - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => - Val := 1; - Zx := 0; - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos => - Val := 1; - Zx := 1; - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos => - Val := 0; - Zx := 1; - when others => - -- Only 9 values. - raise Internal_Error; - end case; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => + Val := 1; + Zx := 0; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos => + Val := 1; + Zx := 1; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos => + Val := 0; + Zx := 1; when others => + -- Only 9 values. raise Internal_Error; end case; + end From_Std_Logic; + + procedure From_Bit (Enum : Int64; Val : out Uns32) is + begin + if Enum = 0 then + Val := 0; + elsif Enum = 1 then + Val := 1; + else + raise Internal_Error; + end if; + end From_Bit; + + procedure To_Logic + (Enum : Int64; Etype : Node; Val : out Uns32; Zx : out Uns32) + is + Btype : constant Node := Get_Base_Type (Etype); + begin + if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then + From_Std_Logic (Enum, Val, Zx); + elsif Btype = Vhdl.Std_Package.Boolean_Type_Definition + or else Btype = Vhdl.Std_Package.Bit_Type_Definition + then + From_Bit (Enum, Val); + Zx := 0; + else + raise Internal_Error; + end if; end To_Logic; function Bit_Extract (Val : Value_Acc; Off : Uns32) return Value_Acc is begin case Val.Kind is - when Value_Lit => - declare - Lit : constant Iir_Value_Literal_Acc := Val.Lit; - begin - pragma Assert (Lit.Kind = Iir_Value_Array); - pragma Assert (Lit.Bounds.Nbr_Dims = 1); - pragma Assert (Lit.Bounds.D (1).Length >= Iir_Index32 (Off)); - return Create_Value_Lit - (Lit.Val_Array.V (Lit.Val_Array.Len - Iir_Index32 (Off)), - Get_Element_Subtype (Val.Lit_Type)); - end; + when Value_Array => + pragma Assert (Val.Bounds.D (1).Len >= Off); + return Val.Arr.V (Iir_Index32 (Val.Bounds.D (1).Len - Off)); when Value_Net | Value_Wire => return Create_Value_Net - (Build_Extract_Bit (Build_Context, Get_Net (Val), Off), - No_Range); + (Build_Extract_Bit + (Build_Context, Get_Net (Val, Null_Node), Off), + No_Bound); when others => raise Internal_Error; end case; end Bit_Extract; - function Vec_Extract (Val : Value_Acc; Off : Uns32; Rng : Value_Range_Acc) + function Vec_Extract (Val : Value_Acc; Off : Uns32; Bnd : Value_Bound_Acc) return Value_Acc is begin case Val.Kind is - when Value_Lit => - -- TODO. - raise Internal_Error; when Value_Net | Value_Wire => return Create_Value_Net - (Build_Slice (Build_Context, Get_Net (Val), Off, Rng.Len), - Rng); + (Build_Slice (Build_Context, + Get_Net (Val, Null_Node), Off, Bnd.Len), Bnd); when others => raise Internal_Error; end case; @@ -165,38 +169,66 @@ package body Synth.Expr is end if; end Synth_Uresize; - function Synth_Uresize (Val : Value_Acc; W : Width) return Net is + function Synth_Uresize (Val : Value_Acc; Vtype : Node; W : Width) + return Net is begin - return Synth_Uresize (Get_Net (Val), W); + return Synth_Uresize (Get_Net (Val, Vtype), W); end Synth_Uresize; - procedure Fill_Array_Aggregate - (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Res : Value_Acc; - Dim : Iir_Index32; - Orig : Iir_Index32; - Stride : Iir_Index32) + function Get_Index_Offset (Index: Value_Acc; + Bounds: Value_Bound_Acc; + Expr: Iir) + return Uns32 is + begin + if Index.Kind = Value_Discrete then + declare + Left : constant Int64 := Int64 (Bounds.Left); + Right : constant Int64 := Int64 (Bounds.Right); + begin + case Bounds.Dir is + when Iir_To => + if Index.Scal >= Left and then Index.Scal <= Right then + -- to + return Uns32 (Index.Scal - Left); + end if; + when Iir_Downto => + if Index.Scal <= Left and then Index.Scal >= Right then + -- downto + return Uns32 (Left - Index.Scal); + end if; + end case; + end; + else + raise Internal_Error; + end if; + Error_Msg_Synth (+Expr, "index out of bounds"); + return 0; + end Get_Index_Offset; + + procedure Fill_Array_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Res : Value_Acc; + Dim : Natural) is - Bound : constant Iir_Value_Literal_Acc := Res.Bounds.D (Dim); + Bound : constant Value_Bound_Acc := Res.Bounds.D (1); Aggr_Type : constant Node := Get_Type (Aggr); El_Type : constant Node := Get_Element_Subtype (Aggr_Type); - Idx_Type : constant Node := - Get_Index_Type (Aggr_Type, Natural (Dim - 1)); - type Boolean_Array is array (Iir_Index32 range <>) of Boolean; + Nbr_Dims : constant Natural := Get_Nbr_Dimensions (Aggr_Type); + Idx_Type : constant Node := Get_Index_Type (Aggr_Type, Dim); + type Boolean_Array is array (Uns32 range <>) of Boolean; pragma Pack (Boolean_Array); - Is_Set : Boolean_Array (0 .. Bound.Length - 1); + Is_Set : Boolean_Array (0 .. Bound.Len - 1); Value : Node; Assoc : Node; - Pos : Iir_Index32; + Pos : Uns32; - procedure Set_Elem (Pos : Iir_Index32) + procedure Set_Elem (Pos : Uns32) is Val : Value_Acc; begin - if Dim = Res.Bounds.Nbr_Dims then + if Dim = Nbr_Dims - 1 then Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); - Res.Arr.V (Orig + Stride * Pos) := Val; + Res.Arr.V (Iir_Index32 (Pos + 1)) := Val; pragma Assert (not Is_Set (Pos)); Is_Set (Pos) := True; else @@ -212,14 +244,14 @@ package body Synth.Expr is loop case Get_Kind (Assoc) is when Iir_Kind_Choice_By_None => - if Pos >= Bound.Length then + if Pos >= Bound.Len then Error_Msg_Synth (+Assoc, "element out of array bound"); else Set_Elem (Pos); end if; Pos := Pos + 1; when Iir_Kind_Choice_By_Others => - while Pos < Bound.Length loop + while Pos < Bound.Len loop if not Is_Set (Pos) then Set_Elem (Pos); end if; @@ -235,8 +267,7 @@ package body Synth.Expr is if not Is_Const (Idx) then Error_Msg_Synth (+Ch, "choice is not static"); else - Set_Elem (Simul.Execution.Get_Index_Offset - (Idx.Lit, Bound, Ch)); + Set_Elem (Get_Index_Offset (Idx, Bound, Ch)); end if; end; when Iir_Kind_Choice_By_Range => @@ -258,7 +289,7 @@ package body Synth.Expr is (Net_Array, Net_Array_Acc); -- Convert the one-dimension VAL to a net by concatenating. - function Vectorize_Array (Val : Value_Acc) return Value_Acc + function Vectorize_Array (Val : Value_Acc; Etype : Node) return Value_Acc is Arr : Net_Array_Acc; Len : Iir_Index32; @@ -285,14 +316,15 @@ package body Synth.Expr is and then Off < 32 and then Is_Logic (Val.Arr.V (Idx)) loop - To_Logic (Val.Arr.V (Idx).Lit, B_Va, B_Zx); + B_Va := Val.Arr.V (Idx).Log_Val; + B_Zx := Val.Arr.V (Idx).Log_Zx; W_Zx := W_Zx or Shift_Left (B_Zx, Off); W_Va := W_Va or Shift_Left (B_Va, Off); Off := Off + 1; Idx := Idx + 1; end loop; if Off = 0 then - E := Get_Net (Val.Arr.V (Idx)); + E := Get_Net (Val.Arr.V (Idx), Etype); Idx := Idx + 1; else if W_Zx = 0 then @@ -336,13 +368,94 @@ package body Synth.Expr is Len := New_Idx; end loop; - Res := Create_Value_Net (Arr (1), Bounds_To_Range (Val.Bounds.D (1))); + Res := Create_Value_Net (Arr (1), Val.Bounds.D (1)); Free_Net_Array (Arr); return Res; end Vectorize_Array; + function Synth_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc + is + L, R : Value_Acc; + Res : Value_Acc; + begin + L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); + R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); + case Get_Kind (Get_Type (Rng)) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Physical_Subtype_Definition => + Res := Create_Value_Range ((Get_Direction (Rng), L.Scal, R.Scal)); + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Floating_Subtype_Definition => + Res := Create_Value_Fp_Range ((Get_Direction (Rng), L.Fp, R.Fp)); + when others => + Error_Kind ("synth_range_expression", Get_Type (Rng)); + end case; + return Res; + end Synth_Range_Expression; + + function Synth_Range (Syn_Inst : Synth_Instance_Acc; Bound : Node) + return Value_Acc is + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + return Synth_Range_Expression (Syn_Inst, Bound); + when Iir_Kind_Integer_Subtype_Definition => + return Synth_Range (Syn_Inst, Get_Range_Constraint (Bound)); + when others => + Error_Kind ("synth_range", Bound); + end case; + end Synth_Range; + + function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; + Atype : Node; + Dim : Natural) return Value_Bound_Acc + 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, Dim); + begin + return Synth_Bounds_From_Range (Syn_Inst, Index_Type); + end; + else + declare + Bnds : constant Value_Acc := Get_Value (Syn_Inst, Atype); + begin + return Bnds.Bnds.D (Iir_Index32 (Dim) + 1); + end; + end if; + end Synth_Array_Bounds; + + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; + Atype : Node) return Value_Bound_Acc + is + Rng : Value_Acc; + Len : Int64; + begin + Rng := Synth_Range (Syn_Inst, Atype); + case Rng.Rng.Dir is + when Iir_To => + Len := Rng.Rng.Right - Rng.Rng.Left + 1; + when Iir_Downto => + Len := Rng.Rng.Left - Rng.Rng.Right + 1; + end case; + if Len < 0 then + Len := 0; + end if; + return Create_Value_Bound + ((Rng.Rng.Dir, Int32 (Rng.Rng.Left), Int32 (Rng.Rng.Right), + Uns32 (Len))); + end Synth_Bounds_From_Range; + function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node; Aggr_Type : Node) return Value_Acc is @@ -350,22 +463,27 @@ package body Synth.Expr is case Get_Kind (Aggr_Type) is when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => + if not Is_Vector_Type (Aggr_Type) then + -- TODO: generalize, in particular multi-dim arrays. + raise Internal_Error; + end if; declare - Bnd : Iir_Value_Literal_Acc; + Bnd : Value_Bound_Acc; + Bnds : Value_Bound_Array_Acc; Res : Value_Acc; begin -- Create bounds. - Bnd := Simul.Execution.Create_Array_Bounds_From_Type - (Syn_Inst.Sim, Aggr_Type, False); + Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 0); -- Allocate result - Res := Create_Array_Value (Bnd.Bounds); + Bnds := Create_Value_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Value_Array (Bnds); Create_Array_Data (Res); - Fill_Array_Aggregate - (Syn_Inst, Aggr, Res, - 1, 1, Res.Arr.Len / Res.Bounds.D (1).Length); + Fill_Array_Aggregate (Syn_Inst, Aggr, Res, 0); if Is_Vector_Type (Aggr_Type) then -- Vectorize - Res := Vectorize_Array (Res); + Res := Vectorize_Array + (Res, Get_Element_Subtype (Aggr_Type)); end if; return Res; end; @@ -377,57 +495,56 @@ package body Synth.Expr is end case; end Synth_Aggregate; - function Synth_Bit_Eq_Const (Cst : Value_Acc; Expr : Value_Acc; Loc : Node) - return Value_Acc + function Synth_Bit_Eq_Const + (Cst : Value_Acc; Expr : Value_Acc; Etype : Node; Loc : Node) + return Value_Acc is pragma Unreferenced (Loc); Val : Uns32; - Xz : Uns32; + Zx : Uns32; begin - To_Logic (Cst.Lit, Val, Xz); - if Xz /= 0 then + To_Logic (Cst.Scal, Etype, Val, Zx); + if Zx /= 0 then return Create_Value_Net - (Build_Const_UL32 (Build_Context, 0, 1, 1), No_Range); + (Build_Const_UL32 (Build_Context, 0, 1, 1), No_Bound); elsif Val = 1 then return Expr; else pragma Assert (Val = 0); return Create_Value_Net - (Build_Monadic (Build_Context, Id_Not, Get_Net (Expr)), No_Range); + (Build_Monadic (Build_Context, Id_Not, Get_Net (Expr, Etype)), + No_Bound); end if; end Synth_Bit_Eq_Const; - function Extract_Range (Val : Value_Acc) return Value_Range_Acc is + function Extract_Bound (Val : Value_Acc) return Value_Bound_Acc is begin case Val.Kind is when Value_Net => - return Val.N_Range; + return Val.N_Bound; when Value_Wire => - return Val.W_Range; + return Val.W_Bound; when others => raise Internal_Error; end case; - end Extract_Range; + end Extract_Bound; -- Create the result range of an operator. According to the ieee standard, -- the range is LEN-1 downto 0. - function Create_Res_Range (Prev : Value_Acc; N : Net) - return Value_Range_Acc + function Create_Res_Bound (Prev : Value_Acc; N : Net) return Value_Bound_Acc is - Res : Value_Range_Acc; + Res : Value_Bound_Acc; Wd : Width; begin case Prev.Kind is when Value_Net | Value_Wire => - Res := Extract_Range (Prev); - when Value_Lit => - Res := No_Range; + Res := Extract_Bound (Prev); when others => raise Internal_Error; end case; - if Res /= No_Range + if Res /= No_Bound and then Res.Dir = Iir_Downto and then Res.Right = 0 then @@ -436,50 +553,94 @@ package body Synth.Expr is end if; Wd := Get_Width (N); - return Create_Range_Value ((Iir_Downto, Wd, Int32 (Wd - 1), 0)); - end Create_Res_Range; + return Create_Value_Bound ((Dir => Iir_Downto, + Left => Int32 (Wd - 1), + Right => 0, + Len => Wd)); + end Create_Res_Bound; + + function Create_Bounds_From_Length + (Syn_Inst : Synth_Instance_Acc; Atype : Iir; Len : Iir_Index32) + return Value_Bound_Acc + is + Res : Value_Bound_Acc; + Index_Bounds : Value_Acc; + begin + Index_Bounds := Synth_Range (Syn_Inst, Atype); + + Res := Create_Value_Bound ((Left => Int32 (Index_Bounds.Rng.Left), + Right => 0, + Dir => Index_Bounds.Rng.Dir, + Len => Uns32 (Len))); + + if Len = 0 then + -- Special case. + Res.Right := Res.Left; + case Index_Bounds.Rng.Dir is + when Iir_To => + Res.Left := Res.Right + 1; + when Iir_Downto => + Res.Left := Res.Right - 1; + end case; + else + case Index_Bounds.Rng.Dir is + when Iir_To => + Res.Right := Res.Left + Int32 (Len - 1); + when Iir_Downto => + Res.Right := Res.Left - Int32 (Len - 1); + end case; + end if; + return Res; + end Create_Bounds_From_Length; function Synth_Dyadic_Operation (Syn_Inst : Synth_Instance_Acc; Def : Iir_Predefined_Functions; - Left : Value_Acc; - Right : Value_Acc; + Left_Expr : Node; + Right_Expr : Node; Expr : Node) return Value_Acc is + Ltype : constant Node := Get_Type (Left_Expr); + Rtype : constant Node := Get_Type (Right_Expr); + Left : Value_Acc; + Right : Value_Acc; + function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is begin return Create_Value_Net - (Build_Dyadic (Build_Context, Id, Get_Net (Left), Get_Net (Right)), - No_Range); + (Build_Dyadic (Build_Context, Id, + Get_Net (Left, Ltype), Get_Net (Right, Rtype)), + No_Bound); end Synth_Bit_Dyadic; function Synth_Compare (Id : Compare_Module_Id) return Value_Acc is begin return Create_Value_Net - (Build_Compare (Build_Context, Id, Get_Net (Left), Get_Net (Right)), - No_Range); + (Build_Compare (Build_Context, Id, + Get_Net (Left, Ltype), Get_Net (Right, Rtype)), + No_Bound); end Synth_Compare; function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is - L : constant Net := Get_Net (Left); + L : constant Net := Get_Net (Left, Ltype); begin return Create_Value_Net - (Build_Dyadic (Build_Context, Id, L, Get_Net (Right)), - Create_Res_Range (Left, L)); + (Build_Dyadic (Build_Context, Id, L, Get_Net (Right, Rtype)), + Create_Res_Bound (Left, L)); end Synth_Vec_Dyadic; function Synth_Dyadic_Uns (Id : Dyadic_Module_Id; Is_Res_Vec : Boolean) return Value_Acc is - L : constant Net := Get_Net (Left); - R : constant Net := Get_Net (Right); + L : constant Net := Get_Net (Left, Ltype); + R : constant Net := Get_Net (Right, Rtype); W : constant Width := Width'Max (Get_Width (L), Get_Width (R)); - Rtype : Value_Range_Acc; + Rtype : Value_Bound_Acc; begin if Is_Res_Vec then - Rtype := Create_Range_Value ((Iir_Downto, W, Int32 (W - 1), 0)); + Rtype := Create_Value_Bound ((Iir_Downto, Int32 (W - 1), 0, W)); else - Rtype := No_Range; + Rtype := No_Bound; end if; return Create_Value_Net (Build_Dyadic @@ -487,6 +648,9 @@ package body Synth.Expr is Rtype); end Synth_Dyadic_Uns; begin + Left := Synth_Expression (Syn_Inst, Left_Expr); + Right := Synth_Expression (Syn_Inst, Right_Expr); + case Def is when Iir_Predefined_Error => return null; @@ -519,11 +683,12 @@ package body Synth.Expr is return Synth_Bit_Dyadic (Id_Xnor); when Iir_Predefined_Enum_Equality => - if Get_Width (Left) = 1 then + if Is_Bit_Type (Ltype) then + pragma Assert (Is_Bit_Type (Rtype)); if Is_Const (Left) then - return Synth_Bit_Eq_Const (Left, Right, Expr); + return Synth_Bit_Eq_Const (Left, Right, Ltype, Expr); elsif Is_Const (Right) then - return Synth_Bit_Eq_Const (Right, Left, Expr); + return Synth_Bit_Eq_Const (Right, Left, Ltype, Expr); end if; end if; return Synth_Compare (Id_Eq); @@ -535,12 +700,13 @@ package body Synth.Expr is when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat => -- "+" (Unsigned, Natural) declare - L : constant Net := Get_Net (Left); + L : constant Net := Get_Net (Left, Ltype); begin return Create_Value_Net - (Build_Dyadic (Build_Context, Id_Add, - L, Synth_Uresize (Right, Get_Width (Left))), - Create_Res_Range (Left, L)); + (Build_Dyadic + (Build_Context, Id_Add, + L, Synth_Uresize (Right, Rtype, Get_Width (Left))), + Create_Res_Bound (Left, L)); end; when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns => -- "+" (Unsigned, Unsigned) @@ -548,12 +714,13 @@ package body Synth.Expr is when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat => -- "-" (Unsigned, Natural) declare - L : constant Net := Get_Net (Left); + L : constant Net := Get_Net (Left, Ltype); begin return Create_Value_Net - (Build_Dyadic (Build_Context, Id_Sub, - L, Synth_Uresize (Right, Get_Width (Left))), - Create_Res_Range (Left, L)); + (Build_Dyadic + (Build_Context, Id_Sub, + L, Synth_Uresize (Right, Rtype, Get_Width (Left))), + Create_Res_Bound (Left, L)); end; when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Uns => -- "-" (Unsigned, Unsigned) @@ -562,51 +729,49 @@ package body Synth.Expr is -- "=" (Unsigned, Natural) return Create_Value_Net (Build_Compare (Build_Context, Id_Eq, - Get_Net (Left), - Synth_Uresize (Right, Get_Width (Left))), - No_Range); + Get_Net (Left, Ltype), + Synth_Uresize (Right, Rtype, Get_Width (Left))), + No_Bound); when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Uns => -- "=" (Unsigned, Unsigned) return Create_Value_Net (Build_Compare (Build_Context, Id_Eq, - Get_Net (Left), Get_Net (Right)), - No_Range); + Get_Net (Left, Ltype), + Get_Net (Right, Rtype)), + No_Bound); when Iir_Predefined_Array_Element_Concat => declare - L : constant Net := Get_Net (Left); + L : constant Net := Get_Net (Left, Ltype); begin return Create_Value_Net - (Build_Concat2 (Build_Context, L, Get_Net (Right)), - Bounds_To_Range (Simul.Execution.Create_Bounds_From_Length - (Syn_Inst.Sim, - Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Width (L) + 1)))); + (Build_Concat2 (Build_Context, L, + Get_Net (Right, Rtype)), + Create_Bounds_From_Length + (Syn_Inst, + Get_Index_Type (Get_Type (Expr), 0), + Iir_Index32 (Get_Width (L) + 1))); end; when Iir_Predefined_Element_Array_Concat => declare - R : constant Net := Get_Net (Right); + R : constant Net := Get_Net (Right, Rtype); begin return Create_Value_Net - (Build_Concat2 (Build_Context, Get_Net (Left), R), - Bounds_To_Range (Simul.Execution.Create_Bounds_From_Length - (Syn_Inst.Sim, - Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Width (R) + 1)))); + (Build_Concat2 (Build_Context, Get_Net (Left, Ltype), R), + Create_Bounds_From_Length + (Syn_Inst, + Get_Index_Type (Get_Type (Expr), 0), + Iir_Index32 (Get_Width (R) + 1))); end; when Iir_Predefined_Integer_Plus => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Lit - (Create_I64_Value (Left.Lit.I64 + Right.Lit.I64), - Get_Type (Expr)); + return Create_Value_Discrete (Left.Scal + Right.Scal); else -- TODO: non-const. raise Internal_Error; end if; when Iir_Predefined_Integer_Minus => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Lit - (Create_I64_Value (Left.Lit.I64 - Right.Lit.I64), - Get_Type (Expr)); + return Create_Value_Discrete (Left.Scal - Right.Scal); else -- TODO: non-const. raise Internal_Error; @@ -618,24 +783,31 @@ package body Synth.Expr is end case; end Synth_Dyadic_Operation; - function Synth_Monadic_Operation (Def : Iir_Predefined_Functions; - Operand : Value_Acc; + function Synth_Monadic_Operation (Syn_Inst : Synth_Instance_Acc; + Def : Iir_Predefined_Functions; + Operand_Expr : Node; Loc : Node) return Value_Acc is + Operand : Value_Acc; + function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Value_Acc is begin return Create_Value_Net - (Build_Monadic (Build_Context, Id, Get_Net (Operand)), - No_Range); + (Build_Monadic (Build_Context, Id, + Get_Net (Operand, Get_Type (Operand_Expr))), + No_Bound); end Synth_Bit_Monadic; - function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Value_Acc is - Op: constant Net := Get_Net (Operand); + + function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Value_Acc + is + Op: constant Net := Get_Net (Operand, Get_Type (Operand_Expr)); begin return Create_Value_Net (Build_Monadic (Build_Context, Id, Op), - Create_Res_Range (Operand, Op)); + Create_Res_Bound (Operand, Op)); end Synth_Vec_Monadic; begin + Operand := Synth_Expression (Syn_Inst, Operand_Expr); case Def is when Iir_Predefined_Error => return null; @@ -662,27 +834,25 @@ package body Synth.Expr is return Synth_Name (Syn_Inst, Get_Named_Entity (Name)); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Signal_Declaration => + | Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Declaration => return Get_Value (Syn_Inst, Name); - when Iir_Kind_Constant_Declaration - | Iir_Kind_Enumeration_Literal => - return Create_Value_Lit - (Simul.Execution.Execute_Expression (Syn_Inst.Sim, Name), - Get_Type (Name)); + when Iir_Kind_Enumeration_Literal => + return Create_Value_Discrete (Int64 (Get_Enum_Pos (Name))); when others => Error_Kind ("synth_name", Name); end case; end Synth_Name; - function In_Range (Rng : Value_Range_Acc; V : Int32) return Boolean is + function In_Bounds (Bnd : Value_Bound_Acc; V : Int32) return Boolean is begin - case Rng.Dir is + case Bnd.Dir is when Iir_To => - return V >= Rng.Left and then V <= Rng.Right; + return V >= Bnd.Left and then V <= Bnd.Right; when Iir_Downto => - return V <= Rng.Left and then V >= Rng.Right; + return V <= Bnd.Left and then V >= Bnd.Right; end case; - end In_Range; + end In_Bounds; function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Value_Acc @@ -692,24 +862,21 @@ package body Synth.Expr is Indexes : constant Iir_Flist := Get_Index_List (Name); Idx_Val : constant Value_Acc := Synth_Expression (Syn_Inst, Get_Nth_Element (Indexes, 0)); - Rng : Value_Range_Acc; - Idx : Int32; + Rng : Value_Bound_Acc; + Off : Int32; begin if Get_Nbr_Elements (Indexes) /= 1 then Error_Msg_Synth (+Name, "multi-dim arrays not supported"); return null; end if; - if Idx_Val.Kind /= Value_Lit - or else Idx_Val.Lit.Kind /= Iir_Value_I64 - then + if Idx_Val.Kind /= Value_Discrete then Error_Msg_Synth (+Name, "non constant integer index not supported"); return null; end if; - Rng := Extract_Range (Pfx); - Idx := Int32 (Idx_Val.Lit.I64); - if not In_Range (Rng, Idx) then + Rng := Extract_Bound (Pfx); + if not In_Bounds (Rng, Int32 (Idx_Val.Scal)) then Error_Msg_Synth (+Name, "index not within bounds"); return null; end if; @@ -717,10 +884,11 @@ package body Synth.Expr is -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. case Rng.Dir is when Iir_To => - return Bit_Extract (Pfx, Uns32 (Rng.Right - Idx)); + Off := Rng.Right - Int32 (Idx_Val.Scal); when Iir_Downto => - return Bit_Extract (Pfx, Uns32 (Idx - Rng.Right)); + Off := Int32 (Idx_Val.Scal) - Rng.Right; end case; + return Bit_Extract (Pfx, Uns32 (Off)); end Synth_Indexed_Name; function Synth_Slice_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) @@ -729,10 +897,10 @@ package body Synth.Expr is Pfx : constant Value_Acc := Synth_Expression (Syn_Inst, Get_Prefix (Name)); Expr : constant Node := Get_Suffix (Name); - Res_Rng : Value_Range_Acc; + Res_Bnd : Value_Bound_Acc; Left, Right : Value_Acc; Dir : Iir_Direction; - Rng : Value_Range_Acc; + Bnd : Value_Bound_Acc; begin case Get_Kind (Expr) is when Iir_Kind_Range_Expression => @@ -743,50 +911,48 @@ package body Synth.Expr is Error_Msg_Synth (+Expr, "only range supported for slices"); end case; - if Left.Kind /= Value_Lit - or else Left.Lit.Kind /= Iir_Value_I64 - then + if Left.Kind /= Value_Discrete then Error_Msg_Synth (+Name, "non constant integer left not supported"); return null; end if; - if Right.Kind /= Value_Lit - or else Right.Lit.Kind /= Iir_Value_I64 - then + if Right.Kind /= Value_Discrete then Error_Msg_Synth (+Name, "non constant integer right not supported"); return null; end if; - Rng := Extract_Range (Pfx); - if Rng.Dir /= Dir then + Bnd := Extract_Bound (Pfx); + if Bnd.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); return null; end if; - if not In_Range (Rng, Int32 (Left.Lit.I64)) - or else not In_Range (Rng, Int32 (Right.Lit.I64)) + if not In_Bounds (Bnd, Int32 (Left.Scal)) + or else not In_Bounds (Bnd, Int32 (Right.Scal)) then Error_Msg_Synth (+Name, "index not within bounds"); return null; end if; - case Rng.Dir is + case Bnd.Dir is when Iir_To => - Res_Rng := Create_Range_Value - (Value_Range'(Dir => Iir_To, - Len => Width (Right.Lit.I64 - Left.Lit.I64 + 1), - Left => Int32 (Left.Lit.I64), - Right => Int32 (Right.Lit.I64))); + Res_Bnd := Create_Value_Bound + (Value_Bound_Type' + (Dir => Iir_To, + Len => Width (Right.Scal - Left.Scal + 1), + Left => Int32 (Left.Scal), + Right => Int32 (Right.Scal))); return Vec_Extract - (Pfx, Uns32 (Rng.Right - Res_Rng.Right), Res_Rng); + (Pfx, Uns32 (Bnd.Right - Res_Bnd.Right), Res_Bnd); when Iir_Downto => - Res_Rng := Create_Range_Value - (Value_Range'(Dir => Iir_Downto, - Len => Width (Left.Lit.I64 - Right.Lit.I64 + 1), - Left => Int32 (Left.Lit.I64), - Right => Int32 (Right.Lit.I64))); + Res_Bnd := Create_Value_Bound + (Value_Bound_Type' + (Dir => Iir_Downto, + Len => Width (Left.Scal - Right.Scal + 1), + Left => Int32 (Left.Scal), + Right => Int32 (Right.Scal))); return Vec_Extract - (Pfx, Uns32 (Res_Rng.Right - Rng.Right), Res_Rng); + (Pfx, Uns32 (Res_Bnd.Right - Bnd.Right), Res_Bnd); end case; end Synth_Slice_Name; @@ -824,7 +990,7 @@ package body Synth.Expr is Lit : Node; Posedge : Boolean; begin - Clk := Get_Net (Synth_Name (Syn_Inst, Prefix)); + Clk := Get_Net (Synth_Name (Syn_Inst, Prefix), Get_Type (Prefix)); if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); return Build_Edge (Build_Context, Clk); @@ -880,14 +1046,14 @@ package body Synth.Expr is Prefix := Extract_Event_Expr_Prefix (Left); if Is_Valid (Prefix) then return Create_Value_Net - (Extract_Clock_Level (Syn_Inst, Right, Prefix), No_Range); + (Extract_Clock_Level (Syn_Inst, Right, Prefix), No_Bound); end if; -- Try with right. Prefix := Extract_Event_Expr_Prefix (Right); if Is_Valid (Prefix) then return Create_Value_Net - (Extract_Clock_Level (Syn_Inst, Left, Prefix), No_Range); + (Extract_Clock_Level (Syn_Inst, Left, Prefix), No_Bound); end if; return null; @@ -933,6 +1099,32 @@ package body Synth.Expr is end if; end Error_Unknown_Operator; + function Synth_String_Literal (Syn_Inst : Synth_Instance_Acc; Str : Node) + return Value_Acc + 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); + Bounds : Value_Bound_Acc; + Barr : Value_Bound_Array_Acc; + Res : Value_Acc; + Pos : Nat8; + begin + Bounds := Synth_Array_Bounds (Syn_Inst, Str_Type, 0); + Barr := Create_Value_Bound_Array (1); + Barr.D (1) := Bounds; + Res := Create_Value_Array (Barr); + + for I in Res.Arr.V'Range loop + -- FIXME: use literal from type ?? + Pos := Str_Table.Element_String8 (Id, Pos32 (I)); + Res.Arr.V (I) := Create_Value_Discrete (Int64 (Pos)); + end loop; + + return Res; + end Synth_String_Literal; + function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Node) return Value_Acc is @@ -943,28 +1135,25 @@ package body Synth.Expr is Imp : constant Node := Get_Implementation (Expr); Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); - Left : Value_Acc; - Right : Value_Acc; + Edge : Value_Acc; begin -- Match clock-edge if Def = Iir_Predefined_Boolean_And then - Left := Synth_Clock_Edge (Syn_Inst, Expr); - if Left /= null then - return Left; + Edge := Synth_Clock_Edge (Syn_Inst, Expr); + if Edge /= null then + return Edge; end if; end if; -- FIXME: short-circuit operators ? - Left := Synth_Expression (Syn_Inst, Get_Left (Expr)); - Right := Synth_Expression (Syn_Inst, Get_Right (Expr)); if Def in Iir_Predefined_Implicit or else Def in Iir_Predefined_IEEE_Explicit then - return Synth_Dyadic_Operation (Syn_Inst, Def, - Left, Right, Expr); + return Synth_Dyadic_Operation + (Syn_Inst, Def, Get_Left (Expr), Get_Right (Expr), Expr); else Error_Unknown_Operator (Imp, Expr); - return Left; + raise Internal_Error; end if; end; when Iir_Kinds_Monadic_Operator => @@ -972,16 +1161,15 @@ package body Synth.Expr is Imp : constant Node := Get_Implementation (Expr); Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); - Operand : Value_Acc; begin - Operand := Synth_Expression (Syn_Inst, Get_Operand (Expr)); if Def in Iir_Predefined_Implicit or else Def in Iir_Predefined_IEEE_Explicit then - return Synth_Monadic_Operation (Def, Operand, Expr); + return Synth_Monadic_Operation + (Syn_Inst, Def, Get_Operand (Expr), Expr); else Error_Unknown_Operator (Imp, Expr); - return Operand; + raise Internal_Error; end if; end; when Iir_Kind_Simple_Name => @@ -990,13 +1178,19 @@ package body Synth.Expr is return Synth_Indexed_Name (Syn_Inst, Expr); when Iir_Kind_Slice_Name => return Synth_Slice_Name (Syn_Inst, Expr); - when Iir_Kind_Character_Literal - | Iir_Kind_Integer_Literal - | Iir_Kind_String_Literal8 - | Iir_Kind_Enumeration_Literal => - return Create_Value_Lit - (Simul.Execution.Execute_Expression (Syn_Inst.Sim, Expr), - Get_Base_Type (Get_Type (Expr))); + when Iir_Kind_Character_Literal => + return Synth_Expression_With_Type + (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); + when Iir_Kind_Integer_Literal => + return Create_Value_Discrete (Get_Value (Expr)); + when Iir_Kind_Floating_Point_Literal => + return Create_Value_Float (Get_Fp_Value (Expr)); + when Iir_Kind_Physical_Int_Literal => + return Create_Value_Discrete (Get_Physical_Value (Expr)); + when Iir_Kind_String_Literal8 => + return Synth_String_Literal (Syn_Inst, Expr); + when Iir_Kind_Enumeration_Literal => + return Synth_Name (Syn_Inst, Expr); when Iir_Kind_Type_Conversion => return Synth_Type_Conversion (Syn_Inst, Expr); when Iir_Kind_Qualified_Expression => @@ -1011,16 +1205,18 @@ package body Synth.Expr is if Imp = Vhdl.Ieee.Std_Logic_1164.Rising_Edge then Clk := Get_Net (Synth_Assoc_In - (Syn_Inst, Get_Parameter_Association_Chain (Expr))); + (Syn_Inst, Get_Parameter_Association_Chain (Expr)), + Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type); Edge := Build_Edge (Build_Context, Clk); - return Create_Value_Net (Edge, No_Range); + return Create_Value_Net (Edge, No_Bound); elsif Imp = Vhdl.Ieee.Std_Logic_1164.Falling_Edge then Clk := Get_Net (Synth_Assoc_In - (Syn_Inst, Get_Parameter_Association_Chain (Expr))); + (Syn_Inst, Get_Parameter_Association_Chain (Expr)), + Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type); Clk := Build_Monadic (Build_Context, Id_Not, Clk); Edge := Build_Edge (Build_Context, Clk); - return Create_Value_Net (Edge, No_Range); + return Create_Value_Net (Edge, No_Bound); end if; Error_Msg_Synth (+Expr, "user function call to %i is not handled", +Imp); diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 67ab253ff..0061767a0 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -19,7 +19,6 @@ -- MA 02110-1301, USA. with Types; use Types; -with Simul.Environments; use Simul.Environments; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Vhdl.Nodes; use Vhdl.Nodes; @@ -28,9 +27,10 @@ package Synth.Expr is function Is_Const (Val : Value_Acc) return Boolean; function Get_Width (Val : Value_Acc) return Uns32; - procedure To_Logic (Lit : Iir_Value_Literal_Acc; - Val : out Uns32; - Zx : out Uns32); + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32); + procedure From_Bit (Enum : Int64; Val : out Uns32); + procedure To_Logic + (Enum : Int64; Etype : Node; Val : out Uns32; Zx : out Uns32); function Bit_Extract (Val : Value_Acc; Off : Uns32) return Value_Acc; @@ -40,4 +40,14 @@ package Synth.Expr is function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; + Atype : Node) return Value_Bound_Acc; + + function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; + Atype : Node; + Dim : Natural) return Value_Bound_Acc; + + function Synth_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc; end Synth.Expr; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 7b34308c6..b5b51644d 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -37,10 +37,7 @@ with Synth.Expr; use Synth.Expr; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; -with Simul.Environments; use Simul.Environments; -with Simul.Annotations; -with Simul.Execution; -with Simul.Elaboration; use Simul.Elaboration; +with Simul.Annotations; use Simul.Annotations; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; @@ -66,11 +63,11 @@ package body Synth.Stmts is (Syn_Inst, Get_We_Value (Wf), Targ_Type); end Synth_Waveform; - procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc) is + procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc; Vtype : Node) is begin case Dest.Kind is when Value_Wire => - Phi_Assign (Dest.W, Get_Net (Val)); + Phi_Assign (Dest.W, Get_Net (Val, Vtype)); when others => raise Internal_Error; end case; @@ -118,7 +115,8 @@ package body Synth.Stmts is when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration => - Synth_Assign (Get_Value (Syn_Inst, Target), Val); + Synth_Assign (Get_Value (Syn_Inst, Target), + Val, Get_Type (Target)); when Iir_Kind_Aggregate => Synth_Assignment_Aggregate (Syn_Inst, Target, Val); when others => @@ -215,7 +213,8 @@ package body Synth.Stmts is end if; Pop_Phi (Phi_False); - Merge_Phis (Build_Context, Get_Net (Cond_Val), Phi_True, Phi_False); + Merge_Phis (Build_Context, Get_Net (Cond_Val, Get_Type (Cond)), + Phi_True, Phi_False); end if; end Synth_If_Statement; @@ -604,7 +603,7 @@ package body Synth.Stmts is -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); - Sel_Net := Get_Net (Sel); + Sel_Net := Get_Net (Sel, Get_Type (Expr)); for I in Wires'Range loop declare @@ -653,19 +652,16 @@ package body Synth.Stmts is Free_Alternative_Data_Array (Alts); end Synth_Case_Statement; - procedure Synth_Subprogram_Association - (Subprg_Inst : Synth_Instance_Acc; - Caller_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node) + procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; + Caller_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node) is - use Simul.Annotations; Inter : Node; Assoc : Node; Assoc_Inter : Node; Actual : Node; Val : Value_Acc; - Slot : Object_Slot_Type; begin Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; @@ -685,9 +681,9 @@ package body Synth.Stmts is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration => -- FIXME: Arguments are passed by copy. - Simul.Elaboration.Create_Object (Subprg_Inst.Sim, Inter); + Create_Object (Subprg_Inst, Inter, null); when Iir_Kind_Interface_Signal_Declaration => - Simul.Elaboration.Create_Signal (Subprg_Inst.Sim, Inter); + Create_Object (Subprg_Inst, Inter, null); when Iir_Kind_Interface_File_Declaration => raise Internal_Error; end case; @@ -696,8 +692,7 @@ package body Synth.Stmts is when Iir_In_Mode => Val := Synth_Expression_With_Type (Caller_Inst, Actual, Get_Type (Inter)); - Slot := Get_Info (Inter).Slot; - Subprg_Inst.Objects (Slot) := Val; + Create_Object (Subprg_Inst, Inter, Val); when Iir_Out_Mode => Synth_Declaration (Subprg_Inst, Inter); when Iir_Inout_Mode => @@ -745,8 +740,8 @@ package body Synth.Stmts is Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Subprg_Body : constant Node := Get_Subprogram_Body (Imp); Decls_Chain : constant Node := Get_Declaration_Chain (Subprg_Body); - Sub_Sim_Inst : Block_Instance_Acc; Sub_Syn_Inst : Synth_Instance_Acc; + M : Areapools.Mark_Type; begin if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then Error_Msg_Synth (+Stmt, "call to implicit %n is not supported", +Imp); @@ -756,15 +751,13 @@ package body Synth.Stmts is return; end if; - Areapools.Mark (Syn_Inst.Sim.Marker, Instance_Pool.all); - Sub_Sim_Inst := - Simul.Execution.Create_Subprogram_Instance (Syn_Inst.Sim, null, Imp); - Sub_Syn_Inst := Make_Instance (Sub_Sim_Inst); + Areapools.Mark (M, Instance_Pool.all); + Sub_Syn_Inst := Make_Instance (Syn_Inst, Get_Info (Imp)); Synth_Subprogram_Association (Sub_Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain); - Elaborate_Declarative_Part (Sub_Sim_Inst, Decls_Chain); + Synth_Declarations (Sub_Syn_Inst, Decls_Chain); if Is_Valid (Decls_Chain) then Sub_Syn_Inst.Name := New_Sname (Syn_Inst.Name, Get_Identifier (Imp)); @@ -778,6 +771,7 @@ package body Synth.Stmts is (Sub_Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain); Free_Instance (Sub_Syn_Inst); + Areapools.Release (M, Instance_Pool.all); end Synth_Procedure_Call; procedure Synth_Sequential_Statements @@ -811,21 +805,18 @@ package body Synth.Stmts is Proc_Pool : aliased Areapools.Areapool; procedure Synth_Process_Statement (Syn_Inst : Synth_Instance_Acc; - Sim_Inst : Block_Instance_Acc; Proc : Node) is use Areapools; + Info : constant Sim_Info_Acc := Get_Info (Proc); Decls_Chain : constant Node := Get_Declaration_Chain (Proc); Proc_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin - Proc_Inst := Make_Instance (Sim_Inst); + Proc_Inst := Make_Instance (Syn_Inst, Info); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; - -- Processes were not elaborated. - Elaborate_Declarative_Part (Sim_Inst, Decls_Chain); - if Is_Valid (Decls_Chain) then Proc_Inst.Name := New_Sname (Syn_Inst.Name, Get_Identifier (Proc)); Synth_Declarations (Proc_Inst, Decls_Chain); @@ -840,14 +831,15 @@ package body Synth.Stmts is end Synth_Process_Statement; procedure Synth_Generate_Statement_Body - (Syn_Inst : Synth_Instance_Acc; Sim_Inst : Block_Instance_Acc; Bod : Node) + (Syn_Inst : Synth_Instance_Acc; Bod : Node) is use Areapools; + Info : constant Sim_Info_Acc := Get_Info (Bod); Decls_Chain : constant Node := Get_Declaration_Chain (Bod); Bod_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin - Bod_Inst := Make_Instance (Sim_Inst); + Bod_Inst := Make_Instance (Syn_Inst, Info); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; @@ -867,10 +859,8 @@ package body Synth.Stmts is procedure Synth_Concurrent_Statements (Syn_Inst : Synth_Instance_Acc; Stmts : Node) is - Sim_Child : Block_Instance_Acc; Stmt : Node; begin - Sim_Child := Syn_Inst.Sim.Children; Stmt := Stmts; while Is_Valid (Stmt) loop Push_Phi; @@ -880,30 +870,30 @@ package body Synth.Stmts is when Iir_Kind_Concurrent_Conditional_Signal_Assignment => Synth_Conditional_Signal_Assignment (Syn_Inst, Stmt); when Iir_Kind_Sensitized_Process_Statement => - pragma Assert (Sim_Child.Label = Stmt); - Synth_Process_Statement (Syn_Inst, Sim_Child, Stmt); - Sim_Child := Sim_Child.Brother; + Synth_Process_Statement (Syn_Inst, Stmt); when Iir_Kind_If_Generate_Statement => declare Gen : Node; Bod : Node; + Cond : Value_Acc; begin Gen := Stmt; - while Gen /= Null_Node loop - Bod := Get_Generate_Statement_Body (Gen); - if Sim_Child.Label = Bod then - Synth_Generate_Statement_Body - (Syn_Inst, Sim_Child, Bod); - Sim_Child := Sim_Child.Brother; + loop + -- FIXME: else clause. + Cond := Synth_Expression (Syn_Inst, Get_Condition (Gen)); + pragma Assert (Cond.Kind = Value_Discrete); + if Cond.Scal = 1 then + Bod := Get_Generate_Statement_Body (Gen); + Synth_Generate_Statement_Body (Syn_Inst, Bod); exit; end if; Gen := Get_Generate_Else_Clause (Gen); + exit when Gen = Null_Node; end loop; end; when Iir_Kind_Component_Instantiation_Statement => -- TODO. null; - Sim_Child := Sim_Child.Brother; when others => Error_Kind ("synth_statements", Stmt); end case; diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb index 955e5c9e0..ff516bac0 100644 --- a/src/synth/synth-types.adb +++ b/src/synth/synth-types.adb @@ -22,11 +22,11 @@ with Types; use Types; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Errors; use Vhdl.Errors; -with Simul.Environments; use Simul.Environments; +with Synth.Values; use Synth.Values; +with Synth.Expr; with Simul.Annotations; use Simul.Annotations; -with Simul.Execution; -with Vhdl.Errors; use Vhdl.Errors; package body Synth.Types is function Is_Bit_Type (Atype : Iir) return Boolean is @@ -57,12 +57,10 @@ package body Synth.Types is when Iir_Kind_Array_Subtype_Definition => if Is_Vector_Type (Btype) then declare - Bnd : Iir_Value_Literal_Acc; + Bnd : Value_Bound_Acc; begin - Bnd := Simul.Execution.Execute_Bounds - (Syn_Inst.Sim, - Get_Nth_Element (Get_Index_Subtype_List (Atype), 0)); - return Width (Bnd.Length); + Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Atype, 0); + return Bnd.Len; end; else raise Internal_Error; diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index cb68848e2..902bc0b9b 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -20,37 +20,37 @@ with Ada.Unchecked_Conversion; with System; -with Areapools; package body Synth.Values is function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); - function To_Value_Range_Acc is new Ada.Unchecked_Conversion - (System.Address, Value_Range_Acc); function To_Value_Array_Acc is new Ada.Unchecked_Conversion (System.Address, Values.Value_Array_Acc); + function To_Value_Bound_Acc is new Ada.Unchecked_Conversion + (System.Address, Value_Bound_Acc); + function To_Value_Bound_Array_Acc is new Ada.Unchecked_Conversion + (System.Address, Value_Bound_Array_Acc); - function Create_Value_Wire (W : Wire_Id; Rng : Value_Range_Acc) + function Create_Value_Wire (W : Wire_Id; Bnd : Value_Bound_Acc) return Value_Acc is subtype Value_Type_Wire is Value_Type (Values.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, - W_Range => Rng))); + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Wire, + W => W, + W_Bound => Bnd))); end Create_Value_Wire; - function Create_Value_Net (N : Net; Rng : Value_Range_Acc) return Value_Acc + function Create_Value_Net (N : Net; Bnd : Value_Bound_Acc) 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, N_Range => Rng))); + Value_Type_Net'(Kind => Value_Net, N => N, N_Bound => Bnd))); end Create_Value_Net; function Create_Value_Mux2 (Cond : Value_Acc; T : Value_Acc; F : Value_Acc) @@ -64,36 +64,38 @@ package body Synth.Values is (Kind => Value_Mux2, M_Cond => Cond, M_T => T, M_F => F))); end Create_Value_Mux2; - function Create_Value_Lit (Val : Iir_Value_Literal_Acc; Typ : Iir) - return Value_Acc + function Create_Value_Logic (Val, Zx : Uns32) return Value_Acc is - subtype Value_Type_Lit is Value_Type (Value_Lit); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Lit); + subtype Value_Type_Logic is Value_Type (Value_Logic); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Logic); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Lit, Lit => Val, Lit_Type => Typ))); - end Create_Value_Lit; + (Kind => Value_Logic, Log_Val => Val, Log_Zx => Zx))); + end Create_Value_Logic; - function Bounds_To_Nbr_Elements (Bounds : Value_Bounds_Array_Acc) - return Iir_Index32 + function Create_Value_Discrete (Val : Int64) return Value_Acc is - Len : Iir_Index32; + subtype Value_Type_Discrete is Value_Type (Value_Discrete); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Discrete); begin - Len := 1; - for I in Bounds.D'Range loop - Len := Len * Bounds.D (I).Length; - end loop; - return Len; - end Bounds_To_Nbr_Elements; + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Discrete, Scal => Val))); + end Create_Value_Discrete; - procedure Create_Array_Data (Arr : Value_Acc) + function Create_Value_Float (Val : Fp64) return Value_Acc is - use System; - use Areapools; - Len : constant Iir_Index32 := Bounds_To_Nbr_Elements (Arr.Bounds); + subtype Value_Type_Float is Value_Type (Value_Float); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Float); + begin + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Float, Fp => Val))); + end Create_Value_Float; - subtype Data_Type is Values.Value_Array_Type (Len); + function Create_Value_Array (Ndim : Iir_Index32) return Value_Array_Acc + is + use System; + subtype Data_Type is Values.Value_Array_Type (Ndim); Res : Address; begin -- Manually allocate the array to handle large arrays without @@ -114,42 +116,166 @@ package body Synth.Values is null; end; - Arr.Arr := To_Value_Array_Acc (Res); + return To_Value_Array_Acc (Res); + end Create_Value_Array; + + procedure Create_Array_Data (Arr : Value_Acc) + is + Len : Width; + begin + Len := 1; + for I in Arr.Bounds.D'Range loop + Len := Len * Arr.Bounds.D (I).Len; + end loop; + + Arr.Arr := Create_Value_Array (Iir_Index32 (Len)); end Create_Array_Data; - function Create_Array_Value (Bounds : Value_Bounds_Array_Acc) + function Create_Value_Array (Bounds : Value_Bound_Array_Acc) return Value_Acc is - subtype Value_Type_Array is Value_Type (Values.Value_Array); + subtype Value_Type_Array is Value_Type (Value_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Array); Res : Value_Acc; begin - Res := To_Value_Acc - (Alloc (Current_Pool, - (Kind => Values.Value_Array, - Arr => null, Bounds => Bounds))); + Res := To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Array, + Arr => null, Bounds => Bounds))); Create_Array_Data (Res); return Res; - end Create_Array_Value; + end Create_Value_Array; - function Create_Range_Value (Rng : Value_Range) return Value_Range_Acc + function Create_Value_Bound_Array (Ndim : Iir_Index32) + return Value_Bound_Array_Acc is - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Range); + use System; + subtype Data_Type is Value_Bound_Array (Ndim); + Res : Address; begin - return To_Value_Range_Acc (Alloc (Current_Pool, Rng)); - end Create_Range_Value; + -- Manually allocate the array to handle large arrays without + -- creating a large temporary value. + Areapools.Allocate + (Current_Pool.all, Res, + Data_Type'Size / Storage_Unit, Data_Type'Alignment); - function Bounds_To_Range (Val : Iir_Value_Literal_Acc) - return Value_Range_Acc + declare + -- Discard the warnings for no pragma Import as we really want + -- to use the default initialization. + pragma Warnings (Off); + Addr1 : constant Address := Res; + Init : Data_Type; + for Init'Address use Addr1; + pragma Warnings (On); + begin + null; + end; + + return To_Value_Bound_Array_Acc (Res); + end Create_Value_Bound_Array; + + function Create_Value_Bounds (Bounds : Value_Bound_Array_Acc) + return Value_Acc + is + subtype Value_Type_Bounds is Value_Type (Value_Bounds); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Bounds); + + Res : Value_Acc; + begin + Res := To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Bounds, + Bnds => Bounds))); + return Res; + end Create_Value_Bounds; + + function Create_Value_Instance (Inst : Instance_Id) return Value_Acc + is + subtype Value_Type_Instance is Value_Type (Value_Instance); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Instance); + begin + return To_Value_Acc + (Alloc (Current_Pool, + (Kind => Value_Instance, Instance => Inst))); + end Create_Value_Instance; + + function Create_Value_Range (Rng : Value_Range_Type) return Value_Acc + is + subtype Value_Type_Range is Value_Type (Value_Range); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Range); + begin + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Range, Rng => Rng))); + end Create_Value_Range; + + function Create_Value_Fp_Range (Rng : Value_Fp_Range_Type) return Value_Acc + is + subtype Value_Type_Fp_Range is Value_Type (Value_Fp_Range); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Fp_Range); + begin + return To_Value_Acc (Alloc (Current_Pool, + (Kind => Value_Fp_Range, Fp_Rng => Rng))); + end Create_Value_Fp_Range; + + function Create_Value_Bound (Dir : Iir_Direction; Left, Right : Value_Acc) + return Value_Bound_Acc is + begin + pragma Assert (Left.Kind = Right.Kind); + case Left.Kind is + when Value_Discrete => + declare + Len : Int64; + begin + case Dir is + when Iir_To => + Len := Right.Scal - Left.Scal + 1; + when Iir_Downto => + Len := Left.Scal - Right.Scal + 1; + end case; + if Len < 0 then + Len := 0; + end if; + return Create_Value_Bound + ((Dir, Int32 (Left.Scal), Int32 (Right.Scal), + Len => Uns32 (Len))); + end; + when others => + raise Internal_Error; + end case; + end Create_Value_Bound; + + function Create_Value_Bound (Bnd : Value_Bound_Type) return Value_Bound_Acc + is + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Bound_Type); + begin + return To_Value_Bound_Acc (Alloc (Current_Pool, Bnd)); + end Create_Value_Bound; + + function Copy (Src: in Value_Acc) return Value_Acc + is + Res: Value_Acc; + begin + case Src.Kind is + when Value_Range => + Res := Create_Value_Range (Src.Rng); + when Value_Fp_Range => + Res := Create_Value_Fp_Range (Src.Fp_Rng); + when Value_Wire => + Res := Create_Value_Wire (Src.W, Src.W_Bound); + when others => + raise Internal_Error; + end case; + return Res; + end Copy; + + function Unshare (Src : Value_Acc; Pool : Areapool_Acc) + return Value_Acc is - pragma Assert (Val.Kind = Iir_Value_Range); - pragma Assert (Val.Left.Kind = Iir_Value_I64); - pragma Assert (Val.Right.Kind = Iir_Value_I64); + Prev_Pool : constant Areapool_Acc := Current_Pool; + Res : Value_Acc; begin - return Create_Range_Value ((Dir => Val.Dir, - Len => Width (Val.Length), - Left => Int32 (Val.Left.I64), - Right => Int32 (Val.Right.I64))); - end Bounds_To_Range; + Current_Pool := Pool; + Res := Copy (Src); + Current_Pool := Prev_Pool; + return Res; + end Unshare; end Synth.Values; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index cc452a556..283443ffe 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -20,9 +20,10 @@ with Types; use Types; with Netlists; use Netlists; -with Synth.Environment; use Synth.Environment; -with Simul.Environments; use Simul.Environments; with Vhdl.Nodes; use Vhdl.Nodes; +with Synth.Environment; use Synth.Environment; +with Areapools; use Areapools; + package Synth.Values is -- Values is how signals and variables are decomposed. This is similar to @@ -40,14 +41,31 @@ package Synth.Values is Value_Mux2, + -- A bit/logic value (boolean, bit, std_logic) + Value_Logic, + + -- A discrete value (integer or enumeration). + Value_Discrete, + + Value_Float, + + Value_Range, + Value_Fp_Range, + + -- A range with a length. + Value_Bound, + + -- A vector of bounds, for arrays. + Value_Bounds, + -- A non-vector array. Value_Array, -- A record. Value_Record, - -- A known value (from simulation). - Value_Lit + -- A package. + Value_Instance ); type Value_Type (Kind : Value_Kind); @@ -62,66 +80,127 @@ package Synth.Values is type Value_Array_Acc is access Value_Array_Type; - type Value_Range is record + type Value_Range_Type is record + Dir : Iir_Direction; + Left : Int64; + Right : Int64; + end record; + + type Value_Fp_Range_Type is record + Dir : Iir_Direction; + Left : Fp64; + Right : Fp64; + end record; + + type Value_Bound_Type is record Dir : Iir_Direction; - Len : Width; Left : Int32; Right : Int32; + Len : Width; + end record; + + type Value_Bound_Acc is access Value_Bound_Type; + + No_Bound : constant Value_Bound_Acc := null; + + type Value_Bound_Array_Type is array (Iir_Index32 range <>) of + Value_Bound_Acc; + + type Value_Bound_Array (Len : Iir_Index32) is record + D : Value_Bound_Array_Type (1 .. Len); end record; - type Value_Range_Acc is access Value_Range; - No_Range : constant Value_Range_Acc := null; + type Value_Bound_Array_Acc is access Value_Bound_Array; + + type Instance_Id is new Nat32; type Value_Type (Kind : Value_Kind) is record case Kind is when Value_Net => N : Net; - N_Range : Value_Range_Acc; + N_Bound : Value_Bound_Acc; when Value_Wire => W : Wire_Id; - W_Range : Value_Range_Acc; + W_Bound : Value_Bound_Acc; when Value_Mux2 => M_Cond : Value_Acc; M_T : Value_Acc; M_F : Value_Acc; - when Value_Lit => - Lit : Simul.Environments.Iir_Value_Literal_Acc; - Lit_Type : Iir; + when Value_Logic => + Log_Val : Uns32; + Log_Zx : Uns32; + when Value_Discrete => + Scal : Int64; + when Value_Float => + Fp : Fp64; + when Value_Range => + Rng : Value_Range_Type; + when Value_Fp_Range => + Fp_Rng : Value_Fp_Range_Type; + when Value_Bound => + Bnd : Value_Bound_Acc; + when Value_Bounds => + Bnds : Value_Bound_Array_Acc; when Value_Array => Arr : Value_Array_Acc; - Bounds : Value_Bounds_Array_Acc; + Bounds : Value_Bound_Array_Acc; when Value_Record => - Rec : Value_Array_Acc; + Rec : Value_Array_Acc; + when Value_Instance => + Instance : Instance_Id; end case; end record; + Global_Pool : aliased Areapool; + Expr_Pool : aliased Areapool; + + -- Areapool used by Create_*_Value + Current_Pool : Areapool_Acc := Expr_Pool'Access; + + -- Pool for objects allocated in the current instance. + Instance_Pool : Areapool_Acc; + -- Create a Value_Net. - function Create_Value_Net (N : Net; Rng : Value_Range_Acc) return Value_Acc; + function Create_Value_Net (N : Net; Bnd : Value_Bound_Acc) return Value_Acc; -- Create a Value_Wire. For a bit wire, RNG must be null. - function Create_Value_Wire (W : Wire_Id; Rng : Value_Range_Acc) + function Create_Value_Wire (W : Wire_Id; Bnd : Value_Bound_Acc) return Value_Acc; -- Create a mux2. function Create_Value_Mux2 (Cond : Value_Acc; T : Value_Acc; F : Value_Acc) return Value_Acc; - -- Create a Value_Lit. - function Create_Value_Lit (Val : Iir_Value_Literal_Acc; Typ : Iir) - return Value_Acc; + function Create_Value_Logic (Val, Zx : Uns32) return Value_Acc; + function Create_Value_Discrete (Val : Int64) return Value_Acc; + + function Create_Value_Float (Val : Fp64) return Value_Acc; + + function Create_Value_Array (Ndim : Iir_Index32) return Value_Array_Acc; + function Create_Value_Bound_Array (Ndim : Iir_Index32) + return Value_Bound_Array_Acc; -- Create a Value_Array. - function Create_Array_Value (Bounds : Value_Bounds_Array_Acc) + function Create_Value_Array (Bounds : Value_Bound_Array_Acc) return Value_Acc; + function Create_Value_Bounds (Bounds : Value_Bound_Array_Acc) + return Value_Acc; + -- Allocate the ARR component of the Value_Type ARR, using BOUNDS. procedure Create_Array_Data (Arr : Value_Acc); + function Create_Value_Instance (Inst : Instance_Id) return Value_Acc; + + function Create_Value_Bound (Bnd : Value_Bound_Type) return Value_Bound_Acc; + -- Allocate a Value_Range. - function Create_Range_Value (Rng : Value_Range) return Value_Range_Acc; + function Create_Value_Range (Rng : Value_Range_Type) return Value_Acc; + function Create_Value_Fp_Range (Rng : Value_Fp_Range_Type) return Value_Acc; + function Create_Value_Bound (Dir : Iir_Direction; Left, Right : Value_Acc) + return Value_Bound_Acc; - -- Create a Value_Range from a simulation bound. - function Bounds_To_Range (Val : Iir_Value_Literal_Acc) - return Value_Range_Acc; + function Unshare (Src : Value_Acc; Pool : Areapool_Acc) + return Value_Acc; end Synth.Values; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index cd72354e4..b17cff003 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -25,10 +25,7 @@ with Netlists.Builders; use Netlists.Builders; with Netlists.Utils; with Vhdl.Utils; use Vhdl.Utils; -with Simul.Annotations; -with Simul.Execution; -with Simul.Environments; use Simul.Environments; -with Simul.Elaboration; use Simul.Elaboration; +with Simul.Annotations; use Simul.Annotations; with Synth.Environment; use Synth.Environment; with Synth.Values; use Synth.Values; @@ -137,7 +134,7 @@ package body Synthesis is end Create_Output_Wire; function Synth_Entity - (Parent : Module; Arch : Iir; Sim_Inst : Block_Instance_Acc) + (Parent_Module : Module; Parent_Inst : Synth_Instance_Acc; Arch : Iir) return Synth_Instance_Acc is Entity : constant Iir := Get_Entity (Arch); @@ -148,7 +145,8 @@ package body Synthesis is Nbr_Outputs : Port_Nbr; Num : Uns32; begin - Syn_Inst := Make_Instance (Sim_Inst); + Syn_Inst := Make_Instance (Parent_Inst, Get_Info (Arch)); + Syn_Inst.Block_Scope := Get_Info (Entity); Syn_Inst.Name := New_Sname_User (Get_Identifier (Entity)); -- Allocate values and count inputs and outputs @@ -156,6 +154,7 @@ package body Synthesis is Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop + Synth_Declaration_Type (Syn_Inst, Inter); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => Make_Object (Syn_Inst, Wire_Input, Inter); @@ -171,9 +170,9 @@ package body Synthesis is end loop; -- Declare module. - Syn_Inst.M := - New_User_Module (Parent, New_Sname_User (Get_Identifier (Entity)), - Id_User_None, Nbr_Inputs, Nbr_Outputs, 0); + Syn_Inst.M := New_User_Module + (Parent_Module, New_Sname_User (Get_Identifier (Entity)), + Id_User_None, Nbr_Inputs, Nbr_Outputs, 0); -- Add ports to module. declare @@ -236,7 +235,7 @@ package body Synthesis is return Syn_Inst; end Synth_Entity; - procedure Synth_Dependencies (Unit : Iir) + procedure Synth_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node) is Dep_List : constant Iir_List := Get_Dependence_List (Unit); Dep_It : List_Iterator; @@ -249,7 +248,7 @@ package body Synthesis is pragma Assert (Get_Kind (Dep) = Iir_Kind_Design_Unit); if not Get_Elab_Flag (Dep) then Set_Elab_Flag (Dep, True); - Synth_Dependencies (Dep); + Synth_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 => @@ -261,16 +260,17 @@ package body Synthesis is when Iir_Kind_Package_Declaration => pragma Assert (not Is_Uninstantiated_Package (Dep_Unit)); declare - Sim_Info : constant Sim_Info_Acc := - Simul.Annotations.Get_Info (Dep_Unit); - Sim_Inst : constant Block_Instance_Acc := - Simul.Execution.Get_Instance_By_Scope - (Global_Instances, Sim_Info); - Bid : constant Block_Instance_Id := Sim_Inst.Id; + Info : constant Sim_Info_Acc := Get_Info (Dep_Unit); Syn_Inst : Synth_Instance_Acc; + Val : Value_Acc; begin - pragma Assert (Instance_Map (Bid) = null); - Syn_Inst := Make_Instance (Sim_Inst); + Syn_Inst := Make_Instance (Parent_Inst, Info); + Val := Create_Value_Instance (Syn_Inst); + if Parent_Inst /= Global_Instance then + Create_Object (Parent_Inst, Dep_Unit, Val); + else + Parent_Inst.Objects (Info.Pkg_Slot) := Val; + end if; Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Dep_Unit)); end; @@ -305,16 +305,18 @@ package body Synthesis is Error_Kind ("synth_design", Unit); end case; - Instance_Map := new Instance_Map_Array (0 .. Nbr_Block_Instances); - Des := New_Design (New_Sname_Artificial (Get_Identifier ("top"))); Build_Context := Build_Builders (Des); + Instance_Pool := Global_Pool'Access; + Global_Instance := Make_Instance (null, Global_Info); -- Dependencies first. - Synth_Dependencies (Get_Design_Unit (Get_Entity (Arch))); - Synth_Dependencies (Get_Design_Unit (Arch)); + Synth_Dependencies + (Global_Instance, Get_Design_Unit (Get_Entity (Arch))); + Synth_Dependencies + (Global_Instance, Get_Design_Unit (Arch)); - Syn_Inst := Synth_Entity (Des, Arch, Top_Instance); + Syn_Inst := Synth_Entity (Des, Global_Instance, Arch); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; diff --git a/src/vhdl/simulate/simul-annotations.adb b/src/vhdl/simulate/simul-annotations.adb index 651dc0a5c..18b41561c 100644 --- a/src/vhdl/simulate/simul-annotations.adb +++ b/src/vhdl/simulate/simul-annotations.adb @@ -69,8 +69,10 @@ package body Simul.Annotations is Ref => Obj, Obj_Scope => Block_Info, Slot => Block_Info.Nbr_Objects); - -- Reserve one more slot for value, and initial driver value. - Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 2; + if not Flag_Synthesis then + -- Reserve one more slot for value, and initial driver value. + Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 2; + end if; when Kind_Terminal => Info := new Sim_Info_Type'(Kind => Kind_Terminal, Ref => Obj, @@ -118,22 +120,17 @@ package body Simul.Annotations is -- If EXPR has not a literal value, create one. -- This is necessary for subtype bounds. procedure Annotate_Range_Expression - (Block_Info: Sim_Info_Acc; Expr: Iir_Range_Expression) - is + (Block_Info: Sim_Info_Acc; Expr: Iir_Range_Expression) is begin if Get_Info (Expr) /= null then return; end if; --- if Expr = null or else Get_Info (Expr) /= null then --- return; --- end if; Create_Object_Info (Block_Info, Expr); end Annotate_Range_Expression; -- Annotate type definition DEF only if it is anonymous. procedure Annotate_Anonymous_Type_Definition - (Block_Info: Sim_Info_Acc; Def: Iir) - is + (Block_Info: Sim_Info_Acc; Def: Iir) is begin if Is_Anonymous_Type_Definition (Def) then Annotate_Type_Definition (Block_Info, Def); @@ -305,8 +302,10 @@ package body Simul.Annotations is end if; end if; Set_Info (Def, Info); - Annotate_Range_Expression - (Block_Info, Get_Range_Constraint (Def)); + if not Flag_Synthesis then + Annotate_Range_Expression + (Block_Info, Get_Range_Constraint (Def)); + end if; end; when Iir_Kind_Integer_Subtype_Definition @@ -317,7 +316,9 @@ package body Simul.Annotations is if El /= Null_Iir then case Get_Kind (El) is when Iir_Kind_Range_Expression => - Annotate_Range_Expression (Block_Info, El); + if not Flag_Synthesis then + Annotate_Range_Expression (Block_Info, El); + end if; -- A physical subtype may be defined by an integer range. if Get_Kind (Def) = Iir_Kind_Physical_Subtype_Definition then @@ -332,6 +333,9 @@ package body Simul.Annotations is Error_Kind ("annotate_type_definition (rc)", El); end case; end if; + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def); + end if; Annotate_Anonymous_Type_Definition (Block_Info, Get_Base_Type (Def)); @@ -355,14 +359,19 @@ package body Simul.Annotations is Annotate_Anonymous_Type_Definition (Block_Info, El); when Iir_Kind_Array_Subtype_Definition => - declare - List : constant Iir_Flist := Get_Index_Subtype_List (Def); - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Index_Type (List, I); - Annotate_Anonymous_Type_Definition (Block_Info, El); - end loop; - end; + if Flag_Synthesis then + -- For the bounds. + Create_Object_Info (Block_Info, Def); + else + declare + List : constant Iir_Flist := Get_Index_Subtype_List (Def); + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Index_Type (List, I); + Annotate_Anonymous_Type_Definition (Block_Info, El); + end loop; + end; + end if; when Iir_Kind_Record_Type_Definition => declare @@ -634,6 +643,16 @@ package body Simul.Annotations is Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl)); end Annotate_Package_Body; + procedure Annotate_Declaration_Type (Block_Info: Sim_Info_Acc; Decl: Iir) + is + Ind : constant Iir := Get_Subtype_Indication (Decl); + begin + if Ind = Null_Iir or else Get_Kind (Ind) in Iir_Kinds_Denoting_Name then + return; + end if; + Annotate_Type_Definition (Block_Info, Ind); + end Annotate_Declaration_Type; + procedure Annotate_Declaration (Block_Info: Sim_Info_Acc; Decl: Iir) is begin case Get_Kind (Decl) is @@ -658,12 +677,12 @@ package body Simul.Annotations is end; when Iir_Kind_Signal_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + Annotate_Declaration_Type (Block_Info, Decl); Create_Signal_Info (Block_Info, Decl); when Iir_Kind_Variable_Declaration | Iir_Kind_Iterator_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + Annotate_Declaration_Type (Block_Info, Decl); Create_Object_Info (Block_Info, Decl); when Iir_Kind_Constant_Declaration => @@ -672,19 +691,18 @@ package body Simul.Annotations is then -- Create the slot only if the constant is not a full constant -- declaration. - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Type (Decl)); + Annotate_Declaration_Type (Block_Info, Decl); Create_Object_Info (Block_Info, Decl); end if; when Iir_Kind_File_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + Annotate_Declaration_Type (Block_Info, Decl); Create_Object_Info (Block_Info, Decl, Kind_File); when Iir_Kind_Terminal_Declaration => Add_Terminal_Info (Block_Info, Decl); when Iir_Kinds_Branch_Quantity_Declaration => - Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl)); + Annotate_Declaration_Type (Block_Info, Decl); Add_Quantity_Info (Block_Info, Decl); when Iir_Kind_Type_Declaration @@ -726,8 +744,10 @@ package body Simul.Annotations is begin Value := Get_Attribute_Value_Spec_Chain (Decl); while Value /= Null_Iir loop - Annotate_Anonymous_Type_Definition - (Block_Info, Get_Type (Value)); + if not Flag_Synthesis then + Annotate_Anonymous_Type_Definition + (Block_Info, Get_Type (Value)); + end if; Create_Object_Info (Block_Info, Value); Value := Get_Spec_Chain (Value); end loop; @@ -1047,24 +1067,17 @@ package body Simul.Annotations is is Entity_Info: Sim_Info_Acc; begin - Entity_Info := - new Sim_Info_Type'(Kind => Kind_Block, - Ref => Decl, - Inst_Slot => Invalid_Instance_Slot, - Nbr_Objects => 0, - Nbr_Instances => 0); + Entity_Info := new Sim_Info_Type'(Kind => Kind_Block, + Ref => Decl, + Inst_Slot => Invalid_Instance_Slot, + Nbr_Objects => 0, + Nbr_Instances => 0); Set_Info (Decl, Entity_Info); - -- generic list. Annotate_Interface_List (Entity_Info, Get_Generic_Chain (Decl), True); - - -- Port list. Annotate_Interface_List (Entity_Info, Get_Port_Chain (Decl), True); - -- declarations Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl)); - - -- processes. Annotate_Concurrent_Statements_List (Entity_Info, Get_Concurrent_Statement_Chain (Decl)); end Annotate_Entity; diff --git a/src/vhdl/simulate/simul-annotations.ads b/src/vhdl/simulate/simul-annotations.ads index 453200450..52d637907 100644 --- a/src/vhdl/simulate/simul-annotations.ads +++ b/src/vhdl/simulate/simul-annotations.ads @@ -20,6 +20,9 @@ with Types; use Types; with Vhdl.Nodes; use Vhdl.Nodes; package Simul.Annotations is + -- If True, annotate for synthesis. + Flag_Synthesis : Boolean := False; + type Object_Slot_Type is new Natural; -- This slot is not used. -- cgit v1.2.3