summaryrefslogtreecommitdiff
path: root/src/grt
diff options
context:
space:
mode:
authorTristan Gingold2014-12-05 06:07:39 +0100
committerTristan Gingold2014-12-05 06:07:39 +0100
commit23d12bfb244b6271b78f21ff938c8406aec0c0d8 (patch)
treeaf405a7359d2e9b852fc86e93e2a564d390423b8 /src/grt
parent94fc2d91a57a3bbd89798c2c62cb0bd588fb21ed (diff)
downloadghdl-23d12bfb244b6271b78f21ff938c8406aec0c0d8.tar.gz
ghdl-23d12bfb244b6271b78f21ff938c8406aec0c0d8.tar.bz2
ghdl-23d12bfb244b6271b78f21ff938c8406aec0c0d8.zip
fst: dump type of signals.
Diffstat (limited to 'src/grt')
-rw-r--r--src/grt/grt-avhpi.adb13
-rw-r--r--src/grt/grt-avhpi.ads3
-rw-r--r--src/grt/grt-fst.adb40
3 files changed, 51 insertions, 5 deletions
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