From 7c8f4b6b20d42ba69d889f11c3da1f7aca877792 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 18 May 2020 18:38:57 +0200
Subject: netlists: add disp_stats.

---
 src/ghdldrv/ghdlsynth.adb | 10 +++++++++-
 src/synth/netlists.adb    | 30 ++++++++++++++++++++++++++++++
 src/synth/netlists.ads    |  3 +++
 3 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index d7d1965fc..dd2b40503 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -65,7 +65,9 @@ package body Ghdlsynth is
       --  Control format of the output.
       Disp_Inline : Boolean := True;
       Disp_Id : Boolean := True;
-      Oformat : Out_Format := Format_Default;
+      Oformat     : Out_Format := Format_Default;
+
+      Flag_Stats : Boolean := False;
 
       --  Control name encoding of the top-entity.
       Top_Encoding : Name_Encoding := Name_Asis;
@@ -175,6 +177,8 @@ package body Ghdlsynth is
          else
             Flags.Verbose := True;
          end if;
+      elsif Option = "--stats" then
+         Cmd.Flag_Stats := True;
       else
          Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
       end if;
@@ -449,6 +453,10 @@ package body Ghdlsynth is
       end if;
 
       Disp_Design (Cmd, Format_Vhdl, Res, Config, Inst);
+
+      if Cmd.Flag_Stats then
+         Netlists.Disp_Stats;
+      end if;
    end Perform_Action;
 
    function Get_Libghdl_Name return String
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 840849162..09a01f841 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -20,6 +20,7 @@
 
 with Std_Names;
 with Tables;
+with Simple_IO;
 
 with Netlists.Utils; use Netlists.Utils;
 with Netlists.Gates;
@@ -998,6 +999,35 @@ package body Netlists is
          Pval_Word_Table.Table (Pval_Rec.Zx_Idx + Off) := Val.Zx;
       end if;
    end Write_Pval;
+
+   procedure Disp_Stats
+   is
+      use Simple_IO;
+      Unused : Natural;
+   begin
+      Put_Line_Err ("Statistics for netlists:");
+      Put_Line_Err
+        (" snames:    " & Sname'Image (Snames_Table.Last));
+      Put_Line_Err
+        (" modules:   " & Module'Image (Modules_Table.Last));
+      Put_Line_Err
+        (" instances: " & Instance'Image (Instances_Table.Last));
+      Unused := 0;
+      for I in No_Instance + 1 .. Instances_Table.Last loop
+         if Get_Module (I) = Free_Module then
+            Unused := Unused + 1;
+         end if;
+      end loop;
+      Put_Line_Err
+        (" free instances: " & Natural'Image (Unused));
+      Put_Line_Err
+        (" nets:      " & Net'Image (Nets_Table.Last));
+      Put_Line_Err
+        (" inputs:    " & Input'Image (Inputs_Table.Last));
+      Put_Line_Err
+        (" params:    " & Param_Idx'Image (Params_Table.Last));
+   end Disp_Stats;
+
 begin
    --  Initialize snames_table: create the first entry for No_Sname.
    Snames_Table.Append ((Kind => Sname_Artificial,
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index 2801b8fb0..58900e748 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -327,6 +327,9 @@ package Netlists is
    --  OFF is the word offset, from 0 to (len - 1) / 32.
    function Read_Pval (P : Pval; Off : Uns32) return Logic_32;
    procedure Write_Pval (P : Pval; Off : Uns32; Val : Logic_32);
+
+   --  Display some usage stats on the standard error.
+   procedure Disp_Stats;
 private
    type Sname is new Uns32 range 0 .. 2**30 - 1;
    No_Sname : constant Sname := 0;
-- 
cgit v1.2.3