simul: improve debugger (display of signals value)

4 files changed, 74 insertions, 38 deletions

diff --git a/src/simul/simul-vhdl_debug.adb b/src/simul/simul-vhdl_debug.adb
index c54bea94f..8edf963d8 100644
--- a/src/simul/simul-vhdl_debug.adb
+++ b/src/simul/simul-vhdl_debug.adb
@@ -138,43 +138,45 @@ package body Simul.Vhdl_Debug is
       New_Line;
    end Disp_Conn_Entry;
 
-   function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type)
-     return Int64 is
+   procedure Disp_Value (Value_Ptr : Ghdl_Value_Ptr;
+                         Mode : Mode_Type;
+                         Btype : Node) is
    begin
       case Mode is
          when Mode_B1 =>
-            return Ghdl_B1'Pos (Value_Ptr.B1);
+            Disp_Enumeration_Value (Ghdl_B1'Pos (Value_Ptr.B1), Btype);
          when Mode_E8 =>
-            return Int64 (Value_Ptr.E8);
+            Disp_Enumeration_Value (Int64 (Value_Ptr.E8), Btype);
          when Mode_E32 =>
-            return Int64 (Value_Ptr.E32);
+            Disp_Enumeration_Value (Int64 (Value_Ptr.E32), Btype);
          when Mode_I32 =>
-            return Int64 (Value_Ptr.I32);
+            Disp_Integer_Value (Int64 (Value_Ptr.I32), Btype);
          when Mode_I64 =>
-            return Int64 (Value_Ptr.I64);
+            Disp_Integer_Value (Int64 (Value_Ptr.I64), Btype);
          when Mode_F64 =>
-            raise Internal_Error;
+            Disp_Float_Value (Fp64 (Value_Ptr.F64), Btype);
       end case;
-   end Read_Value;
+   end Disp_Value;
 
-   function Read_Value (Value : Value_Union; Mode : Mode_Type)
-     return Int64 is
+   procedure Disp_Value (Value : Value_Union;
+                         Mode : Mode_Type;
+                         Btype : Node) is
    begin
       case Mode is
          when Mode_B1 =>
-            return Ghdl_B1'Pos (Value.B1);
+            Disp_Enumeration_Value (Ghdl_B1'Pos (Value.B1), Btype);
          when Mode_E8 =>
-            return Int64 (Value.E8);
+            Disp_Enumeration_Value (Int64 (Value.E8), Btype);
          when Mode_E32 =>
-            return Int64 (Value.E32);
+            Disp_Enumeration_Value (Int64 (Value.E32), Btype);
          when Mode_I32 =>
-            return Int64 (Value.I32);
+            Disp_Integer_Value (Int64 (Value.I32), Btype);
          when Mode_I64 =>
-            return Int64 (Value.I64);
+            Disp_Integer_Value (Int64 (Value.I64), Btype);
          when Mode_F64 =>
-            raise Internal_Error;
+            Disp_Float_Value (Fp64 (Value.F64), Btype);
       end case;
-   end Read_Value;
+   end Disp_Value;
 
    procedure Disp_Transaction (Trans : Transaction_Acc;
                                Sig_Type : Node;
@@ -186,9 +188,9 @@ package body Simul.Vhdl_Debug is
       loop
          case T.Kind is
             when Trans_Value =>
-               Disp_Discrete_Value (Read_Value (T.Val, Mode), Sig_Type);
+               Disp_Value (T.Val, Mode, Sig_Type);
             when Trans_Direct =>
-               Disp_Discrete_Value (Read_Value (T.Val_Ptr, Mode), Sig_Type);
+               Disp_Value (T.Val_Ptr, Mode, Sig_Type);
             when Trans_Null =>
                Put ("NULL");
             when Trans_Error =>
@@ -218,9 +220,9 @@ package body Simul.Vhdl_Debug is
       Put (' ');
       Grt.Disp_Signals.Disp_Single_Signal_Attributes (Sig);
       Put (" val=");
-      Disp_Discrete_Value (Read_Value (Sig.Value_Ptr, Sig.Mode), Stype);
+      Disp_Value (Sig.Value_Ptr, Sig.Mode, Stype);
       Put ("; drv=");
-      Disp_Discrete_Value (Read_Value (Sig.Driving_Value, Sig.Mode), Stype);
+      Disp_Value (Sig.Driving_Value, Sig.Mode, Stype);
       if Sig.Nbr_Ports > 0 then
          Put (';');
          Put_Int32 (Int32 (Sig.Nbr_Ports));
@@ -267,9 +269,7 @@ package body Simul.Vhdl_Debug is
    procedure For_Each_Scalar_Signal (S : Memtyp; Stype : Node) is
    begin
       case S.Typ.Kind is
-         when Type_Bit
-           | Type_Logic
-           | Type_Discrete =>
+         when Type_Scalars =>
             For_Scalar_Signal (S, Get_Base_Type (Stype));
          when Type_Vector
            | Type_Array =>
@@ -309,8 +309,7 @@ package body Simul.Vhdl_Debug is
                      Get_Type (El));
                end loop;
             end;
-         when Type_Float
-           | Type_Unbounded_Vector
+         when Type_Unbounded_Vector
            | Type_Unbounded_Record
            | Type_Unbounded_Array
            | Type_Slice
diff --git a/src/synth/elab-debugger.adb b/src/synth/elab-debugger.adb
index 66b1fe835..441a64eb1 100644
--- a/src/synth/elab-debugger.adb
+++ b/src/synth/elab-debugger.adb
@@ -448,6 +448,10 @@ package body Elab.Debugger is
       P : Natural;
    begin
       P := Skip_Blanks (Line);
+      if P > Line'Last then
+         Put_Line ("missing subprogram name");
+         return;
+      end if;
       if Line (P) = '"' then
          --  An operator name.
          declare
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb
index 8db0f2058..d47c310f0 100644
--- a/src/synth/elab-vhdl_debug.adb
+++ b/src/synth/elab-vhdl_debug.adb
@@ -55,23 +55,51 @@ package body Elab.Vhdl_Debug is
                             & Natural'Image (Line));
    end Put_Stmt_Trace;
 
+   procedure Disp_Integer_Value (Val : Int64; Btype : Node)
+   is
+      pragma Unreferenced (Btype);
+   begin
+      Put_Int64 (Val);
+   end Disp_Integer_Value;
+
+   procedure Disp_Enumeration_Value (Val : Int64; Btype : Node)
+   is
+      Pos : constant Natural := Natural (Val);
+      Enums : constant Node_Flist :=
+        Get_Enumeration_Literal_List (Btype);
+      Id : constant Name_Id :=
+        Get_Identifier (Get_Nth_Element (Enums, Pos));
+   begin
+      Put (Name_Table.Image (Id));
+   end Disp_Enumeration_Value;
+
+   procedure Disp_Physical_Value (Val : Int64; Btype : Node)
+   is
+      Id : constant Name_Id := Get_Identifier (Get_Primary_Unit (Btype));
+   begin
+      Put_Int64 (Val);
+      Put (' ');
+      Put (Name_Table.Image (Id));
+   end Disp_Physical_Value;
+
+   procedure Disp_Float_Value (Val : Fp64; Btype : Node)
+   is
+      pragma Unreferenced (Btype);
+   begin
+      Put_Fp64 (Val);
+   end Disp_Float_Value;
+
    procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is
    begin
       case Get_Kind (Btype) is
          when Iir_Kind_Integer_Type_Definition
            | Iir_Kind_Integer_Subtype_Definition =>
-            Put_Int64 (Val);
+            Disp_Integer_Value (Val, Btype);
          when Iir_Kind_Enumeration_Type_Definition
            | Iir_Kind_Enumeration_Subtype_Definition =>
-            declare
-               Pos : constant Natural := Natural (Val);
-               Enums : constant Node_Flist :=
-                 Get_Enumeration_Literal_List (Btype);
-               Id : constant Name_Id :=
-                 Get_Identifier (Get_Nth_Element (Enums, Pos));
-            begin
-               Put (Name_Table.Image (Id));
-            end;
+            Disp_Enumeration_Value (Val, Btype);
+         when Iir_Kind_Physical_Type_Definition =>
+            Disp_Physical_Value (Val, Btype);
          when others =>
             Vhdl.Errors.Error_Kind ("disp_discrete_value", Btype);
       end case;
@@ -158,7 +186,7 @@ package body Elab.Vhdl_Debug is
             if I /= 1 then
                Put (", ");
             end if;
-            Disp_Value_Array ((Mem.Typ,
+            Disp_Value_Array ((Mem.Typ.Arr_El,
                                Mem.Mem + Size_Type (Len - I) * Stride),
                               A_Type);
          end loop;
diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads
index a1200d621..f9dd900c0 100644
--- a/src/synth/elab-vhdl_debug.ads
+++ b/src/synth/elab-vhdl_debug.ads
@@ -27,6 +27,11 @@ package Elab.Vhdl_Debug is
    procedure Disp_Memtyp (M : Memtyp; Vtype : Node);
    function Walk_Declarations (Cb : Walk_Cb) return Walk_Status;
 
+   procedure Disp_Integer_Value (Val : Int64; Btype : Node);
+   procedure Disp_Enumeration_Value (Val : Int64; Btype : Node);
+   procedure Disp_Physical_Value (Val : Int64; Btype : Node);
+   procedure Disp_Float_Value (Val : Fp64; Btype : Node);
+
    procedure Disp_Discrete_Value (Val : Int64; Btype : Node);
 
    procedure Disp_Declaration_Objects