synth: use a global table for instances attributes

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