diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/synth/netlists-disp_vhdl.adb | 86 | ||||
-rw-r--r-- | src/synth/netlists-disp_vhdl.ads | 1 | ||||
-rw-r--r-- | src/synth/netlists-dump.adb | 92 | ||||
-rw-r--r-- | src/synth/netlists.adb | 80 | ||||
-rw-r--r-- | src/synth/netlists.ads | 25 | ||||
-rw-r--r-- | src/synth/synth-disp_vhdl.adb | 1 |
6 files changed, 117 insertions, 168 deletions
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb index 4fafdda69..a9db40b11 100644 --- a/src/synth/netlists-disp_vhdl.adb +++ b/src/synth/netlists-disp_vhdl.adb @@ -1332,6 +1332,40 @@ package body Netlists.Disp_Vhdl is end case; end Disp_Instance_Inline; + procedure Disp_Architecture_Attributes (Inst : Instance) + is + Attrs : constant Attribute := Get_Instance_First_Attribute (Inst); + Attr : Attribute; + Kind : Param_Type; + Val : Pval; + begin + Attr := Attrs; + while Attr /= No_Attribute loop + Put (" -- attribute "); + Put_Id (Get_Attribute_Name (Attr)); + Put (" of "); + Put_Name (Get_Instance_Name (Inst)); + Put (" is "); + Kind := Get_Attribute_Type (Attr); + Val := Get_Attribute_Pval (Attr); + case Kind is + when Param_Invalid + | Param_Uns32 => + Put ("??"); + when Param_Pval_String => + Disp_Pval_String (Val); + when Param_Pval_Vector + | Param_Pval_Integer + | Param_Pval_Boolean + | Param_Pval_Real + | Param_Pval_Time_Ps => + Disp_Pval_Binary (Val); + end case; + Put_Line (";"); + Attr := Get_Attribute_Next (Attr); + end loop; + end Disp_Architecture_Attributes; + procedure Disp_Architecture_Declarations (M : Module) is Id : Module_Id; @@ -1418,6 +1452,10 @@ package body Netlists.Disp_Vhdl is end loop; end if; end case; + + if Has_Instance_Attribute (Inst) then + Disp_Architecture_Attributes (Inst); + end if; end loop; end Disp_Architecture_Declarations; @@ -1456,52 +1494,6 @@ package body Netlists.Disp_Vhdl is end loop; end Disp_Architecture_Statements; - procedure Disp_Architecture_Attributes (M : Module) - is - Attrs : constant Instances_Attribute_Map_Acc := - Get_Instance_Attributes (M); - Attr : Attribute; - Inst : Instance; - Kind : Param_Type; - Val : Pval; - begin - if Attrs = null then - -- No attributes at all. - return; - end if; - - for I in Instances_Attribute_Maps.First_Index - .. Instances_Attribute_Maps.Last_Index (Attrs.all) - loop - Attr := Instances_Attribute_Maps.Get_Value (Attrs.all, I); - Inst := Instances_Attribute_Maps.Get_By_Index (Attrs.all, I); - while Attr /= No_Attribute loop - Put (" -- attribute "); - Put_Id (Get_Attribute_Name (Attr)); - Put (" of "); - Put_Name (Get_Instance_Name (Inst)); - Put (" is "); - Kind := Get_Attribute_Type (Attr); - Val := Get_Attribute_Pval (Attr); - case Kind is - when Param_Invalid - | Param_Uns32 => - Put ("??"); - when Param_Pval_String => - Disp_Pval_String (Val); - when Param_Pval_Vector - | Param_Pval_Integer - | Param_Pval_Boolean - | Param_Pval_Real - | Param_Pval_Time_Ps => - Disp_Pval_Binary (Val); - end case; - Put_Line (";"); - Attr := Get_Attribute_Next (Attr); - end loop; - end loop; - end Disp_Architecture_Attributes; - procedure Disp_Architecture (M : Module) is Self_Inst : constant Instance := Get_Self_Instance (M); @@ -1521,8 +1513,6 @@ package body Netlists.Disp_Vhdl is Disp_Architecture_Declarations (M); - Disp_Architecture_Attributes (M); - Put_Line ("begin"); Disp_Architecture_Statements (M); diff --git a/src/synth/netlists-disp_vhdl.ads b/src/synth/netlists-disp_vhdl.ads index b286685d2..ca09798df 100644 --- a/src/synth/netlists-disp_vhdl.ads +++ b/src/synth/netlists-disp_vhdl.ads @@ -20,7 +20,6 @@ package Netlists.Disp_Vhdl is procedure Disp_Vhdl (M : Module); procedure Disp_Architecture_Declarations (M : Module); - procedure Disp_Architecture_Attributes (M : Module); procedure Disp_Architecture_Statements (M : Module); procedure Put_Type (W : Width); diff --git a/src/synth/netlists-dump.adb b/src/synth/netlists-dump.adb index bd9554839..256fd978f 100644 --- a/src/synth/netlists-dump.adb +++ b/src/synth/netlists-dump.adb @@ -209,6 +209,44 @@ package body Netlists.Dump is end case; end Dump_Parameter; + procedure Dump_Attributes (Inst : Instance; Indent : Natural := 0) + is + Attrs : constant Attribute := Get_Instance_First_Attribute (Inst); + Attr : Attribute; + Kind : Param_Type; + Val : Pval; + begin + Attr := Attrs; + while Attr /= No_Attribute loop + pragma Assert (Has_Instance_Attribute (Inst)); + + Put_Indent (Indent); + Put ("attribute "); + Put_Id (Get_Attribute_Name (Attr)); + Put (" of "); + Dump_Name (Get_Instance_Name (Inst)); + Disp_Instance_Id (Inst); + Put (" := "); + Kind := Get_Attribute_Type (Attr); + Val := Get_Attribute_Pval (Attr); + case Kind is + when Param_Invalid + | Param_Uns32 => + Put ("??"); + when Param_Pval_String => + Disp_Pval_String (Val); + when Param_Pval_Vector + | Param_Pval_Integer + | Param_Pval_Boolean + | Param_Pval_Real + | Param_Pval_Time_Ps => + Disp_Pval_Binary (Val); + end case; + Put_Line (";"); + Attr := Get_Attribute_Next (Attr); + end loop; + end Dump_Attributes; + procedure Dump_Instance (Inst : Instance; Indent : Natural := 0) is Loc : constant Location_Type := Locations.Get_Location (Inst); @@ -231,6 +269,8 @@ package body Netlists.Dump is end; end if; + Dump_Attributes (Inst, Indent); + Put_Indent (Indent); Put ("instance "); Dump_Name (Get_Instance_Name (Inst)); @@ -309,56 +349,6 @@ package body Netlists.Dump is New_Line; end Dump_Module_Port; - procedure Dump_Attributes (M : Module; Indent : Natural := 0) - is - Attrs : constant Instances_Attribute_Map_Acc := - Get_Instance_Attributes (M); - Attr : Attribute; - Inst : Instance; - Kind : Param_Type; - Val : Pval; - begin - if Attrs = null then - -- No attributes at all. - return; - end if; - - for I in Instances_Attribute_Maps.First_Index - .. Instances_Attribute_Maps.Last_Index (Attrs.all) - loop - Attr := Instances_Attribute_Maps.Get_Value (Attrs.all, I); - Inst := Instances_Attribute_Maps.Get_By_Index (Attrs.all, I); - while Attr /= No_Attribute loop - pragma Assert (Has_Instance_Attribute (Inst)); - - Put_Indent (Indent); - Put ("attribute "); - Put_Id (Get_Attribute_Name (Attr)); - Put (" of "); - Dump_Name (Get_Instance_Name (Inst)); - Disp_Instance_Id (Inst); - Put (" := "); - Kind := Get_Attribute_Type (Attr); - Val := Get_Attribute_Pval (Attr); - case Kind is - when Param_Invalid - | Param_Uns32 => - Put ("??"); - when Param_Pval_String => - Disp_Pval_String (Val); - when Param_Pval_Vector - | Param_Pval_Integer - | Param_Pval_Boolean - | Param_Pval_Real - | Param_Pval_Time_Ps => - Disp_Pval_Binary (Val); - end case; - Put_Line (";"); - Attr := Get_Attribute_Next (Attr); - end loop; - end loop; - end Dump_Attributes; - procedure Dump_Module_Header (M : Module; Indent : Natural := 0) is begin -- Module id and name. @@ -419,8 +409,6 @@ package body Netlists.Dump is Dump_Module (S, Indent + 1); end loop; - Dump_Attributes (M, Indent + 1); - declare Self : constant Instance := Get_Self_Instance (M); begin diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb index 976334b32..3de0a69fb 100644 --- a/src/synth/netlists.adb +++ b/src/synth/netlists.adb @@ -20,6 +20,7 @@ with Std_Names; with Name_Table; with Tables; with Simple_IO; +with Dyn_Maps; with Netlists.Utils; use Netlists.Utils; with Netlists.Gates; @@ -129,8 +130,7 @@ package body Netlists is Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, - Last_Instance => No_Instance, - Attrs => null)); + Last_Instance => No_Instance)); Res := Modules_Table.Last; Self := Create_Self_Instance (Res); pragma Unreferenced (Self); @@ -175,8 +175,7 @@ package body Netlists is Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, - Last_Instance => No_Instance, - Attrs => null)); + Last_Instance => No_Instance)); Res := Modules_Table.Last; -- Append @@ -313,6 +312,7 @@ package body Netlists is Table_Low_Bound => No_Param_Idx, Table_Initial => 256); + -- Hash INST (simply return its index). function Hash (Inst : Instance) return Hash_Value_Type is begin return Hash_Value_Type (Inst); @@ -1174,67 +1174,67 @@ package body Netlists is -- Attributes - function Attribute_Hash (Params : Instance) return Hash_Value_Type is + package Attributes_Table is new Tables + (Table_Component_Type => Attribute_Record, + Table_Index_Type => Attribute, + Table_Low_Bound => 0, + Table_Initial => 64); + + function Instance_Attribute_Hash (Params : Instance) + return Hash_Value_Type is begin return Hash_Value_Type (Params); - end Attribute_Hash; + end Instance_Attribute_Hash; - function Attribute_Build (Params : Instance) return Instance is + function Instance_Attribute_Build (Params : Instance) return Instance is begin return Params; - end Attribute_Build; + end Instance_Attribute_Build; - function Attribute_Build_Value (Obj : Instance) return Attribute + function Instance_Attribute_Build_Value (Obj : Instance) return Attribute is pragma Unreferenced (Obj); begin return No_Attribute; - end Attribute_Build_Value; + end Instance_Attribute_Build_Value; - package Attributes_Table is new Tables - (Table_Component_Type => Attribute_Record, - Table_Index_Type => Attribute, - Table_Low_Bound => 0, - Table_Initial => 64); + package Instances_Attribute_Maps is new Dyn_Maps + (Params_Type => Instance, + Object_Type => Instance, + Value_Type => Attribute, + Hash => Instance_Attribute_Hash, + Build => Instance_Attribute_Build, + Build_Value => Instance_Attribute_Build_Value, + Equal => "="); + + Instances_Attribute_Map : Instances_Attribute_Maps.Instance; procedure Set_Instance_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 : Instances_Attribute_Maps.Index_Type; Prev : Attribute; begin - if Module_Rec.Attrs = null then - Module_Rec.Attrs := new Instances_Attribute_Maps.Instance; - Instances_Attribute_Maps.Init (Module_Rec.Attrs.all); - end if; - -- There is now at least one attribute for INST. Instances_Table.Table (Inst).Has_Attr := True; -- Get (or create and get) an entry for INST. If created, it will be -- No_Attribute (returned by attribute_build_value). - Instances_Attribute_Maps.Get_Index (Module_Rec.Attrs.all, Inst, Idx); + Instances_Attribute_Maps.Get_Index (Instances_Attribute_Map, Inst, Idx); - Prev := Instances_Attribute_Maps.Get_Value (Module_Rec.Attrs.all, Idx); + Prev := Instances_Attribute_Maps.Get_Value + (Instances_Attribute_Map, Idx); Attributes_Table.Append ((Name => Id, Typ => Ptype, Val => Pv, Chain => Prev)); Attr := Attributes_Table.Last; - Instances_Attribute_Maps.Set_Value (Module_Rec.Attrs.all, Idx, Attr); + Instances_Attribute_Maps.Set_Value (Instances_Attribute_Map, Idx, Attr); end Set_Instance_Attribute; - function Get_Instance_Attributes (M : Module) - return Instances_Attribute_Map_Acc is - begin - return Modules_Table.Table (M).Attrs; - end Get_Instance_Attributes; - function Has_Instance_Attribute (Inst : Instance) return Boolean is begin return Instances_Table.Table (Inst).Has_Attr; @@ -1248,15 +1248,13 @@ package body Netlists is return No_Attribute; end if; declare - M : constant Module := Get_Instance_Parent (Inst); - Attrs : constant Instances_Attribute_Map_Acc := - Get_Instance_Attributes (M); Idx : Instances_Attribute_Maps.Index_Type; Res : Attribute; begin - pragma Assert (Attrs /= null); - Instances_Attribute_Maps.Get_Index (Attrs.all, Inst, Idx); - Res := Instances_Attribute_Maps.Get_Value (Attrs.all, Idx); + Instances_Attribute_Maps.Get_Index + (Instances_Attribute_Map, Inst, Idx); + Res := Instances_Attribute_Maps.Get_Value + (Instances_Attribute_Map, Idx); return Res; end; end Get_Instance_First_Attribute; @@ -1532,8 +1530,7 @@ begin Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, - Last_Instance => No_Instance, - Attrs => null)); + Last_Instance => No_Instance)); pragma Assert (Modules_Table.Last = No_Module); Modules_Table.Append ((Parent => No_Module, @@ -1549,8 +1546,7 @@ begin Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, - Last_Instance => No_Instance, - Attrs => null)); + Last_Instance => No_Instance)); pragma Assert (Modules_Table.Last = Free_Module); Instances_Table.Append ((Parent => No_Module, @@ -1604,4 +1600,6 @@ begin pragma Assert (Attributes_Table.Last = No_Attribute); Ports_Attribute_Maps.Init (Ports_Attribute_Map); + + Instances_Attribute_Maps.Init (Instances_Attribute_Map); end Netlists; diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads index 3a2f45d54..365e1f1a2 100644 --- a/src/synth/netlists.ads +++ b/src/synth/netlists.ads @@ -18,7 +18,6 @@ with Types; use Types; with Hash; use Hash; -with Dyn_Maps; package Netlists is -- Netlists. @@ -409,24 +408,6 @@ private Chain : Attribute; end record; - function Attribute_Hash (Params : Instance) return Hash_Value_Type; - function Attribute_Build (Params : Instance) return Instance; - function Attribute_Build_Value (Obj : Instance) return Attribute; - - -- Per instance map of attribute. - -- The index is the sub-instance, the value is the attribute chain. - package Instances_Attribute_Maps is new Dyn_Maps - (Params_Type => Instance, - Object_Type => Instance, - Value_Type => Attribute, - Hash => Attribute_Hash, - Build => Attribute_Build, - Build_Value => Attribute_Build_Value, - Equal => "="); - - type Instances_Attribute_Map_Acc is - access Instances_Attribute_Maps.Instance; - type Module_Record is record Parent : Module; Name : Sname; @@ -449,18 +430,12 @@ private -- FIXME: use an array instead ? First_Instance : Instance; Last_Instance : Instance; - - -- Map of instance (of this module) to its attributes. - Attrs : Instances_Attribute_Map_Acc; end record; function Get_First_Port_Desc (M : Module) return Port_Desc_Idx; function Get_First_Output (Inst : Instance) return Net; function Get_Port_Desc (Idx : Port_Desc_Idx) return Port_Desc; - function Get_Instance_Attributes (M : Module) - return Instances_Attribute_Map_Acc; - function Is_Valid (I : Instance) return Boolean; type Instance_Record is record diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index cbded9008..58f7989e7 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -541,7 +541,6 @@ package body Synth.Disp_Vhdl is Put_Line (" is"); Disp_Ports_As_Signals (Main); Disp_Architecture_Declarations (Main); - Disp_Architecture_Attributes (Main); Put_Line ("begin"); if Inst /= null then |