diff options
| -rw-r--r-- | src/grt/grt-fst.adb | 25 | ||||
| -rw-r--r-- | src/grt/grt-images.adb | 7 | ||||
| -rw-r--r-- | src/grt/grt-types.ads | 2 | ||||
| -rw-r--r-- | src/grt/grt-vcd.adb | 159 | ||||
| -rw-r--r-- | src/grt/grt-vcd.ads | 51 | ||||
| -rw-r--r-- | src/grt/grt-vpi.adb | 25 |
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. |