synth: rewrite cleanup pass.

7 files changed, 188 insertions, 68 deletions

diff --git a/src/synth/netlists-cleanup.adb b/src/synth/netlists-cleanup.adb
new file mode 100644
index 000000000..207a8a63e
--- /dev/null
+++ b/src/synth/netlists-cleanup.adb
@@ -0,0 +1,107 @@
+--  Netlist cleanup.
+--  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.Utils; use Netlists.Utils;
+
+package body Netlists.Cleanup is
+   function Is_Unused_Instance (Inst : Instance) return Boolean
+   is
+      Nbr_Outputs : constant Port_Idx := Get_Nbr_Outputs (Inst);
+      N : Net;
+   begin
+      --  An instance without outputs is considered as used.
+      if Nbr_Outputs = 0 then
+         return Get_Module (Inst) = Free_Module;
+      end if;
+
+      for Idx in 0 .. Nbr_Outputs - 1 loop
+         N := Get_Output (Inst, Idx);
+         if Is_Connected (N) then
+            --  Connected output.
+            return False;
+         end if;
+      end loop;
+
+      --  All outputs are unconnected.
+      return True;
+   end Is_Unused_Instance;
+
+   procedure Extract_If_Unused (Inst : Instance; List : in out Instance) is
+   begin
+      if Is_Unused_Instance (Inst) then
+         Extract_Instance (Inst);
+         Set_Next_Instance (Inst, List);
+         List := Inst;
+      end if;
+   end Extract_If_Unused;
+
+   --  TODO: use mark & sweep to remove unused assignments ?
+   procedure Remove_Unconnected_Instances (M : Module)
+   is
+      Inst : Instance;
+      Next_Inst : Instance;
+      List : Instance;
+   begin
+      --  Extract from instances of M all unconnected instances.  Put them
+      --  in a list.
+      List := No_Instance;
+
+      Inst := Get_First_Instance (M);
+      while Inst /= No_Instance loop
+         Next_Inst := Get_Next_Instance (Inst);
+         Extract_If_Unused (Inst, List);
+         Inst := Next_Inst;
+      end loop;
+
+      --  While the list is not empty:
+      --    extract the first instance of the list.
+      --    unconnect all inputs of the instance, free the instance.
+      --    if unconnected an input resulted in an instance without connected
+      --      output, extract it from M and append it in the list.
+      while List /= No_Instance loop
+         Inst := List;
+         List := Get_Next_Instance (Inst);
+
+         declare
+            Nbr_Inputs : constant Port_Nbr := Get_Nbr_Inputs (Inst);
+            Inp : Input;
+            Drv : Net;
+            Inst2 : Instance;
+         begin
+            if Nbr_Inputs > 0 then
+               for K in 0 .. Nbr_Inputs - 1 loop
+                  Inp := Get_Input (Inst, K);
+                  Drv := Get_Driver (Inp);
+                  if Drv /= No_Net then
+                     --  The input was already unconnected.
+                     Disconnect (Inp);
+                     if Get_First_Sink (Drv) = No_Input then
+                        Inst2 := Get_Net_Parent (Drv);
+                        Extract_If_Unused (Inst2, List);
+                     end if;
+                  end if;
+               end loop;
+            end if;
+         end;
+
+         Free_Instance (Inst);
+      end loop;
+   end Remove_Unconnected_Instances;
+end Netlists.Cleanup;
diff --git a/src/synth/netlists-cleanup.ads b/src/synth/netlists-cleanup.ads
new file mode 100644
index 000000000..7f373130d
--- /dev/null
+++ b/src/synth/netlists-cleanup.ads
@@ -0,0 +1,26 @@
+--  Netlist cleanup.
+--  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.Cleanup is
+   --  Remove instances of module M whose outputs are not connected.
+   --  Their inputs will be deconnected, which can result in new instances
+   --  that are also removed.
+   procedure Remove_Unconnected_Instances (M : Module);
+end Netlists.Cleanup;
diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 02e1ea24a..d5a1f2edd 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -175,63 +175,4 @@ package body Netlists.Utils is
       --  Free Inst
       Free_Instance (Inst);
    end Disconnect_And_Free;
