From 23d12bfb244b6271b78f21ff938c8406aec0c0d8 Mon Sep 17 00:00:00 2001
From: Tristan Gingold
Date: Fri, 5 Dec 2014 06:07:39 +0100
Subject: fst: dump type of signals.

---
 src/grt/grt-avhpi.adb | 13 ++++++++++++-
 src/grt/grt-avhpi.ads |  3 ++-
 src/grt/grt-fst.adb   | 40 +++++++++++++++++++++++++++++++++++++---
 3 files changed, 51 insertions(+), 5 deletions(-)

(limited to 'src/grt')

diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb
index b935fd9..690a6bb 100644
--- a/src/grt/grt-avhpi.adb
+++ b/src/grt/grt-avhpi.adb
@@ -380,6 +380,11 @@ package body Grt.Avhpi is
             Res := (Kind => VhpiPhysTypeDeclK,
                     Ctxt => Ctxt,
                     Atype => Rti);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64 =>
+            Res := (Kind => VhpiIntTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
          when Ghdl_Rtik_Subtype_Scalar =>
             Res := (Kind => VhpiSubtypeDeclK,
                     Ctxt => Ctxt,
@@ -569,6 +574,9 @@ package body Grt.Avhpi is
 
       procedure Add (Str : Ghdl_C_String) is
       begin
+         if Str = null then
+            return;
+         end if;
          for I in Str'Range loop
             exit when Str (I) = NUL;
             Add (Str (I));
@@ -582,6 +590,8 @@ package body Grt.Avhpi is
             case Obj.Kind is
                when VhpiEnumTypeDeclK =>
                   Add (To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name);
+               when VhpiIntTypeDeclK =>
+                  Add (To_Ghdl_Rtin_Type_Scalar_Acc (Obj.Atype).Name);
                when VhpiSubtypeDeclK =>
                   Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name);
                when VhpiArrayTypeDeclK =>
@@ -1107,7 +1117,8 @@ package body Grt.Avhpi is
          when VhpiSubtypeIndicK
            | VhpiSubtypeDeclK
            | VhpiArrayTypeDeclK
-           | VhpiPhysTypeDeclK =>
+           | VhpiPhysTypeDeclK
+           | VhpiIntTypeDeclK =>
             return Hdl1.Atype = Hdl2.Atype;
          when others =>
             -- FIXME: todo
diff --git a/src/grt/grt-avhpi.ads b/src/grt/grt-avhpi.ads
index 1eff5a8..e55a1d8 100644
--- a/src/grt/grt-avhpi.ads
+++ b/src/grt/grt-avhpi.ads
@@ -538,7 +538,8 @@ private
            | VhpiSubtypeDeclK
            | VhpiArrayTypeDeclK
            | VhpiEnumTypeDeclK
-           | VhpiPhysTypeDeclK =>
+           | VhpiPhysTypeDeclK
+           | VhpiIntTypeDeclK =>
             Atype : Ghdl_Rti_Access;
          when VhpiCompInstStmtK =>
             Inst : Ghdl_Rtin_Instance_Acc;
diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb
index a81022b..0c33285 100644
--- a/src/grt/grt-fst.adb
+++ b/src/grt/grt-fst.adb
@@ -198,6 +198,8 @@ package body Grt.Fst is
 
    procedure Fst_Add_Signal (Sig : VhpiHandleT)
    is
+      Sig_Type, Sig_Base_Type : VhpiHandleT;
+      Err : AvhpiErrorT;
       Vcd_El : Verilog_Wire_Info;
       Vt : fstVarType;
       Sdt : fstSupplementalDataType;
@@ -205,6 +207,9 @@ package body Grt.Fst is
       Len : Interfaces.C.unsigned;
       Name : String (1 .. 128);
       Name_Len : Natural;
+      Type_Name : String (1 .. 32);
+      Type_Name_Len : Natural;
+      Type_C_Name : Ghdl_C_String;
       Hand : fstHandle;
       Alias : fstHandle;
       H : Ghdl_Index_Type;
@@ -283,6 +288,35 @@ package body Grt.Fst is
          end;
       end if;
 
+      --  Extract type name.
+      Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Err);
+      if Err /= AvhpiErrorOk then
+         Avhpi_Error (Err);
+      end if;
+      Vhpi_Handle (VhpiTypeMark, Sig_Type, Sig_Type, Err);
+      if Err /= AvhpiErrorOk then
+         Avhpi_Error (Err);
+      end if;
+      Vhpi_Get_Str (VhpiNameP, Sig_Type, Type_Name, Type_Name_Len);
+      if Type_Name_Len = 0 then
+         --  Try with the base type.
+         Vhpi_Handle (VhpiBaseType, Sig_Type, Sig_Base_Type, Err);
+         if Err /= AvhpiErrorOk then
+            Avhpi_Error (Err);
+         end if;
+         Vhpi_Get_Str (VhpiNameP, Sig_Base_Type, Type_Name, Type_Name_Len);
+      end if;
+      if Type_Name_Len = 0 then
+         Type_C_Name := null;
+      else
+         if Type_Name_Len >= Type_Name'Last then
+            --  Truncate name.
+            Type_Name_Len := Type_Name'Last - 1;
+         end if;
+         Type_Name (Type_Name_Len + 1) := NUL;
+         Type_C_Name := To_Ghdl_C_String (Type_Name'Address);
+      end if;
+
       Vhpi_Get_Str (VhpiNameP, Sig, Name, Name_Len);
       if Name_Len >= Name'Length
         or else Vcd_El.Irange /= null
@@ -318,14 +352,14 @@ package body Grt.Fst is
             Name_Len := Name_Len + 1;
 
             Hand := fstWriterCreateVar2
-              (Context, Vt, Dir, Len, To_Ghdl_C_String (Name2'Address),
-               Alias, null, FST_SVT_VHDL_SIGNAL, Sdt);
+              (Context, Vt, Dir, Len, To_Ghdl_C_String (Name2'Address), Alias,
+               Type_C_Name, FST_SVT_VHDL_SIGNAL, Sdt);
          end;
       else
          Name (Name_Len) := NUL;
          Hand := fstWriterCreateVar2
            (Context, Vt, Dir, Len, To_Ghdl_C_String (Name'Address),
-            Alias, null, FST_SVT_VHDL_SIGNAL, Sdt);
+            Alias, Type_C_Name, FST_SVT_VHDL_SIGNAL, Sdt);
       end if;
 
       if Flag_Aliases and then Interfaces.C."/=" (Alias, Null_fstHandle) then
-- 
cgit