grt: add --list-features, and --has-feature

14 files changed, 93 insertions, 19 deletions

diff --git a/src/grt/ghdl_main.adb b/src/grt/ghdl_main.adb
index 2d1a008..86f11aa 100644
--- a/src/grt/ghdl_main.adb
+++ b/src/grt/ghdl_main.adb
@@ -35,9 +35,7 @@ with Grt.Std_Logic_1164;
 with Grt.Errors;
 pragma Warnings (On);
 
-
-function Ghdl_Main (Argc : Integer; Argv : System.Address)
-                   return Integer
+function Ghdl_Main (Argc : Integer; Argv : System.Address) return Integer
 is
    --  Grt_Init corresponds to the 'adainit' subprogram for grt.
    procedure Grt_Init;
@@ -48,6 +46,7 @@ is
 
    Default_Progname : constant String := "ghdl_design" & NUL;
 begin
+   --  Set program name.
    if Argc > 0 then
       Grt.Options.Progname := To_Argv_Type (Argv)(0);
    else
diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index bf49fbb..bf9db80 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -1170,11 +1170,12 @@ package body Grt.Disp_Rti is
    is
       procedure P (Str : String) renames Put_Line;
    begin
-      P (" --dump-rti        dump Run Time Information");
+      P (" --dump-rti         dump Run Time Information");
    end Disp_Rti_Help;
 
    Disp_Rti_Hooks : aliased constant Hooks_Type :=
