synth: defer gates removal after at end of entity synthesis.

6 files changed, 95 insertions, 29 deletions

diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb
index 3dece320b..abd754d2d 100644
--- a/src/synth/netlists-utils.adb
+++ b/src/synth/netlists-utils.adb
@@ -123,4 +123,63 @@ 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 60b8b7a7a..cdf474da2 100644
--- a/src/synth/netlists-utils.ads
+++ b/src/synth/netlists-utils.ads
@@ -41,4 +41,10 @@ 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 d8f286a8a..6e84e2116 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -290,7 +290,21 @@ package body Netlists is
       Table_Low_Bound => No_Param_Idx,
       Table_Initial => 256);
 
-   procedure Append_Instance (M_Ent : in out Module_Record; Inst : Instance) is
+   procedure Extract_All_Instances (M : Module; First_Instance : out Instance)
+   is
+      pragma Assert (Is_Valid (M));
+      M_Ent : Module_Record renames Modules_Table.Table (M);
+   begin
+      First_Instance := M_Ent.First_Instance;
+
+      --  Clear the instance list.
+      M_Ent.First_Instance := No_Instance;
+      M_Ent.Last_Instance := No_Instance;
+   end Extract_All_Instances;
+
+   procedure Append_Instance (M : Module; Inst : Instance)
+   is
+      M_Ent : Module_Record renames Modules_Table.Table (M);
    begin
       if M_Ent.First_Instance = No_Instance then
          M_Ent.First_Instance := Inst;
@@ -311,7 +325,6 @@ package body Netlists is
    is
       pragma Assert (Is_Valid (Parent));
       pragma Assert (Is_Valid (M));
-      Parent_Ent : Module_Record renames Modules_Table.Table (Parent);
       Res : Instance;
       Inputs : constant Input := Inputs_Table.Allocate (Natural (Nbr_Inputs));
       Outputs : constant Net := Nets_Table.Allocate (Natural (Nbr_Outputs));
@@ -329,7 +342,7 @@ package body Netlists is
       Res := Instances_Table.Last;
 
       --  Link instance
-      Append_Instance (Parent_Ent, Res);
+      Append_Instance (Parent, Res);
 
       --  Setup inputs.
       if Nbr_Inputs > 0 then
@@ -404,25 +417,6 @@ package body Netlists is
       Instances_Table.Table (Inst).Klass := Free_Module;
    end Free_Instance;
 
-   procedure Remove_Free_Instances (M : Module)
-   is
-      pragma Assert (Is_Valid (M));
-      M_Ent : Module_Record renames Modules_Table.Table (M);
-      Inst : Instance;
-   begin
-      Inst := M_Ent.First_Instance;
-
-      M_Ent.First_Instance := No_Instance;
-      M_Ent.Last_Instance := No_Instance;
-
-      while Inst /= No_Instance loop
-         if Get_Id (Inst) /= Id_Free then
-            Append_Instance (M_Ent, Inst);
-         end if;
-         Inst := Get_Next_Instance (Inst);
-      end loop;
-   end Remove_Free_Instances;
-
    function Get_Module (Inst : Instance) return Module is
    begin
       pragma Assert (Is_Valid (Inst));
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index 53e56a8c0..368051b9c 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -202,9 +202,6 @@ package Netlists is
    --  Use Remove_Free_Instances for a cleanup.
    procedure Free_Instance (Inst : Instance);
 
-   --  Unlink all free instances of M.
-   procedure Remove_Free_Instances (M : Module);
-
    function Is_Self_Instance (I : Instance) return Boolean;
    function Get_Module (Inst : Instance) return Module;
    function Get_Instance_Name (Inst : Instance) return Sname;
@@ -315,6 +312,11 @@ private
       First_Output : Net;
    end record;
 
+   --  Procedures to rewrite the instances of a module: first extract the chain
+   --  of instances from module M, then add the ones to keep.
+   procedure Extract_All_Instances (M : Module; First_Instance : out Instance);
+   procedure Append_Instance (M : Module; Inst : Instance);
+
    type Input is new Uns32;
    No_Input : constant Input := 0;
 
diff --git a/src/synth/synth-inference.adb b/src/synth/synth-inference.adb
index 68f10c638..898d1ad51 100644
--- a/src/synth/synth-inference.adb
+++ b/src/synth/synth-inference.adb
@@ -100,12 +100,13 @@ package body Synth.Inference is
             begin
                Drv := Get_Driver (I0);
                if Get_Id (Get_Net_Parent (Drv)) in Edge_Module_Id then
-                  Disconnect (I0);
+                  --  INST is clearly not synthesizable (boolean operation on
+                  --  an edge).  Will be removed at the end by
+                  --  remove_unused_instances.  Do not remove it now as its
+                  --  output may be used by other nets.
                   Clk := Drv;
                   I1 := Get_Input (Inst, 1);
                   Enable := Get_Driver (I1);
-                  Disconnect (I1);
-                  Free_Instance (Inst);
                end if;
             end;
          when others =>
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index 6361db001..6c767ce2d 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -22,6 +22,7 @@ with Types; use Types;
 with Name_Table; use Name_Table;
 
 with Netlists.Builders; use Netlists.Builders;
+with Netlists.Utils;
 
 with Iirs_Utils; use Iirs_Utils;
 with Elaboration; use Elaboration;
@@ -221,7 +222,10 @@ package body Synthesis is
       Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
       Synth_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
 
-      Remove_Free_Instances (Syn_Inst.M);
+      --  Remove unused gates.  This is not only an optimization but also
+      --  a correctness point: there might be some unsynthesizable gates, like
+      --  the one created for 'rising_egde (clk) and not rst'.
+      Netlists.Utils.Remove_Unused_Instances (Syn_Inst.M);
 
       return Syn_Inst;
    end Synth_Entity;