netlists: add a very simple dot dump.

4 files changed, 159 insertions, 1 deletions

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index ad0ea91c6..d7d1965fc 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -43,6 +43,7 @@ with Vhdl.Utils;
 
 with Netlists.Dump;
 with Netlists.Disp_Vhdl;
+with Netlists.Disp_Dot;
 with Netlists.Errors;
 
 with Synthesis;
@@ -52,7 +53,10 @@ with Synth.Flags; use Synth.Flags;
 
 package body Ghdlsynth is
    type Out_Format is
-     (Format_Default, Format_Raw, Format_Dump, Format_Vhdl, Format_None);
+     (Format_Default,
+      Format_Raw, Format_Dump, Format_Dot,
+      Format_Vhdl,
+      Format_None);
 
    type Name_Id_Array is array (Natural range <>) of Name_Id;
 
@@ -147,6 +151,8 @@ package body Ghdlsynth is
          Cmd.Oformat := Format_Raw;
       elsif Option = "--out=dump" then
          Cmd.Oformat := Format_Dump;
+      elsif Option = "--out=dot" then
+         Cmd.Oformat := Format_Dot;
       elsif Option = "--out=none" then
          Cmd.Oformat := Format_None;
       elsif Option = "--out=vhdl" then
@@ -340,6 +346,8 @@ package body Ghdlsynth is
          when Format_Dump =>
             Netlists.Dump.Flag_Disp_Inline := Cmd.Disp_Inline;
             Netlists.Dump.Dump_Module (Res);
+         when Format_Dot =>
+            Netlists.Disp_Dot.Disp_Dot_Top_Module (Res);
          when Format_Vhdl =>
             if Boolean'(True) then
                Ent := Vhdl.Utils.Get_Entity_From_Configuration (Config);
diff --git a/src/synth/netlists-disp_dot.adb b/src/synth/netlists-disp_dot.adb
new file mode 100644
index 000000000..59e39e239
--- /dev/null
+++ b/src/synth/netlists-disp_dot.adb
@@ -0,0 +1,123 @@
+--  Routine to dump (for debugging purpose) a netlist.
+--  Copyright (C) 2017 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Simple_IO; use Simple_IO;
+with Utils_IO; use Utils_IO;
+
+with Netlists.Utils; use Netlists.Utils;
+with Netlists.Iterators; use Netlists.Iterators;
+with Netlists.Dump; use Netlists.Dump;
+
+package body Netlists.Disp_Dot is
+   procedure Disp_Dot_Instance (Inst : Instance)
+   is
+      M : constant Module := Get_Module (Inst);
+      N : Net;
+      I : Input;
+      D : Instance;
+   begin
+      Put ("  i");
+      Put_Uns32 (Uns32 (Inst));
+      Put (" [label=""");
+      Dump_Name (Get_Module_Name (M));
+      if False then
+         Put (""" id=""");
+         Put_Uns32 (Uns32 (Inst));
+      end if;
+      Put_Line ("""];");
+
+      for Idx in 1 .. Get_Nbr_Outputs (Inst) loop
+         N := Get_Output (Inst, Idx - 1);
+         I := Get_First_Sink (N);
+         while I /= No_Input loop
+            D := Get_Input_Parent (I);
+            Put ("  i");
+            Put_Uns32 (Uns32 (Inst));
+            Put (" -> i");
+            Put_Uns32 (Uns32 (D));
+            Put (" [label=""n");
+            Put_Uns32 (Uns32 (N));
+            Put ("""]");
+            Put_Line (";");
+            I := Get_Next_Sink (I);
+         end loop;
+      end loop;
+   end Disp_Dot_Instance;
+
+   procedure Disp_Dot_Module (M : Module) is
+   begin
+      Put ("digraph m");
+      Put_Uns32 (Uns32 (M));
+      Put_Line (" {");
+
+      --  Handle inputs.
+      declare
+         Self : constant Instance := Get_Self_Instance (M);
+         N : Net;
+         I : Input;
+         D : Instance;
+      begin
+         if Self /= No_Instance then
+            for Idx in 1 .. Get_Nbr_Inputs (M) loop
+               Put ("  p");
+               Put_Uns32 (Uns32 (Idx - 1));
+               Put (" [label=""");
+               Dump_Name (Get_Input_Desc (M, Idx - 1).Name);
+               Put ("""];");
+               New_Line;
+
+               N := Get_Output (Self, Idx - 1);
+               I := Get_First_Sink (N);
+               while I /= No_Input loop
+                  D := Get_Input_Parent (I);
+                  Put ("  p");
+                  Put_Uns32 (Uns32 (Idx - 1));
+                  Put (" -> i");
+                  Put_Uns32 (Uns32 (D));
+                  Put (" [label=""n");
+                  Put_Uns32 (Uns32 (N));
+                  Put ("""]");
+                  Put_Line (";");
+                  I := Get_Next_Sink (I);
+               end loop;
+               New_Line;
+            end loop;
+         end if;
+      end;
+
+      for Inst of Instances (M) loop
+         Disp_Dot_Instance (Inst);
+         New_Line;
+      end loop;
+
+      Put_Line ("}");
+   end Disp_Dot_Module;
+
+   procedure Disp_Dot_Top_Module (M : Module) is
+   begin
+      --  Submodules.
+      for S of Sub_Modules (M) loop
+         if Get_Id (S) >= Id_User_None then
+            Disp_Dot_Module (S);
+            exit;
+         end if;
+      end loop;
+   end Disp_Dot_Top_Module;
+end Netlists.Disp_Dot;
diff --git a/src/synth/netlists-disp_dot.ads b/src/synth/netlists-disp_dot.ads
new file mode 100644
index 000000000..91b77bdfd
--- /dev/null
+++ b/src/synth/netlists-disp_dot.ads
@@ -0,0 +1,25 @@
+--  Routine to dump (for debugging purpose) a netlist.
+--  Copyright (C) 2017 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Netlists;
+
+package Netlists.Disp_Dot is
+   procedure Disp_Dot_Top_Module (M : Module);
+end Netlists.Disp_Dot;
diff --git a/src/synth/netlists-dump.ads b/src/synth/netlists-dump.ads
index ff03e1d62..5fdafb696 100644
--- a/src/synth/netlists-dump.ads
+++ b/src/synth/netlists-dump.ads
@@ -25,6 +25,8 @@ package Netlists.Dump is
    --  If set, print nets/instances/modules identifier.
    Flag_Disp_Id : Boolean := True;
 
+   procedure Dump_Name (N : Sname);
+
    procedure Dump_Net_Name (N : Net; With_Id : Boolean := False);
    procedure Disp_Driver (Drv : Net; Indent : Natural);
    procedure Disp_Instance