synth: use original entity to display netlist.

7 files changed, 314 insertions, 22 deletions

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index d25d649e8..d7f6bb848 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -33,11 +33,13 @@ with Vhdl.Configuration;
 with Vhdl.Annotations;
 with Vhdl.Utils;
 
-with Synthesis;
 with Netlists; use Netlists;
 with Netlists.Dump;
 with Netlists.Disp_Vhdl;
 
+with Synthesis;
+with Synth.Disp_Vhdl;
+
 package body Ghdlsynth is
    type Out_Format is (Format_Raw, Format_Vhdl);
 
@@ -202,6 +204,7 @@ package body Ghdlsynth is
    is
       Res : Module;
       Config : Iir;
+      Ent : Iir;
    begin
       Config := Ghdl_Synth_Configure (Args);
 
@@ -219,7 +222,12 @@ package body Ghdlsynth is
             Netlists.Dump.Flag_Disp_Inline := Cmd.Disp_Inline;
             Netlists.Dump.Disp_Module (Res);
          when Format_Vhdl =>
-            Netlists.Disp_Vhdl.Disp_Vhdl (Res);
+            if True then
+               Ent := Vhdl.Utils.Get_Entity_From_Configuration (Config);
+               Synth.Disp_Vhdl.Disp_Vhdl_Wrapper (Ent, Res);
+            else
+               Netlists.Disp_Vhdl.Disp_Vhdl (Res);
+            end if;
       end case;
    end Perform_Action;
 
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index 7e254c50a..cb02c49ca 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -637,23 +637,8 @@ package body Netlists.Disp_Vhdl is
       end case;
    end Disp_Instance_Inline;
 
-   procedure Disp_Architecture (M : Module)
-   is
-      Self_Inst : constant Instance := Get_Self_Instance (M);
+   procedure Disp_Architecture_Declarations (M : Module) is
    begin
-      if Self_Inst = No_Instance then
-         --  Not defined.
-         return;
-      end if;
-
-      Put ("architecture rtl of ");
-      Put_Name (Get_Name (M));
-      Put_Line (" is");
-
-      --  Dummy display:
-      --  * generate one signal per net
-      --  * generate instances
-
       --  Display signal declarations.
       --  There are as many signals as gate outputs.
       for Inst of Instances (M) loop
@@ -678,9 +663,12 @@ package body Netlists.Disp_Vhdl is
             end loop;
          end if;
       end loop;
+   end Disp_Architecture_Declarations;
 
-      Put_Line ("begin");
-
+   procedure Disp_Architecture_Statements (M : Module)
+   is
+      Self_Inst : constant Instance := Get_Self_Instance (M);
+   begin
       --  Output assignments.
       declare
          Idx : Port_Idx;
@@ -701,6 +689,30 @@ package body Netlists.Disp_Vhdl is
             Disp_Instance_Inline (Inst);
          end if;
       end loop;
+   end Disp_Architecture_Statements;
+
+   procedure Disp_Architecture (M : Module)
+   is
+      Self_Inst : constant Instance := Get_Self_Instance (M);
+   begin
+      if Self_Inst = No_Instance then
+         --  Not defined.
+         return;
+      end if;
+
+      Put ("architecture rtl of ");
+      Put_Name (Get_Name (M));
+      Put_Line (" is");
+
+      --  Dummy display:
+      --  * generate one signal per net
+      --  * generate instances
+
+      Disp_Architecture_Declarations (M);
+
+      Put_Line ("begin");
+
+      Disp_Architecture_Statements (M);
 
       Put_Line ("end rtl;");
       New_Line;
diff --git a/src/synth/netlists-disp_vhdl.ads b/src/synth/netlists-disp_vhdl.ads
index 995b15334..afc29458f 100644
--- a/src/synth/netlists-disp_vhdl.ads
+++ b/src/synth/netlists-disp_vhdl.ads
@@ -21,6 +21,11 @@
 package Netlists.Disp_Vhdl is
    procedure Disp_Vhdl (M : Module);
 
-   --  Display only the ports (as vhdl) of M.
-   procedure Disp_Entity_Ports (M : Module);
+   procedure Disp_Architecture_Declarations (M : Module);
+   procedure Disp_Architecture_Statements (M : Module);
+
+   procedure Put_Type (W : Width);
+   procedure Put_Name (N : Sname);
+
+   procedure Disp_Vhdl (M : Module; Is_Top : Boolean);
 end Netlists.Disp_Vhdl;
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index edc66dbf8..72ceac948 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -80,6 +80,12 @@ package body Netlists is
       return Snames_Table.Table (Name).Prefix;
    end Get_Sname_Prefix;
 
