From bbc36065b2806bc6b96e747b347facff06d5272b Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 8 Jun 2021 06:21:04 +0200 Subject: grt-vcd: add get_vcd_value_kind --- src/grt/grt-vcd.adb | 68 ++++++++++++++++++++++++++++++----------------------- src/grt/grt-vcd.ads | 6 ++++- src/grt/grt-vpi.adb | 8 +++---- 3 files changed, 47 insertions(+), 35 deletions(-) (limited to 'src/grt') diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index c08176a27..480da947c 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -333,6 +333,31 @@ package body Grt.Vcd is end case; end Rti_Array_To_Vcd_Kind; + function Get_Vcd_Value_Kind (Sig : VhpiHandleT) return Vcd_Value_Kind is + begin + case Vhpi_Get_Kind (Sig) is + when VhpiPortDeclK => + case Vhpi_Get_Mode (Sig) is + when VhpiInMode + | VhpiInoutMode + | VhpiBufferMode + | VhpiLinkageMode => + return Vcd_Effective; + when VhpiOutMode => + return Vcd_Driving; + when VhpiErrorMode => + return Vcd_Value_Bad; + end case; + when VhpiSigDeclK => + return Vcd_Effective; + when VhpiGenericDeclK + | VhpiConstDeclK => + return Vcd_Variable; + when others => + return Vcd_Value_Bad; + end case; + end Get_Vcd_Value_Kind; + procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info) is Sig_Type : VhpiHandleT; @@ -383,37 +408,16 @@ package body Grt.Vcd is Kind := Vcd_Bad; end case; - -- Do not allow null-array. - if Kind = Vcd_Bad - or else (Irange /= null and then Irange.I32.Len = 0) - then + if Kind = Vcd_Bad then Info := (Vtype => Vcd_Bad, Val => Vcd_Effective, Ptr => Null_Address); return; end if; - case Vhpi_Get_Kind (Sig) is - when VhpiPortDeclK => - case Vhpi_Get_Mode (Sig) is - when VhpiInMode - | VhpiInoutMode - | VhpiBufferMode - | VhpiLinkageMode => - Val := Vcd_Effective; - when VhpiOutMode => - Val := Vcd_Driving; - when VhpiErrorMode => - Kind := Vcd_Bad; - end case; - when VhpiSigDeclK => - Val := Vcd_Effective; - when VhpiGenericDeclK - | VhpiConstDeclK => - Val := Vcd_Variable; - when others => - Info := (Vtype => Vcd_Bad, - Val => Vcd_Effective, Ptr => Null_Address); - return; - end case; + Val := Get_Vcd_Value_Kind (Sig); + if Val = Vcd_Value_Bad then + Info := (Vtype => Vcd_Bad, Val => Vcd_Effective, Ptr => Null_Address); + return; + end if; -- For vectors: extract range. Irange := null; @@ -424,6 +428,10 @@ package body Grt.Vcd is begin Extract_Range (Bounds, Idx_Rti, Irange); end; + -- Do not allow null-array. + if Irange.I32.Len = 0 then + Kind := Vcd_Bad; + end if; end if; -- Build the info. @@ -465,7 +473,7 @@ package body Grt.Vcd is function Verilog_Wire_Val (Info : Verilog_Wire_Info) return Ghdl_Value_Ptr is begin - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => return To_Signal_Arr_Ptr (Info.Ptr)(0).Value_Ptr; when Vcd_Driving => @@ -478,7 +486,7 @@ package body Grt.Vcd is function Verilog_Wire_Val (Info : Verilog_Wire_Info; Idx : Ghdl_Index_Type) return Ghdl_Value_Ptr is begin - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => return To_Signal_Arr_Ptr (Info.Ptr)(Idx).Value_Ptr; when Vcd_Driving => @@ -548,7 +556,7 @@ package body Grt.Vcd is Vcd_Put ("$comment "); Vcd_Put_Name (Sig); Vcd_Put (" is "); - case Vcd_El.Val is + case Vcd_Value_Valid (Vcd_El.Val) is when Vcd_Effective => Vcd_Put ("effective "); when Vcd_Driving => diff --git a/src/grt/grt-vcd.ads b/src/grt/grt-vcd.ads index 261c5b5d4..62910adf4 100644 --- a/src/grt/grt-vcd.ads +++ b/src/grt/grt-vcd.ads @@ -71,7 +71,11 @@ package Grt.Vcd is 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, Vcd_Variable); + type Vcd_Value_Kind is + (Vcd_Effective, Vcd_Driving, Vcd_Variable, Vcd_Value_Bad); + + subtype Vcd_Value_Valid is + Vcd_Value_Kind range Vcd_Effective .. Vcd_Variable; -- For signals. subtype Vcd_Value_Signals is Vcd_Value_Kind diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 5d75db2c1..df5d1e639 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -1050,7 +1050,7 @@ package body Grt.Vpi is V : constant Ghdl_B1 := Ghdl_B1 (Vec (J) = '1' or Vec (J) = 'H'); begin - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => Ghdl_Signal_Force_Effective_B1 (To_Signal_Arr_Ptr (Info.Ptr)(J), V); @@ -1070,7 +1070,7 @@ package body Grt.Vpi is declare V : constant Ghdl_E8 := Std_Ulogic'Pos (Vec (J)); begin - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => Ghdl_Signal_Force_Effective_E8 (To_Signal_Arr_Ptr (Info.Ptr)(J), V); @@ -1093,7 +1093,7 @@ package body Grt.Vpi is V := V or Shift_Left (1, Natural (Vec'Last - I)); end if; end loop; - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => Ghdl_Signal_Force_Effective_E8 (To_Signal_Arr_Ptr (Info.Ptr)(0), V); @@ -1120,7 +1120,7 @@ package body Grt.Vpi is end if; end loop; V := To_Ghdl_I32 (R); - case Info.Val is + case Vcd_Value_Valid (Info.Val) is when Vcd_Effective => Ghdl_Signal_Force_Effective_I32 (To_Signal_Arr_Ptr (Info.Ptr)(0), V); -- cgit v1.2.3