diff options
Diffstat (limited to 'src/grt/grt-vpi.adb')
| -rw-r--r-- | src/grt/grt-vpi.adb | 507 |
1 files changed, 454 insertions, 53 deletions
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 136010a77..f1305e1db 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -66,6 +66,8 @@ package body Grt.Vpi is -- If true, emit traces Flag_Trace : Boolean := False; + Trace_File : FILEs; + Trace_Indent : Natural := 0; ------------------------------------------------------------------------------- -- * * * h e l p e r s * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -132,10 +134,147 @@ package body Grt.Vpi is procedure Vpi_Trace (Msg : String) is begin if Flag_Trace then - Put_Line (Msg); + Put_Line (Trace_File, Msg); end if; end Vpi_Trace; + procedure Trace_Start (Msg : String) is + begin + for I in 1 .. Trace_Indent loop + Put (Trace_File, ' '); + end loop; + Put (Trace_File, Msg); + end Trace_Start; + + procedure Trace (Msg : String) is + begin + Put (Trace_File, Msg); + end Trace; + + procedure Trace (V : Integer) is + begin + Put_I32 (Trace_File, Ghdl_I32 (V)); + end Trace; + + procedure Trace_Cb_Reason (V : Integer) is + begin + case V is + when cbValueChange => + Trace ("cbValueChange"); + when cbReadWriteSynch => + Trace ("cbReadWriteSynch"); + when cbReadOnlySynch => + Trace ("cbReadOnlySynch"); + when cbNextSimTime => + Trace ("cbNextSimTime"); + when cbAfterDelay => + Trace ("cbAfterDelay"); + when cbEndOfCompile => + Trace ("cbEndOfCompile"); + when cbStartOfSimulation => + Trace ("cbStartOfSimulation"); + when cbEndOfSimulation => + Trace ("cbEndOfSimulation"); + when others => + Trace (V); + end case; + end Trace_Cb_Reason; + + procedure Trace_Property (V : Integer) is + begin + case V is + when vpiUndefined => + Trace ("vpiUndefined"); + when vpiType => + Trace ("vpiType"); + when vpiName => + Trace ("vpiName"); + when vpiFullName => + Trace ("vpiFullName"); + when vpiSize => + Trace ("vpiSize"); + when vpiTimePrecision => + Trace ("vpiTimePrecision"); + when vpiScalar => + Trace ("vpiScalar"); + when vpiVector => + Trace ("vpiVector"); + + when vpiModule => + Trace ("vpiModule"); + when vpiNet => + Trace ("vpiNet"); + when vpiScope => + Trace ("vpiScope"); + when vpiInternalScope => + Trace ("vpiInternalScope"); + when vpiLeftRange => + Trace ("vpiLeftRange"); + when vpiRightRange => + Trace ("vpiRightRange"); + + when others => + Trace (V); + end case; + end Trace_Property; + + procedure Trace_Time_Tag (V : Integer) is + begin + case V is + when vpiSimTime => + Trace ("vpiSimTime"); + when others => + Trace (V); + end case; + end Trace_Time_Tag; + + procedure Trace (H : vpiHandle) + is + function To_Address is + new Ada.Unchecked_Conversion (vpiHandle, System.Address); + begin + Put (Trace_File, To_Address (H)); + end Trace; + + procedure Trace (Str : Ghdl_C_String) is + begin + Put (Trace_File, '"'); + Put (Trace_File, Str); + Put (Trace_File, '"'); + end Trace; + + procedure Trace_Time (V : Std_Time) is + begin + Put_Time (Trace_File, V); + end Trace_Time; + + procedure Trace_Value (V : p_vpi_value) is + begin + case V.Format is + when vpiBinStrVal + | vpiOctStrVal + | vpiDecStrVal + | vpiHexStrVal + | vpiStringVal => + Trace (V.Str); + when vpiScalarVal => + Trace (V.Scalar); + when vpiIntVal => + Trace (V.Integer_m); + --when vpiRealVal=> null; -- what is the equivalent to double? + --when vpiTimeVal=> mTime: p_vpi_time; + --when vpiVectorVal=> mVector: p_vpi_vecval; + --when vpiStrengthVal=> mStrength: p_vpi_strengthval; + when others => + null; + end case; + end Trace_Value; + + procedure Trace_Newline is + begin + New_Line (Trace_File); + end Trace_Newline; + function Vpi_Time_To_Time (V : s_vpi_time) return Std_Time is Res : Std_Time; begin @@ -154,16 +293,13 @@ package body Grt.Vpi is -- 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 + function Vpi_Iterate_Internal + (aType: integer; Ref: vpiHandle) return vpiHandle is Res : vpiHandle; Rel : VhpiOneToManyT; Error : AvhpiErrorT; begin - Vpi_Trace ("vpi_iterate"); - - Reset_Error; - case aType is when vpiNet => Rel := VhpiDecls; @@ -183,15 +319,38 @@ package body Grt.Vpi is -- find the proper start object for our scan if Ref = null then - return null; + Res := null; + else + Res := new struct_vpiHandle (aType); + Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error); + + if Error /= AvhpiErrorOk then + Free (Res); + end if; + end if; + + return Res; + end Vpi_Iterate_Internal; + + function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle + is + Res : vpiHandle; + begin + if Flag_Trace then + Trace_Start ("vpi_iterate ("); + Trace_Property (aType); + Trace (", "); + Trace (Ref); + Trace (") = "); end if; - Res := new struct_vpiHandle (aType); - Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error); + Res := Vpi_Iterate_Internal (aType, Ref); - if Error /= AvhpiErrorOk then - Free (Res); + if Flag_Trace then + Trace (Res); + Trace_Newline; end if; + return Res; end vpi_iterate; @@ -217,19 +376,75 @@ package body Grt.Vpi is -- end case; -- end ii_vpi_get_type; - function vpi_get (Property: integer; Ref: vpiHandle) return Integer is + function Vpi_Get_Size (Ref : vpiHandle) return Integer + is + Info : Verilog_Wire_Info; + begin + Get_Verilog_Wire (Ref.Ref, Info); + if Info.Kind /= Vcd_Bad then + return Natural (Get_Wire_Length (Info)); + else + return 0; + end if; + end Vpi_Get_Size; + + function Vpi_Get_Vector (Ref : vpiHandle) return Boolean + is + Info : Verilog_Wire_Info; + begin + Get_Verilog_Wire (Ref.Ref, Info); + case Info.Kind is + when Vcd_Bool + | Vcd_Integer32 + | Vcd_Float64 + | Vcd_Bit + | Vcd_Stdlogic => + return False; + when Vcd_Bitvector + | Vcd_Stdlogic_Vector => + return True; + when Vcd_Bad => + return False; + end case; + end Vpi_Get_Vector; + + function vpi_get (Property: integer; Ref: vpiHandle) return Integer + is + Res : Integer; begin - Vpi_Trace ("vpi_get"); + if Flag_Trace then + Trace_Start ("vpi_get ("); + Trace_Property (Property); + Trace (", "); + Trace (Ref); + Trace (") = "); + end if; case Property is - when vpiType=> - return Ref.mType; - when vpiTimePrecision=> - return -9; -- is this nano-seconds? + when vpiType => + Res := Ref.mType; + when vpiTimePrecision => + Res := -9; -- is this nano-seconds? + when vpiSize => + Res := Vpi_Get_Size (Ref); + when vpiVector => + Res := Boolean'Pos (Vpi_Get_Vector (Ref)); when others=> dbgPut_Line ("vpi_get: unknown property"); - return 0; + Res := 0; end case; + + if Flag_Trace then + case Property is + when vpiType => + Trace_Property (Res); + when others => + Trace (Res); + end case; + Trace_Newline; + end if; + + return Res; end vpi_get; function Vhpi_Handle_To_Vpi_Prop (Res : VhpiHandleT) return Integer is @@ -278,15 +493,13 @@ package body Grt.Vpi is -- 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 + function Vpi_Scan_Internal (Iter: vpiHandle) return vpiHandle is Res : VhpiHandleT; Error : AvhpiErrorT; R : vpiHandle; Kind, Expected_Kind : Integer; begin - Vpi_Trace ("vpi_scan"); - if Iter = null then return null; end if; @@ -327,20 +540,39 @@ package body Grt.Vpi is end if; end loop; return null; + end Vpi_Scan_Internal; + + function vpi_scan (Iter: vpiHandle) return vpiHandle + is + Res : vpiHandle; + begin + if Flag_Trace then + Trace_Start ("vpi_scan ("); + Trace (Iter); + Trace (") = "); + end if; + + Res := Vpi_Scan_Internal (Iter); + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + + return Res; 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 + function Vpi_Get_Str_Internal (Property : Integer; Ref : vpiHandle) + return Ghdl_C_String is Prop : VhpiStrPropertyT; Len : Natural; + Res : Ghdl_C_String; begin - Vpi_Trace ("vpi_get_str"); - if Ref = null then return null; end if; @@ -363,22 +595,45 @@ package body Grt.Vpi is end if; end loop; -- Remove the initial '.'. - return To_Ghdl_C_String (Tmpstring2 (2)'Address); + Res := To_Ghdl_C_String (Tmpstring2 (2)'Address); else - return To_Ghdl_C_String (Tmpstring2'Address); + Res := To_Ghdl_C_String (Tmpstring2'Address); end if; - end vpi_get_str; + return Res; + end Vpi_Get_Str_Internal; + + function vpi_get_str (Property : Integer; Ref : vpiHandle) + return Ghdl_C_String + is + Res : Ghdl_C_String; + begin + if Flag_Trace then + Trace_Start ("vpi_get_str ("); + Trace_Property (Property); + Trace (", "); + Trace (Ref); + Trace (") = "); + end if; + + Res := Vpi_Get_Str_Internal (Property, Ref); + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + + return Res; + 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 + function Vpi_Handle_Internal + (aType : Integer; Ref : vpiHandle) return vpiHandle is Res : vpiHandle; begin - Vpi_Trace ("vpi_handle"); - if Ref = null then return null; end if; @@ -406,6 +661,28 @@ package body Grt.Vpi is when others => return null; end case; + end Vpi_Handle_Internal; + + function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle + is + Res : vpiHandle; + begin + if Flag_Trace then + Trace_Start ("vpi_handle ("); + Trace_Property (aType); + Trace (", "); + Trace (Ref); + Trace (") = "); + end if; + + Res := Vpi_Handle_Internal (aType, Ref); + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + + return Res; end vpi_handle; ------------------------------------------------------------------------ @@ -513,7 +790,13 @@ package body Grt.Vpi is procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value) is begin - Vpi_Trace ("vpi_get_value"); + if Flag_Trace then + Trace_Start ("vpi_get_value ("); + Trace (Expr); + Trace (", {format="); + Trace (Value.Format); + Trace ("}) = "); + end if; case Value.Format is when vpiObjTypeVal=> @@ -563,6 +846,11 @@ package body Grt.Vpi is when vpiStrengthVal=> dbgPut_Line("vpi_get_value: vpiStrengthVal"); when others=> dbgPut_Line("vpi_get_value: unknown mFormat"); end case; + + if Flag_Trace then + Trace_Value (Value); + Trace_Newline; + end if; end vpi_get_value; ------------------------------------------------------------------------ @@ -683,7 +971,15 @@ package body Grt.Vpi is Info : Verilog_Wire_Info; Len : Ghdl_Index_Type; begin - Vpi_Trace ("vpi_put_value"); + if Flag_Trace then + Trace_Start ("vpi_put_value ("); + Trace (aObj); + Trace (", "); + Trace_Value (aValue); + Trace (")"); + Trace_Newline; + end if; + Reset_Error; -- A very simple write procedure for VPI. @@ -778,11 +1074,18 @@ package body Grt.Vpi is -- see IEEE 1364-2001, page xxx procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time) is - function To_Unsigned_64 is new Ada.Unchecked_Conversion - (Std_Time, Unsigned_64); + function To_Unsigned_64 is + new Ada.Unchecked_Conversion (Std_Time, Unsigned_64); + Res : Std_Time; V : Unsigned_64; begin - Vpi_Trace ("vpi_get_time"); + if Flag_Trace then + Trace_Start ("vpi_get_time ("); + Trace (Obj); + Trace (", {mtype="); + Trace_Time_Tag (Time.mType); + Trace ("}) = "); + end if; if Obj /= null or else Time.mType /= vpiSimTime @@ -791,10 +1094,17 @@ package body Grt.Vpi is return; end if; - V := To_Unsigned_64 (Current_Time) / 1000; + Res := Current_Time; + + V := To_Unsigned_64 (Res) / 1000; Time.mHigh := Unsigned_32 (V / 2 ** 32); Time.mLow := Unsigned_32 (V mod 2 ** 32); Time.mReal := 0.0; + + if Flag_Trace then + Trace_Time (Res); + Trace_Newline; + end if; end vpi_get_time; ------------------------------------------------------------------------ @@ -851,8 +1161,21 @@ package body Grt.Vpi is is Hand : constant vpiHandle := To_vpiHandle (Arg); begin - Vpi_Trace ("vpi: call callback"); + if Flag_Trace then + Trace_Start ("vpi call callback "); + Trace_Cb_Reason (Hand.Cb.Reason); + Trace (" "); + Trace (Hand); + Trace_Newline; + Trace_Indent := Trace_Indent + 1; + end if; Execute_Callback (Hand); + if Flag_Trace then + Trace_Indent := Trace_Indent - 1; + Trace_Start ("vpi end callback "); + Trace (Hand); + Trace_Newline; + end if; end Call_Callback; procedure Call_Valuechange_Callback (Arg : System.Address) @@ -863,8 +1186,7 @@ package body Grt.Vpi is -- Note: the call may remove H from the list, or even -- destroy it. -- However, we assume it doesn't remove the next callback... - Vpi_Trace ("vpi: call valuechange cb"); - Execute_Callback (Hand); + Call_Callback (Arg); end if; end Call_Valuechange_Callback; @@ -891,7 +1213,20 @@ package body Grt.Vpi is Res : vpiHandle; T : Std_Time; begin - Vpi_Trace ("vpi_register_cb"); + if Flag_Trace then + Trace_Start ("vpi_register_cb ({reason="); + Trace_Cb_Reason (Data.Reason); + Trace (", obj="); + Trace (Data.Obj); + case Data.Reason is + when cbAfterDelay => + Trace (", time="); + Trace_Time (Vpi_Time_To_Time (Data.Time.all)); + when others => + null; + end case; + Trace ("}) = "); + end if; Res := new struct_vpiHandle (vpiCallback); Res.Cb := Data.all; @@ -930,8 +1265,13 @@ package body Grt.Vpi is when others => dbgPut_Line ("vpi_register_cb: unknown reason"); Free (Res); - return null; end case; + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + return Res; end vpi_register_cb; @@ -1017,16 +1357,15 @@ package body Grt.Vpi is end loop; end Find_By_Name; - function vpi_handle_by_name (Name : Ghdl_C_String; Scope : vpiHandle) - return vpiHandle + function Vpi_Handle_By_Name_Internal + (Name : Ghdl_C_String; Scope : vpiHandle) return vpiHandle is B, E : Natural; Base, El : VhpiHandleT; Err : AvhpiErrorT; Prop : Integer; + Res : vpiHandle; begin - Vpi_Trace ("vpi_handle_by_name"); - -- Extract the start point. if Scope = null then Get_Root_Scope (Base); @@ -1075,10 +1414,35 @@ package body Grt.Vpi is Prop := Vhpi_Handle_To_Vpi_Prop (Base); if Prop /= vpiUndefined then - return Build_vpiHandle (Base, Prop); + Res := Build_vpiHandle (Base, Prop); else - return null; + Res := null; end if; + + return Res; + end Vpi_Handle_By_Name_Internal; + + function vpi_handle_by_name (Name : Ghdl_C_String; Scope : vpiHandle) + return vpiHandle + is + Res : vpiHandle; + begin + if Flag_Trace then + Trace_Start ("vpi_handle_by_name ("); + Trace (Name); + Trace (", "); + Trace (Scope); + Trace (") = "); + end if; + + Res := Vpi_Handle_By_Name_Internal (Name, Scope); + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + + return Res; end vpi_handle_by_name; -- unsigned int vpi_mcd_close(unsigned int mcd) @@ -1117,9 +1481,16 @@ package body Grt.Vpi is function vpi_remove_cb (Ref : vpiHandle) return Integer is Ref_Copy : vpiHandle; + Res : Integer; begin - Vpi_Trace ("vpi_remove_cb"); + if Flag_Trace then + Trace_Start ("vpi_remove_cb ("); + Trace (Ref); + Trace (") = "); + end if; + Res := 1; + Ref_Copy := Ref; case Ref.Cb.Reason is when cbValueChange => Delete_Callback (Ref.Cb_Handle); @@ -1127,11 +1498,17 @@ package body Grt.Vpi is | cbReadOnlySynch => Delete_Callback (Ref.Cb_Handle); when others => - return 0; + Res := 0; + Ref_Copy := null; end case; - Ref_Copy := Ref; Free (Ref_Copy); - return 1; + + if Flag_Trace then + Trace (Res); + Trace_Newline; + end if; + + return Res; end vpi_remove_cb; -- void vpi_vprintf(const char*fmt, va_list ap) @@ -1221,7 +1598,30 @@ package body Grt.Vpi is Vpi_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last); Vpi_Filename (Vpi_Filename'Last) := NUL; return True; - elsif Opt = "--vpi-trace" then + elsif Opt'Length >= 11 and then Opt (F + 5 .. F + 10) = "-trace" then + if Opt'Length > 11 and then Opt (F + 11) = '=' then + declare + Filename : String (1 .. Opt'Length - 11); + Mode : constant String := "wt" & NUL; + begin + Filename (1 .. Filename'Last - 1) := Opt (F + 12 .. Opt'Last); + Filename (Filename'Last) := NUL; + Trace_File := fopen (Filename'Address, Mode'Address); + if Trace_File = NULL_Stream then + Error_C ("cannot open vpi trace file '"); + Error_C (Opt (F + 12 .. Opt'Last)); + Error_E ("'"); + return False; + end if; + end; + elsif Opt'Length = 11 then + Trace_File := stdout; + else + Error_C ("incorrect option '"); + Error_C (Opt); + Error_E ("'"); + return False; + end if; Flag_Trace := True; return True; else @@ -1233,6 +1633,7 @@ package body Grt.Vpi is procedure Vpi_Help is begin Put_Line (" --vpi=FILENAME load VPI module"); + Put_Line (" --vpi-trace[=FILE] trace vpi calls to FILE"); end Vpi_Help; ------------------------------------------------------------------------ |