fst: dump enumerations.

6 files changed, 173 insertions, 96 deletions

diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb
index 45d5142df..506d01cfa 100644
--- a/src/grt/grt-fst.adb
+++ b/src/grt/grt-fst.adb
@@ -33,6 +33,7 @@ with Grt.Signals; use Grt.Signals;
 with Grt.Table;
 with Grt.Astdio; use Grt.Astdio;
 with Grt.Hooks; use Grt.Hooks;
+with Grt.Rtis; use Grt.Rtis;
 with Grt.Rtis_Types; use Grt.Rtis_Types;
 with Grt.Vstrings;
 with Ada.Unchecked_Deallocation;
@@ -216,6 +217,10 @@ package body Grt.Fst is
          when Vcd_Bad =>
             --  Not handled.
             return;
+         when Vcd_Enum8 =>
+            Vt := FST_VT_GEN_STRING;
+            Len := 1;
+            Sdt := FST_SDT_NONE;
          when Vcd_Bool =>
             Vt := FST_VT_VCD_REG;
             Len := 1;
@@ -331,7 +336,7 @@ package body Grt.Fst is
       --  Extract name (avoid truncation, append verilog range for arrays).
       Vhpi_Get_Str (VhpiNameP, Sig, Name, Name_Len);
       if Name_Len >= Name'Length
-        or else Vcd_El.Irange /= null
+        or else Vcd_El.Kind in Vcd_Var_Vectors
       then
          declare
             Name2 : String (1 .. Name_Len + 3 + 2 * 11 + 1);
