First import from sources

1 files changed, 716 insertions, 0 deletions

diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
new file mode 100644
index 0000000..66f248c
--- /dev/null
+++ b/translate/grt/grt-vcd.adb
@@ -0,0 +1,716 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+with Interfaces;
+with Grt.Stdio; use Grt.Stdio;
+with System; use System;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with GNAT.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+
+package body Grt.Vcd is
+   --  VCD filename.
+   Vcd_Filename : String_Access := null;
+   --  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 : Natural := Opt'First;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         --  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;
+         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");
+   end Vcd_Help;
+
+   procedure Vcd_Put (Str : String)
+   is
+      R : size_t;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Vcd_Stream);
+   end Vcd_Put;
+
+   procedure Vcd_Putc (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Vcd_Stream);
+   end Vcd_Putc;
+
+   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
+   begin
+      Put_I32 (Vcd_Stream, V);
+   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
+      Mode : constant String := "wt" & NUL;
+   begin
+      if Vcd_Filename = null then
+         Vcd_Stream := NULL_Stream;
+         return;
+      end if;
+      if Vcd_Filename.all = "-" & NUL then
+         Vcd_Stream := stdout;
+      else
+         Vcd_Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+         if Vcd_Stream = NULL_Stream then
+            Error_C ("cannot open ");
+            Error_E (Vcd_Filename (Vcd_Filename'First
+                                   .. Vcd_Filename'Last - 1));
+            return;
+         end if;
+      end if;
+      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 chars;
+         pragma Import (C, ctime);
+
+         R : int;
+      begin
+         Cur_Time := time (Null_Address);
+         R := fputs (ctime (Cur_Time'Address), Vcd_Stream);
+         -- Note: ctime already append a LF.
+      end;
+      Vcd_Put_End;
+      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 GNAT.Table
+     (Table_Component_Type => Verilog_Wire_Info,
+      Table_Index_Type => Vcd_Index_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   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;
+      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;
+      Sig_Rti : Ghdl_Rtin_Object_Acc;
+      Rti : Ghdl_Rti_Access;
+      Error : AvhpiErrorT;
+      Sig_Addr : Address;
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Sig));
+
+      --  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_B2
+           | 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_Subtype_Array_Ptr =>
+            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 := To_Addr_Acc (Sig_Addr).all;
+               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_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_B2)
+   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;
+
+   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.B2);
+               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);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B2);
+                  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.B2);
+               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);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B2);
+                  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 =>
+                  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 =>
+                  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
+   begin
+      Vcd_Putc ('#');
+      Put_I64 (Vcd_Stream, Ghdl_I64 (Cycle_Time));
+      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_Stream = NULL_Stream 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
+      --  Do nothing if there is no VCD file to generate.
+      if Vcd_Stream = NULL_Stream then
+         return;
+      end if;
+
+      --  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
+      null;
+   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;