simul-debugger: improve info signals.

5 files changed, 196 insertions, 70 deletions

diff --git a/src/grt/grt-disp_signals.adb b/src/grt/grt-disp_signals.adb
index f2e86572c..e4dadc578 100644
--- a/src/grt/grt-disp_signals.adb
+++ b/src/grt/grt-disp_signals.adb
@@ -96,6 +96,12 @@ package body Grt.Disp_Signals is
       Blk : Ghdl_Rtin_Block_Acc;
       Nctxt : Rti_Context;
    begin
+      --  Avoid fault.
+      if Ctxt = Null_Context then
+         Put ('?');
+         return;
+      end if;
+
       Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
       case Blk.Common.Kind is
          when Ghdl_Rtik_Block
@@ -159,15 +165,8 @@ package body Grt.Disp_Signals is
       end loop;
    end Disp_Transaction;
 
-   procedure Disp_Simple_Signal
-     (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean)
-   is
-      function To_Address is new Ada.Unchecked_Conversion
-        (Source => Resolved_Signal_Acc, Target => Address);
+   procedure Disp_Single_Signal_Attributes (Sig : Ghdl_Signal_Ptr) is
    begin
-      Put (' ');
-      Put (stdout, Sig.all'Address);
-      Put (' ');
       Disp_Mode (Sig.Mode);
       Put (' ');
       if Sig.Active then
@@ -196,6 +195,18 @@ package body Grt.Disp_Signals is
          Put (" last_active=");
          Put_Time (stdout, Sig.Last_Active);
       end if;
+   end Disp_Single_Signal_Attributes;
+
+   procedure Disp_Simple_Signal
+     (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean)
+   is
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Resolved_Signal_Acc, Target => Address);
+   begin
+      Put (' ');
+      Put (stdout, Sig.all'Address);
+      Put (' ');
+      Disp_Single_Signal_Attributes (Sig);
       Put (" val=");
       declare
          Val : constant Value_Union := Read_Value (Sig.Value_Ptr, Sig.Mode);
@@ -221,7 +232,7 @@ package body Grt.Disp_Signals is
          case Sig.S.Mode_Sig is
             when Mode_Signal_User =>
                if Sig.S.Resolv /= null then
-                  Put (stdout, " res func ");
+                  Put (stdout, " resolver=");
                   Put (stdout, To_Address(Sig.S.Resolv));
                end if;
                if Sig.S.Nbr_Drivers = 0 then
diff --git a/src/grt/grt-disp_signals.ads b/src/grt/grt-disp_signals.ads
index 73bd60d06..82905d5b8 100644
--- a/src/grt/grt-disp_signals.ads
+++ b/src/grt/grt-disp_signals.ads
@@ -37,6 +37,9 @@ package Grt.Disp_Signals is
 
    procedure Disp_Mode_Signal (Mode : Mode_Signal_Type);
 
+   --  Disp attributes of SIG.
+   procedure Disp_Single_Signal_Attributes (Sig : Ghdl_Signal_Ptr);
+
    --  Disp informations on signal SIG.
    --  To be used inside the debugger.
    procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr);
diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb
index 80c8f7baa..4ddf1130c 100644
--- a/src/vhdl/simulate/simul-debugger.adb
+++ b/src/vhdl/simulate/simul-debugger.adb
@@ -17,7 +17,7 @@
 --  02111-1307, USA.
 
 with System;
-with Ada.Text_IO; use Ada.Text_IO;
+--  with Ada.Text_IO; use Ada.Text_IO;
 with Tables;
 with Types; use Types;
 with Name_Table;
@@ -34,18 +34,22 @@ with Libraries;
 with Std_Package;
 with Simul.Annotations; use Simul.Annotations;
 with Simul.Elaboration; use Simul.Elaboration;
+with Simul.Execution; use Simul.Execution;
 with Iirs_Utils; use Iirs_Utils;
 with Errorout; use Errorout;
 with Disp_Vhdl;
-with Simul.Execution; use Simul.Execution;
 with Iirs_Walk; use Iirs_Walk;
 with Areapools; use Areapools;
