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/synth/synth-decls.adb | 198 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 185 insertions(+), 13 deletions(-) (limited to 'src/synth/synth-decls.adb') 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 => -- cgit v1.2.3