-
-   function Is_Unused_Instance (Inst : Instance) return Boolean
-   is
-      Nbr_Outputs : constant Port_Idx := Get_Nbr_Outputs (Inst);
-      N : Net;
-   begin
-      --  An instance without outputs is considered as used.
-      if Nbr_Outputs = 0 then
-         return False;
-      end if;
-
-      for Idx in 0 .. Nbr_Outputs - 1 loop
-         N := Get_Output (Inst, Idx);
-         if Is_Connected (N) then
-            --  Connected output.
-            return False;
-         end if;
-      end loop;
-
-      --  All outputs are unconnected.
-      return True;
-   end Is_Unused_Instance;
-
-   procedure Remove_Unused_Instances (M : Module)
-   is
-      pragma Assert (Is_Valid (M));
-      Inst : Instance;
-   begin
-      Extract_All_Instances (M, Inst);
-
-      --  Add the self instance (the first one).
-      Append_Instance (M, Inst);
-      Inst := Get_Next_Instance (Inst);
-
-      while Inst /= No_Instance loop
-         if not (Get_Id (Inst) = Id_Free
-                   or else Is_Unused_Instance (Inst))
-         then
-            --  Keep this used instance.
-            Append_Instance (M, Inst);
-         end if;
-         Inst := Get_Next_Instance (Inst);
-      end loop;
-   end Remove_Unused_Instances;
-
-   procedure Remove_Free_Instances (M : Module)
-   is
-      pragma Assert (Is_Valid (M));
-      Inst : Instance;
-   begin
-      Extract_All_Instances (M, Inst);
-
-      while Inst /= No_Instance loop
-         if Get_Id (Inst) /= Id_Free then
-            Append_Instance (M, Inst);
-         end if;
-         Inst := Get_Next_Instance (Inst);
-      end loop;
-   end Remove_Free_Instances;
 end Netlists.Utils;
diff --git a/src/synth/netlists-utils.ads b/src/synth/netlists-utils.ads
index 165e986d8..10406500d 100644
--- a/src/synth/netlists-utils.ads
+++ b/src/synth/netlists-utils.ads
@@ -56,11 +56,4 @@ package Netlists.Utils is
    --  Disconnect input I.  If the driver of I has no output(s) connected,
    --  disconnect and free it.
    procedure Disconnect_And_Free (I : Input);
-
-   --  Unlink all free instances of M.
-   procedure Remove_Free_Instances (M : Module);
-
-   --  Unlink all unused instances of M.
-   procedure Remove_Unused_Instances (M : Module);
-
 end Netlists.Utils;
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 6597be8ed..b152dccd5 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -322,9 +322,35 @@ package body Netlists is
       else
          Instances_Table.Table (M_Ent.Last_Instance).Next_Instance := Inst;
       end if;
+      Instances_Table.Table (Inst).Prev_Instance := M_Ent.Last_Instance;
       M_Ent.Last_Instance := Inst;
    end Append_Instance;
 