@@ -517,6 +522,18 @@ package body Grt.Fst is
       fstWriterEmitValueChange (Context, Hand, Str'Address);
    end Fst_Put_Integer32;
 
+   procedure Fst_Put_Enum8
+     (Hand : fstHandle; V : Ghdl_E8; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : constant Ghdl_C_String := Enum_Rti.Names (Ghdl_Index_Type (V));
+   begin
+      fstWriterEmitVariableLengthValueChange
+        (Context, Hand, To_Address (Str),
+         Interfaces.C.unsigned (strlen (Str)));
+   end Fst_Put_Enum8;
+
    procedure Fst_Put_Var (I : Fst_Index_Type)
    is
       From_Bit : constant array (Ghdl_B1) of Character := "01";
@@ -527,7 +544,7 @@ package body Grt.Fst is
       Hand : constant fstHandle := V.Hand;
       Sig : constant Signal_Arr_Ptr := V.Wire.Sigs;
    begin
-      if V.Wire.Irange = null then
+      if V.Wire.Kind not in Vcd_Var_Vectors then
          Len := 1;
       else
          Len := V.Wire.Irange.I32.Len;
@@ -560,6 +577,8 @@ package body Grt.Fst is
                   Fst_Put_Integer32 (Hand, Sig (0).Value_Ptr.E32);
                when Vcd_Float64 =>
                   null;
+               when Vcd_Enum8 =>
+                  Fst_Put_Enum8 (Hand, Sig (0).Value_Ptr.E8, V.Wire.Rti);
                when Vcd_Bad =>
                   null;
             end case;
@@ -590,6 +609,8 @@ package body Grt.Fst is
                   Fst_Put_Integer32 (Hand, Sig (0).Driving_Value.E32);
                when Vcd_Float64 =>
                   null;
+               when Vcd_Enum8 =>
+                  Fst_Put_Enum8 (Hand, Sig (0).Driving_Value.E8, V.Wire.Rti);
                when Vcd_Bad =>
                   null;
             end case;
diff --git a/src/grt/grt-images.adb b/src/grt/grt-images.adb
index e56c8354b..8e15d103a 100644
--- a/src/grt/grt-images.adb
+++ b/src/grt/grt-images.adb
@@ -62,11 +62,10 @@ package body Grt.Images is
    procedure Return_Enum
      (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
    is
-      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
-      Str : Ghdl_C_String;
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : constant Ghdl_C_String := Enum_Rti.Names (Index);
    begin
-      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str := Enum_Rti.Names (Index);
       Return_String (Res, Str (1 .. strlen (Str)));
    end Return_Enum;
 
diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads
index ff85c6779..4824762b7 100644
--- a/src/grt/grt-types.ads
+++ b/src/grt/grt-types.ads
@@ -132,6 +132,8 @@ package Grt.Types is
 
    function To_Ghdl_C_String is new Ada.Unchecked_Conversion
      (Source => Address, Target => Ghdl_C_String);
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Ghdl_C_String, Target => Address);
 
    --  Str_len.
    type String_Ptr is access String (1 .. Natural'Last);
diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb
index 063850e36..4a9153643 100644
--- a/src/grt/grt-vcd.adb
+++ b/src/grt/grt-vcd.adb
@@ -244,32 +244,33 @@ package body Grt.Vcd is
       null;
    end Avhpi_Error;
 
-   function Rti_To_Vcd_Kind (Rti : Ghdl_Rti_Access) return Vcd_Var_Kind
-   is
-      Rti1 : Ghdl_Rti_Access;
+   function Rti_To_Vcd_Kind (Rti : Ghdl_Rti_Access) return Vcd_Var_Kind is
    begin
-      if Rti.Kind = Ghdl_Rtik_Subtype_Scalar then
-         Rti1 := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype;
-      else
-         Rti1 := Rti;
-      end if;
-
-      if Rti1 = Std_Standard_Boolean_RTI_Ptr then
-         return Vcd_Bool;
-      end if;
-      if Rti1 = Std_Standard_Bit_RTI_Ptr then
-         return Vcd_Bit;
-      end if;
-      if Rti1 = Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr then
-         return Vcd_Stdlogic;
-      end if;
-      if Rti1.Kind = Ghdl_Rtik_Type_I32 then
-         return Vcd_Integer32;
-      end if;
-      if Rti1.Kind = Ghdl_Rtik_Type_F64 then
-         return Vcd_Float64;
-      end if;
-      return Vcd_Bad;
+      case Rti.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            return Rti_To_Vcd_Kind
+              (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
+         when Ghdl_Rtik_Type_B1 =>
+            if Rti = Std_Standard_Boolean_RTI_Ptr then
+               return Vcd_Bool;
+            elsif Rti = Std_Standard_Bit_RTI_Ptr then
+               return Vcd_Bit;
+            else
+               return Vcd_Bad;
+            end if;
+         when Ghdl_Rtik_Type_I32 =>
+            return Vcd_Integer32;
+         when Ghdl_Rtik_Type_F64 =>
+            return Vcd_Float64;
+         when Ghdl_Rtik_Type_E8 =>
+            if Rti = Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr then
+               return Vcd_Stdlogic;
+            else
+               return Vcd_Enum8;
+            end if;
+         when others =>
+            return Vcd_Bad;
+      end case;
    end Rti_To_Vcd_Kind;
 
    function Rti_To_Vcd_Kind (Rti : Ghdl_Rtin_Type_Array_Acc)
@@ -277,18 +278,24 @@ package body Grt.Vcd is
    is
       It : Ghdl_Rti_Access;
    begin
+      --  Support only one-dimensional arrays...
       if Rti.Nbr_Dim /= 1 then
          return Vcd_Bad;
       end if;
+
+      --  ... whose index is a scalar...
       It := Rti.Indexes (0);
       if It.Kind /= Ghdl_Rtik_Subtype_Scalar then
          return Vcd_Bad;
       end if;
+
+      --  ... integer.
       if To_Ghdl_Rtin_Subtype_Scalar_Acc (It).Basetype.Kind
         /= Ghdl_Rtik_Type_I32
       then
          return Vcd_Bad;
       end if;
+
       case Rti_To_Vcd_Kind (Rti.Element) is
          when Vcd_Bit =>
             return Vcd_Bitvector;
@@ -305,6 +312,11 @@ package body Grt.Vcd is
       Rti : Ghdl_Rti_Access;
       Error : AvhpiErrorT;
       Sig_Addr : Address;
+
+      Kind : Vcd_Var_Kind;
+      Sigs : Grt.Signals.Signal_Arr_Ptr;
+      Irange : Ghdl_Range_Ptr;
+      Val : Vcd_Value_Kind;
    begin
       --  Extract type of the signal.
       Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error);
@@ -319,22 +331,22 @@ package body Grt.Vcd is
          Sig_Addr := To_Addr_Acc (Sig_Addr).all;
       end if;
 
-      Info.Kind := Vcd_Bad;
+      Kind := Vcd_Bad;
+      Irange := null;
       case Rti.Kind is
          when Ghdl_Rtik_Type_B1
            | Ghdl_Rtik_Type_E8
            | Ghdl_Rtik_Subtype_Scalar =>
-            Info.Kind := Rti_To_Vcd_Kind (Rti);
-            Info.Sigs := To_Signal_Arr_Ptr (Sig_Addr);
-            Info.Irange := null;
+            Kind := Rti_To_Vcd_Kind (Rti);
+            Sigs := To_Signal_Arr_Ptr (Sig_Addr);
          when Ghdl_Rtik_Subtype_Array =>
             declare
                St : Ghdl_Rtin_Subtype_Array_Acc;
             begin
                St := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
-               Info.Kind := Rti_To_Vcd_Kind (St.Basetype);
-               Info.Sigs := To_Signal_Arr_Ptr (Sig_Addr);
-               Info.Irange := To_Ghdl_Range_Ptr
+               Kind := Rti_To_Vcd_Kind (St.Basetype);
+               Sigs := To_Signal_Arr_Ptr (Sig_Addr);
+               Irange := To_Ghdl_Range_Ptr
                  (Loc_To_Addr (St.Common.Depth, St.Bounds,
                                Avhpi_Get_Context (Sig)));
             end;
@@ -342,20 +354,18 @@ package body Grt.Vcd is
             declare
                Uc : Ghdl_Uc_Array_Acc;
             begin
-               Info.Kind := Rti_To_Vcd_Kind
-                 (To_Ghdl_Rtin_Type_Array_Acc (Rti));
+               Kind := Rti_To_Vcd_Kind (To_Ghdl_Rtin_Type_Array_Acc (Rti));
                Uc := To_Ghdl_Uc_Array_Acc (Sig_Addr);
-               Info.Sigs := To_Signal_Arr_Ptr (Uc.Base);
-               Info.Irange := To_Ghdl_Range_Ptr (Uc.Bounds);
+               Sigs := To_Signal_Arr_Ptr (Uc.Base);
+               Irange := To_Ghdl_Range_Ptr (Uc.Bounds);
             end;
          when others =>
-            Info.Irange := null;
+            null;
       end case;
 
       --  Do not allow null-array.
-      if Info.Irange /= null and then Info.Irange.I32.Len = 0 then
-         Info.Kind := Vcd_Bad;
-         Info.Irange := null;
+      if Irange /= null and then Irange.I32.Len = 0 then
+         Info := (Kind => Vcd_Bad, Val => Vcd_Effective, Sigs => null);
          return;
       end if;
 
@@ -365,24 +375,45 @@ package body Grt.Vcd is
               | VhpiInoutMode
               | VhpiBufferMode
               | VhpiLinkageMode =>
-               Info.Val := Vcd_Effective;
+               Val := Vcd_Effective;
             when VhpiOutMode =>
-               Info.Val := Vcd_Driving;
+               Val := Vcd_Driving;
             when VhpiErrorMode =>
-               Info.Kind := Vcd_Bad;
+               Kind := Vcd_Bad;
          end case;
       else
-         Info.Val := Vcd_Effective;
+         Val := Vcd_Effective;
       end if;
+
+      case Kind is
+         when Vcd_Bad =>
+            Info := (Vcd_Bad, Vcd_Effective, null);
+         when Vcd_Enum8 =>
+            Info := (Vcd_Enum8, Val, Sigs, Rti);
+         when Vcd_Bool =>
+            Info := (Vcd_Bool, Val, Sigs);
+         when Vcd_Integer32 =>
+            Info := (Vcd_Integer32, Val, Sigs);
+         when Vcd_Float64 =>
+            Info := (Vcd_Float64, Val, Sigs);
+         when Vcd_Bit =>
+            Info := (Vcd_Bit, Val, Sigs);
+         when Vcd_Stdlogic =>
+            Info := (Vcd_Stdlogic, Val, Sigs);
+         when Vcd_Bitvector =>
+            Info := (Vcd_Bitvector, Val, Sigs, Irange);
+         when Vcd_Stdlogic_Vector =>
+            Info := (Vcd_Stdlogic_Vector, Val, Sigs, Irange);
+      end case;
    end Get_Verilog_Wire;
 
    function Get_Wire_Length (Info : Verilog_Wire_Info)
                             return Ghdl_Index_Type is
    begin
-      if Info.Irange = null then
-         return 1;
-      else
+      if Info.Kind in Vcd_Var_Vectors then
          return Info.Irange.I32.Len;
+      else
+         return 1;
       end if;
    end Get_Wire_Length;
 
@@ -393,7 +424,9 @@ package body Grt.Vcd is
    begin
       Get_Verilog_Wire (Sig, Vcd_El);
 
-      if Vcd_El.Kind = Vcd_Bad then
+      if Vcd_El.Kind = Vcd_Bad
+        or else Vcd_El.Kind = Vcd_Enum8
+      then
          Vcd_Put ("$comment ");
          Vcd_Put_Name (Sig);
          Vcd_Put (" is not handled");
@@ -420,14 +453,15 @@ package body Grt.Vcd is
               | Vcd_Stdlogic_Vector =>
                Vcd_Put ("reg ");
                Vcd_Put_I32 (Ghdl_I32 (Vcd_El.Irange.I32.Len));
-            when Vcd_Bad =>
+            when Vcd_Bad
+              | Vcd_Enum8 =>
                null;
          end case;
          Vcd_Putc (' ');
          Vcd_Put_Idcode (N);
          Vcd_Putc (' ');
          Vcd_Put_Name (Sig);
-         if Vcd_El.Irange /= null then
+         if Vcd_El.Kind in Vcd_Var_Vectors then
             Vcd_Putc ('[');
             Vcd_Put_I32 (Vcd_El.Irange.I32.Left);
             Vcd_Putc (':');
@@ -679,7 +713,8 @@ package body Grt.Vcd is
                      Vcd_Put_Stdlogic (V.Sigs (J).Value_Ptr.E8);
                   end loop;
                   Vcd_Putc (' ');
-               when Vcd_Bad =>
+               when Vcd_Bad
+                 | Vcd_Enum8 =>
                   null;
             end case;
          when Vcd_Driving =>
@@ -709,7 +744,8 @@ package body Grt.Vcd is
                      Vcd_Put_Stdlogic (V.Sigs (J).Driving_Value.E8);
                   end loop;
                   Vcd_Putc (' ');
-               when Vcd_Bad =>
+               when Vcd_Bad
+                 | Vcd_Enum8 =>
                   null;
             end case;
       end case;
@@ -720,19 +756,14 @@ package body Grt.Vcd is
    function Verilog_Wire_Changed (Info : Verilog_Wire_Info; Last : Std_Time)
                                  return Boolean
    is
-      Len : Ghdl_Index_Type;
+      Len : constant Ghdl_Index_Type := Get_Wire_Length (Info);
    begin
-      if Info.Irange = null then
-         Len := 1;
-      else
-         Len := Info.Irange.I32.Len;
-      end if;
-
       case Info.Val is
          when Vcd_Effective =>
             case Info.Kind is
                when Vcd_Bit
                  | Vcd_Bool
+                 | Vcd_Enum8
                  | Vcd_Stdlogic
                  | Vcd_Bitvector
                  | Vcd_Stdlogic_Vector
@@ -750,6 +781,7 @@ package body Grt.Vcd is
             case Info.Kind is
                when Vcd_Bit
                  | Vcd_Bool
+                 | Vcd_Enum8
                  | Vcd_Stdlogic
                  | Vcd_Bitvector
                  | Vcd_Stdlogic_Vector
@@ -769,17 +801,12 @@ package body Grt.Vcd is
 
    function Verilog_Wire_Event (Info : Verilog_Wire_Info) return Boolean
    is
-      Len : Ghdl_Index_Type;
+      Len : constant Ghdl_Index_Type := Get_Wire_Length (Info);
    begin
-      if Info.Irange = null then
-         Len := 1;
-      else
-         Len := Info.Irange.I32.Len;
-      end if;
-
       case Info.Kind is
          when Vcd_Bit
            | Vcd_Bool
+           | Vcd_Enum8
            | Vcd_Stdlogic
            | Vcd_Bitvector
            | Vcd_Stdlogic_Vector
diff --git a/src/grt/grt-vcd.ads b/src/grt/grt-vcd.ads
index bc7917cba..c2755d253 100644
--- a/src/grt/grt-vcd.ads
+++ b/src/grt/grt-vcd.ads
@@ -25,6 +25,7 @@
 
 with Grt.Types; use Grt.Types;
 with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Rtis;
 with Grt.Signals;
 
 package Grt.Vcd is
@@ -37,23 +38,53 @@ package Grt.Vcd is
    Vcd_Putc : Vcd_Putc_Acc;
    Vcd_Close : Vcd_Close_Acc;
 
-   type Vcd_Var_Kind is (Vcd_Bad,
-                         Vcd_Bool,
-                         Vcd_Integer32,
-                         Vcd_Float64,
-                         Vcd_Bit, Vcd_Stdlogic,
-                         Vcd_Bitvector, Vcd_Stdlogic_Vector);
+   --  VCD type of an object
+   type Vcd_Var_Kind is
+     (
+      --  Incompatible vcd type
+      Vcd_Bad,
+
+      --  A user-defined enumerated type (other than bit or boolean)
+      Vcd_Enum8,
+
+      --  Boolean
+      Vcd_Bool,
+
+      --  32bit integer
+      Vcd_Integer32,
+
+      --  64bit float
+      Vcd_Float64,
+
+      --  A bit type
+      Vcd_Bit, Vcd_Stdlogic,
+
+      --  A bit vector type
+      Vcd_Bitvector, Vcd_Stdlogic_Vector
+     );
+
+   subtype Vcd_Var_Vectors is Vcd_Var_Kind
+     range Vcd_Bitvector .. Vcd_Stdlogic_Vector;
 
    --  Which value to be displayed: effective or driving (for out signals).
    type Vcd_Value_Kind is (Vcd_Effective, Vcd_Driving);
 
-   type Verilog_Wire_Info is record
+   type Verilog_Wire_Info (Kind : Vcd_Var_Kind := Vcd_Bad) is record
+      Val : Vcd_Value_Kind;
+
       --  Access to an array of signals.
       Sigs : Grt.Signals.Signal_Arr_Ptr;
 
-      Irange : Ghdl_Range_Ptr;
-      Kind : Vcd_Var_Kind;
-      Val : Vcd_Value_Kind;
+      case Kind is
+         when Vcd_Var_Vectors =>
+            --  Vector bounds.
+            Irange : Ghdl_Range_Ptr;
+         when Vcd_Enum8 =>
+            --  Base type.
+            Rti : Rtis.Ghdl_Rti_Access;
+         when others =>
+            null;
+      end case;
    end record;
 
    procedure Get_Verilog_Wire (Sig : VhpiHandleT;
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb
index 6cc34a1c9..90c75ef93 100644
--- a/src/grt/grt-vpi.adb
+++ b/src/grt/grt-vpi.adb
@@ -398,7 +398,8 @@ package body Grt.Vpi is
            | Vcd_Integer32
            | Vcd_Float64
            | Vcd_Bit
-           | Vcd_Stdlogic =>
+           | Vcd_Stdlogic
+           | Vcd_Enum8 =>
             return False;
          when Vcd_Bitvector
            | Vcd_Stdlogic_Vector =>
@@ -739,11 +740,7 @@ package body Grt.Vpi is
          return null;
       end if;
 
-      if Info.Irange = null then
-         Len := 1;
-      else
-         Len := Info.Irange.I32.Len;
-      end if;
+      Len := Get_Wire_Length (Info);
 
       Tmpstring3idx := 1; -- reset string buffer
 
@@ -751,6 +748,7 @@ package body Grt.Vpi is
          when Vcd_Effective =>
             case Info.Kind is
                when Vcd_Bad
+                 | Vcd_Enum8
                  | Vcd_Integer32
                  | Vcd_Float64 =>
                   return null;
@@ -769,6 +767,7 @@ package body Grt.Vpi is
          when Vcd_Driving =>
             case Info.Kind is
                when Vcd_Bad
+                 | Vcd_Enum8
                  | Vcd_Integer32
                  | Vcd_Float64 =>
                   return null;
@@ -900,6 +899,8 @@ package body Grt.Vpi is
                   end case;
                end;
             end loop;
+         when Vcd_Enum8 =>
+            null;
          when Vcd_Integer32
            | Vcd_Float64 =>
             null;
@@ -1012,14 +1013,10 @@ package body Grt.Vpi is
          return null;
       end if;
 
-      if Info.Irange = null then
-         Len := 1;
-      else
-         Len := Info.Irange.I32.Len;
-         if Len = 0 then
-            --  No signal.
-            return null;
-         end if;
+      Len := Get_Wire_Length (Info);
+      if Len = 0 then
+         --  No signal.
+         return null;
       end if;
 
       -- Step 1: convert vpi object to internal format.