diff options
Diffstat (limited to 'translate/grt/grt-vpi.adb')
| -rw-r--r-- | translate/grt/grt-vpi.adb | 988 |
1 files changed, 0 insertions, 988 deletions
diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb deleted file mode 100644 index 9b77319f1..000000000 --- a/translate/grt/grt-vpi.adb +++ /dev/null @@ -1,988 +0,0 @@ --- GHDL Run Time (GRT) - VPI interface. --- Copyright (C) 2002 - 2014 Tristan Gingold & Felix Bertram --- --- 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. - --- Description: VPI interface for GRT runtime --- the main purpose of this code is to interface with the --- Icarus Verilog Interactive (IVI) simulator GUI - -------------------------------------------------------------------------------- --- TODO: -------------------------------------------------------------------------------- --- DONE: --- * The GHDL VPI implementation doesn't support time --- callbacks (cbReadOnlySynch). This is needed to support --- IVI run. Currently, the GHDL simulation runs until --- complete once a single 'run' is performed... --- * You are loading '_'-prefixed symbols when you --- load the vpi plugin. On Linux, there is no leading --- '_'. I just added code to try both '_'-prefixed and --- non-'_'-prefixed symbols. I have placed the changed --- file in the same download dir as the snapshot --- * I did find out why restart doesn't work for GHDL. --- You are passing back the leaf name of signals when the --- FullName is requested. -------------------------------------------------------------------------------- - -with Ada.Unchecked_Deallocation; -with System.Storage_Elements; -- Work around GNAT bug. -pragma Unreferenced (System.Storage_Elements); -with Grt.Stdio; use Grt.Stdio; -with Grt.C; use Grt.C; -with Grt.Signals; use Grt.Signals; -with Grt.Table; -with Grt.Astdio; use Grt.Astdio; -with Grt.Hooks; use Grt.Hooks; -with Grt.Vcd; use Grt.Vcd; -with Grt.Errors; use Grt.Errors; -with Grt.Rtis_Types; -pragma Elaborate_All (Grt.Table); - -package body Grt.Vpi is - -- The VPI interface requires libdl (dlopen, dlsym) to be linked in. - -- This is now set in Makefile, since this is target dependent. - -- pragma Linker_Options ("-ldl"); - - --errAnyString: constant String := "grt-vcd.adb: any string" & NUL; - --errNoString: constant String := "grt-vcd.adb: no string" & NUL; - - type Vpi_Index_Type is new Integer; - -------------------------------------------------------------------------------- --- * * * h e l p e r s * * * * * * * * * * * * * * * * * * * * * * * * * * -------------------------------------------------------------------------------- - - ------------------------------------------------------------------------ - -- debugging helpers - procedure dbgPut (Str : String) - is - S : size_t; - pragma Unreferenced (S); - begin - S := fwrite (Str'Address, Str'Length, 1, stderr); - end dbgPut; - - procedure dbgPut (C : Character) - is - R : int; - pragma Unreferenced (R); - begin - R := fputc (Character'Pos (C), stderr); - end dbgPut; - - procedure dbgNew_Line is - begin - dbgPut (Nl); - end dbgNew_Line; - - procedure dbgPut_Line (Str : String) - is - begin - dbgPut (Str); - dbgNew_Line; - end dbgPut_Line; - --- procedure dbgPut_Line (Str : Ghdl_Str_Len_Type) --- is --- begin --- Put_Str_Len(stderr, Str); --- dbgNew_Line; --- end dbgPut_Line; - - procedure Free is new Ada.Unchecked_Deallocation - (Name => vpiHandle, Object => struct_vpiHandle); - - ------------------------------------------------------------------------ - -- NUL-terminate strings. - -- note: there are several buffers - -- see IEEE 1364-2001 --- tmpstring1: string(1..1024); --- function NulTerminate1 (Str : Ghdl_Str_Len_Type) return Ghdl_C_String --- is --- begin --- for i in 1..Str.Len loop --- tmpstring1(i):= Str.Str(i); --- end loop; --- tmpstring1(Str.Len+1):= NUL; --- return To_Ghdl_C_String (tmpstring1'Address); --- end NulTerminate1; - -------------------------------------------------------------------------------- --- * * * V P I f u n c t i o n s * * * * * * * * * * * * * * * * * * * * -------------------------------------------------------------------------------- - - ------------------------------------------------------------------------ - -- vpiHandle vpi_iterate(int type, vpiHandle ref) - -- Obtain an iterator handle to objects with a one-to-many relationship. - -- see IEEE 1364-2001, page 685 - function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle - is - Res : vpiHandle; - Rel : VhpiOneToManyT; - Error : AvhpiErrorT; - begin - --dbgPut_Line ("vpi_iterate"); - - case aType is - when vpiNet => - Rel := VhpiDecls; - when vpiModule => - if Ref = null then - Res := new struct_vpiHandle (vpiModule); - Get_Root_Inst (Res.Ref); - return Res; - else - Rel := VhpiInternalRegions; - end if; - when vpiInternalScope => - Rel := VhpiInternalRegions; - when others => - return null; - end case; - - -- find the proper start object for our scan - if Ref = null then - return null; - end if; - - Res := new struct_vpiHandle (aType); - Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error); - - if Error /= AvhpiErrorOk then - Free (Res); - end if; - return Res; - end vpi_iterate; - - ------------------------------------------------------------------------ - -- int vpi_get(int property, vpiHandle ref) - -- Get the value of an integer or boolean property of an object. - -- see IEEE 1364-2001, chapter 27.6, page 667 --- function ii_vpi_get_type (aRef: Ghdl_Instance_Name_Acc) return Integer --- is --- begin --- case aRef.Kind is --- when Ghdl_Name_Entity --- | Ghdl_Name_Architecture --- | Ghdl_Name_Block --- | Ghdl_Name_Generate_Iterative --- | Ghdl_Name_Generate_Conditional --- | Ghdl_Name_Instance => --- return vpiModule; --- when Ghdl_Name_Signal => --- return vpiNet; --- when others => --- return vpiUndefined; --- end case; --- end ii_vpi_get_type; - - function vpi_get (Property: integer; Ref: vpiHandle) return Integer - is - begin - case Property is - when vpiType=> - return Ref.mType; - when vpiTimePrecision=> - return -9; -- is this nano-seconds? - when others=> - dbgPut_Line ("vpi_get: unknown property"); - return 0; - end case; - end vpi_get; - - ------------------------------------------------------------------------ - -- vpiHandle vpi_scan(vpiHandle iter) - -- Scan the Verilog HDL hierarchy for objects with a one-to-many - -- relationship. - -- see IEEE 1364-2001, chapter 27.36, page 709 - function vpi_scan (Iter: vpiHandle) return vpiHandle - is - Res : VhpiHandleT; - Error : AvhpiErrorT; - R : vpiHandle; - begin - --dbgPut_Line ("vpi_scan"); - if Iter = null then - return null; - end if; - - -- There is only one top-level module. - if Iter.mType = vpiModule then - case Vhpi_Get_Kind (Iter.Ref) is - when VhpiRootInstK => - R := new struct_vpiHandle (Iter.mType); - R.Ref := Iter.Ref; - Iter.Ref := Null_Handle; - return R; - when VhpiUndefined => - return null; - when others => - -- Fall through. - null; - end case; - end if; - - loop - Vhpi_Scan (Iter.Ref, Res, Error); - exit when Error /= AvhpiErrorOk; - - case Vhpi_Get_Kind (Res) is - when VhpiEntityDeclK - | VhpiArchBodyK - | VhpiBlockStmtK - | VhpiIfGenerateK - | VhpiForGenerateK - | VhpiCompInstStmtK => - case Iter.mType is - when vpiInternalScope - | vpiModule => - return new struct_vpiHandle'(mType => vpiModule, - Ref => Res); - when others => - null; - end case; - when VhpiPortDeclK - | VhpiSigDeclK => - if Iter.mType = vpiNet then - declare - Info : Verilog_Wire_Info; - begin - Get_Verilog_Wire (Res, Info); - if Info.Kind /= Vcd_Bad then - return new struct_vpiHandle'(mType => vpiNet, - Ref => Res); - end if; - end; - end if; - when others => - null; - end case; - end loop; - return null; - end vpi_scan; - - ------------------------------------------------------------------------ - -- char *vpi_get_str(int property, vpiHandle ref) - -- see IEEE 1364-2001, page xxx - Tmpstring2 : String (1 .. 1024); - function vpi_get_str (Property : Integer; Ref : vpiHandle) - return Ghdl_C_String - is - Prop : VhpiStrPropertyT; - Len : Natural; - begin - --dbgPut_Line ("vpiGetStr"); - - if Ref = null then - return null; - end if; - - case Property is - when vpiFullName=> - Prop := VhpiFullNameP; - when vpiName=> - Prop := VhpiNameP; - when others=> - dbgPut_Line ("vpi_get_str: undefined property"); - return null; - end case; - Vhpi_Get_Str (Prop, Ref.Ref, Tmpstring2, Len); - Tmpstring2 (Len + 1) := NUL; - if Property = vpiFullName then - for I in Tmpstring2'First .. Len loop - if Tmpstring2 (I) = ':' then - Tmpstring2 (I) := '.'; - end if; - end loop; - -- Remove the initial '.'. - return To_Ghdl_C_String (Tmpstring2 (2)'Address); - else - return To_Ghdl_C_String (Tmpstring2'Address); - end if; - end vpi_get_str; - - ------------------------------------------------------------------------ - -- vpiHandle vpi_handle(int type, vpiHandle ref) - -- Obtain a handle to an object with a one-to-one relationship. - -- see IEEE 1364-2001, chapter 27.16, page 682 - function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle - is - Res : vpiHandle; - begin - --dbgPut_Line ("vpi_handle"); - - if Ref = null then - return null; - end if; - - case aType is - when vpiScope => - case Ref.mType is - when vpiModule => - Res := new struct_vpiHandle (vpiScope); - Res.Ref := Ref.Ref; - return Res; - when others => - return null; - end case; - when vpiRightRange - | vpiLeftRange => - case Ref.mType is - when vpiNet => - Res := new struct_vpiHandle (aType); - Res.Ref := Ref.Ref; - return Res; - when others => - return null; - end case; - when others => - return null; - end case; - end vpi_handle; - - ------------------------------------------------------------------------ - -- void vpi_get_value(vpiHandle expr, p_vpi_value value); - -- Retrieve the simulation value of an object. - -- see IEEE 1364-2001, chapter 27.14, page 675 - Tmpstring3idx : integer; - Tmpstring3 : String (1 .. 1024); - procedure ii_vpi_get_value_bin_str_B1 (Val : Ghdl_B1) - is - begin - case Val is - when True => - Tmpstring3 (Tmpstring3idx) := '1'; - when False => - Tmpstring3 (Tmpstring3idx) := '0'; - end case; - Tmpstring3idx := Tmpstring3idx + 1; - end ii_vpi_get_value_bin_str_B1; - - procedure ii_vpi_get_value_bin_str_E8 (Val : Ghdl_E8) - is - type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character; - Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-"; - begin - if Val not in Map_Type_E8'range then - Tmpstring3 (Tmpstring3idx) := '?'; - else - Tmpstring3 (Tmpstring3idx) := Map_Std_E8(Val); - end if; - Tmpstring3idx := Tmpstring3idx + 1; - end ii_vpi_get_value_bin_str_E8; - - function ii_vpi_get_value_bin_str (Obj : VhpiHandleT) - return Ghdl_C_String - is - Info : Verilog_Wire_Info; - Len : Ghdl_Index_Type; - begin - case Vhpi_Get_Kind (Obj) is - when VhpiPortDeclK - | VhpiSigDeclK => - null; - when others => - return null; - end case; - - -- Get verilog compat info. - Get_Verilog_Wire (Obj, Info); - if Info.Kind = Vcd_Bad then - return null; - end if; - - if Info.Irange = null then - Len := 1; - else - Len := Info.Irange.I32.Len; - end if; - - Tmpstring3idx := 1; -- reset string buffer - - case Info.Val is - when Vcd_Effective => - case Info.Kind is - when Vcd_Bad - | Vcd_Integer32 - | Vcd_Float64 => - return null; - when Vcd_Bit - | Vcd_Bool - | Vcd_Bitvector => - for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_B1 - (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B1); - end loop; - when Vcd_Stdlogic - | Vcd_Stdlogic_Vector => - for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_E8 - (To_Signal_Arr_Ptr (Info.Addr)(J).Value.E8); - end loop; - end case; - when Vcd_Driving => - case Info.Kind is - when Vcd_Bad - | Vcd_Integer32 - | Vcd_Float64 => - return null; - when Vcd_Bit - | Vcd_Bool - | Vcd_Bitvector => - for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_B1 - (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B1); - end loop; - when Vcd_Stdlogic - | Vcd_Stdlogic_Vector => - for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_E8 - (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.E8); - end loop; - end case; - end case; - Tmpstring3 (Tmpstring3idx) := NUL; - return To_Ghdl_C_String (Tmpstring3'Address); - end ii_vpi_get_value_bin_str; - - procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value) - is - begin - case Value.Format is - when vpiObjTypeVal=> - -- fill in the object type and value: - -- For an integer, vpiIntVal - -- For a real, vpiRealVal - -- For a scalar, either vpiScalar or vpiStrength - -- For a time variable, vpiTimeVal with vpiSimTime - -- For a vector, vpiVectorVal - dbgPut_Line ("vpi_get_value: vpiObjTypeVal"); - when vpiBinStrVal=> - Value.Str := ii_vpi_get_value_bin_str (Expr.Ref); - --aValue.mStr := NulTerminate2(aExpr.mRef.Name.all); - when vpiOctStrVal=> - dbgPut_Line("vpi_get_value: vpiNet, vpiOctStrVal"); - when vpiDecStrVal=> - dbgPut_Line("vpi_get_value: vpiNet, vpiDecStrVal"); - when vpiHexStrVal=> - dbgPut_Line("vpi_get_value: vpiNet, vpiHexStrVal"); - when vpiScalarVal=> - dbgPut_Line("vpi_get_value: vpiNet, vpiScalarVal"); - when vpiIntVal=> - case Expr.mType is - when vpiLeftRange - | vpiRightRange=> - declare - Info : Verilog_Wire_Info; - begin - Get_Verilog_Wire (Expr.Ref, Info); - if Info.Irange /= null then - if Expr.mType = vpiLeftRange then - Value.Integer_m := Integer (Info.Irange.I32.Left); - else - Value.Integer_m := Integer (Info.Irange.I32.Right); - end if; - else - Value.Integer_m := 0; - end if; - end; - when others=> - dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType"); - end case; - when vpiRealVal=> dbgPut_Line("vpi_get_value: vpiRealVal"); - when vpiStringVal=> dbgPut_Line("vpi_get_value: vpiStringVal"); - when vpiTimeVal=> dbgPut_Line("vpi_get_value: vpiTimeVal"); - when vpiVectorVal=> dbgPut_Line("vpi_get_value: vpiVectorVal"); - when vpiStrengthVal=> dbgPut_Line("vpi_get_value: vpiStrengthVal"); - when others=> dbgPut_Line("vpi_get_value: unknown mFormat"); - end case; - end vpi_get_value; - - ------------------------------------------------------------------------ - -- void vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value, - -- p_vpi_time when, int flags) - -- Alter the simulation value of an object. - -- see IEEE 1364-2001, chapter 27.14, page 675 - -- FIXME - - procedure ii_vpi_put_value_bin_str_B1 (SigPtr : Ghdl_Signal_Ptr; - Value : Character) - is - Tempval : Value_Union; - begin - -- use the Set_Effective_Value procedure to update the signal - case Value is - when '0' => - Tempval.B1 := false; - when '1' => - Tempval.B1 := true; - when others => - dbgPut_Line("ii_vpi_put_value_bin_str_B1: " - & "wrong character - signal wont be set"); - return; - end case; - SigPtr.Driving_Value := Tempval; - Set_Effective_Value (SigPtr, Tempval); - end ii_vpi_put_value_bin_str_B1; - - procedure ii_vpi_put_value_bin_str_E8 (SigPtr : Ghdl_Signal_Ptr; - Value : Character) - is - Tempval : Value_Union; - begin - case Value is - when 'U' => - Tempval.E8 := 0; - when 'X' => - Tempval.E8 := 1; - when '0' => - Tempval.E8 := 2; - when '1' => - Tempval.E8 := 3; - when 'Z' => - Tempval.E8 := 4; - when 'W' => - Tempval.E8 := 5; - when 'L' => - Tempval.E8 := 6; - when 'H' => - Tempval.E8 := 7; - when '-' => - Tempval.E8 := 8; - when others => - dbgPut_Line("ii_vpi_put_value_bin_str_B8: " - & "wrong character - signal wont be set"); - return; - end case; - SigPtr.Driving_Value := Tempval; - Set_Effective_Value (SigPtr, Tempval); - end ii_vpi_put_value_bin_str_E8; - - - procedure ii_vpi_put_value_bin_str(Obj : VhpiHandleT; - ValueStr : Ghdl_C_String) - is - Info : Verilog_Wire_Info; - Len : Ghdl_Index_Type; - begin - -- Check the Obj type. - -- * The vpiHandle has a reference (field Ref) to a VhpiHandleT - -- when it doesnt come from a callback. - case Vhpi_Get_Kind(Obj) is - when VhpiPortDeclK - | VhpiSigDeclK => - null; - when others => - return; - end case; - - -- The following code segment was copied from the - -- ii_vpi_get_value function. - -- Get verilog compat info. - Get_Verilog_Wire (Obj, Info); - if Info.Kind = Vcd_Bad then - return; - end if; - - if Info.Irange = null then - Len := 1; - else - Len := Info.Irange.I32.Len; - end if; - - -- Step 1: convert vpi object to internal format. - -- p_vpi_handle -> Ghdl_Signal_Ptr - -- To_Signal_Arr_Ptr (Info.Addr) does part of the magic - - -- Step 2: convert datum to appropriate type. - -- Ghdl_C_String -> Value_Union - - -- Step 3: assigns value to object using Set_Effective_Value - -- call (from grt-signals) - -- Set_Effective_Value(sig_ptr, conv_value); - - - -- Took the skeleton from ii_vpi_get_value function - -- This point of the function must convert the string value to the - -- native ghdl format. - case Info.Kind is - when Vcd_Bad => - return; - when Vcd_Bit - | Vcd_Bool - | Vcd_Bitvector => - for J in 0 .. Len - 1 loop - ii_vpi_put_value_bin_str_B1( - To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); - end loop; - when Vcd_Stdlogic - | Vcd_Stdlogic_Vector => - for J in 0 .. Len - 1 loop - ii_vpi_put_value_bin_str_E8( - To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); - end loop; - when Vcd_Integer32 - | Vcd_Float64 => - null; - end case; - - -- Always return null, because this simulation kernel cannot send - -- a handle to the event back. - return; - end ii_vpi_put_value_bin_str; - - - -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value, - -- p_vpi_time when, int flags) - function vpi_put_value (aObj: vpiHandle; - aValue: p_vpi_value; - aWhen: p_vpi_time; - aFlags: integer) - return vpiHandle - is - pragma Unreferenced (aWhen); - pragma Unreferenced (aFlags); - begin - -- A very simple write procedure for VPI. - -- Basically, it accepts bin_str values and converts to appropriate - -- types (only std_logic and bit values and vectors). - - -- It'll use Set_Effective_Value procedure to update signals - - -- Ignoring aWhen and aFlags, for now. - - -- Checks the format of aValue. Only vpiBinStrVal will be accepted - -- for now. - case aValue.Format is - when vpiObjTypeVal => - dbgPut_Line ("vpi_put_value: vpiObjTypeVal"); - when vpiBinStrVal => - ii_vpi_put_value_bin_str(aObj.Ref, aValue.Str); - -- dbgPut_Line ("vpi_put_value: vpiBinStrVal"); - when vpiOctStrVal => - dbgPut_Line ("vpi_put_value: vpiNet, vpiOctStrVal"); - when vpiDecStrVal => - dbgPut_Line ("vpi_put_value: vpiNet, vpiDecStrVal"); - when vpiHexStrVal => - dbgPut_Line ("vpi_put_value: vpiNet, vpiHexStrVal"); - when vpiScalarVal => - dbgPut_Line ("vpi_put_value: vpiNet, vpiScalarVal"); - when vpiIntVal => - dbgPut_Line ("vpi_put_value: vpiIntVal"); - when vpiRealVal => - dbgPut_Line("vpi_put_value: vpiRealVal"); - when vpiStringVal => - dbgPut_Line("vpi_put_value: vpiStringVal"); - when vpiTimeVal => - dbgPut_Line("vpi_put_value: vpiTimeVal"); - when vpiVectorVal => - dbgPut_Line("vpi_put_value: vpiVectorVal"); - when vpiStrengthVal => - dbgPut_Line("vpi_put_value: vpiStrengthVal"); - when others => - dbgPut_Line("vpi_put_value: unknown mFormat"); - end case; - - -- Must return a scheduled event caused by vpi_put_value() - -- Still dont know how to do it. - return null; - end vpi_put_value; - - ------------------------------------------------------------------------ - -- void vpi_get_time(vpiHandle obj, s_vpi_time*t); - -- see IEEE 1364-2001, page xxx - Sim_Time : Std_Time; - procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time) - is - pragma Unreferenced (Obj); - begin - --dbgPut_Line ("vpi_get_time"); - Time.mType := vpiSimTime; - Time.mHigh := 0; - Time.mLow := Integer (Sim_Time / 1000000); - Time.mReal := 0.0; - end vpi_get_time; - - ------------------------------------------------------------------------ - -- vpiHandle vpi_register_cb(p_cb_data data) - g_cbEndOfCompile : p_cb_data; - g_cbEndOfSimulation: p_cb_data; - --g_cbValueChange: s_cb_data; - g_cbReadOnlySync: p_cb_data; - - type Vpi_Var_Type is record - Info : Verilog_Wire_Info; - Cb : s_cb_data; - end record; - - package Vpi_Table is new Grt.Table - (Table_Component_Type => Vpi_Var_Type, - Table_Index_Type => Vpi_Index_Type, - Table_Low_Bound => 0, - Table_Initial => 32); - - function vpi_register_cb (Data : p_cb_data) return vpiHandle - is - Res : p_cb_data := null; - begin - --dbgPut_Line ("vpi_register_cb"); - case Data.Reason is - when cbEndOfCompile => - Res := new s_cb_data'(Data.all); - g_cbEndOfCompile := Res; - Sim_Time:= 0; - when cbEndOfSimulation => - Res := new s_cb_data'(Data.all); - g_cbEndOfSimulation := Res; - when cbValueChange => - declare - N : Vpi_Index_Type; - begin - --g_cbValueChange:= aData.all; - Vpi_Table.Increment_Last; - N := Vpi_Table.Last; - Vpi_Table.Table (N).Cb := Data.all; - Get_Verilog_Wire (Data.Obj.Ref, Vpi_Table.Table (N).Info); - end; - when cbReadOnlySynch=> - Res := new s_cb_data'(Data.all); - g_cbReadOnlySync := Res; - when others=> - dbgPut_Line ("vpi_register_cb: unknwon reason"); - end case; - if Res /= null then - return new struct_vpiHandle'(mType => vpiCallback, - Cb => Res); - else - return null; - end if; - end vpi_register_cb; - -------------------------------------------------------------------------------- --- * * * V P I d u m m i e s * * * * * * * * * * * * * * * * * * * * * * -------------------------------------------------------------------------------- - - -- int vpi_free_object(vpiHandle ref) - function vpi_free_object (aRef: vpiHandle) return integer - is - pragma Unreferenced (aRef); - begin - return 0; - end vpi_free_object; - - -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p) - function vpi_get_vlog_info (aVlog_info_p: System.Address) return integer - is - pragma Unreferenced (aVlog_info_p); - begin - return 0; - end vpi_get_vlog_info; - - -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index) - function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer) - return vpiHandle - is - pragma Unreferenced (aRef); - pragma Unreferenced (aIndex); - begin - return null; - end vpi_handle_by_index; - - -- unsigned int vpi_mcd_close(unsigned int mcd) - function vpi_mcd_close (Mcd: integer) return integer - is - pragma Unreferenced (Mcd); - begin - return 0; - end vpi_mcd_close; - - -- char *vpi_mcd_name(unsigned int mcd) - function vpi_mcd_name (Mcd: integer) return integer - is - pragma Unreferenced (Mcd); - begin - return 0; - end vpi_mcd_name; - - -- unsigned int vpi_mcd_open(char *name) - function vpi_mcd_open (Name : Ghdl_C_String) return Integer - is - pragma Unreferenced (Name); - begin - return 0; - end vpi_mcd_open; - - -- void vpi_register_systf(const struct t_vpi_systf_data*ss) - procedure vpi_register_systf(aSs: System.Address) - is - pragma Unreferenced (aSs); - begin - null; - end vpi_register_systf; - - -- int vpi_remove_cb(vpiHandle ref) - function vpi_remove_cb (Ref : vpiHandle) return Integer - is - pragma Unreferenced (Ref); - begin - return 0; - end vpi_remove_cb; - - -- void vpi_vprintf(const char*fmt, va_list ap) - procedure vpi_vprintf (Fmt : Address; Ap : Address) - is - pragma Unreferenced (Fmt); - pragma Unreferenced (Ap); - begin - null; - end vpi_vprintf; - - -- missing here, see grt-cvpi.c: - -- vpi_mcd_open_x - -- vpi_mcd_vprintf - -- vpi_mcd_fputc - -- vpi_mcd_fgetc - -- vpi_sim_vcontrol - -- vpi_chk_error - -- pi_handle_by_name - ------------------------------------------------------------------------------- --- * * * G H D L h o o k s * * * * * * * * * * * * * * * * * * * * * * * ------------------------------------------------------------------------------- - - -- VCD filename. - Vpi_Filename : String_Access := null; - - ------------------------------------------------------------------------ - -- Return TRUE if OPT is an option for VPI. - function Vpi_Option (Opt : String) return Boolean - is - F : constant Natural := Opt'First; - begin - if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then - return False; - end if; - if Opt'Length > 6 and then Opt (F + 5) = '=' then - -- Add an extra NUL character. - Vpi_Filename := new String (1 .. Opt'Length - 6 + 1); - Vpi_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last); - Vpi_Filename (Vpi_Filename'Last) := NUL; - return True; - else - return False; - end if; - end Vpi_Option; - - ------------------------------------------------------------------------ - procedure Vpi_Help is - begin - Put_Line (" --vpi=FILENAME load VPI module"); - end Vpi_Help; - - ------------------------------------------------------------------------ - -- Called before elaboration. - - -- void loadVpiModule(const char* modulename) - function LoadVpiModule (Filename: Address) return Integer; - pragma Import (C, LoadVpiModule, "loadVpiModule"); - - - procedure Vpi_Init - is - begin - Sim_Time:= 0; - - --g_cbEndOfCompile.mCb_rtn:= null; - --g_cbEndOfSimulation.mCb_rtn:= null; - --g_cbValueChange.mCb_rtn:= null; - - if Vpi_Filename /= null then - if LoadVpiModule (Vpi_Filename.all'Address) /= 0 then - Error ("cannot load VPI module"); - end if; - end if; - end Vpi_Init; - - procedure Vpi_Cycle; - - ------------------------------------------------------------------------ - -- Called after elaboration. - procedure Vpi_Start - is - Res : Integer; - pragma Unreferenced (Res); - begin - if Vpi_Filename = null then - return; - end if; - - Grt.Rtis_Types.Search_Types_RTI; - Register_Cycle_Hook (Vpi_Cycle'Access); - if g_cbEndOfCompile /= null then - Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile); - end if; - end Vpi_Start; - - ------------------------------------------------------------------------ - -- Called before each non delta cycle. - procedure Vpi_Cycle - is - Res : Integer; - pragma Unreferenced (Res); - begin - if g_cbReadOnlySync /= null - and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000) - then - Res := g_cbReadOnlySync.Cb_Rtn.all (g_cbReadOnlySync); - end if; - - for I in Vpi_Table.First .. Vpi_Table.Last loop - if Verilog_Wire_Changed (Vpi_Table.Table (I).Info, Sim_Time) then - Res := Vpi_Table.Table (I).Cb.Cb_Rtn.all - (To_p_cb_data (Vpi_Table.Table (I).Cb'Address)); - end if; - end loop; - - if Current_Time /= Std_Time'last then - Sim_Time:= Current_Time; - end if; - end Vpi_Cycle; - - ------------------------------------------------------------------------ - -- Called at the end of the simulation. - procedure Vpi_End - is - Res : Integer; - pragma Unreferenced (Res); - begin - if g_cbEndOfSimulation /= null then - Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation); - end if; - end Vpi_End; - - Vpi_Hooks : aliased constant Hooks_Type := - (Option => Vpi_Option'Access, - Help => Vpi_Help'Access, - Init => Vpi_Init'Access, - Start => Vpi_Start'Access, - Finish => Vpi_End'Access); - - procedure Register is - begin - Register_Hooks (Vpi_Hooks'Access); - end Register; -end Grt.Vpi; |