WIP: netlists: reuse free instances.

1 files changed, 220 insertions, 37 deletions

diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 25d928ab3..168289b38 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -274,24 +274,39 @@ package body Netlists is
 
    --  Instances
 
+   --  List of free instances, linked by Next_Instance.
+   Free_Instances : Instance := No_Instance;
+
    package Instances_Table is new Tables
      (Table_Component_Type => Instance_Record,
       Table_Index_Type => Instance,
       Table_Low_Bound => No_Instance,
       Table_Initial => 1024);
 
+   --  List of free nets.
+   --  As most of gates have only one output, just keep a single list.
+   Free_Nets : Net := No_Net;
+
    package Nets_Table is new Tables
      (Table_Component_Type => Net_Record,
       Table_Index_Type => Net,
       Table_Low_Bound => No_Net,
       Table_Initial => 1024);
 
+   --  List of free consecutive inputs.
+   Free_Inputs : array (Port_Idx range 1 .. 4) of Input :=
+     (others => No_Input);
+
    package Inputs_Table is new Tables
      (Table_Component_Type => Input_Record,
       Table_Index_Type => Input,
       Table_Low_Bound => No_Input,
       Table_Initial => 1024);
 
+   Free_Params : array (Param_Idx range 1 .. 32) of Param_Idx :=
+     (others => No_Param_Idx);
+   Free_Params2 : Param_Idx := No_Param_Idx;
+
    package Params_Table is new Tables
      (Table_Component_Type => Uns32,
       Table_Index_Type => Param_Idx,
@@ -398,24 +413,81 @@ package body Netlists is
       pragma Assert (Is_Valid (Parent));
       pragma Assert (Is_Valid (M));
       Res : Instance;
-      Inputs : constant Input := Inputs_Table.Allocate (Natural (Nbr_Inputs));
-      Outputs : constant Net := Nets_Table.Allocate (Natural (Nbr_Outputs));
-      Params : constant Param_Idx :=
-        Params_Table.Allocate (Natural (Nbr_Params));
-   begin
-      Instances_Table.Append ((Parent => Parent,
-                               Flag3 | Flag4 => False,
-                               Next_Instance => No_Instance,
-                               Prev_Instance => No_Instance,
-                               Klass => M,
-                               Flag_Mark => False,
-                               Flag5 | Flag6 => False,
-                               Flag2 => False,
-                               Name => Name,
-                               First_Param => Params,
-                               First_Input => Inputs,
-                               First_Output => Outputs));
-      Res := Instances_Table.Last;
+      Inputs : Input;
+      Outputs : Net;
+      Params : Param_Idx;
+   begin
+      if Free_Instances = No_Instance then
+         Instances_Table.Increment_Last;
+         Res := Instances_Table.Last;
+      else
+         Res := Free_Instances;
+         Free_Instances := Instances_Table.Table (Res).Next_Instance;
+      end if;
+
+      if Nbr_Inputs > 0 then
+         if Nbr_Inputs <= Free_Inputs'Last then
+            if Free_Inputs (Nbr_Inputs) /= No_Input then
+               --  Get a free input from the free list.
+               Inputs := Free_Inputs (Nbr_Inputs);
+               Free_Inputs (Nbr_Inputs) :=
+                 Inputs_Table.Table (Inputs).Next_Sink;
+            elsif Nbr_Inputs = 1 and then Free_Inputs (2) /= No_Input
+            then
+               --  Ok, common case: need just one input; get it from the list
+               --  of free 2-inputs.
+               pragma Assert (Free_Inputs (1) = No_Input);
+               Inputs := Free_Inputs (2);
+               Free_Inputs (2) := Inputs_Table.Table (Inputs).Next_Sink;
+               Free_Inputs (1) := Inputs + 1;
+               Inputs_Table.Table (Inputs + 1).Next_Sink := 0;
+            else
+               Inputs := Inputs_Table.Allocate (Natural (Nbr_Inputs));
+            end if;
+         else
+            Inputs := Inputs_Table.Allocate (Natural (Nbr_Inputs));
+         end if;
+      else
+         Inputs := No_Input;
+      end if;
+
+      if Nbr_Outputs > 0 then
+         if Nbr_Outputs = 1 and then Free_Nets /= No_Net then
+            Outputs := Free_Nets;
+            Free_Nets := Net (Nets_Table.Table (Outputs).First_Sink);
+         else
+            Outputs := Nets_Table.Allocate (Natural (Nbr_Outputs));
+         end if;
+      else
+         Outputs := No_Net;
+      end if;
+
+      if Nbr_Params > 0 then
+         if Nbr_Params <= Free_Params'Last
+           and then Free_Params (Nbr_Params) /= No_Param_Idx
+         then
+            Params := Free_Params (Nbr_Params);
+            Free_Params (Nbr_Params) :=
+              Param_Idx (Params_Table.Table (Params));
+         else
+            Params := Params_Table.Allocate (Natural (Nbr_Params));
+         end if;
+      else
+         Params := No_Param_Idx;
+      end if;
+
+      Instances_Table.Table (Res) := ((Parent => Parent,
+                                       Flag3 | Flag4 => False,
+                                       Next_Instance => No_Instance,
+                                       Prev_Instance => No_Instance,
+                                       Klass => M,
+                                       Flag_Mark => False,
+                                       Flag5 | Flag6 => False,
+                                       Flag2 => False,
+                                       Name => Name,
+                                       First_Param => Params,
+                                       First_Input => Inputs,
+                                       First_Output => Outputs));
 
       --  Setup inputs.
       if Nbr_Inputs > 0 then
@@ -527,12 +599,25 @@ package body Netlists is
       return Irec.Parent = Irec.Klass;
    end Is_Self_Instance;
 
+   type Module_Counter_Type is array (Module range 1 .. 128) of Natural;
+   Free_Instances_Counter :  Module_Counter_Type :=
+     (others => 0);
+
+   procedure Free_Input (First : Input; Nbr : Port_Nbr)
+   is
+      pragma Assert (Nbr in Free_Inputs'Range);
+   begin
+      Inputs_Table.Table (First).Next_Sink := Free_Inputs (Nbr);
+      Free_Inputs (Nbr) := First;
+   end Free_Input;
+
    procedure Free_Instance (Inst : Instance)
    is
       pragma Assert (Is_Valid (Inst));
       Inst_Rec : Instance_Record renames Instances_Table.Table (Inst);
       Nbr_Outputs : Port_Nbr;
-      Nbr_Inputs : Port_Nbr;
+      Nbr_Inputs  : Port_Nbr;
+      Nbr_Params : Param_Idx;
    begin
       pragma Assert (not Check_Connected (Inst));
 
@@ -540,6 +625,11 @@ package body Netlists is
       pragma Assert (Inst_Rec.Prev_Instance = No_Instance);
       pragma Assert (Inst_Rec.Next_Instance = No_Instance);
 
+      if Inst_Rec.Klass <= Free_Instances_Counter'Last then
+         Free_Instances_Counter (Inst_Rec.Klass) :=
+           Free_Instances_Counter (Inst_Rec.Klass) + 1;
+      end if;
+
       Nbr_Outputs := Get_Nbr_Outputs (Inst);
       for I in 1 .. Nbr_Outputs loop
          declare
@@ -549,6 +639,18 @@ package body Netlists is
          end;
       end loop;
 
+      if Nbr_Outputs /= 0 then
+         --  Put all nets, one by one, on the list of free nets.
+         for I in 0 .. Net (Nbr_Outputs - 1) loop
+            Nets_Table.Table (Inst_Rec.First_Output + I).First_Sink :=
+              Input (Inst_Rec.First_Output + I + 1);
+         end loop;
+         Nets_Table.Table (Inst_Rec.First_Output
+                           + Net (Nbr_Outputs - 1)).First_Sink :=
+           Input (Free_Nets);
+         Free_Nets := Inst_Rec.First_Output;
+      end if;
+
       Nbr_Inputs := Get_Nbr_Inputs (Inst);
       for I in 1 .. Nbr_Inputs loop
          declare
@@ -558,7 +660,49 @@ package body Netlists is
          end;
       end loop;
 
+      if Nbr_Inputs /= 0 then
+         if Nbr_Inputs <= Free_Inputs'Last then
+            Free_Input (Inst_Rec.First_Input, Nbr_Inputs);
+         else
+            declare
+               Num : Port_Nbr;
+               First : Input;
+            begin
+               --  Free per pairs.
+               Num := Nbr_Inputs;
+               First := Inst_Rec.First_Input;
+               while Num >= 2 loop
+                  Free_Input (First, 2);
+                  First := First + 2;
+                  Num := Num - 2;
+               end loop;
+               --  Free the last one.
+               if Num = 1 then
+                  Free_Input (First, 1);
+               end if;
+            end;
+         end if;
+      end if;
+
+      Nbr_Params := Get_Nbr_Params (Inst);
+      if Nbr_Params /= 0 then
+         if Nbr_Params <= Free_Params'Last then
+            Params_Table.Table (Inst_Rec.First_Param) :=
+              Uns32 (Free_Params (Nbr_Params));
+            Free_Params (Nbr_Params) := Inst_Rec.First_Param;
+         else
+            Params_Table.Table (Inst_Rec.First_Param) :=
+              Uns32 (Free_Params2);
+            Params_Table.Table (Inst_Rec.First_Param + 1) :=
+              Uns32 (Nbr_Params);
+            Free_Params2 := Inst_Rec.First_Param;
+         end if;
+      end if;
+
       Inst_Rec.Klass := Free_Module;
+
+      Inst_Rec.Next_Instance := Free_Instances;
+      Free_Instances := Inst;
    end Free_Instance;
 
    function Get_Module (Inst : Instance) return Module is
@@ -1027,11 +1171,25 @@ package body Netlists is
       end if;
    end Write_Pval;
 
+   function Count_Free_Inputs (Head : Input) return Natural
+   is
+      Unused : Natural;
+      Inp : Input;
+   begin
+      Unused := 0;
+      Inp := Head;
+      while Inp /= No_Input loop
+         Unused := Unused + 1;
+         Inp := Inputs_Table.Table (Inp).Next_Sink;
+      end loop;
+      return Unused;
+   end Count_Free_Inputs;
+
    procedure Disp_Stats
    is
       use Simple_IO;
       Unused : Natural;
-      Nbr_Modules : array (Module range 1 .. 130) of Natural := (others => 0);
+      Nbr_Modules : Module_Counter_Type := (others => 0);
    begin
       Put_Line_Err ("Statistics for netlists:");
       Put_Line_Err
@@ -1071,6 +1229,15 @@ package body Netlists is
       end loop;
       Put_Line_Err
         (" (free:" & Natural'Image (Unused) & ')');
+      for I in Free_Inputs'Range loop
+         Unused := Count_Free_Inputs (Free_Inputs (I));
+         if Unused /= 0 then
+            Put_Line_Err ("  free" & Port_Nbr'Image (I) & " inputs:"
+                          & Natural'Image (Unused)
+                          & " *" & Port_Nbr'Image (I)
+                          & " =" & Natural'Image (Unused * Natural (I)));
+         end if;
+      end loop;
 
       Put_Line_Err
         (" params:    " & Param_Idx'Image (Params_Table.Last));
@@ -1084,23 +1251,39 @@ package body Netlists is
             end if;
          end;
       end loop;
-      for I in Nbr_Modules'Range loop
-         if Nbr_Modules (I) /= 0 then
-            declare
-               Name : constant Sname := Get_Module_Name (I);
-            begin
-               case Get_Sname_Kind (Name) is
-                  when Sname_User
-                     | Sname_Artificial =>
-                     Put_Err
-                       ("  " & Name_Table.Image (Get_Sname_Suffix (Name)));
-                  when others =>
-                     Put_Err
-                       ("  module " & Module_Id'Image (Get_Id (I)));
-               end case;
-               Put_Line_Err (":" & Natural'Image (Nbr_Modules (I)));
-            end;
-         end if;
+
+      for J in 1 .. 2 loop
+         case J is
+            when 1 =>
+               Put_Line_Err (" Number of instances (per module):");
+            when 2 =>
+               Put_Line_Err (" Number of freed instances (per module):");
+         end case;
+         for I in Module_Counter_Type'Range loop
+            case J is
+               when 1 =>
+                  Unused := Nbr_Modules (I);
+               when 2 =>
+                  Unused := Free_Instances_Counter (I);
+            end case;
+
+            if Unused /= 0 then
+               declare
+                  Name : constant Sname := Get_Module_Name (I);
+               begin
+                  case Get_Sname_Kind (Name) is
+                     when Sname_User
+                        | Sname_Artificial =>
+                        Put_Err
+                          ("  " & Name_Table.Image (Get_Sname_Suffix (Name)));
+                     when others =>
+                        Put_Err
+                          ("  module " & Module_Id'Image (Get_Id (I)));
+                  end case;
+                  Put_Line_Err (":" & Natural'Image (Unused));
+               end;
+            end if;
+         end loop;
       end loop;
    end Disp_Stats;