From a0919fe84b25f37d0307805650379830094fcfbf Mon Sep 17 00:00:00 2001 From: Ben Reynwar Date: Sun, 10 May 2020 07:56:48 -0700 Subject: Constants in vpi (#1297) * Adding some very basic vpi tests. * Modify test so that's it's checking VPI access to constants. * Provide VPI to access constants. * Add vpi tests to testsuite. * Fix bug to allow getting values of generic/constant boolean and std_logic. * Fix stupid copying mistake in last commit. * Formatting and trying to get tests working on windows. * Fixing comment and removing redundant VhpiConstantDeclK --- src/grt/grt-avhpi.adb | 31 ++++++++++++++++++++++++------- src/grt/grt-vcd.adb | 3 ++- src/grt/grt-vpi.adb | 25 ++++++++++++++++++++----- src/grt/grt-vpi.ads | 1 + 4 files changed, 47 insertions(+), 13 deletions(-) (limited to 'src/grt') diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index 374dcc3a6..5e234b9c7 100644 --- a/src/grt/grt-avhpi.adb +++ b/src/grt/grt-avhpi.adb @@ -126,7 +126,8 @@ package body Grt.Avhpi is end case; when VhpiIndexedNames => case Ref.Kind is - when VhpiGenericDeclK => + when VhpiGenericDeclK | + VhpiConstDeclK=> Res := (Kind => AvhpiNameIteratorK, Ctxt => Ref.Ctxt, N_Addr => Avhpi_Get_Address (Ref), @@ -184,7 +185,8 @@ package body Grt.Avhpi is El_Type1 : Ghdl_Rti_Access; begin case Obj_Rti.Common.Kind is - when Ghdl_Rtik_Generic => + when Ghdl_Rtik_Generic | + Ghdl_Rtik_Constant => Is_Sig := False; when others => Internal_Error ("add_index"); @@ -391,6 +393,10 @@ package body Grt.Avhpi is Res := (Kind => VhpiGenericDeclK, Ctxt => Ctxt, Obj => To_Ghdl_Rtin_Object_Acc (Rti)); + when Ghdl_Rtik_Constant => + Res := (Kind => VhpiConstDeclK, + Ctxt => Ctxt, + Obj => To_Ghdl_Rtin_Object_Acc (Rti)); when Ghdl_Rtik_Subtype_Array => declare Atype : constant Ghdl_Rtin_Subtype_Composite_Acc := @@ -480,6 +486,7 @@ package body Grt.Avhpi is case Ch.Kind is when Ghdl_Rtik_Port | Ghdl_Rtik_Generic + | Ghdl_Rtik_Constant | Ghdl_Rtik_Signal | Ghdl_Rtik_Type_Array | Ghdl_Rtik_Subtype_Array @@ -599,7 +606,8 @@ package body Grt.Avhpi is return Obj.Inst.Name; when VhpiSigDeclK | VhpiPortDeclK - | VhpiGenericDeclK => + | VhpiGenericDeclK + | VhpiConstDeclK => return Obj.Obj.Name; when VhpiSubtypeDeclK => return To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name; @@ -715,7 +723,8 @@ package body Grt.Avhpi is Add (Obj.Inst.Name); when VhpiSigDeclK | VhpiPortDeclK - | VhpiGenericDeclK => + | VhpiGenericDeclK + | VhpiConstDeclK => Add (Obj.Obj.Name); when VhpiIfGenerateK => Add (To_Ghdl_Rtin_Generate_Acc @@ -937,7 +946,8 @@ package body Grt.Avhpi is | VhpiSubtypeDeclK | VhpiArrayTypeDeclK => Atype := Ref.Atype; - when VhpiGenericDeclK => + when VhpiGenericDeclK + | VhpiConstDeclK => Atype := Ref.Obj.Obj_Type; when VhpiIndexedNameK => Atype := Ref.N_Type; @@ -1130,7 +1140,8 @@ package body Grt.Avhpi is case Obj.Kind is when VhpiSigDeclK | VhpiPortDeclK - | VhpiGenericDeclK => + | VhpiGenericDeclK + | VhpiConstDeclK => -- Objects. Linecol := Obj.Obj.Linecol; when VhpiPackInstK @@ -1230,7 +1241,8 @@ package body Grt.Avhpi is return Obj.Atype; when VhpiSigDeclK | VhpiPortDeclK - | VhpiGenericDeclK => + | VhpiGenericDeclK + | VhpiConstDeclK => return To_Ghdl_Rti_Access (Obj.Obj); when others => return null; @@ -1288,8 +1300,13 @@ package body Grt.Avhpi is Vptr := To_Ghdl_Value_Ptr (Obj.N_Addr); Atype := Obj.N_Type; when VhpiGenericDeclK => + -- Putting values for generics is necessary to support SDF + -- annotations. Vptr := To_Ghdl_Value_Ptr (Avhpi_Get_Address (Obj)); Atype := Obj.Obj.Obj_Type; + when VhpiConstDeclK => + -- Don't support changing values of constants. + return AvhpiErrorNotImplemented; when others => return AvhpiErrorNotImplemented; end case; diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index 6722f2a75..aab295555 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -416,7 +416,8 @@ package body Grt.Vcd is end case; when VhpiSigDeclK => Val := Vcd_Effective; - when VhpiGenericDeclK => + when VhpiGenericDeclK + | VhpiConstDeclK => Val := Vcd_Variable; when others => Info := (Vtype => Vcd_Bad, diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index a2884bd76..afcc2692f 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -574,6 +574,15 @@ package body Grt.Vpi is return vpiParameter; end if; end; + when VhpiConstDeclK => + declare + Info : Verilog_Wire_Info; + begin + Get_Verilog_Wire (Res, Info); + if Info.Vtype /= Vcd_Bad then + return vpiConstant; + end if; + end; when others => null; end case; @@ -596,6 +605,9 @@ package body Grt.Vpi is when vpiParameter => return new struct_vpiHandle'(mType => vpiParameter, Ref => Res); + when vpiConstant => + return new struct_vpiHandle'(mType => vpiConstant, + Ref => Res); when others => return null; end case; @@ -859,7 +871,8 @@ package body Grt.Vpi is case Vhpi_Get_Kind (Obj) is when VhpiPortDeclK | VhpiSigDeclK - | VhpiGenericDeclK => + | VhpiGenericDeclK + | VhpiConstDeclK => null; when others => return null; @@ -894,13 +907,15 @@ package body Grt.Vpi is Append_Bin (Ghdl_U64 (V), 32); end; when Vcd_Bit - | Vcd_Bool - | Vcd_Bitvector => + | Vcd_Bool => + Append (Buf_Value, Map_Std_B1 (Verilog_Wire_Val (Info).B1)); + when Vcd_Bitvector => for J in 0 .. Len - 1 loop Append (Buf_Value, Map_Std_B1 (Verilog_Wire_Val (Info, J).B1)); end loop; - when Vcd_Stdlogic - | Vcd_Stdlogic_Vector => + when Vcd_Stdlogic => + Append (Buf_Value, E8_To_Char (Verilog_Wire_Val (Info).E8)); + when Vcd_Stdlogic_Vector => for J in 0 .. Len - 1 loop Append (Buf_Value, E8_To_Char (Verilog_Wire_Val (Info, J).E8)); end loop; diff --git a/src/grt/grt-vpi.ads b/src/grt/grt-vpi.ads index 578ed23af..353451edd 100644 --- a/src/grt/grt-vpi.ads +++ b/src/grt/grt-vpi.ads @@ -38,6 +38,7 @@ package Grt.Vpi is vpiSize : constant Integer := 4; vpiFile : constant Integer := 5; vpiLineNo : constant Integer := 6; + vpiConstant : constant Integer := 7; vpiDefName : constant Integer := 9; vpiTimePrecision : constant Integer := 12; -- cgit v1.2.3