+with Grt.Types; use Grt.Types;
 with Grt.Disp;
 with Grt.Readline;
 with Grt.Errors;
 with Grt.Disp_Signals;
+with Grt.Signals; use Grt.Signals;
 with Grt.Processes;
 with Grt.Options;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
 
 package body Simul.Debugger is
    --  This exception can be raised by a debugger command to directly return
@@ -126,26 +130,26 @@ package body Simul.Debugger is
    procedure Disp_Iir_Location (N : Iir) is
    begin
       if N = Null_Iir then
-         Put (Standard_Error, "??:??:??");
+         Put (stderr, "??:??:??");
       else
-         Put (Standard_Error, Disp_Location (N));
+         Put (stderr, Disp_Location (N));
       end if;
-      Put (Standard_Error, ": ");
+      Put (stderr, ": ");
    end Disp_Iir_Location;
 
    -- Disp a message during execution.
    procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is
    begin
       Disp_Iir_Location (Loc);
-      Put_Line (Standard_Error, Msg);
+      Put_Line (stderr, Msg);
       Grt.Errors.Fatal_Error;
    end Error_Msg_Exec;
 
    procedure Warning_Msg_Exec (Msg: String; Loc: Iir) is
    begin
       Disp_Iir_Location (Loc);
-      Put (Standard_Error, "warning: ");
-      Put_Line (Standard_Error, Msg);
+      Put (stderr, "warning: ");
+      Put_Line (stderr, Msg);
    end Warning_Msg_Exec;
 
    -- Disp a message for a constraint error.
@@ -154,20 +158,20 @@ package body Simul.Debugger is
       if Expr /= Null_Iir then
          Disp_Iir_Location (Expr);
       end if;
-      Put (Standard_Error, "constraint violation");
+      Put (stderr, "constraint violation");
       if Expr /= Null_Iir then
          case Get_Kind (Expr) is
             when Iir_Kind_Addition_Operator =>
-               Put_Line (Standard_Error, " in the ""+"" operation");
+               Put_Line (stderr, " in the ""+"" operation");
             when Iir_Kind_Substraction_Operator =>
-               Put_Line (Standard_Error, " in the ""-"" operation");
+               Put_Line (stderr, " in the ""-"" operation");
             when Iir_Kind_Integer_Literal =>
-               Put_Line (Standard_Error, ", literal out of range");
+               Put_Line (stderr, ", literal out of range");
             when Iir_Kind_Interface_Signal_Declaration
               | Iir_Kind_Signal_Declaration =>
-               Put_Line (Standard_Error, " for " & Disp_Node (Expr));
+               Put_Line (stderr, " for " & Disp_Node (Expr));
             when others =>
-               New_Line (Standard_Error);
+               New_Line (stderr);
          end case;
       end if;
       Grt.Errors.Fatal_Error;
@@ -364,6 +368,54 @@ package body Simul.Debugger is
       Put (")");
    end Disp_Signal_Record;
 
