diff options
| -rw-r--r-- | src/synth/netlists.adb | 63 | ||||
| -rw-r--r-- | src/synth/netlists.ads | 33 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 54 |
3 files changed, 123 insertions, 27 deletions
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb index 717a595f3..52c4d1277 100644 --- a/src/synth/netlists.adb +++ b/src/synth/netlists.adb @@ -25,7 +25,6 @@ with Simple_IO; with Netlists.Utils; use Netlists.Utils; with Netlists.Gates; -with Dyn_Interning; package body Netlists is @@ -1176,36 +1175,60 @@ package body Netlists is -- Attributes - type Attribute_Record is record - Inst : Instance; - First : Attribute; - end record; - function Attribute_Hash (Params : Instance) return Hash_Value_Type is begin return Hash_Value_Type (Params); end Attribute_Hash; - function Attribute_Build (Params : Instance) return Attribute_Record is + function Attribute_Build (Params : Instance) return Attribute_Map_Element is begin - return Attribute_Record'(Inst => Params, - First => No_Attribute); + return Attribute_Map_Element'(Inst => Params, + First => No_Attribute); end Attribute_Build; - function Attribute_Equal (Obj : Attribute_Record; Params : Instance) + function Attribute_Equal (Obj : Attribute_Map_Element; Params : Instance) return Boolean is begin return Obj.Inst = Params; end Attribute_Equal; - package Attribute_Tables is new Dyn_Interning - (Params_Type => Instance, - Object_Type => Attribute_Record, - Hash => Attribute_Hash, - Build => Attribute_Build, - Equal => Attribute_Equal); + package Attributes_Table is new Tables + (Table_Component_Type => Attribute_Record, + Table_Index_Type => Attribute, + Table_Low_Bound => 0, + Table_Initial => 64); + + + procedure Set_Attribute + (Inst : Instance; Id : Name_Id; Ptype : Param_Type; Pv : Pval) + is + pragma Assert (Is_Valid (Inst)); + M : constant Module := Get_Instance_Parent (Inst); + Module_Rec : Module_Record renames Modules_Table.Table (M); + Attr : Attribute; + Idx : Attribute_Maps.Index_Type; + Prev : Attribute_Map_Element; + begin + + if Module_Rec.Attrs = null then + Module_Rec.Attrs := new Attribute_Maps.Instance; + Attribute_Maps.Init (Module_Rec.Attrs.all); + end if; + + Attribute_Maps.Get_Index (Module_Rec.Attrs.all, Inst, Idx); + + Prev := Attribute_Maps.Get_By_Index (Module_Rec.Attrs.all, Idx); + Attributes_Table.Append ((Name => Id, + Typ => Ptype, + Val => Pv, + Chain => Prev.First)); + Attr := Attributes_Table.Last; + + Attribute_Maps.Modify (Module_Rec.Attrs.all, Idx, + Attribute_Map_Element'(Inst => Inst, + First => Attr)); + end Set_Attribute; - type Attribute_Tables_Instance is new Attribute_Tables.Instance; -- Statistics function Count_Free_Inputs (Head : Input) return Natural @@ -1406,4 +1429,10 @@ begin pragma Assert (Pval_Table.Last = No_Pval); Pval_Word_Table.Append (0); + + Attributes_Table.Append ((Name => No_Name_Id, + Typ => Param_Invalid, + Val => No_Pval, + Chain => No_Attribute)); + pragma Assert (Attributes_Table.Last = No_Attribute); end Netlists; diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads index 37cd2279b..8ac063a3f 100644 --- a/src/synth/netlists.ads +++ b/src/synth/netlists.ads @@ -20,6 +20,7 @@ with Types; use Types; with Hash; use Hash; +with Dyn_Interning; package Netlists is -- Netlists. @@ -326,6 +327,10 @@ package Netlists is function Read_Pval (P : Pval; Off : Uns32) return Logic_32; procedure Write_Pval (P : Pval; Off : Uns32; Val : Logic_32); + -- Add an attribute to INST. + procedure Set_Attribute + (Inst : Instance; Id : Name_Id; Ptype : Param_Type; Pv : Pval); + -- Display some usage stats on the standard error. procedure Disp_Stats; private @@ -367,17 +372,32 @@ private type Attribute is new Uns32; No_Attribute : Attribute := 0; - type Attribute_Tables_Instance; - - type Attribute_Table_Acc is access Attribute_Tables_Instance; - - type Attribute_Value is record + type Attribute_Record is record Name : Name_Id; Val : Pval; Typ : Param_Type; Chain : Attribute; end record; + type Attribute_Map_Element is record + Inst : Instance; + First : Attribute; + end record; + + function Attribute_Hash (Params : Instance) return Hash_Value_Type; + function Attribute_Build (Params : Instance) return Attribute_Map_Element; + function Attribute_Equal (Obj : Attribute_Map_Element; Params : Instance) + return Boolean; + + package Attribute_Maps is new Dyn_Interning + (Params_Type => Instance, + Object_Type => Attribute_Map_Element, + Hash => Attribute_Hash, + Build => Attribute_Build, + Equal => Attribute_Equal); + + type Attribute_Map_Acc is access Attribute_Maps.Instance; + type Module_Record is record Parent : Module; Name : Sname; @@ -401,7 +421,8 @@ private First_Instance : Instance; Last_Instance : Instance; - Attrs : Attribute_Table_Acc; + -- Map of instance (of this module) to its attributes. + Attrs : Attribute_Map_Acc; end record; function Get_First_Port_Desc (M : Module) return Port_Desc_Idx; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 7dad4d9ba..784a3a9b1 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -20,6 +20,7 @@ with Types; use Types; with Mutils; use Mutils; +with Std_Names; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; @@ -592,16 +593,57 @@ package body Synth.Decls is end if; end Synth_Constant_Declaration; + procedure Synth_Attribute_Object (Syn_Inst : Synth_Instance_Acc; + Attr_Value : Node; + Attr_Decl : Node; + Val : Valtyp) + is + Obj : constant Node := Get_Designated_Entity (Attr_Value); + Id : constant Name_Id := Get_Identifier (Attr_Decl); + Inst : Instance; + V : Valtyp; + Ptype : Param_Type; + Pv : Pval; + begin + if Id = Std_Names.Name_Foreign then + -- Not for synthesis. + return; + end if; + + case Get_Kind (Obj) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration => + V := Get_Value (Syn_Inst, Obj); + pragma Assert (V.Val.Kind = Value_Wire); + Inst := Get_Net_Parent (Get_Wire_Gate (V.Val.W)); + when Iir_Kind_Component_Instantiation_Statement => + -- TODO + return; + when others => + -- TODO: components ? + -- TODO: Interface_Signal ? But no instance for them. + Warning_Msg_Synth + (+Attr_Value, "attribute %i for %n is not kept in the netlist", + (+Attr_Decl, +Obj)); + return; + end case; + + Ptype := Type_To_Param_Type (Get_Type (Attr_Decl)); + Pv := Memtyp_To_Pval (Get_Memtyp (Val)); + + Set_Attribute (Inst, Id, Ptype, Pv); + end Synth_Attribute_Object; + procedure Synth_Attribute_Specification (Syn_Inst : Synth_Instance_Acc; Spec : Node) is - Decl : constant Node := Get_Attribute_Designator (Spec); - Value : Iir_Attribute_Value; + Attr_Decl : constant Node := + Get_Named_Entity (Get_Attribute_Designator (Spec)); + Value : Node; Val : Valtyp; Val_Type : Type_Acc; begin - Val_Type := Get_Subtype_Object - (Syn_Inst, Get_Type (Get_Named_Entity (Decl))); + Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl)); Value := Get_Attribute_Value_Spec_Chain (Spec); while Value /= Null_Iir loop -- 2. The expression is evaluated to determine the value @@ -624,6 +666,10 @@ package body Synth.Decls is Create_Object (Syn_Inst, Value, Val); -- Unshare (Val, Instance_Pool); + if not Get_Instance_Const (Syn_Inst) then + Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val); + end if; + Value := Get_Spec_Chain (Value); end loop; end Synth_Attribute_Specification; |