+   procedure Set_Sname_Prefix (Name : Sname; Prefix : Sname) is
+   begin
+      pragma Assert (Is_Valid (Name));
+      Snames_Table.Table (Name).Prefix := Prefix;
+   end Set_Sname_Prefix;
+
    function Get_Sname_Suffix (Name : Sname) return Name_Id
    is
       subtype Snames_Suffix is Sname_Kind range Sname_User .. Sname_Artificial;
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index 56393ac28..0e7647b79 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -67,6 +67,9 @@ package Netlists is
    function Get_Sname_Version (Name : Sname) return Uns32;
    function Get_Sname_Num (Name : Sname) return Uns32;
 
+   --  Modifies an Sname.
+   procedure Set_Sname_Prefix (Name : Sname; Prefix : Sname);
+
    --  TODO: procedure to free an Sname.
 
    --  Module.
diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb
new file mode 100644
index 000000000..21ac11737
--- /dev/null
+++ b/src/synth/synth-disp_vhdl.adb
@@ -0,0 +1,231 @@
+--  Disp a netlist in vhdl using the original entity.
+--  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.
+
+with Simple_IO; use Simple_IO;
+with Types; use Types;
+with Name_Table;
+
+with Vhdl.Prints;
+with Vhdl.Ieee.Std_Logic_1164;
+with Vhdl.Errors; use Vhdl.Errors;
+
+with Netlists.Iterators; use Netlists.Iterators;
+with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl;
+
+package body Synth.Disp_Vhdl is
+   procedure Disp_Signal (Desc : Port_Desc) is
+   begin
+      Put ("  signal ");
+      Put_Name (Desc.Name);
+      Put (": ");
+      Put_Type (Desc.W);
+      Put_Line (";");
+   end Disp_Signal;
+
+   procedure Disp_Ports_As_Signals (M : Module) is
+   begin
+      for I in 1 .. Get_Nbr_Inputs (M) loop
+         Disp_Signal (Get_Input_Desc (M, I - 1));
+      end loop;
+      for I in 1 .. Get_Nbr_Outputs (M) loop
+         Disp_Signal (Get_Output_Desc (M, I - 1));
+      end loop;
+   end Disp_Ports_As_Signals;
+
+   procedure Disp_In_Converter
+     (M : Module; Idx : in out Port_Idx; Pfx : String; Ptype : Node)
+   is
+      Btype : constant Node := Get_Base_Type (Ptype);
+      Desc : constant Port_Desc := Get_Input_Desc (M, Idx);
+   begin
+      case Get_Kind (Btype) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
+              or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
+            then
+               --  Nothing to do.
+               Put_Line ("  wrap_" & Pfx & " <= " & Pfx & ";");
+               Idx := Idx + 1;
+            else
+               Error_Kind ("disp_in_converter(enum)", Ptype);
+            end if;
+         when Iir_Kind_Array_Type_Definition =>
+            if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then
+               --  Nothing to do.
+               Put ("  wrap_" & Pfx & " <= " & Pfx);
+               if Desc.W = 1 then
+                  --  This is an array of length 1.  A scalar is used in the
+                  --  netlist.
+                  Put (" (" & Pfx & "'left)");
+               end if;
+               Put_Line (";");
+               Idx := Idx + 1;
+            else
+               Error_Kind ("disp_in_converter(arr)", Ptype);
+            end if;
+         when others =>
+            Error_Kind ("disp_in_converter", Ptype);
+      end case;
+   end Disp_In_Converter;
+
+   procedure Disp_Out_Converter
+     (M : Module; Idx : in out Port_Idx; Pfx : String; Ptype : Node)
+   is
+      Btype : constant Node := Get_Base_Type (Ptype);
+      Desc : constant Port_Desc := Get_Output_Desc (M, Idx);
+   begin
+      case Get_Kind (Btype) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
+              or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
+            then
+               --  Nothing to do.
+               Put_Line ("  " & Pfx & " <= wrap_" & Pfx & ";");
+               Idx := Idx + 1;
+            else
+               --  Any other enum.
+               Put ("  " & Pfx & " <= ");
+               Put (Name_Table.Image (Get_Identifier
+                                        (Get_Type_Declarator (Ptype))));
+               Put ("'val (to_integer(unsigned(wrap_" & Pfx & ")));");
+               New_Line;
+               Idx := Idx + 1;
+            end if;
+         when Iir_Kind_Array_Type_Definition =>
+            if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type then
+               --  Nothing to do.
+               Put ("  " & Pfx);
+               if Desc.W = 1 then
+                  --  This is an array of length 1.  A scalar is used in the
+                  --  netlist.
+                  Put (" (" & Pfx & "'left)");
+               end if;
+               Put_Line (" <= wrap_" & Pfx & ";");
+               Idx := Idx + 1;
+            else
+               Error_Kind ("disp_out_converter(arr)", Ptype);
+            end if;
+         when others =>
+            Error_Kind ("disp_out_converter", Ptype);
+      end case;
+   end Disp_Out_Converter;
+
+   procedure Disp_Vhdl_Wrapper (Ent : Node; Top : Module)
+   is
+      Unit : constant Node := Get_Design_Unit (Ent);
+      Main : Module;
+      Name_Wrap : Name_Id;
+   begin
+      --  Extract the first user submodule.
+      Main := Get_First_Sub_Module (Top);
+      while Get_Id (Main) < Id_User_None loop
+         Main := Get_Next_Sub_Module (Main);
+      end loop;
+
+      --  Disp the original design unit.
+      Vhdl.Prints.Disp_Vhdl (Unit);
+
+      --  Disp sub-units (in reverse order).
+      declare
+         M : Module;
+         Num : Natural;
+      begin
+         Num := 0;
+         M := Get_Next_Sub_Module (Main);
+         while M /= No_Module loop
+            if Get_Id (M) >= Id_User_None then
+               Num := Num + 1;
+            end if;
+            M := Get_Next_Sub_Module (M);
+         end loop;
+
+         declare
+            type Module_Array is array (1 .. Num) of Module;
+            Modules : Module_Array;
+         begin
+            Num := 0;
+            M := Get_Next_Sub_Module (Main);
+            while M /= No_Module loop
+               if Get_Id (M) >= Id_User_None then
+                  Num := Num + 1;
+                  Modules (Num) := M;
+               end if;
+               M := Get_Next_Sub_Module (M);
+            end loop;
+
+            for I in reverse Modules'Range loop
+               Netlists.Disp_Vhdl.Disp_Vhdl (Modules (I), False);
+            end loop;
+         end;
+      end;
+      New_Line;
+
+      --  Rename ports.
+      Name_Wrap := Name_Table.Get_Identifier ("wrap");
+      for P of Ports_Desc (Main) loop
+         pragma Assert (Get_Sname_Prefix (P.Name) = No_Sname);
+         Set_Sname_Prefix (P.Name, New_Sname_User (Name_Wrap));
+      end loop;
+
+      Put_Line ("library ieee;");
+      Put_Line ("use ieee.numeric_std.all;");
+      New_Line;
+      Put ("architecture rtl of ");
+      Put (Name_Table.Image (Get_Identifier (Ent)));
+      Put_Line (" is");
+      Disp_Ports_As_Signals (Main);
+      Disp_Architecture_Declarations (Main);
+
+      Put_Line ("begin");
+      --  TODO: add assert for the value of the generics.
+
+      declare
+         Idx : Port_Idx;
+         Port : Node;
+      begin
+         Port := Get_Port_Chain (Ent);
+         Idx := 0;
+         while Port /= Null_Node loop
+            if Get_Mode (Port) = Iir_In_Mode then
+               Disp_In_Converter
+                 (Main, Idx,
+                  Name_Table.Image (Get_Identifier (Port)), Get_Type (Port));
+            end if;
+            Port := Get_Chain (Port);
+         end loop;
+         pragma Assert (Idx = Get_Nbr_Inputs (Main));
+
+         Port := Get_Port_Chain (Ent);
+         Idx := 0;
+         while Port /= Null_Node loop
+            if Get_Mode (Port) = Iir_Out_Mode then
+               Disp_Out_Converter
+                 (Main, Idx,
+                  Name_Table.Image (Get_Identifier (Port)), Get_Type (Port));
+            end if;
+            Port := Get_Chain (Port);
+         end loop;
+         pragma Assert (Idx = Get_Nbr_Outputs (Main));
+      end;
+
+      Disp_Architecture_Statements (Main);
+      Put_Line ("end rtl;");
+   end Disp_Vhdl_Wrapper;
+end Synth.Disp_Vhdl;
diff --git a/src/synth/synth-disp_vhdl.ads b/src/synth/synth-disp_vhdl.ads
new file mode 100644
index 000000000..845a5f392
--- /dev/null
+++ b/src/synth/synth-disp_vhdl.ads
@@ -0,0 +1,27 @@
+--  Disp a netlist in vhdl using the original entity.
+--  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.
+
+with Netlists; use Netlists;
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+package Synth.Disp_Vhdl is
+   --  Disp ENT (like the original text) and its content as a wrapper.
+   procedure Disp_Vhdl_Wrapper (Ent : Node; Top : Module);
+end Synth.Disp_Vhdl;