netlists-dump: also dump attributes

3 files changed, 168 insertions, 74 deletions

diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index 7c7fe8031..413e19e13 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -19,13 +19,13 @@
 with Simple_IO; use Simple_IO;
 with Utils_IO; use Utils_IO;
 with Types_Utils; use Types_Utils;
-with Name_Table; use Name_Table;
 with Files_Map;
 
 with Netlists.Utils; use Netlists.Utils;
 with Netlists.Iterators; use Netlists.Iterators;
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Locations;
+with Netlists.Dump; use Netlists.Dump;
 
 package body Netlists.Disp_Vhdl is
    Flag_Merge_Lit : constant Boolean := True;
@@ -45,11 +45,6 @@ package body Netlists.Disp_Vhdl is
       end if;
    end Put_Type;
 
-   procedure Put_Id (N : Name_Id) is
-   begin
-      Put (Name_Table.Image (N));
-   end Put_Id;
-
    procedure Put_Name_Version (N : Sname) is
    begin
       Put_Uns32 (Get_Sname_Version (N));
@@ -152,64 +147,6 @@ package body Netlists.Disp_Vhdl is
       end;
    end Disp_Net_Name;
 
-   Bchar : constant array (Uns32 range 0 .. 3) of Character := "01ZX";
-
-   procedure Disp_Binary_Digit (Va : Uns32; Zx : Uns32; I : Natural) is
-   begin
-      Put (Bchar (((Va / 2**I) and 1) + ((Zx / 2**I) and 1) * 2));
-   end Disp_Binary_Digit;
-
-   procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is
-   begin
-      for I in 1 .. W loop
-         Disp_Binary_Digit (Va, Zx, W - I);
-      end loop;
-   end Disp_Binary_Digits;
-
-   procedure Disp_Pval_Binary (Pv : Pval)
-   is
-      Len : constant Uns32 := Get_Pval_Length (Pv);
-      V   : Logic_32;
-      Off : Uns32;
-   begin
-      Put ('"');
-      if Len > 0 then
-         V := Read_Pval (Pv, (Len - 1) / 32);
-         for I in reverse 0 .. Len - 1 loop
-            Off := I mod 32;
-            if Off = 31 then
-               V := Read_Pval (Pv, I / 32);
-            end if;
-            Disp_Binary_Digit (V.Val, V.Zx, Natural (Off));
-         end loop;
-      end if;
-      Put ('"');
-   end Disp_Pval_Binary;
-
-   procedure Disp_Pval_String (Pv : Pval)
-   is
-      Len : constant Uns32 := Get_Pval_Length (Pv);
-      pragma Assert (Len rem 8 = 0);
-      V   : Logic_32;
-      Off : Uns32;
-      C   : Uns32;
-   begin
-      Put ('"');
-      if Len > 0 then
-         V := Read_Pval (Pv, (Len - 1) / 32);
-         for I in reverse 0 .. (Len / 8) - 1 loop
-            Off := I mod 4;
-            if Off = 3 then
-               V := Read_Pval (Pv, I / 4);
-            end if;
-            pragma Assert (V.Zx = 0);
-            C := Shift_Right (V.Val, Natural (8 * Off)) and 16#ff#;
-            Put (Character'Val (C));
-         end loop;
-      end if;
-      Put ('"');
-   end Disp_Pval_String;
-
    procedure Disp_Instance_Gate (Inst : Instance)
    is
       Imod : constant Module := Get_Module (Inst);
diff --git a/src/synth/netlists-dump.adb b/src/synth/netlists-dump.adb
index 502dd5616..d105df37e 100644
--- a/src/synth/netlists-dump.adb
+++ b/src/synth/netlists-dump.adb
@@ -32,6 +32,76 @@ package body Netlists.Dump is
       Put_Trim (Width'Image (W));
    end Put_Width;
 
+   procedure Put_Id (N : Name_Id) is
+   begin
+      Put (Name_Table.Image (N));
+   end Put_Id;
+
+   procedure Disp_Binary_Digit (Va : Uns32; Zx : Uns32; I : Natural) is
+   begin
+      Put (Bchar (((Va / 2**I) and 1) + ((Zx / 2**I) and 1) * 2));
+   end Disp_Binary_Digit;
+
+   procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is
+   begin
+      for I in 1 .. W loop
+         Disp_Binary_Digit (Va, Zx, W - I);
+      end loop;
+   end Disp_Binary_Digits;
+
+   procedure Disp_Pval_Binary (Pv : Pval)
+   is
+      Len : constant Uns32 := Get_Pval_Length (Pv);
+      V   : Logic_32;
+      Off : Uns32;
+   begin
+      Put ('"');
+      if Len > 0 then
+         V := Read_Pval (Pv, (Len - 1) / 32);
+         for I in reverse 0 .. Len - 1 loop
+            Off := I mod 32;
+            if Off = 31 then
+               V := Read_Pval (Pv, I / 32);
+            end if;
+            Disp_Binary_Digit (V.Val, V.Zx, Natural (Off));
+         end loop;
+      end if;
+      Put ('"');
+   end Disp_Pval_Binary;
+
+   procedure Disp_Pval_String (Pv : Pval)
+   is
+      Len : constant Uns32 := Get_Pval_Length (Pv);
+      pragma Assert (Len rem 8 = 0);
+      V   : Logic_32;
+      Off : Uns32;
+      C   : Uns32;
+   begin
+      Put ('"');
+      if Len > 0 then
+         V := Read_Pval (Pv, (Len - 1) / 32);
+         for I in reverse 0 .. (Len / 8) - 1 loop
+            Off := I mod 4;
+            if Off = 3 then
+               V := Read_Pval (Pv, I / 4);
+            end if;
+            pragma Assert (V.Zx = 0);
+            C := Shift_Right (V.Val, Natural (8 * Off)) and 16#ff#;
+            Put (Character'Val (C));
+         end loop;
+      end if;
+      Put ('"');
+   end Disp_Pval_String;
+
+   procedure Disp_Instance_Id (Inst : Instance) is
+   begin
+      if Flag_Disp_Id then
+         Put ("{i");
+         Put_Trim (Instance'Image (Inst));
+         Put ('}');
+      end if;
+   end Disp_Instance_Id;
+
    procedure Dump_Name (N : Sname)
    is
       use Name_Table;
@@ -55,7 +125,7 @@ package body Netlists.Dump is
             Put (Image (Get_Sname_Suffix (N)));
          when Sname_Artificial =>
             Put ("$");
-            Put (Image (Get_Sname_Suffix (N)));
+            Put_Id (Get_Sname_Suffix (N));
          when Sname_Version =>
             Put ("%");
             Put_Uns32 (Get_Sname_Version (N));
@@ -157,11 +227,7 @@ package body Netlists.Dump is
       Put_Indent (Indent);
       Put ("instance ");
       Dump_Name (Get_Instance_Name (Inst));
-      if Flag_Disp_Id then
-         Put (" {i");
-         Put_Trim (Instance'Image (Inst));
-         Put ('}');
-      end if;
+      Disp_Instance_Id (Inst);
       Put (": ");
       Dump_Name (Get_Module_Name (Get_Module (Inst)));
       New_Line;
@@ -236,6 +302,55 @@ package body Netlists.Dump is
       New_Line;
    end Dump_Module_Port;
 
+   procedure Dump_Attributes (M : Module; Indent : Natural := 0)
+   is
+      Attrs : constant Attribute_Map_Acc := Get_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
+        Attribute_Maps.First_Index .. Attribute_Maps.Last_Index (Attrs.all)
+      loop
+         Attr := Attribute_Maps.Get_Value (Attrs.all, I);
+         Inst := Attribute_Maps.Get_By_Index (Attrs.all, I);
+         while Attr /= No_Attribute loop
+            pragma Assert (Has_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.
@@ -296,6 +411,8 @@ 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
@@ -404,6 +521,9 @@ package body Netlists.Dump is
       if Get_Nbr_Outputs (Inst) /= 1 then
          return False;
       end if;
+      if Has_Attribute (Inst) then
+         return False;
+      end if;
       O := Get_Output (Inst, 0);
       Inp := Get_First_Sink (O);
       if Inp = No_Input or else Get_Next_Sink (Inp) /= No_Input then
@@ -503,10 +623,40 @@ package body Netlists.Dump is
 
       Dump_Name (Get_Module_Name (M));
 
-      if Flag_Disp_Id then
-         Put ("{i");
-         Put_Trim (Instance'Image (Inst));
-         Put ('}');
+      Disp_Instance_Id (Inst);
+
+      if Has_Attribute (Inst) then
+         declare
+            Attr  : Attribute;
+            Kind  : Param_Type;
+            Val   : Pval;
+         begin
+            Attr := Get_First_Attribute (Inst);
+            Put ("(* ");
+            loop
+               Put_Id (Get_Attribute_Name (Attr));
+               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;
+               Attr := Get_Attribute_Next (Attr);
+               exit when Attr = No_Attribute;
+               Put (", ");
+            end loop;
+            Put (" *)");
+         end;
       end if;
 
       if Get_Nbr_Params (Inst) > 0 then
diff --git a/src/synth/netlists-dump.ads b/src/synth/netlists-dump.ads
index afef798b3..2fcb429be 100644
--- a/src/synth/netlists-dump.ads
+++ b/src/synth/netlists-dump.ads
@@ -23,6 +23,13 @@ package Netlists.Dump is
    --  If set, print nets/instances/modules identifier.
    Flag_Disp_Id : Boolean := True;
 
+   Bchar : constant array (Uns32 range 0 .. 3) of Character := "01ZX";
+
+   procedure Put_Id (N : Name_Id);
+   procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural);
+   procedure Disp_Pval_Binary (Pv : Pval);
+   procedure Disp_Pval_String (Pv : Pval);
+
    procedure Dump_Name (N : Sname);
 
    procedure Dump_Net_Name (N : Net; With_Id : Boolean := False);