-- 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. -- VHPI implementation that uses Avhpi. -- Targeted functionality: -- Handles allocation for transient strings and structures -- Handles callback object creation and executing callbacks -- Provides VHPI error support -- Provides VHPI tracing support with System; use System; with Interfaces; use Interfaces; with Grt.C; use Grt.C; with Grt.Avhpi; use Grt.Avhpi; with Grt.Callbacks; with Grt.Rtis; use Grt.Rtis; with Grt.Types; use Grt.Types; with Grt.Vcd; package Grt.Vhpi is -- ********************************************************************** -- NOTE: Currently this is a minimal implementation that loads VHPI -- libraries but does not implement VHPI functionality beyond -- vhpi_check_error(). -- Calling most vhpi_* functions will raise a VHPI error condition. -- ********************************************************************** type Vhpi_Internal_Handle (<>) is private; type Vhpi_External_Handle is access Vhpi_Internal_Handle; pragma No_Strict_Aliasing (Vhpi_External_Handle); type VhpiFormatT is ( VhpiBinStrVal, VhpiOctStrVal, VhpiDecStrVal, VhpiHexStrVal, VhpiEnumVal, VhpiIntVal, VhpiLogicVal, VhpiRealVal, VhpiStrVal, VhpiCharVal, VhpiTimeVal, VhpiPhysVal, VhpiObjTypeVal, VhpiPtrVal, VhpiEnumVecVal, VhpiIntVecVal, VhpiLogicVecVal, VhpiRealVecVal, VhpiTimeVecVal, VhpiPhysVecVal, VhpiPtrVecVal, VhpiRawDataVal, VhpiSmallEnumVal, VhpiSmallEnumVecVal, VhpiLongIntVal, VhpiLongIntVecVal, VhpiSmallPhysVal, VhpiSmallPhysVecVal ); pragma Convention (C, VhpiFormatT); for VhpiFormatT use ( VhpiBinStrVal => 1, VhpiOctStrVal => 2, VhpiDecStrVal => 3, VhpiHexStrVal => 4, VhpiEnumVal => 5, VhpiIntVal => 6, VhpiLogicVal => 7, VhpiRealVal => 8, VhpiStrVal => 9, VhpiCharVal => 10, VhpiTimeVal => 11, VhpiPhysVal => 12, VhpiObjTypeVal => 13, VhpiPtrVal => 14, VhpiEnumVecVal => 15, VhpiIntVecVal => 16, VhpiLogicVecVal => 17, VhpiRealVecVal => 18, VhpiTimeVecVal => 19, VhpiPhysVecVal => 20, VhpiPtrVecVal => 21, VhpiRawDataVal => 22, VhpiSmallEnumVal => 23, VhpiSmallEnumVecVal => 24, VhpiLongIntVal => 25, VhpiLongIntVecVal => 26, VhpiSmallPhysVal => 27, VhpiSmallPhysVecVal => 28 ); type VhpiFormat_Access is access VhpiFormatT; -- typedef struct vhpiPhysS -- { -- int32_t high; -- uint32_t low; -- } vhpiPhysT; type VhpiPhysT is record High : Integer_32; Low : Unsigned_32; end record; pragma Convention (C, VhpiPhysT); type VhpiTimeT is new VhpiPhysT; pragma Convention (C, VhpiTimeT); type VhpiTime_Access is access VhpiTimeT; -- typedef struct vhpiValueS -- { -- vhpiFormatT format; -- size_t bufSize; -- int32_t numElems; -- vhpiPhysT unit; -- union -- { -- vhpiEnumT enumv, *enumvs; -- vhpiSmallEnumT smallenumv, *smallenumvs; -- vhpiIntT intg, *intgs; -- vhpiLongIntT longintg, *longintgs; -- vhpiRealT real, *reals; -- vhpiSmallPhysT smallphys, *smallphyss; -- vhpiPhysT phys, *physs; -- vhpiTimeT time, *times; -- vhpiCharT ch, *str; -- void *ptr, **ptrs; -- } value; -- } vhpiValueT; type VhpiValueT (Format : VhpiFormatT) is record BufSize : size_t; NumElems : Unsigned_32; Unit : VhpiPhysT; case Format is when VhpiBinStrVal | VhpiOctStrVal | VhpiDecStrVal | VhpiHexStrVal | VhpiStrVal => Str : Ghdl_C_String; when VhpiEnumVal | VhpiLogicVal => Enumv : Unsigned_32; when VhpiSmallEnumVal => SmallEnumv : Unsigned_8; when VhpiIntVal => Intg : Integer_32; when VhpiLongIntVal => LongIntg : Integer_64; when VhpiRealVal => Realv : Ghdl_Real; when VhpiCharVal => Ch : Character; when VhpiTimeVal => Time : VhpiTimeT; when VhpiPhysVal => Phys : VhpiPhysT; when VhpiSmallPhysVal => SmallPhys : Integer_32; when VhpiPtrVal | VhpiRawDataVal => Ptr : System.Address; when VhpiEnumVecVal | VhpiLogicVecVal => Enumvs : System.Address; when VhpiSmallEnumVecVal => SmallEnumvs : System.Address; when VhpiIntVecVal => Intgs : System.Address; when VhpiLongIntVecVal => LongIntgs : System.Address; when VhpiRealVecVal => Realvs : System.Address; when VhpiTimeVecVal => Times : System.Address; when VhpiPhysVecVal => Physs : System.Address; when VhpiSmallPhysVecVal => SmallPhyss : System.Address; when VhpiPtrVecVal => Ptrs : System.Address; when others => -- VhpiObjTypeVal null; end case; end record; -- No use of convention C, as there is no direct equivalent in the norm. type VhpiValue_Access is access VhpiValueT; type VhpiSeverityT is ( VhpiNote, VhpiWarning, VhpiError, VhpiSystem, VhpiInternal, VhpiFailure ); pragma Convention (C, VhpiSeverityT); for VhpiSeverityT use ( VhpiNote => 1, VhpiWarning => 2, VhpiError => 3, VhpiSystem => 4, VhpiInternal => 5, VhpiFailure => 6 ); -- typedef struct vhpiErrorInfoS -- { -- vhpiSeverityT severity; -- char *message; -- char *str; -- char *file; -- int32_t line; -- } vhpiErrorInfoT; type VhpiErrorInfoT is record Severity : VhpiSeverityT; Msg : Ghdl_C_String; Str : Ghdl_C_String; File : Ghdl_C_String; Line : Integer_32; end record; pragma Convention (C, VhpiErrorInfoT); type VhpiErrorInfo_Access is access VhpiErrorInfoT; -- typedef struct vhpiCbDataS -- { -- int32_t reason; -- void (*cb_rtn) (const struct vhpiCbDataS *); -- vhpiHandleT obj; -- vhpiTimeT *time; -- vhpiValueT *value; -- void *user_data; -- } vhpiCbDataT; type VhpiCbDataT; type VhpiCbFctT is access procedure (Data : access constant VhpiCbDataT); pragma Convention (C, VhpiCbFctT); type VhpiCbDataT is record Reason : Integer_32; Cb_Rtn : VhpiCbFctT; Obj : Vhpi_External_Handle; Time : VhpiTime_Access; Value : VhpiValue_Access; User_Data : System.Address; end record; pragma Convention (C, VhpiCbDataT); type VhpiCbData_Access is access VhpiCbDataT; type Callback_Flags is private; ---------------------------------------------------------------------------- -- 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; pragma Export (C, vhpi_register_cb, "vhpi_register_cb"); -- int vhpi_remove_cb (vhpiHandleT cb_obj) function vhpi_remove_cb (Cb : Vhpi_External_Handle) return Integer; pragma Export (C, vhpi_remove_cb, "vhpi_remove_cb"); -- int vhpi_disable_cb (vhpiHandleT cb_obj) function vhpi_disable_cb (Cb : Vhpi_External_Handle) return Integer; pragma Export (C, vhpi_disable_cb, "vhpi_disable_cb"); -- int vhpi_enable_cb (vhpiHandleT cb_obj) function vhpi_enable_cb (Cb : Vhpi_External_Handle) return Integer; pragma Export (C, vhpi_enable_cb, "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; pragma Export (C, vhpi_get_cb_info, "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; pragma Export (C, vhpi_handle_by_name, "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; pragma Export (C, vhpi_handle_by_index, "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; pragma Export (C, vhpi_handle, "vhpi_handle"); -- vhpiHandleT vhpi_iterator (vhpiOneToManyT type, -- vhpiHandleT referenceHandle) function vhpi_iterator (Rel: Integer; Ref: Vhpi_External_Handle) return Vhpi_External_Handle; pragma Export (C, vhpi_iterator, "vhpi_iterator"); -- vhpiHandleT vhpi_scan (vhpiHandleT iterator) function vhpi_scan (Iter : Vhpi_External_Handle) return Vhpi_External_Handle; pragma Export (C, vhpi_scan, "vhpi_scan"); -- For processing properties -- vhpiIntT vhpi_get (vhpiIntPropertyT property, vhpiHandleT object) function vhpi_get (Property: Integer; Ref: Vhpi_External_Handle) return VhpiIntT; pragma Export (C, vhpi_get, "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; pragma Export (C, vhpi_get_str, "vhpi_get_str"); -- vhpiRealT vhpi_get_real (vhpiRealPropertyT property, vhpiHandleT object) function vhpi_get_real (Property : Integer; Ref : Vhpi_External_Handle) return Ghdl_Real; pragma Export (C, vhpi_get_real, "vhpi_get_real"); -- vhpiPhysT vhpi_get_phys (vhpiPhysPropertyT property, vhpiHandleT object) function vhpi_get_phys (Property : Integer; Ref : Vhpi_External_Handle) return VhpiPhysT; pragma Export (C, vhpi_get_phys, "vhpi_get_phys"); -- For access to protected types type VhpiUserFctT is access function return Integer; pragma Convention (C, VhpiUserFctT); -- 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; pragma Export (C, vhpi_protected_call, "vhpi_protected_call"); -- For value processing type VhpiPutValueModeT is ( VhpiDeposit, VhpiDepositPropagate, VhpiForce, VhpiForcePropagate, VhpiRelease, VhpiSizeConstraint ); pragma Convention (C, VhpiPutValueModeT); type VhpiDelayModeT is ( VhpiInertial, VhpiTransport ); pragma Convention (C, VhpiDelayModeT); -- int vhpi_get_value (vhpiHandleT expr, vhpiValueT *value_p) function vhpi_get_value (Expr : Vhpi_External_Handle; Value : VhpiValue_Access) return Integer; pragma Export (C, vhpi_get_value, "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; pragma Export (C, vhpi_put_value, "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; pragma Export (C, vhpi_schedule_transaction, "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; pragma Export (C, vhpi_format_value, "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); pragma Export (C, vhpi_get_time, "vhpi_get_time"); vhpiNoActivity : constant Integer := -1; -- int vhpi_get_next_time (vhpiTimeT *time_p) function vhpi_get_next_time (Time : VhpiTime_Access) return Integer; pragma Export (C, vhpi_get_next_time, "vhpi_get_next_time"); -- Missing, see grt-cvhpi.c -- int vhpi_control (vhpiSimControlT command, ...); -- int vhpi_printf (const char *format, ...); -- int vhpi_vprintf (const char *format, va_list args); -- Utilities to print VHDL strings -- int vhpi_is_printable ( char ch ) function vhpi_is_printable (Ch : Character) return Integer; pragma Export (C, vhpi_is_printable, "vhpi_is_printable"); -- Utility routines -- int vhpi_compare_handles (vhpiHandleT handle1, vhpiHandleT handle2) function vhpi_compare_handles (Hdl1, Hdl2 : Vhpi_External_Handle) return Integer; pragma Export (C, vhpi_compare_handles, "vhpi_compare_handles"); -- int vhpi_check_error (vhpiErrorInfoT *error_info_p) function vhpi_check_error (Info : VhpiErrorInfo_Access) return Integer; pragma Export (C, vhpi_check_error, "vhpi_check_error"); -- int vhpi_release_handle (vhpiHandleT object) function vhpi_release_handle (Obj : Vhpi_External_Handle) return Integer; pragma Export (C, vhpi_release_handle, "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; pragma Export (C, vhpi_create, "vhpi_create"); -- Foreign model data structures and functions type VhpiForeignKindT is ( VhpiArchF, VhpiFuncF, VhpiProcF, VhpiLibF, VhpiAppF ); pragma Convention (C, VhpiForeignKindT); for VhpiForeignKindT use ( VhpiArchF => 1, VhpiFuncF => 2, VhpiProcF => 3, VhpiLibF => 4, VhpiAppF => 5 ); type VhpiForeignFctT is new VhpiCbFctT; pragma Convention (C, VhpiForeignFctT); -- typedef struct vhpiForeignDataS { -- vhpiForeignKindT kind; -- char * libraryName; -- char * modelName; -- void (*elabf) (const struct vhpiCbDataS *cb_data_p); -- void (*execf) (const struct vhpiCbDataS *cb_data_p); -- } vhpiForeignDataT; type VhpiForeignDataT is record Kind : VhpiForeignKindT; Lib_Name : Ghdl_C_String; Model_Name : Ghdl_C_String; Elab_Fun : VhpiForeignFctT; Exec_Fun : VhpiForeignFctT; end record; pragma Convention (C, VhpiForeignDataT); type VhpiForeignData_Access is access VhpiForeignDataT; -- vhpiHandleT vhpi_register_foreignf (vhpiForeignDataT *foreignDatap) function vhpi_register_foreignf (Data : VhpiForeignData_Access) return Vhpi_External_Handle; pragma Export (C, vhpi_register_foreignf, "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; pragma Export (C, vhpi_get_foreignf_info, "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; pragma Export (C, vhpi_get_data, "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; pragma Export (C, vhpi_put_data, "vhpi_put_data"); ---------------------------------------------------------------------------- -- Internal helper functions ---------------------------------------------------------------------------- type VhpiSimControlT is ( VhpiStop, VhpiFinish, VhpiReset ); pragma Convention (C, VhpiSimControlT); for VhpiSimControlT use (VhpiStop => 0, VhpiFinish => 1, VhpiReset => 2); -- int vhpi_control (vhpiSimControlT command, ...) -- See grt-cvhpi.c function Vhpi_Control_Internal (Command : VhpiSimControlT; Status : Integer) return Integer; pragma Export (C, Vhpi_Control_Internal, "Vhpi_Control_Internal"); -- int vhpi_assert (vhpiSeverityT severity, char *formatmsg, ...) -- See grt-cvhpi.c function Vhpi_Assert_Internal (Severity : Integer; Msg : Ghdl_C_String) return Integer; pragma Export (C, Vhpi_Assert_Internal, "Vhpi_Assert_Internal"); procedure Register; private type Callback_Flags is new Integer_32; VhpiReturnCb : constant Callback_Flags := 2#0000_0001#; VhpiDisableCb : constant Callback_Flags := 2#0000_0010#; -- Wrap VhpiHandleT -- Keep Callback objects out of Avhpi, they are allocated when registered type Vhpi_Internal_Handle (Kind : VhpiClassKindT) is record case Kind is when VhpiCallbackK => Cb : aliased VhpiCbDataT; Cb_Prev, Cb_Next : Vhpi_External_Handle; Cb_Wire : Grt.Vcd.Verilog_Wire_Info; Cb_Handle : Callbacks.Callback_Handle; Cb_Refcnt : Natural; when others => Ref : VhpiHandleT; end case; end record; end Grt.Vhpi;