-     (Option => Disp_Rti_Option'Access,
+     (Desc => new String'("dump-rti: implement --dump-rti"),
+      Option => Disp_Rti_Option'Access,
       Help => Disp_Rti_Help'Access,
       Init => null,
       Start => Disp_All'Access,
diff --git a/src/grt/grt-disp_tree.adb b/src/grt/grt-disp_tree.adb
index 3eb715d..8ff87ee 100644
--- a/src/grt/grt-disp_tree.adb
+++ b/src/grt/grt-disp_tree.adb
@@ -449,7 +449,9 @@ package body Grt.Disp_Tree is
    end Disp_Tree_Help;
 
    Disp_Tree_Hooks : aliased constant Hooks_Type :=
-     (Option => Disp_Tree_Option'Access,
+     (Desc => new String'
+        ("disp-tree: display design hierarchy (--disp-tree)"),
+      Option => Disp_Tree_Option'Access,
       Help => Disp_Tree_Help'Access,
       Init => null,
       Start => Disp_Hierarchy'Access,
diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb
index 9d6a861..6292668 100644
--- a/src/grt/grt-fst.adb
+++ b/src/grt/grt-fst.adb
@@ -662,7 +662,8 @@ package body Grt.Fst is
    end Fst_End;
 
    Fst_Hooks : aliased constant Hooks_Type :=
-     (Option => Fst_Option'Access,
+     (Desc => new String'("fst: dump waveform in fst file format"),
+      Option => Fst_Option'Access,
       Help => Fst_Help'Access,
       Init => Fst_Init'Access,
       Start => Fst_Start'Access,
diff --git a/src/grt/grt-hooks.adb b/src/grt/grt-hooks.adb
index 6a77aaf..44a9b7a 100644
--- a/src/grt/grt-hooks.adb
+++ b/src/grt/grt-hooks.adb
@@ -22,6 +22,7 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
+with Grt.Astdio;
 
 package body Grt.Hooks is
    type Hooks_Cell;
@@ -156,6 +157,43 @@ package body Grt.Hooks is
    begin
       null;
    end Proc_Hook_Nil;
+
+   procedure Display_Hooks_Desc
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Desc /= null then
+            Grt.Astdio.Put_Line (Cell.Hooks.Desc.all);
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Display_Hooks_Desc;
+
+   function Has_Feature (Name : String) return Boolean
+   is
+      Len : constant Natural := Name'Length;
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Desc /= null then
+            declare
+               F : String renames Cell.Hooks.Desc.all;
+            begin
+               if F'Length > Len
+                 and then F (F'First .. F'First + Len - 1) = Name
+                 and then F (F'First + Len) = ':'
+               then
+                  return True;
+               end if;
+            end;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+      return False;
+   end Has_Feature;
 end Grt.Hooks;
 
 
diff --git a/src/grt/grt-hooks.ads b/src/grt/grt-hooks.ads
index 20846c7..1243908 100644
--- a/src/grt/grt-hooks.ads
+++ b/src/grt/grt-hooks.ads
@@ -28,7 +28,15 @@ package Grt.Hooks is
    type Option_Hook_Type is access function (Opt : String) return Boolean;
    type Proc_Hook_Type is access procedure;
 
+   type Cst_String_Acc is access constant String;
+
    type Hooks_Type is record
+      --  A one-line description of the hook.  The format is:
+      --  "NAME: description".  NAME should be uniq and is tested by the
+      --  switch --has-feature=NAME.
+      --  DESC can be null if there is no interesting feature added.
+      Desc : Cst_String_Acc;
+
       --  Called for every unknown command line argument.
       --  Return TRUE if handled.
       Option : Option_Hook_Type;
@@ -54,6 +62,12 @@ package Grt.Hooks is
    --  Register an hook which will call PROC after every non-delta cycles.
    procedure Register_Cycle_Hook (Proc : Proc_Hook_Type);
 
+   --  Display the description of the hooks.
+   procedure Display_Hooks_Desc;
+
+   --  Return True if NAME is present in the list of modules.
+   function Has_Feature (Name : String) return Boolean;
+
    --  Call hooks.
    function Call_Option_Hooks (Opt : String) return Boolean;
    procedure Call_Help_Hooks;
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 5d825de..743e4b3 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -123,14 +123,14 @@ package body Grt.Main is
       --  Decode options.
       Grt.Options.Decode (Stop);
 
-      --  Check coherency between GRT and GHDL generated code.
-      Check_Flag_String;
-
       --  Early stop (for options such as --help).
       if Stop then
          return;
       end if;
 
+      --  Check coherency between GRT and GHDL generated code.
+      Check_Flag_String;
+
       --  Internal initializations.
       Grt.Hooks.Call_Init_Hooks;
 
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index 446439f..a03b6be 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -162,6 +162,9 @@ package body Grt.Options is
       P (" --expect-failure  invert exit status");
       P (" --no-run          do not simulate, only elaborate");
       --  P (" --threads=N       use N threads for simulation");
+      P ("Additional features:");
+      P (" --has-feature=X   test presence of feature X");
+      P (" --list-features   display the list of features");
       Grt.Hooks.Call_Help_Hooks;
       P ("trace options:");
       P (" --disp-time       disp time as simulation advances");
@@ -228,7 +231,17 @@ package body Grt.Options is
          Status := Decode_Option_Last;
       elsif Option = "--help" or else Option = "-h" then
          Help;
-         Status := Decode_Option_Help;
+         Status := Decode_Option_Stop;
+      elsif Option = "--list-features" then
+         Grt.Hooks.Display_Hooks_Desc;
+         Status := Decode_Option_Stop;
+      elsif Len > 14 and then Option (1 .. 14) = "--has-feature=" then
+         if Grt.Hooks.Has_Feature (Option (15 .. Len)) then
+            Grt.Errors.Exit_Status := 0;
+         else
+            Grt.Errors.Exit_Status := 1;
+         end if;
+         Status := Decode_Option_Stop;
       elsif Option = "--disp-time" then
          Disp_Time := True;
       elsif Option = "--trace-signals" then
@@ -499,7 +512,7 @@ package body Grt.Options is
                when Decode_Option_Last =>
                   Last_Opt := I;
                   exit;
-               when Decode_Option_Help =>
+               when Decode_Option_Stop =>
                   Stop := True;
                when Decode_Option_Ok =>
                   null;
diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads
index 34180f1..44a85b6 100644
--- a/src/grt/grt-options.ads
+++ b/src/grt/grt-options.ads
@@ -65,8 +65,8 @@ package Grt.Options is
       --  Last option, next arguments aren't options.
       Decode_Option_Last,
 
-      --  --help option, program shouldn't run.
-      Decode_Option_Help,
+      --  For options like --help: program shouldn't run.
+      Decode_Option_Stop,
 
       --  Option was successfuly decoded.
       Decode_Option_Ok);
diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb
index 9cdc100..13da7f9 100644
--- a/src/grt/grt-vcd.adb
+++ b/src/grt/grt-vcd.adb
@@ -833,7 +833,8 @@ package body Grt.Vcd is
    end Vcd_End;
 
    Vcd_Hooks : aliased constant Hooks_Type :=
-     (Option => Vcd_Option'Access,
+     (Desc => new String'("vcd: save waveforms in vcf file format"),
+      Option => Vcd_Option'Access,
       Help => Vcd_Help'Access,
       Init => Vcd_Init'Access,
       Start => Vcd_Start'Access,
diff --git a/src/grt/grt-vcdz.adb b/src/grt/grt-vcdz.adb
index 8e1ceb6..b15a3c1 100644
--- a/src/grt/grt-vcdz.adb
+++ b/src/grt/grt-vcdz.adb
@@ -103,7 +103,8 @@ package body Grt.Vcdz is
    end Vcdz_Help;
 
    Vcdz_Hooks : aliased constant Hooks_Type :=
-     (Option => Vcdz_Option'Access,
+     (Desc => new String'("vcdz: save waveforms in gzipped vcf file format"),
+      Option => Vcdz_Option'Access,
       Help => Vcdz_Help'Access,
       Init => Proc_Hook_Nil'Access,
       Start => Proc_Hook_Nil'Access,
diff --git a/src/grt/grt-vital_annotate.adb b/src/grt/grt-vital_annotate.adb
index 1b5ae47..02c0beb 100644
--- a/src/grt/grt-vital_annotate.adb
+++ b/src/grt/grt-vital_annotate.adb
@@ -644,7 +644,9 @@ package body Grt.Vital_Annotate is
    end Sdf_Help;
 
    Sdf_Hooks : aliased constant Hooks_Type :=
-     (Option => Sdf_Option'Access,
+     (Desc => new String'
+        ("sdf-annotate: annotate vital generics from an sdf file"),
+      Option => Sdf_Option'Access,
       Help => Sdf_Help'Access,
       Init => Proc_Hook_Nil'Access,
       Start => Sdf_Start'Access,
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb
index 37cc714..bc594e4 100644
--- a/src/grt/grt-vpi.adb
+++ b/src/grt/grt-vpi.adb
@@ -973,7 +973,8 @@ package body Grt.Vpi is
    end Vpi_End;
 
    Vpi_Hooks : aliased constant Hooks_Type :=
-     (Option => Vpi_Option'Access,
+     (Desc => new String'("vpi: vpi compatible API"),
+      Option => Vpi_Option'Access,
       Help => Vpi_Help'Access,
       Init => Vpi_Init'Access,
       Start => Vpi_Start'Access,
diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb
index 8894f40..72b33d3 100644
--- a/src/grt/grt-waves.adb
+++ b/src/grt/grt-waves.adb
@@ -1665,7 +1665,8 @@ package body Grt.Waves is
    end Wave_End;
 
    Wave_Hooks : aliased constant Hooks_Type :=
-     (Option => Wave_Option'Access,
+     (Desc => new String'("ghw: save waveforms in ghw file format"),
+      Option => Wave_Option'Access,
       Help => Wave_Help'Access,
       Init => Wave_Init'Access,
       Start => Wave_Start'Access,