diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-12-05 06:07:39 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-12-05 06:07:39 +0100 |
commit | 23d12bfb244b6271b78f21ff938c8406aec0c0d8 (patch) | |
tree | af405a7359d2e9b852fc86e93e2a564d390423b8 /src/grt | |
parent | 94fc2d91a57a3bbd89798c2c62cb0bd588fb21ed (diff) | |
download | ghdl-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.adb | 13 | ||||
-rw-r--r-- | src/grt/grt-avhpi.ads | 3 | ||||
-rw-r--r-- | src/grt/grt-fst.adb | 40 |
3 files changed, 51 insertions, 5 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index b935fd9a3..690a6bb8f 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 1eff5a8a3..e55a1d881 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 a81022be9..0c3328580 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 |