diff options
Diffstat (limited to 'src/grt/grt-vcd.adb')
| -rw-r--r-- | src/grt/grt-vcd.adb | 845 |
1 files changed, 845 insertions, 0 deletions
diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb new file mode 100644 index 0000000..d4a9ea0 --- /dev/null +++ b/src/grt/grt-vcd.adb @@ -0,0 +1,845 @@ +-- GHDL Run Time (GRT) - VCD generator. +-- Copyright (C) 2002 - 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. +with Interfaces; +with Grt.Stdio; use Grt.Stdio; +with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); +with Grt.Errors; use Grt.Errors; +with Grt.Signals; use Grt.Signals; +with Grt.Table; +with Grt.Astdio; use Grt.Astdio; +with Grt.C; use Grt.C; +with Grt.Hooks; use Grt.Hooks; +with Grt.Rtis; use Grt.Rtis; +with Grt.Rtis_Addr; use Grt.Rtis_Addr; +with Grt.Rtis_Types; use Grt.Rtis_Types; +with Grt.Vstrings; +pragma Elaborate_All (Grt.Table); + +package body Grt.Vcd is + -- If TRUE, put $date in vcd file. + -- Can be set to FALSE to make vcd comparaison easier. + Flag_Vcd_Date : Boolean := True; + + Stream : FILEs; + + procedure My_Vcd_Put (Str : String) + is + R : size_t; + pragma Unreferenced (R); + begin + R := fwrite (Str'Address, Str'Length, 1, Stream); + end My_Vcd_Put; + + procedure My_Vcd_Putc (C : Character) + is + R : int; + pragma Unreferenced (R); + begin + R := fputc (Character'Pos (C), Stream); + end My_Vcd_Putc; + + procedure My_Vcd_Close is + begin + fclose (Stream); + Stream := NULL_Stream; + end My_Vcd_Close; + + -- VCD filename. + -- Stream corresponding to the VCD filename. + --Vcd_Stream : FILEs; + + -- Index type of the table of vcd variables to dump. + type Vcd_Index_Type is new Integer; + + -- Return TRUE if OPT is an option for VCD. + function Vcd_Option (Opt : String) return Boolean + is + F : constant Natural := Opt'First; + Mode : constant String := "wt" & NUL; + Vcd_Filename : String_Access; + begin + if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then + return False; + end if; + if Opt'Length = 12 and then Opt (F + 5 .. F + 11) = "-nodate" then + Flag_Vcd_Date := False; + return True; + end if; + if Opt'Length > 6 and then Opt (F + 5) = '=' then + if Vcd_Close /= null then + Error ("--vcd: file already set"); + return True; + end if; + + -- Add an extra NUL character. + Vcd_Filename := new String (1 .. Opt'Length - 6 + 1); + Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last); + Vcd_Filename (Vcd_Filename'Last) := NUL; + + if Vcd_Filename.all = "-" & NUL then + Stream := stdout; + else + Stream := fopen (Vcd_Filename.all'Address, Mode'Address); + if Stream = NULL_Stream then + Error_C ("cannot open "); + Error_E (Vcd_Filename (Vcd_Filename'First + .. Vcd_Filename'Last - 1)); + return True; + end if; + end if; + Vcd_Putc := My_Vcd_Putc'Access; + Vcd_Put := My_Vcd_Put'Access; + Vcd_Close := My_Vcd_Close'Access; + return True; + else + return False; + end if; + end Vcd_Option; + + procedure Vcd_Help is + begin + Put_Line (" --vcd=FILENAME dump signal values into a VCD file"); + Put_Line (" --vcd-nodate do not write date in VCD file"); + end Vcd_Help; + + procedure Vcd_Newline is + begin + Vcd_Putc (Nl); + end Vcd_Newline; + + procedure Vcd_Putline (Str : String) is + begin + Vcd_Put (Str); + Vcd_Newline; + end Vcd_Putline; + +-- procedure Vcd_Put (Str : Ghdl_Str_Len_Type) +-- is +-- begin +-- Put_Str_Len (Vcd_Stream, Str); +-- end Vcd_Put; + + procedure Vcd_Put_I32 (V : Ghdl_I32) + is + Str : String (1 .. 11); + First : Natural; + begin + Vstrings.To_String (Str, First, V); + Vcd_Put (Str (First .. Str'Last)); + end Vcd_Put_I32; + + procedure Vcd_Put_Idcode (N : Vcd_Index_Type) + is + Str : String (1 .. 8); + V, R : Vcd_Index_Type; + L : Natural; + begin + L := 0; + V := N; + loop + R := V mod 93; + V := V / 93; + L := L + 1; + Str (L) := Character'Val (33 + R); + exit when V = 0; + end loop; + Vcd_Put (Str (1 .. L)); + end Vcd_Put_Idcode; + + procedure Vcd_Put_Name (Obj : VhpiHandleT) + is + Name : String (1 .. 128); + Name_Len : Integer; + begin + Vhpi_Get_Str (VhpiNameP, Obj, Name, Name_Len); + if Name_Len <= Name'Last then + Vcd_Put (Name (1 .. Name_Len)); + else + -- Truncate. + Vcd_Put (Name); + end if; + end Vcd_Put_Name; + + procedure Vcd_Put_End is + begin + Vcd_Putline ("$end"); + end Vcd_Put_End; + + -- Called before elaboration. + procedure Vcd_Init + is + begin + if Vcd_Close = null then + return; + end if; + if Flag_Vcd_Date then + Vcd_Putline ("$date"); + Vcd_Put (" "); + declare + type time_t is new Interfaces.Integer_64; + Cur_Time : time_t; + + function time (Addr : Address) return time_t; + pragma Import (C, time); + + function ctime (Timep: Address) return Ghdl_C_String; + pragma Import (C, ctime); + + Ct : Ghdl_C_String; + begin + Cur_Time := time (Null_Address); + Ct := ctime (Cur_Time'Address); + for I in Positive loop + exit when Ct (I) = NUL; + Vcd_Putc (Ct (I)); + end loop; + -- Note: ctime already append a LF. + end; + Vcd_Put_End; + end if; + Vcd_Putline ("$version"); + Vcd_Putline (" GHDL v0"); + Vcd_Put_End; + Vcd_Putline ("$timescale"); + Vcd_Putline (" 1 fs"); + Vcd_Put_End; + end Vcd_Init; + + package Vcd_Table is new Grt.Table + (Table_Component_Type => Verilog_Wire_Info, + Table_Index_Type => Vcd_Index_Type, + Table_Low_Bound => 0, + Table_Initial => 32); + + procedure Avhpi_Error (Err : AvhpiErrorT) + is + pragma Unreferenced (Err); + begin + Put_Line ("Vcd.Avhpi_Error!"); + null; + end Avhpi_Error; + + function Rti_To_Vcd_Kind (Rti : Ghdl_Rti_Access) return Vcd_Var_Kind + is + Rti1 : Ghdl_Rti_Access; + 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; + end Rti_To_Vcd_Kind; + + function Rti_To_Vcd_Kind (Rti : Ghdl_Rtin_Type_Array_Acc) + return Vcd_Var_Kind + is + It : Ghdl_Rti_Access; + begin + if Rti.Nbr_Dim /= 1 then + return Vcd_Bad; + end if; + It := Rti.Indexes (0); + if It.Kind /= Ghdl_Rtik_Subtype_Scalar then + return Vcd_Bad; + end if; + 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; + when Vcd_Stdlogic => + return Vcd_Stdlogic_Vector; + when others => + return Vcd_Bad; + end case; + end Rti_To_Vcd_Kind; + + procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info) + is + Sig_Type : VhpiHandleT; + Rti : Ghdl_Rti_Access; + Error : AvhpiErrorT; + Sig_Addr : Address; + begin + -- Extract type of the signal. + Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error); + if Error /= AvhpiErrorOk then + Avhpi_Error (Error); + return; + end if; + + Rti := Avhpi_Get_Rti (Sig_Type); + Sig_Addr := Avhpi_Get_Address (Sig); + Info.Kind := Vcd_Bad; + 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.Addr := Sig_Addr; + Info.Irange := null; + 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.Addr := Sig_Addr; + Info.Irange := To_Ghdl_Range_Ptr + (Loc_To_Addr (St.Common.Depth, St.Bounds, + Avhpi_Get_Context (Sig))); + end; + when Ghdl_Rtik_Type_Array => + declare + Uc : Ghdl_Uc_Array_Acc; + begin + Info.Kind := Rti_To_Vcd_Kind + (To_Ghdl_Rtin_Type_Array_Acc (Rti)); + Uc := To_Ghdl_Uc_Array_Acc (Sig_Addr); + Info.Addr := Uc.Base; + Info.Irange := To_Ghdl_Range_Ptr (Uc.Bounds); + end; + when others => + Info.Irange := 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; + return; + end if; + + if Vhpi_Get_Kind (Sig) = VhpiPortDeclK then + case Vhpi_Get_Mode (Sig) is + when VhpiInMode + | VhpiInoutMode + | VhpiBufferMode + | VhpiLinkageMode => + Info.Val := Vcd_Effective; + when VhpiOutMode => + Info.Val := Vcd_Driving; + when VhpiErrorMode => + Info.Kind := Vcd_Bad; + end case; + else + Info.Val := Vcd_Effective; + end if; + end Get_Verilog_Wire; + + procedure Add_Signal (Sig : VhpiHandleT) + is + N : Vcd_Index_Type; + Vcd_El : Verilog_Wire_Info; + begin + Get_Verilog_Wire (Sig, Vcd_El); + + if Vcd_El.Kind = Vcd_Bad then + Vcd_Put ("$comment "); + Vcd_Put_Name (Sig); + Vcd_Put (" is not handled"); + --Vcd_Put (Ghdl_Type_Kind'Image (Desc.Kind)); + Vcd_Putc (' '); + Vcd_Put_End; + return; + else + Vcd_Table.Increment_Last; + N := Vcd_Table.Last; + + Vcd_Table.Table (N) := Vcd_El; + Vcd_Put ("$var "); + case Vcd_El.Kind is + when Vcd_Integer32 => + Vcd_Put ("integer 32"); + when Vcd_Float64 => + Vcd_Put ("real 64"); + when Vcd_Bool + | Vcd_Bit + | Vcd_Stdlogic => + Vcd_Put ("reg 1"); + when Vcd_Bitvector + | Vcd_Stdlogic_Vector => + Vcd_Put ("reg "); + Vcd_Put_I32 (Ghdl_I32 (Vcd_El.Irange.I32.Len)); + when Vcd_Bad => + null; + end case; + Vcd_Putc (' '); + Vcd_Put_Idcode (N); + Vcd_Putc (' '); + Vcd_Put_Name (Sig); + if Vcd_El.Irange /= null then + Vcd_Putc ('['); + Vcd_Put_I32 (Vcd_El.Irange.I32.Left); + Vcd_Putc (':'); + Vcd_Put_I32 (Vcd_El.Irange.I32.Right); + Vcd_Putc (']'); + end if; + Vcd_Putc (' '); + Vcd_Put_End; + if Boolean'(False) then + Vcd_Put ("$comment "); + Vcd_Put_Name (Sig); + Vcd_Put (" is "); + case Vcd_El.Val is + when Vcd_Effective => + Vcd_Put ("effective "); + when Vcd_Driving => + Vcd_Put ("driving "); + end case; + Vcd_Put_End; + end if; + end if; + end Add_Signal; + + procedure Vcd_Put_Hierarchy (Inst : VhpiHandleT) + is + Decl_It : VhpiHandleT; + Decl : VhpiHandleT; + Error : AvhpiErrorT; + begin + Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error); + if Error /= AvhpiErrorOk then + Avhpi_Error (Error); + return; + end if; + + -- Extract signals. + loop + Vhpi_Scan (Decl_It, Decl, Error); + exit when Error = AvhpiErrorIteratorEnd; + if Error /= AvhpiErrorOk then + Avhpi_Error (Error); + return; + end if; + + case Vhpi_Get_Kind (Decl) is + when VhpiPortDeclK + | VhpiSigDeclK => + Add_Signal (Decl); + when others => + null; + end case; + end loop; + + -- Extract sub-scopes. + Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error); + if Error /= AvhpiErrorOk then + Avhpi_Error (Error); + return; + end if; + + loop + Vhpi_Scan (Decl_It, Decl, Error); + exit when Error = AvhpiErrorIteratorEnd; + if Error /= AvhpiErrorOk then + Avhpi_Error (Error); + return; + end if; + + case Vhpi_Get_Kind (Decl) is + when VhpiIfGenerateK + | VhpiForGenerateK + | VhpiBlockStmtK + | VhpiCompInstStmtK => + Vcd_Put ("$scope module "); + Vcd_Put_Name (Decl); + Vcd_Putc (' '); + Vcd_Put_End; + Vcd_Put_Hierarchy (Decl); + Vcd_Put ("$upscope "); + Vcd_Put_End; + when others => + null; + end case; + end loop; + + end Vcd_Put_Hierarchy; + + procedure Vcd_Put_Bit (V : Ghdl_B1) + is + C : Character; + begin + if V then + C := '1'; + else + C := '0'; + end if; + Vcd_Putc (C); + end Vcd_Put_Bit; + + procedure Vcd_Put_Stdlogic (V : Ghdl_E8) + is + type Map_Type is array (Ghdl_E8 range 0 .. 8) of Character; + -- "UX01ZWLH-" + -- Map_Vlg : constant Map_Type := "xx01zz01x"; + Map_Std : constant Map_Type := "UX01ZWLH-"; + begin + if V not in Map_Type'Range then + Vcd_Putc ('?'); + else + Vcd_Putc (Map_Std (V)); + end if; + end Vcd_Put_Stdlogic; + + procedure Vcd_Put_Integer32 (V : Ghdl_U32) + is + Val : Ghdl_U32; + N : Natural; + begin + Val := V; + N := 32; + while N > 1 loop + exit when (Val and 16#8000_0000#) /= 0; + Val := Val * 2; + N := N - 1; + end loop; + + while N > 0 loop + if (Val and 16#8000_0000#) /= 0 then + Vcd_Putc ('1'); + else + Vcd_Putc ('0'); + end if; + Val := Val * 2; + N := N - 1; + end loop; + end Vcd_Put_Integer32; + + -- Using the floor attribute of Ghdl_F64 will result on a link error while + -- trying to simulate a design. So it was needed to create a floor function + function Digit_Floor (V : Ghdl_F64) return Ghdl_I32 + is + Var : Ghdl_I32; + begin + -- V is always positive here and only of interest when it is a digit + if V > 10.0 then + return -1; + else + Var := Ghdl_I32(V-0.5); --Ghdl_I32 rounds to the nearest integer + -- The rounding made by Ghdl_I32 is asymetric : + -- 0.5 will be rounded to 1, but -0.5 to -1 instead of 0 + if Var > 0 then + return Var; + else + return 0; + end if; + end if; + end Digit_Floor; + + procedure Vcd_Put_Float64 (V : Ghdl_F64) + is + Val_tmp, Fact : Ghdl_F64; + Digit, Exp, Delta_Exp, N_Exp : Ghdl_I32; + -- + begin + Exp := 0; + if V /= V then + Vcd_Put("NaN"); + return; + end if; + if V < 0.0 then + Vcd_Putc ('-'); + Val_tmp := -V; + elsif V = 0.0 then + Vcd_Put("0.0"); + return; + else + Val_tmp := V; + end if; + if Val_tmp > Ghdl_F64'Last then + Vcd_Put("Inf"); + return; + elsif Val_tmp < 1.0 then + Fact := 10.0; + Delta_Exp := -1; + else + Fact := 0.1; + Delta_Exp := 1; + end if; + + -- Seek the first digit + loop + Digit := Digit_Floor(Val_tmp); + if Digit > 0 then + exit; + end if; + Exp := Exp + Delta_Exp; + Val_tmp := Val_tmp * Fact; + end loop; + Vcd_Putc(Character'Val(Digit + 48)); + Vcd_Putc('.'); + for i in 0..4 loop -- 5 digits displayed after the point + Val_tmp := abs(Val_tmp - Ghdl_F64(Digit))*10.0; + Digit := Digit_Floor(Val_tmp); + Vcd_Putc(Character'Val(Digit + 48)); + end loop; + Vcd_Putc('E'); + if Exp < 0 then + Vcd_Putc('-'); + Exp := -Exp; + end if; + N_Exp := 100; + while N_Exp > 0 loop + Vcd_Putc(Character'Val(Exp/N_Exp + 48)); + Exp := Exp mod N_Exp; + N_Exp := N_Exp/10; + end loop; + end Vcd_Put_Float64; + + procedure Vcd_Put_Var (I : Vcd_Index_Type) + is + Addr : Address; + V : Verilog_Wire_Info renames Vcd_Table.Table (I); + Len : Ghdl_Index_Type; + begin + Addr := V.Addr; + if V.Irange = null then + Len := 1; + else + Len := V.Irange.I32.Len; + end if; + case V.Val is + when Vcd_Effective => + case V.Kind is + when Vcd_Bit + | Vcd_Bool => + Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B1); + when Vcd_Stdlogic => + Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Value.E8); + when Vcd_Integer32 => + Vcd_Putc ('b'); + Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32); + Vcd_Putc (' '); + when Vcd_Float64 => + Vcd_Putc ('r'); + Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0).Value.F64); + Vcd_Putc (' '); + when Vcd_Bitvector => + Vcd_Putc ('b'); + for J in 0 .. Len - 1 loop + Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B1); + end loop; + Vcd_Putc (' '); + when Vcd_Stdlogic_Vector => + Vcd_Putc ('b'); + for J in 0 .. Len - 1 loop + Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(J).Value.E8); + end loop; + Vcd_Putc (' '); + when Vcd_Bad => + null; + end case; + when Vcd_Driving => + case V.Kind is + when Vcd_Bit + | Vcd_Bool => + Vcd_Put_Bit + (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B1); + when Vcd_Stdlogic => + Vcd_Put_Stdlogic + (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E8); + when Vcd_Integer32 => + Vcd_Putc ('b'); + Vcd_Put_Integer32 + (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32); + Vcd_Putc (' '); + when Vcd_Float64 => + Vcd_Putc ('r'); + Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0) + .Driving_Value.F64); + Vcd_Putc (' '); + when Vcd_Bitvector => + Vcd_Putc ('b'); + for J in 0 .. Len - 1 loop + Vcd_Put_Bit + (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B1); + end loop; + Vcd_Putc (' '); + when Vcd_Stdlogic_Vector => + Vcd_Putc ('b'); + for J in 0 .. Len - 1 loop + Vcd_Put_Stdlogic + (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.E8); + end loop; + Vcd_Putc (' '); + when Vcd_Bad => + null; + end case; + end case; + Vcd_Put_Idcode (I); + Vcd_Newline; + end Vcd_Put_Var; + + function Verilog_Wire_Changed (Info : Verilog_Wire_Info; + Last : Std_Time) + return Boolean + is + Len : Ghdl_Index_Type; + 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_Stdlogic + | Vcd_Bitvector + | Vcd_Stdlogic_Vector + | Vcd_Integer32 + | Vcd_Float64 => + for J in 0 .. Len - 1 loop + if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Event = Last then + return True; + end if; + end loop; + when Vcd_Bad => + null; + end case; + when Vcd_Driving => + case Info.Kind is + when Vcd_Bit + | Vcd_Bool + | Vcd_Stdlogic + | Vcd_Bitvector + | Vcd_Stdlogic_Vector + | Vcd_Integer32 + | Vcd_Float64 => + for J in 0 .. Len - 1 loop + if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Active = Last + then + return True; + end if; + end loop; + when Vcd_Bad => + null; + end case; + end case; + return False; + end Verilog_Wire_Changed; + + procedure Vcd_Put_Time + is + Str : String (1 .. 21); + First : Natural; + begin + Vcd_Putc ('#'); + Vstrings.To_String (Str, First, Ghdl_I64 (Cycle_Time)); + Vcd_Put (Str (First .. Str'Last)); + Vcd_Newline; + end Vcd_Put_Time; + + procedure Vcd_Cycle; + + -- Called after elaboration. + procedure Vcd_Start + is + Root : VhpiHandleT; + begin + -- Do nothing if there is no VCD file to generate. + if Vcd_Close = null then + return; + end if; + + -- Be sure the RTI of std_ulogic is set. + Search_Types_RTI; + + -- Put hierarchy. + Get_Root_Inst (Root); + Vcd_Put_Hierarchy (Root); + + -- End of header. + Vcd_Put ("$enddefinitions "); + Vcd_Put_End; + + Register_Cycle_Hook (Vcd_Cycle'Access); + end Vcd_Start; + + -- Called before each non delta cycle. + procedure Vcd_Cycle is + begin + -- Disp values. + Vcd_Put_Time; + if Cycle_Time = 0 then + -- Disp all values. + for I in Vcd_Table.First .. Vcd_Table.Last loop + Vcd_Put_Var (I); + end loop; + else + -- Disp only values changed. + for I in Vcd_Table.First .. Vcd_Table.Last loop + if Verilog_Wire_Changed (Vcd_Table.Table (I), Cycle_Time) then + Vcd_Put_Var (I); + end if; + end loop; + end if; + end Vcd_Cycle; + + -- Called at the end of the simulation. + procedure Vcd_End is + begin + if Vcd_Close /= null then + Vcd_Close.all; + end if; + end Vcd_End; + + Vcd_Hooks : aliased constant Hooks_Type := + (Option => Vcd_Option'Access, + Help => Vcd_Help'Access, + Init => Vcd_Init'Access, + Start => Vcd_Start'Access, + Finish => Vcd_End'Access); + + procedure Register is + begin + Register_Hooks (Vcd_Hooks'Access); + end Register; +end Grt.Vcd; |