synth: add disp_vhdl.

3 files changed, 269 insertions, 2 deletions

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 48a10e753..cec4a7056 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -29,6 +29,7 @@ with Simul.Elaboration;
 
 with Synthesis;
 with Netlists.Dump;
+with Netlists.Disp_Vhdl;
 
 package body Ghdlsynth is
    --  Command --synth
@@ -125,8 +126,12 @@ package body Ghdlsynth is
       Res : Netlists.Module;
    begin
       Res := Ghdl_Synth (Args);
-      Netlists.Dump.Flag_Disp_Inline := Cmd.Disp_Inline;
-      Netlists.Dump.Disp_Module (Res);
+      if False then
+         Netlists.Dump.Flag_Disp_Inline := Cmd.Disp_Inline;
+         Netlists.Dump.Disp_Module (Res);
+      else
+         Netlists.Disp_Vhdl.Disp_Vhdl (Res);
+      end if;
    end Perform_Action;
 
    procedure Register_Commands is
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
new file mode 100644
index 000000000..9c620e0a0
--- /dev/null
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -0,0 +1,239 @@
+--  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 Ada.Text_IO; use Ada.Text_IO;
+with Name_Table;
+--  with Netlists.Utils; use Netlists.Utils;
+with Netlists.Iterators; use Netlists.Iterators;
+--  with Netlists.Gates; use Netlists.Gates;
+
+package body Netlists.Disp_Vhdl is
+   --  Like Put, but without the leading space (if any).
+   procedure Put_Trim (S : String) is
+   begin
+      if S'First <= S'Last and then S (S'First) = ' ' then
+         Put (S (S'First + 1 .. S'Last));
+      else
+         Put (S);
+      end if;
+   end Put_Trim;
+
+   procedure Put_Type (W : Width) is
+   begin
+      if W = 1 then
+         Put ("std_logic");
+      else
+         Put ("std_logic_vector (");
+         Put_Trim (Width'Image (W - 1));
+         Put (" downto 0)");
+      end if;
+   end Put_Type;
+
+   procedure Put_Name (N : Sname)
+   is
+      use Name_Table;
+      Prefix : Sname;
+   begin
+      --  Do not crash on No_Name.
+      if N = No_Sname then
+         Put ("*nil*");
+         return;
+      end if;
+
+      Prefix := Get_Sname_Prefix (N);
+
+      case Get_Sname_Kind (N) is
+         when Sname_User =>
+            if Prefix = No_Sname then
+               Put ("\");
+            else
+               Put_Name (Prefix);
+               Put (".");
+            end if;
+            Put (Image (Get_Sname_Suffix (N)));
+         when Sname_Artificial =>
+            if Prefix = No_Sname then
+               Put ("$");
+            else
+               Put_Name (Prefix);
+               Put (".");
+            end if;
+            Put (Image (Get_Sname_Suffix (N)));
+         when Sname_Version =>
+            Put_Name (Prefix);
+            Put ("%");
+            Put_Trim (Uns32'Image (Get_Sname_Version (N)));
+      end case;
+   end Put_Name;
+
+   procedure Disp_Entity (M : Module)
+   is
+      First : Boolean;
+   begin
+      --  Module id and name.
+      Put ("entity ");
+      Put_Name (Get_Name (M));
+      Put_Line (" is");
+
+      --  Ports.
+      First := True;
+      for P of Ports_Desc (M) loop
+         if First then
+            Put_Line ("  port (");
+            First := False;
+         else
+            Put_Line (";");
+         end if;
+         Put ("    ");
+         Put_Name (P.Name);
+         Put (" : ");
+         case P.Dir is
+            when Port_In =>
+               Put ("in");
+            when Port_Out =>
+               Put ("out");
+            when Port_Inout =>
+               Put ("inout");
+         end case;
+         Put (' ');
+         Put_Type (P.W);
+      end loop;
+      if not First then
+         Put_Line (");");
+      end if;
+
+      Put ("end entity ");
+      Put_Name (Get_Name (M));
+      Put_Line (";");
+      New_Line;
+   end Disp_Entity;
+
+   procedure Disp_Net_Name (N : Net)
+   is
+      Inst : constant Instance := Get_Parent (N);
+      Idx : constant Port_Idx := Get_Port_Idx (N);
+   begin
+      if Is_Self_Instance (Inst) then
+         Put_Name (Get_Input_Desc (Get_Module (Inst), Idx).Name);
+      else
+         Put_Name (Get_Name (Inst));
+         Put ('.');
+         Put_Name (Get_Output_Desc (Get_Module (Inst), Idx).Name);
+      end if;
+   end Disp_Net_Name;
+
+   procedure Disp_Architecture (M : Module)
+   is
+      First : Boolean;
+   begin
+      Put ("architecture rtl of ");
+      Put_Name (Get_Name (M));
+      Put_Line (" is");
+
+      --  Dummy display:
+      --  * generate one signal per net
+      --  * generate instances
+
+      for Inst of Instances (M) loop
+         if not Is_Self_Instance (Inst) then
+            for N of Outputs (Inst) loop
+               Put ("  signal ");
+               Disp_Net_Name (N);
+               Put (" : ");
+               Put_Type (Get_Width (N));
+               Put_Line (";");
+            end loop;
+         end if;
+      end loop;
+
+      Put_Line ("begin");
+      declare
+         Inst : constant Instance := Get_Self_Instance (M);
+         Idx : Port_Idx;
+      begin
+         Idx := 0;
+         for I of Inputs (Inst) loop
+            Put ("  ");
+            Put_Name (Get_Output_Desc (M, Idx).Name);
+            Put (" <= ");
+            Disp_Net_Name (Get_Driver (I));
+            New_Line;
+         end loop;
+      end;
+
+      for Inst of Instances (M) loop
+         declare
+            Imod : constant Module := Get_Module (Inst);
+            Idx : Port_Idx;
+         begin
+            Put ("  ");
+            Put_Name (Get_Name (Inst));
+            Put (" : work.");
+            Put_Name (Get_Name (Imod));
+            Put_Line (" port map (");
+            First := True;
+            --  Inputs
+            Idx := 0;
+            for I of Inputs (Inst) loop
+               if First then
+                  First := False;
+               else
+                  Put_Line (", ");
+               end if;
+               Put ("    ");
+               Put_Name (Get_Input_Desc (Imod, Idx).Name);
+               Idx := Idx + 1;
+               Put (" => ");
+               Disp_Net_Name (Get_Driver (I));
+            end loop;
+            --  Outputs
+            Idx := 0;
+            for O of Outputs (Inst) loop
+               if First then
+                  First := False;
+               else
+                  Put_Line (", ");
+               end if;
+               Put ("    ");
+               Put_Name (Get_Output_Desc (Imod, Idx).Name);
+               Idx := Idx + 1;
+               Put (" => ");
+               Disp_Net_Name (O);
+            end loop;
+            Put_Line (");");
+         end;
+      end loop;
+
+      Put_Line ("end rtl;");
+      New_Line;
+   end Disp_Architecture;
+
+   procedure Disp_Vhdl (M : Module) is
+   begin
+      for S of Sub_Modules (M) loop
+         if Get_Id (S) >= Id_User_None then
+            Disp_Vhdl (S);
+         end if;
+      end loop;
+
+      Disp_Entity (M);
+      Disp_Architecture (M);
+   end Disp_Vhdl;
+end Netlists.Disp_Vhdl;
diff --git a/src/synth/netlists-disp_vhdl.ads b/src/synth/netlists-disp_vhdl.ads
new file mode 100644
index 000000000..62810d0dc
--- /dev/null
+++ b/src/synth/netlists-disp_vhdl.ads
@@ -0,0 +1,23 @@
+--  Disp a netlist in vhdl.
+--  Copyright (C) 2019 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.
+
+package Netlists.Disp_Vhdl is
+   procedure Disp_Vhdl (M : Module);
+end Netlists.Disp_Vhdl;