diff options
Diffstat (limited to 'translate/grt/grt-vcd.adb')
| -rw-r--r-- | translate/grt/grt-vcd.adb | 845 |
1 files changed, 0 insertions, 845 deletions
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb deleted file mode 100644 index d4a9ea0..0000000 --- a/translate/grt/grt-vcd.adb +++ /dev/null @@ -1,845 +0,0 @@ --- 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; |