netlists: complete support of attributes. For #1318

5 files changed, 102 insertions, 5 deletions

diff --git a/src/synth/netlists-memories.adb b/src/synth/netlists-memories.adb
index 71d733826..e4e4115ed 100644
--- a/src/synth/netlists-memories.adb
+++ b/src/synth/netlists-memories.adb
@@ -1903,6 +1903,7 @@ package body Netlists.Memories is
                when others =>
                   raise Internal_Error;
             end case;
+            Copy_Attributes (Heads (I), Sig);
             Tails (I) := Get_Output (Heads (I), 0);
          end;
       end loop;
diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 145692ef4..74df5908c 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -289,6 +289,20 @@ package body Netlists.Utils is
       end;
    end Same_Net;
 
+   procedure Copy_Attributes (Dest : Instance; Src : Instance)
+   is
+      Attr : Attribute;
+   begin
+      Attr := Get_First_Attribute (Src);
+      while Attr /= No_Attribute loop
+         Set_Attribute (Dest,
+                        Get_Attribute_Name (Attr),
+                        Get_Attribute_Type (Attr),
+                        Get_Attribute_Pval (Attr));
+         Attr := Get_Attribute_Next (Attr);
+      end loop;
+   end Copy_Attributes;
+
    function Clog2 (W : Width) return Width is
    begin
       return Uns32 (Mutils.Clog2 (Uns64 (W)));
diff --git a/src/synth/netlists-utils.ads b/src/synth/netlists-utils.ads
index a6d63dbec..111c6f9f3 100644
--- a/src/synth/netlists-utils.ads
+++ b/src/synth/netlists-utils.ads
@@ -96,6 +96,9 @@ package Netlists.Utils is
 
    function Clog2 (W : Width) return Width;
 
+   --  Copy attribtues of SRC to DEST.
+   procedure Copy_Attributes (Dest : Instance; Src : Instance);
+
    --  Used at many places.
    package Net_Tables is new Dyn_Tables
      (Table_Component_Type => Net,
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 807d53298..59c77e831 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -479,7 +479,8 @@ package body Netlists is
       end if;
 
       Instances_Table.Table (Res) := ((Parent => Parent,
-                                       Flag3 | Flag4 => False,
+                                       Has_Attr => False,
+                                       Flag4 => False,
                                        Next_Instance => No_Instance,
                                        Prev_Instance => No_Instance,
                                        Klass => M,
@@ -1213,6 +1214,9 @@ package body Netlists is
          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;
+
       Attribute_Maps.Get_Index (Module_Rec.Attrs.all, Inst, Idx);
 
       Prev := Attribute_Maps.Get_Value (Module_Rec.Attrs.all, Idx);
@@ -1225,6 +1229,64 @@ package body Netlists is
       Attribute_Maps.Set_Value (Module_Rec.Attrs.all, Idx, Attr);
    end Set_Attribute;
 
+   function Get_Attributes (M : Module) return Attribute_Map_Acc is
+   begin
+      return Modules_Table.Table (M).Attrs;
+   end Get_Attributes;
+
+   function Get_First_Attribute (Inst : Instance) return Attribute
+   is
+      pragma Assert (Is_Valid (Inst));
+   begin
+      if not Instances_Table.Table (Inst).Has_Attr then
+         return No_Attribute;
+      end if;
+      declare
+         M          : constant Module := Get_Instance_Parent (Inst);
+         Attrs      : constant Attribute_Map_Acc := Get_Attributes (M);
+         Idx        : Attribute_Maps.Index_Type;
+         Res        : Attribute;
+      begin
+         pragma Assert (Attrs /= null);
+         Attribute_Maps.Get_Index (Attrs.all, Inst, Idx);
+         Res := Attribute_Maps.Get_Value (Attrs.all, Idx);
+         return Res;
+      end;
+   end Get_First_Attribute;
+
+   function Is_Valid (Attr : Attribute) return Boolean is
+   begin
+      return Attr > No_Attribute and then Attr <= Attributes_Table.Last;
+   end Is_Valid;
+
+   function Get_Attribute_Name (Attr : Attribute) return Name_Id
+   is
+      pragma Assert (Is_Valid (Attr));
+   begin
+      return Attributes_Table.Table (Attr).Name;
+   end Get_Attribute_Name;
+
+   function Get_Attribute_Type (Attr : Attribute) return Param_Type
+   is
+      pragma Assert (Is_Valid (Attr));
+   begin
+      return Attributes_Table.Table (Attr).Typ;
+   end Get_Attribute_Type;
+
+   function Get_Attribute_Pval (Attr : Attribute) return Pval
+   is
+      pragma Assert (Is_Valid (Attr));
+   begin
+      return Attributes_Table.Table (Attr).Val;
+   end Get_Attribute_Pval;
+
+   function Get_Attribute_Next (Attr : Attribute) return Attribute
+   is
+      pragma Assert (Is_Valid (Attr));
+   begin
+      return Attributes_Table.Table (Attr).Chain;
+   end Get_Attribute_Next;
+
    --  Statistics
 
    function Count_Free_Inputs (Head : Input) return Natural
@@ -1384,7 +1446,8 @@ begin
    pragma Assert (Modules_Table.Last = Free_Module);
 
    Instances_Table.Append ((Parent => No_Module,
-                            Flag3 | Flag4 => False,
+                            Has_Attr => False,
+                            Flag4 => False,
                             Next_Instance => No_Instance,
                             Prev_Instance => No_Instance,
                             Klass => No_Module,
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index a425575ab..5ef74a77d 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -210,6 +210,9 @@ package Netlists is
    type Pval is private;
    No_Pval : constant Pval;
 
+   --  Attribute of an instance.
+   type Attribute is private;
+
    --  Subprograms for modules.
    function New_Design (Name : Sname) return Module;
    function New_User_Module (Parent : Module;
@@ -331,6 +334,17 @@ package Netlists is
    procedure Set_Attribute
      (Inst : Instance; Id : Name_Id; Ptype : Param_Type; Pv : Pval);
 
+   --  Return the first attribute for INST.  Returns No_Attribute if none.
+   function Get_First_Attribute (Inst : Instance) return Attribute;
+
+   --  Get name/type/value of an attribute.
+   function Get_Attribute_Name (Attr : Attribute) return Name_Id;
+   function Get_Attribute_Type (Attr : Attribute) return Param_Type;
+   function Get_Attribute_Pval (Attr : Attribute) return Pval;
+
+   --  Get the next attribute for the same instance.
+   function Get_Attribute_Next (Attr : Attribute) return Attribute;
+
    --  Display some usage stats on the standard error.
    procedure Disp_Stats;
 private
@@ -425,13 +439,15 @@ private
    function Get_First_Output (Inst : Instance) return Net;
    function Get_Port_Desc (Idx : Port_Desc_Idx) return Port_Desc;
 
+   function Get_Attributes (M : Module) return Attribute_Map_Acc;
+
    function Is_Valid (I : Instance) return Boolean;
 
    type Instance_Record is record
       --  The instance is instantiated in Parent.
-      Parent : Module;
-      Flag3  : Boolean;
-      Flag4  : Boolean;
+      Parent     : Module;
+      Has_Attr  : Boolean;  --  Set when there is at least one attribute.
+      Flag4      : Boolean;
 
       --  Instances are in a doubly-linked list.
       Prev_Instance : Instance;