+   procedure Disp_Signal_Value
+     (Val : Value_Union; Mode : Mode_Type; Sig_Type : Iir) is
+   begin
+      case Mode is
+         when Mode_I64 =>
+            Put (Ghdl_I64'Image (Val.I64));
+         when Mode_I32 =>
+            Put (Ghdl_I32'Image (Val.I32));
+         when Mode_F64 =>
+            Put (Ghdl_F64'Image (Val.F64));
+         when Mode_E32 =>
+            Disp_Iir_Value_Enum (Ghdl_E32'Pos (Val.E32), Sig_Type);
+         when Mode_E8 =>
+            Disp_Iir_Value_Enum (Ghdl_E8'Pos (Val.E8), Sig_Type);
+         when Mode_B1 =>
+            Disp_Iir_Value_Enum (Ghdl_B1'Pos (Val.B1), Sig_Type);
+      end case;
+   end Disp_Signal_Value;
+
+   procedure Disp_Transaction
+     (Head : Transaction_Acc; Mode : Mode_Type; Sig_Type : Iir)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := Head;
+      loop
+         case Trans.Kind is
+            when Trans_Value =>
+               Disp_Signal_Value (Trans.Val, Mode, Sig_Type);
+            when Trans_Direct =>
+               Disp_Signal_Value (Trans.Val_Ptr.all, Mode, Sig_Type);
+            when Trans_Null =>
+               Put ("NULL");
+            when Trans_Error =>
+               Put ("ERROR");
+         end case;
+         if Trans.Kind = Trans_Direct then
+            Put ("[DIRECT]");
+         else
+            Put ("@");
+            Put_Time (stdout, Trans.Time);
+         end if;
+         Trans := Trans.Next;
+         exit when Trans = null;
+         Put (", ");
+      end loop;
+   end Disp_Transaction;
+
    procedure Disp_Signal (Value : Iir_Value_Literal_Acc; A_Type : Iir) is
    begin
       if Value = null then
@@ -382,7 +434,21 @@ package body Simul.Debugger is
             -- FIXME.
             raise Internal_Error;
          when Iir_Value_Signal =>
-            Grt.Disp_Signals.Disp_A_Signal (Value.Sig);
+            declare
+               Sig : constant Ghdl_Signal_Ptr := Value.Sig;
+            begin
+               Disp_Signal_Value (Sig.Value_Ptr.all, Sig.Mode, A_Type);
+               Grt.Disp_Signals.Disp_Single_Signal_Attributes (Value.Sig);
+               New_Line;
+               if Sig.S.Mode_Sig in Mode_Signal_User then
+                  for I in 1 .. Sig.S.Nbr_Drivers loop
+                     Put ("    ");
+                     Disp_Transaction (Sig.S.Drivers (I - 1).First_Trans,
+                                       Sig.Mode, A_Type);
+                     New_Line;
+                  end loop;
+               end if;
+            end;
          when Iir_Value_File
            | Iir_Value_Protected
            | Iir_Value_Quantity
@@ -437,12 +503,21 @@ package body Simul.Debugger is
                  (Instance, Get_Port_Chain (Ent));
                Disp_Instance_Signals_Of_Chain
                  (Instance, Get_Declaration_Chain (Ent));
+               Disp_Instance_Signals_Of_Chain
+                 (Instance, Get_Declaration_Chain (Blk));
             end;
          when Iir_Kind_Block_Statement =>
             Disp_Instance_Name (Instance);
             Put_Line (" [block]:");
 
-            --  FIXME: ports.
+            declare
+               Header : constant Iir := Get_Block_Header (Blk);
+            begin
+               if Header /= Null_Iir then
+                  Disp_Instance_Signals_Of_Chain
+                    (Instance, Get_Port_Chain (Header));
+               end if;
+            end;
             Disp_Instance_Signals_Of_Chain
               (Instance, Get_Declaration_Chain (Blk));
 
@@ -639,7 +714,6 @@ package body Simul.Debugger is
 
    procedure Disp_Signals_Stats
    is
-      use Grt.Types;
       type Counters_Type is array (Mode_Signal_Type) of Natural;
       Counters : Counters_Type := (others => 0);
       Nbr_User_Signals : Natural := 0;
@@ -1563,32 +1637,61 @@ package body Simul.Debugger is
       end case;
    end Disp_Declared_Signals;
 
-   procedure Info_Signals_Proc (Line : String) is
-      pragma Unreferenced (Line);
+   procedure Info_Signals_Proc (Line : String)
+   is
+      Verbose : Boolean;
+      P : Natural;
+      E : Natural;
    begin
-      if False then
-         Check_Current_Process;
-         Disp_Declared_Signals
-           (Current_Process.Proc, Current_Process.Top_Instance);
-      elsif True then
-         for I in Signals_Table.First .. Signals_Table.Last loop
-            declare
-               S : Signal_Entry renames Signals_Table.Table (I);
-            begin
-               Disp_Instance_Name (S.Instance, False);
-               Put ('.');
-               if S.Kind in Grt.Types.Mode_Signal_User then
-                  Put (Name_Table.Image (Get_Identifier (S.Decl)));
-                  Disp_Value (S.Sig);
-                  Disp_Value (S.Val);
-               else
-                  Disp_Declaration_Object (S.Instance, S.Decl);
+      Verbose := False;
+
+      P := Skip_Blanks (Line);
+      loop
+         E := Get_Word (Line (P .. Line'Last));
+         exit when P > Line'Last;
+         if Line (P .. E) = "-v" then
+            Verbose := True;
+         elsif Line (P .. E) = "-l" then
+            --  Local signals
+            Check_Current_Process;
+            Disp_Declared_Signals
+              (Current_Process.Proc, Current_Process.Top_Instance);
+            return;
+         elsif Line (P .. E) = "-t" then
+            Disp_Signals_Value;
+            return;
+         elsif Line (P .. E) = "-T" then
+            Grt.Disp_Signals.Disp_Signals_Table;
+            return;
+         else
+            Put_Line ("options: -v(erbose) -l(ocal) -t(ree) -T(able)");
+            return;
+         end if;
+         P := E + 1;
+      end loop;
+
+      for I in Signals_Table.First .. Signals_Table.Last loop
+         declare
+            S : Signal_Entry renames Signals_Table.Table (I);
+         begin
+            Disp_Instance_Name (S.Instance, False);
+            Put ('.');
+            if S.Kind in Grt.Types.Mode_Signal_User then
+               Put (Name_Table.Image (Get_Identifier (S.Decl)));
+               New_Line;
+               Put (" sig: ");
+               Disp_Value (S.Sig);
+               Put (" val: ");
+               Disp_Value (S.Val);
+               if Verbose then
+                  --  Dummy to keep compiler happy.
+                  Verbose := False;
                end if;
-            end;
-         end loop;
-      else
-         Disp_Signals_Value;
-      end if;
+            else
+               Disp_Declaration_Object (S.Instance, S.Decl);
+            end if;
+         end;
+      end loop;
    end Info_Signals_Proc;
 
    type Handle_Scope_Type is access procedure (N : Iir);
@@ -1874,7 +1977,6 @@ package body Simul.Debugger is
 
    procedure Run_Proc (Line : String)
    is
-      use Grt.Types;
       Delta_Time : Std_Time;
       P : Positive;
    begin
@@ -2181,7 +2283,7 @@ package body Simul.Debugger is
    end Breakpoint_Hit;
 
    Prompt_Debug : constant String := "debug> " & ASCII.NUL;
-   Prompt_Crash : constant String := "crash> " & ASCII.NUL;
+   Prompt_Error : constant String := "error> " & ASCII.NUL;
    Prompt_Init  : constant String := "init> " & ASCII.NUL;
    Prompt_Elab  : constant String := "elab> " & ASCII.NUL;
 
@@ -2263,11 +2365,11 @@ package body Simul.Debugger is
             end;
          when Reason_Assert =>
             Set_Top_Frame (Current_Process.Instance);
-            Prompt := Prompt_Crash'Address;
+            Prompt := Prompt_Error'Address;
             Put_Line ("assertion failure, enterring in debugger");
          when Reason_Error =>
             Set_Top_Frame (Current_Process.Instance);
-            Prompt := Prompt_Crash'Address;
+            Prompt := Prompt_Error'Address;
             Put_Line ("error occurred, enterring in debugger");
       end case;
 
diff --git a/src/vhdl/simulate/simul-environments.adb b/src/vhdl/simulate/simul-environments.adb
index 4e8622da3..662fd1729 100644
--- a/src/vhdl/simulate/simul-environments.adb
+++ b/src/vhdl/simulate/simul-environments.adb
@@ -18,6 +18,7 @@
 
 with System;
 with Ada.Unchecked_Conversion;
+with Ada.Text_IO;
 with GNAT.Debug_Utilities;
 with Name_Table;
 with Simul.Debugger; use Simul.Debugger;
@@ -808,13 +809,20 @@ package body Simul.Environments is
       end case;
    end Get_Enum_Pos;
 
+   procedure Put_Indent (Indent : Natural)
+   is
+      use Ada.Text_IO;
+   begin
+      Put ((1 .. 2 * Indent => ' '));
+   end Put_Indent;
+
    procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc;
-                             Tab: Ada.Text_IO.Count)
+                             Indent : Natural)
    is
       use Ada.Text_IO;
       use GNAT.Debug_Utilities;
    begin
-      Set_Col (Tab);
+      Put_Indent (Indent);
       if Value = null then
          Put_Line ("*NULL*");
          return;
@@ -851,51 +859,51 @@ package body Simul.Environments is
                Put_Line ("array, length: "
                          & Iir_Index32'Image (Value.Val_Array.Len));
                declare
-                  Ntab: constant Count := Tab + Indentation;
+                  Nindent: constant Natural := Indent + 1;
                begin
-                  Set_Col (Ntab);
+                  Put_Indent (Nindent);
                   if Value.Bounds /= null then
                      Put_Line ("bounds 1 .."
                                & Iir_Index32'Image (Value.Bounds.Nbr_Dims)
                                & ':');
                      for I in Value.Bounds.D'Range loop
-                        Disp_Value_Tab (Value.Bounds.D (I), Ntab);
+                        Disp_Value_Tab (Value.Bounds.D (I), Nindent);
                      end loop;
                   else
                      Put_Line ("bounds = null");
                   end if;
-                  Set_Col (Ntab);
+                  Put_Indent (Nindent);
                   Put_Line ("values 1 .."
                             & Iir_Index32'Image (Value.Val_Array.Len)
                             & ':');
                   for I in Value.Val_Array.V'Range loop
-                     Disp_Value_Tab (Value.Val_Array.V (I), Ntab);
+                     Disp_Value_Tab (Value.Val_Array.V (I), Nindent);
                   end loop;
                end;
             end if;
 
          when Iir_Value_Range =>
             Put_Line ("range:");
-            Set_Col (Tab);
+            Put_Indent (Indent);
             Put (" direction: ");
             Put (Iir_Direction'Image (Value.Dir));
             Put (", length:");
             Put_Line (Iir_Index32'Image (Value.Length));
             if Value.Left /= null then
-               Set_Col (Tab);
+               Put_Indent (Indent);
                Put (" left bound: ");
-               Disp_Value_Tab (Value.Left, Col);
+               Disp_Value_Tab (Value.Left, 0);
             end if;
             if Value.Right /= null then
-               Set_Col (Tab);
+               Put_Indent (Indent);
                Put (" right bound: ");
-               Disp_Value_Tab (Value.Right, Col);
+               Disp_Value_Tab (Value.Right, 0);
             end if;
 
          when Iir_Value_Record =>
             Put_Line ("record:");
             for I in Value.Val_Record.V'Range loop
-               Disp_Value_Tab (Value.Val_Record.V (I), Tab + Indentation);
+               Disp_Value_Tab (Value.Val_Record.V (I), Indent + 1);
             end loop;
          when Iir_Value_Signal =>
             Put ("signal: ");
@@ -920,7 +928,7 @@ package body Simul.Environments is
 
    procedure Disp_Value (Value: Iir_Value_Literal_Acc) is
    begin
-      Disp_Value_Tab (Value, 1);
+      Disp_Value_Tab (Value, 0);
    end Disp_Value;
 
    --  Return TRUE if VALUE has an indirect value.
diff --git a/src/vhdl/simulate/simul-environments.ads b/src/vhdl/simulate/simul-environments.ads
index a451ff5a7..f8104e096 100644
--- a/src/vhdl/simulate/simul-environments.ads
+++ b/src/vhdl/simulate/simul-environments.ads
@@ -16,7 +16,6 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
-with Ada.Text_IO;
 with Ada.Unchecked_Deallocation;
 with Types; use Types;
 with Iirs; use Iirs;
@@ -520,7 +519,10 @@ package Simul.Environments is
    -- Disp a value_literal in raw form.
    procedure Disp_Value (Value: Iir_Value_Literal_Acc);
    procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc;
-                             Tab: Ada.Text_IO.Count);
+                             Indent : Natural);
+
+   -- Disp literal of an enumerated type.
+   procedure Disp_Iir_Value_Enum (Pos : Natural; A_Type : Iir);
 
    -- Disp a value_literal in readable form.
    procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir);