path: root/src/grt/grt-vhpi.adb

--  GHDL Run Time (GRT) - VHPI implementation.
--  Copyright (C) 2021 Marlon James
--
--  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 Ada.Unchecked_Conversion;
with Grt.Astdio; use Grt.Astdio;
with Grt.Errors; use Grt.Errors;
with Grt.Hooks; use Grt.Hooks;
with Grt.Stdio; use Grt.Stdio;
with Grt.Vstrings; use Grt.Vstrings;

package body Grt.Vhpi is
   --  The VHPI interface requires libdl (dlopen, dlsym) to be linked in.
   --  This is now set in Makefile, since this is target dependent.
   --  pragma Linker_Options ("-ldl");

   --  If true, emit traces
   Flag_Trace : Boolean := False;
   Trace_File : FILEs;
   pragma Unreferenced (Flag_Trace);

   VhpiUndefined_External : constant Integer := -1;

   ----------------------------------------------------------------------------
   -- Internal helper functions
   ----------------------------------------------------------------------------

   -- VHPI errors

   Default_Message : constant String := "(no error message)" & NUL;

   Err_Severity : VhpiSeverityT := VhpiNote;
   Err_Message : Ghdl_C_String := To_Ghdl_C_String (Default_Message'Address);
   Err_Str : Ghdl_C_String := null;
   Err_File : Ghdl_C_String := null;
   Err_Line : Integer_32 := -1;
   Err_Occured : Boolean := False;

   Buf_Err_Message : Vstring;

   procedure Reset_Error is
   begin
      Err_Severity := VhpiNote;
      Err_Message := To_Ghdl_C_String (Default_Message'Address);
      Err_Str := null;
      Err_File := null;
      Err_Line := -1;
      Err_Occured := False;
   end Reset_Error;

   Err_Str_S : constant String := "GHDL Error ";
   -- VHPI function not implemented
   VHPI_0001_Str  : constant String := Err_Str_S & "VHPI_0001";

   procedure Set_Err_Str (S : String) is
   begin
      Err_Str := To_Ghdl_C_String (S'Address);
   end Set_Err_Str;

   procedure Error_Unimplimented (Name : String) is
   begin
      Err_Severity := VhpiError;
      Reset (Buf_Err_Message);
      Append (Buf_Err_Message, Name);
      Append (Buf_Err_Message, " not implemented");
      Append (Buf_Err_Message, NUL);
      Err_Message := Get_C_String (Buf_Err_Message);
      Set_Err_Str (VHPI_0001_Str);
      Err_Occured := True;
   end Error_Unimplimented;

   -- Internal implementations for variadic functions in grt-cvhpi.c

   function Vhpi_Assert_Internal (Severity: Integer; Msg : Ghdl_C_String)
                                 return Integer
   is
      pragma Unreferenced (Severity);
      pragma Unreferenced (Msg);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_assert");
      return 0;
   end Vhpi_Assert_Internal;

   function Vhpi_Control_Internal (Command : VhpiSimControlT; Status : Integer)
                                  return Integer
   is
      pragma Unreferenced (Command);
      pragma Unreferenced (Status);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_control");
      return 0;
   end Vhpi_Control_Internal;

   ----------------------------------------------------------------------------
   -- VHPI functions
   ----------------------------------------------------------------------------

   ----------------------------------------------------------------------------
   -- Callback related

   -- vhpiHandleT vhpi_register_cb (vhpiCbDataT *cb_data_p, int32_t flags)
   function vhpi_register_cb (Data : VhpiCbData_Access; Flags : Callback_Flags)
                             return Vhpi_External_Handle
   is
      pragma Unreferenced (Data);
      pragma Unreferenced (Flags);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_register_cb");
      return null;
   end vhpi_register_cb;

   -- int vhpi_remove_cb (vhpiHandleT cb_obj)
   function vhpi_remove_cb (Cb : Vhpi_External_Handle) return Integer
   is
      pragma Unreferenced (Cb);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_remove_cb");
      return 0;
   end vhpi_remove_cb;

   -- int vhpi_disable_cb (vhpiHandleT cb_obj)
   function vhpi_disable_cb (Cb : Vhpi_External_Handle) return Integer
   is
      pragma Unreferenced (Cb);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_disable_cb");
      return 0;
   end vhpi_disable_cb;

   -- int vhpi_enable_cb (vhpiHandleT cb_obj)
   function vhpi_enable_cb (Cb : Vhpi_External_Handle) return Integer
   is
      pragma Unreferenced (Cb);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_enable_cb");
      return 0;
   end vhpi_enable_cb;

   -- int vhpi_get_cb_info (vhpiHandleT object, vhpiCbDataT *cb_data_p)
   function vhpi_get_cb_info
     (Obj : Vhpi_External_Handle; Data : VhpiCbData_Access) return Integer
   is
      pragma Unreferenced (Obj);
      pragma Unreferenced (Data);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_cb_info");
      return 0;
   end vhpi_get_cb_info;

   -- For obtaining handles

   -- vhpiHandleT vhpi_handle_by_name (const char *name, vhpiHandleT scope)
   function vhpi_handle_by_name
     (Name : Ghdl_C_String; Scope : Vhpi_External_Handle)
     return Vhpi_External_Handle
   is
      pragma Unreferenced (Name);
      pragma Unreferenced (Scope);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_handle_by_name");
      return null;
   end vhpi_handle_by_name;

   -- vhpiHandleT vhpi_handle_by_index (vhpiOneToManyT itRel,
   --                                   vhpiHandleT parent, int32_t indx)
   function vhpi_handle_by_index
     (Rel : Integer; Parent : Vhpi_External_Handle; Index: Integer)
     return Vhpi_External_Handle
   is
      pragma Unreferenced (Rel);
      pragma Unreferenced (Parent);
      pragma Unreferenced (Index);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_handle_by_index");
      return null;
   end vhpi_handle_by_index;

   -- For traversing relationships

   -- vhpiHandleT vhpi_handle (vhpiOneToOneT type, vhpiHandleT referenceHandle)
   function vhpi_handle (Rel: Integer; Ref: Vhpi_External_Handle)
                        return Vhpi_External_Handle
   is
      pragma Unreferenced (Rel);
      pragma Unreferenced (Ref);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_handle");
      return null;
   end vhpi_handle;

   -- vhpiHandleT vhpi_iterator (vhpiOneToManyT type,
   --                            vhpiHandleT referenceHandle)
   function vhpi_iterator (Rel: Integer; Ref: Vhpi_External_Handle)
                          return Vhpi_External_Handle
   is
      pragma Unreferenced (Rel);
      pragma Unreferenced (Ref);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_iterator");
      return null;
   end vhpi_iterator;

   -- vhpiHandleT vhpi_scan (vhpiHandleT iterator)
   function vhpi_scan (Iter : Vhpi_External_Handle) return Vhpi_External_Handle
   is
      pragma Unreferenced (Iter);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_scan");
      return null;
   end vhpi_scan;

   -- For processing properties

   -- vhpiIntT vhpi_get (vhpiIntPropertyT property, vhpiHandleT object)
   function vhpi_get (Property: Integer; Ref: Vhpi_External_Handle)
                     return VhpiIntT
   is
      pragma Unreferenced (Property);
      pragma Unreferenced (Ref);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get");
      return VhpiIntT (VhpiUndefined_External);
   end vhpi_get;

   -- const vhpiCharT * vhpi_get_str (vhpiStrPropertyT property,
   --                                 vhpiHandleT object)
   function vhpi_get_str (Property : Integer; Ref : Vhpi_External_Handle)
                         return Ghdl_C_String
   is
      pragma Unreferenced (Property);
      pragma Unreferenced (Ref);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_str");
      return null;
   end vhpi_get_str;

   -- vhpiRealT vhpi_get_real (vhpiRealPropertyT property, vhpiHandleT object)
   function vhpi_get_real (Property : Integer; Ref : Vhpi_External_Handle)
                          return Ghdl_Real
   is
      pragma Unreferenced (Property);
      pragma Unreferenced (Ref);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_real");
      return 0.0;
   end vhpi_get_real;

   -- vhpiPhysT vhpi_get_phys (vhpiPhysPropertyT property, vhpiHandleT object)
   function vhpi_get_phys (Property : Integer; Ref : Vhpi_External_Handle)
                          return VhpiPhysT
   is
      pragma Unreferenced (Property);
      pragma Unreferenced (Ref);

      Res : constant VhpiPhysT := (0, 0);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_phys");
      return Res;
   end vhpi_get_phys;

   -- For access to protected types

   -- int vhpi_protected_call (vhpiHandleT varHdl,
   --                          vhpiUserFctT userFct,
   --                          void *userData)
   function vhpi_protected_call (Var : Vhpi_External_Handle;
                                 User_Fun : VhpiUserFctT;
                                 User_Data : System.Address)
                                return Integer
   is
      pragma Unreferenced (Var);
      pragma Unreferenced (User_Fun);
      pragma Unreferenced (User_Data);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_protected_call");
      return 0;
   end vhpi_protected_call;

   -- For value processing

   -- int vhpi_get_value (vhpiHandleT expr, vhpiValueT *value_p)
   function vhpi_get_value
     (Expr : Vhpi_External_Handle; Value : VhpiValue_Access) return Integer
   is
      pragma Unreferenced (Expr);
      pragma Unreferenced (Value);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_value");
      return 0;
   end vhpi_get_value;

   -- int vhpi_put_value (vhpiHandleT object,
   --                     vhpiValueT *value_p,
   --                     vhpiPutValueModeT mode)
   function vhpi_put_value (Obj : Vhpi_External_Handle;
                            Value : VhpiValue_Access;
                            Mode : VhpiPutValueModeT)
                           return Integer
   is
      pragma Unreferenced (Obj);
      pragma Unreferenced (Value);
      pragma Unreferenced (Mode);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_put_value");
      return 0;
   end vhpi_put_value;

   -- int vhpi_schedule_transaction (vhpiHandleT drivHdl,
   --                                vhpiValueT *value_p,
   --                                uint32_t numValues,
   --                                vhpiTimeT *delayp,
   --                                vhpiDelayModeT delayMode,
   --                                vhpiTimeT *pulseRejp)
   function vhpi_schedule_transaction (Driver : Vhpi_External_Handle;
                                       Value : VhpiValue_Access;
                                       Num_Values : Unsigned_32;
                                       Delay_Value : VhpiTime_Access;
                                       Delay_Mode : VhpiDelayModeT;
                                       Pulse_Rejection : VhpiTime_Access)
                                      return Integer
   is
      pragma Unreferenced (Driver);
      pragma Unreferenced (Value);
      pragma Unreferenced (Num_Values);
      pragma Unreferenced (Delay_Value);
      pragma Unreferenced (Delay_Mode);
      pragma Unreferenced (Pulse_Rejection);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_schedule_transaction");
      return 0;
   end vhpi_schedule_transaction;

   -- int vhpi_format_value (const vhpiValueT *in_value_p,
   --                        vhpiValueT *out_value_p)
   function vhpi_format_value
     (In_Val : VhpiValue_Access; Out_Val : VhpiValue_Access) return Integer
   is
      pragma Unreferenced (In_Val);
      pragma Unreferenced (Out_Val);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_format_value");
      return 0;
   end vhpi_format_value;

   -- For time processing

   -- void vhpi_get_time (vhpiTimeT *time_p, long *cycles)
   procedure vhpi_get_time (Time : VhpiTime_Access; Cycles : access Integer)
   is
      pragma Unreferenced (Time);
      pragma Unreferenced (Cycles);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_time");
      null;
   end vhpi_get_time;

   -- int vhpi_get_next_time (vhpiTimeT *time_p)
   function vhpi_get_next_time (Time : VhpiTime_Access) return Integer
   is
      pragma Unreferenced (Time);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_next_time");
      return 0;
   end vhpi_get_next_time;

   -- Utilities to print VHDL strings

   -- int vhpi_is_printable ( char ch )
   function vhpi_is_printable (Ch : Character) return Integer
   is
      pragma Unreferenced (Ch);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_is_printable");
      return 0;
   end vhpi_is_printable;

   -- Utility routines

   -- int vhpi_compare_handles (vhpiHandleT handle1, vhpiHandleT handle2)
   function vhpi_compare_handles (Hdl1, Hdl2 : Vhpi_External_Handle)
                                 return Integer
   is
      pragma Unreferenced (Hdl1);
      pragma Unreferenced (Hdl2);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_compare_handles");
      return 0;
   end vhpi_compare_handles;

   -- int vhpi_check_error (vhpiErrorInfoT *error_info_p)
   function vhpi_check_error (Info : VhpiErrorInfo_Access) return Integer
   is
      function To_Integer (B : Boolean) return Integer is
      begin
         if B then
            return 1;
         else
            return 0;
         end if;
      end To_Integer;
   begin
      if Info /= null then
         Info.all := (Severity => Err_Severity,
                      Msg => Err_Message,
                      Str => Err_Str,
                      File => Err_File,
                      Line => Err_Line);
      end if;
      return To_Integer (Err_Occured);
   end vhpi_check_error;

   -- int vhpi_release_handle (vhpiHandleT object)
   function vhpi_release_handle (Obj : Vhpi_External_Handle) return Integer
   is
      pragma Unreferenced (Obj);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_release_handle");
      return 0;
   end vhpi_release_handle;

   -- Creation functions
   -- vhpiHandleT vhpi_create (vhpiClassKindT kind,
   --                          vhpiHandleT handle1,
   --                          vhpiHandleT handle2)
   function vhpi_create (Kind : Integer; Hdl1, Hdl2 : Vhpi_External_Handle)
                        return Vhpi_External_Handle
   is
      pragma Unreferenced (Kind);
      pragma Unreferenced (Hdl1);
      pragma Unreferenced (Hdl2);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_create");
      return null;
   end vhpi_create;

   -- Foreign model data structures and functions

   -- vhpiHandleT vhpi_register_foreignf (vhpiForeignDataT *foreignDatap)
   function vhpi_register_foreignf (Data : VhpiForeignData_Access)
                                   return Vhpi_External_Handle
   is
      pragma Unreferenced (Data);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_register_foreignf");
      return null;
   end vhpi_register_foreignf;

   -- int vhpi_get_foreignf_info (vhpiHandleT hdl,
   --                             vhpiForeignDataT *foreignDatap)
   function vhpi_get_foreignf_info
     (Hdl : Vhpi_External_Handle; Data : VhpiForeignData_Access)
     return Integer
   is
      pragma Unreferenced (Hdl);
      pragma Unreferenced (Data);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_foreignf_info");
      return 0;
   end vhpi_get_foreignf_info;

   -- For saving and restoring foreign models data

   -- size_t vhpi_get_data (int32_t id, void *dataLoc, size_t numBytes);
   function vhpi_get_data
     (Id : Integer_32; Data_Loc : System.Address; Num_Bytes : size_t)
     return size_t
   is
      pragma Unreferenced (Id);
      pragma Unreferenced (Data_Loc);
      pragma Unreferenced (Num_Bytes);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_get_data");
      return 0;
   end vhpi_get_data;

   -- size_t vhpi_put_data (int32_t id, void *dataLoc, size_t numBytes);
   function vhpi_put_data
     (Id : Integer_32; Data_Loc : System.Address; Num_Bytes : size_t)
     return size_t
   is
      pragma Unreferenced (Id);
      pragma Unreferenced (Data_Loc);
      pragma Unreferenced (Num_Bytes);
   begin
      Reset_Error;
      Error_Unimplimented ("vhpi_put_data");
      return 0;
   end vhpi_put_data;


   ----------------------------------------------------------------------------
   -- GHDL hooks
   ----------------------------------------------------------------------------

   type Lib_Cell;
   type Lib_Access is access Lib_Cell;

   type Lib_Cell is record
      File_Name : String_Access;
      Func_Name : String_Access;
      Next : Lib_Access;
   end record;

   Vhpi_Libraries : Lib_Access := null;

   procedure Vhpi_Help is
   begin
      Put_Line
        (" --vhpi=FILENAME[:ENTRYPOINT]  load VHPI library, optionally");
      Put_Line
        ("                               provide entry point name");
      Put_Line
        (" --vhpi-trace[=FILE]  trace vhpi calls to stdout or provided FILE");
   end Vhpi_Help;

   ------------------------------------------------------------------------
   --  Return TRUE if OPT is an option for VHPI.
   function Vhpi_Option (Opt : String) return Boolean
   is
      F : constant Natural := Opt'First;

      procedure Bad_Option is
      begin
         Error_S ("incorrect option '");
         Diag_C (Opt);
         Error_E ("'");
      end Bad_Option;
   begin
      if Opt'Length < 6 or else Opt (F .. F + 5) /= "--vhpi" then
         return False;
      end if;
      if Opt'Length = 7 then
         Bad_Option;
         return False;
      end if;
      if Opt'Length > 7 and then Opt (F + 6) = '=' then
         -- Need to support Windows path names and optional entrypoint.
         -- Valid examples:
         -- C:\vhpi_lib.dll:entry_func
         -- .\vhpi_lib.dll:entry_func
         -- ./vhpi_lib.so:entry_func
         -- /path/to/vhpi_lib:entry_func
         -- vhpi_lib:entry_func
         declare
            P : Natural;
            Lf, Ll, L_Len : Natural;
            Ef, El, E_Len : Natural;
            Lib : Lib_Access;
            File : String_Access;
            Func : String_Access;
         begin
            P := F + 7;
            -- Extract library.
            Lf := P;
            while P <= Opt'Length and then Opt (P) /= ':' loop
               P := P + 1;
            end loop;
            -- Skip colon after volume/drive letter on Windows.
            -- This will break if library path is one character.
            if P <= Opt'Length and then Opt (P) = ':' and then P = 2 then
               while P <= Opt'Length and then Opt (P) /= ':' loop
                  P := P + 1;
               end loop;
            end if;
            Ll := P - 1;

            -- Extract entrypoint.
            Ef := P + 1;
            El := Opt'Length;

            -- Store library info.
            Lib := new Lib_Cell;
            --  Add an extra NUL character.
            L_Len := Ll - Lf + 2;
            File := new String (1 .. L_Len);
            File (1 .. L_Len - 1) := Opt (Lf .. Ll);
            File (File'Last) := NUL;
            Lib.File_Name := File;
            if Ef <= El then
               --  Add an extra NUL character.
               E_Len := El - Ef + 2;
               Func := new String (1 .. E_Len);
               Func (1 .. E_Len - 1) := Opt (Ef .. El);
               Func (Func'Last) := NUL;
               Lib.Func_Name := Func;
            end if;

            -- Add new library to the list.
            if Vhpi_Libraries = null then
               Vhpi_Libraries := Lib;
            else
               declare
                  L : Lib_Access := Vhpi_Libraries;
               begin
                  while L.Next /= null loop
                     L := L.Next;
                  end loop;
                  L.Next := Lib;
               end;
            end if;
         end;
         return True;
      elsif Opt'Length >= 12 and then Opt (F + 6 .. F + 11) = "-trace" then
         if Opt'Length > 12 and then Opt (F + 12) = '=' then
            declare
               Filename : String (1 .. Opt'Length - 12);
               Mode : constant String := "wt" & NUL;
            begin
               Filename (1 .. Filename'Last - 1) := Opt (F + 13 .. Opt'Last);
               Filename (Filename'Last) := NUL;
               Trace_File := fopen (Filename'Address, Mode'Address);
               if Trace_File = NULL_Stream then
                  Error_S ("cannot open vhpi trace file '");
                  Diag_C (Opt (F + 13 .. Opt'Last));
                  Error_E ("'");
                  return False;
               end if;
            end;
         elsif Opt'Length = 12 then
            Trace_File := stdout;
         else
            Bad_Option;
            return False;
         end if;
         Flag_Trace := True;
         return True;
      else
         return False;
      end if;
   end Vhpi_Option;

   ------------------------------------------------------------------------
   --  Called before elaboration.

   -- int loadVhpiModule (const char* libname, const char* entrypoint)
   function LoadVhpiModule (Filename, Funcname: Address) return Integer;
   pragma Import (C, LoadVhpiModule, "loadVhpiModule");

   procedure Vhpi_Init
   is
      Lib : Lib_Access := Vhpi_Libraries;
      Res : Integer;
   begin
      if Lib = null then
         return;
      end if;
      while Lib /= null loop
         if Lib.Func_Name = null then
            Res := LoadVhpiModule
              (Lib.File_Name.all'Address, Null_Address);
         else
            Res := LoadVhpiModule
              (Lib.File_Name.all'Address, Lib.Func_Name.all'Address);
         end if;

         if Res /= 0 then
            Error_S ("cannot load VHPI module '");
            Diag_C (Lib.File_Name.all);
            if Lib.Func_Name /= null then
               Diag_C ("' with entry point '");
               Diag_C (Lib.Func_Name.all);
            end if;
            Error_E ("'");
         end if;
         Lib := Lib.Next;
      end loop;
   end Vhpi_Init;

   ------------------------------------------------------------------------
   --  Called after elaboration.
   procedure Vhpi_Start is
   begin
      if Vhpi_Libraries = null then
         return;
      end if;

      -- Grt.Rtis_Types.Search_Types_RTI;
      -- Execute_Callback_List (VhpiCbStartOfSimulation_List);
   end Vhpi_Start;

   ------------------------------------------------------------------------
   --  Called at the end of the simulation.
   procedure Vhpi_End is
   begin
      -- Execute_Callback_List (VhpiCbEndOfSimulation_List);
      Free (Buf_Err_Message);
      null;
   end Vhpi_End;

   Vhpi_Hooks : aliased constant Hooks_Type :=
     (Desc => new String'("vhpi: vhpi compatible API"),
      Option => Vhpi_Option'Access,
      Help => Vhpi_Help'Access,
      Init => Vhpi_Init'Access,
      Start => Vhpi_Start'Access,
      Finish => Vhpi_End'Access);

   procedure Register is
   begin
      Register_Hooks (Vhpi_Hooks'Access);
   end Register;

end Grt.Vhpi;