+   procedure Extract_Instance (Inst : Instance)
+   is
+      pragma Assert (Is_Valid (Inst));
+      Inst_Ent : Instance_Record renames Instances_Table.Table (Inst);
+      M : constant Module := Inst_Ent.Parent;
+      M_Ent : Module_Record renames Modules_Table.Table (M);
+   begin
+      if Inst_Ent.Prev_Instance /= No_Instance then
+         Set_Next_Instance (Inst_Ent.Prev_Instance, Inst_Ent.Next_Instance);
+      else
+         pragma Assert (M_Ent.First_Instance = Inst);
+         M_Ent.First_Instance := Inst_Ent.Next_Instance;
+      end if;
+
+      if Inst_Ent.Next_Instance /= No_Instance then
+         Set_Prev_Instance (Inst_Ent.Next_Instance, Inst_Ent.Prev_Instance);
+      else
+         pragma Assert (M_Ent.Last_Instance = Inst);
+         M_Ent.Last_Instance := Inst_Ent.Prev_Instance;
+      end if;
+
+      Inst_Ent.Prev_Instance := No_Instance;
+      Inst_Ent.Next_Instance := No_Instance;
+   end Extract_Instance;
+
    function New_Instance_Internal (Parent : Module;
                                    M : Module;
                                    Name : Sname;
@@ -343,6 +369,7 @@ package body Netlists is
    begin
       Instances_Table.Append ((Parent => Parent,
                                Next_Instance => No_Instance,
+                               Prev_Instance => No_Instance,
                                Klass => M,
                                Name => Name,
                                First_Param => Params,
@@ -491,6 +518,18 @@ package body Netlists is
       return Instances_Table.Table (Inst).Next_Instance;
    end Get_Next_Instance;
 
+   procedure Set_Next_Instance (Inst : Instance; Next : Instance) is
+   begin
+      pragma Assert (Is_Valid (Inst));
+      Instances_Table.Table (Inst).Next_Instance := Next;
+   end Set_Next_Instance;
+
+   procedure Set_Prev_Instance (Inst : Instance; Prev : Instance) is
+   begin
+      pragma Assert (Is_Valid (Inst));
+      Instances_Table.Table (Inst).Prev_Instance := Prev;
+   end Set_Prev_Instance;
+
    function Get_First_Output (Inst : Instance) return Net is
    begin
       pragma Assert (Is_Valid (Inst));
@@ -831,6 +870,7 @@ begin
 
    Instances_Table.Append ((Parent => No_Module,
                             Next_Instance => No_Instance,
+                            Prev_Instance => No_Instance,
                             Klass => No_Module,
                             Name => No_Sname,
                             First_Param => No_Param_Idx,
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index 4580edb89..c1371c835 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -320,7 +320,9 @@ private
       --  Sub-module brother.
       Next_Sub_Module : Module;
 
+      --  List of instances.
       --  The self instance is the first instance.
+      --  FIXME: use an array instead ?
       First_Instance : Instance;
       Last_Instance : Instance;
    end record;
@@ -337,6 +339,9 @@ private
    type Instance_Record is record
       --  The instance is instantiated in Parent.
       Parent : Module;
+
+      --  Instances are in a doubly-linked list.
+      Prev_Instance : Instance;
       Next_Instance : Instance;
 
       --  For a self-instance, Klass is equal to Parent, and Name is No_Sname.
@@ -348,6 +353,9 @@ private
       First_Output : Net;
    end record;
 
+   procedure Set_Next_Instance (Inst : Instance; Next : Instance);
+   procedure Set_Prev_Instance (Inst : Instance; Prev : Instance);
+
    --  Procedures to rewrite the list of instances of a module:
    --  * first extract the chain of instances from module M (and reset the
    --    list of instances - so there is none),
@@ -356,6 +364,11 @@ private
    procedure Extract_All_Instances (M : Module; First_Instance : out Instance);
    procedure Append_Instance (M : Module; Inst : Instance);
 
+   --  Extract INST from the list of instance of its module.
+   --  Will still be connected, but won't appear anymore in the list of
+   --  instances.
+   procedure Extract_Instance (Inst : Instance);
+
    type Input is new Uns32;
    No_Input : constant Input := 0;
 
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index f2d67b4d7..c636cc497 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -27,7 +27,7 @@ with Std_Names;
 
 with Netlists; use Netlists;
 with Netlists.Builders;
-with Netlists.Utils;
+with Netlists.Cleanup;
 
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Errors;
@@ -916,7 +916,7 @@ package body Synth.Insts is
       --  a correctness point: there might be some unsynthesizable gates, like
       --  the one created for 'rising_egde (clk) and not rst'.
       if not Flags.Flag_Debug_Nocleanup then
-         Netlists.Utils.Remove_Unused_Instances
+         Netlists.Cleanup.Remove_Unconnected_Instances
            (Get_Instance_Module (Syn_Inst));
       end if;
    end Synth_Instance;