diff options
author | Tristan Gingold <tgingold@free.fr> | 2021-06-10 07:57:05 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2021-06-10 07:57:05 +0200 |
commit | c64e7ba56376b933cb0ddb2b4949a83c926a3c67 (patch) | |
tree | 83462d67da076ab04a2dab0462e248d5cff58a57 /src | |
parent | 1bf8aa85f2adbfb7d56a0aea66f52615889bb7bc (diff) | |
download | ghdl-c64e7ba56376b933cb0ddb2b4949a83c926a3c67.tar.gz ghdl-c64e7ba56376b933cb0ddb2b4949a83c926a3c67.tar.bz2 ghdl-c64e7ba56376b933cb0ddb2b4949a83c926a3c67.zip |
vpi: handle get_value for indexed names. Fix #237
Diffstat (limited to 'src')
-rw-r--r-- | src/grt/grt-avhpi.adb | 302 | ||||
-rw-r--r-- | src/grt/grt-avhpi.ads | 20 | ||||
-rw-r--r-- | src/grt/grt-vcd.adb | 14 | ||||
-rw-r--r-- | src/grt/grt-vpi.adb | 231 | ||||
-rw-r--r-- | src/grt/grt-vpi.ads | 8 |
5 files changed, 411 insertions, 164 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index 143596fef..32365ef82 100644 --- a/src/grt/grt-avhpi.adb +++ b/src/grt/grt-avhpi.adb @@ -124,8 +124,8 @@ package body Grt.Avhpi is end case; when VhpiIndexedNames => case Ref.Kind is - when VhpiGenericDeclK | - VhpiConstDeclK=> + when VhpiGenericDeclK + | VhpiConstDeclK=> Res := (Kind => AvhpiNameIteratorK, Ctxt => Ref.Ctxt, N_Addr => Avhpi_Get_Address (Ref), @@ -183,11 +183,13 @@ package body Grt.Avhpi is El_Type1 : Ghdl_Rti_Access; begin case Obj_Rti.Common.Kind is - when Ghdl_Rtik_Generic | - Ghdl_Rtik_Constant => + when Ghdl_Rtik_Generic + | Ghdl_Rtik_Constant => Is_Sig := False; + when Ghdl_Rtik_Signal => + Is_Sig := True; when others => - Internal_Error ("add_index"); + Internal_Error ("add_index(1)"); end case; if El_Type.Kind = Ghdl_Rtik_Subtype_Scalar then @@ -219,7 +221,7 @@ package body Grt.Avhpi is end if; end; when others => - Internal_Error ("add_index"); + Internal_Error ("add_index(2)"); end case; return Obj_Base + Off * El_Size; end Add_Index; @@ -845,6 +847,7 @@ package body Grt.Avhpi is begin -- Default error. Error := AvhpiErrorNotImplemented; + Res := Null_Handle; case Rel is when VhpiDesignUnit => @@ -876,6 +879,7 @@ package body Grt.Avhpi is when others => return; end case; + when VhpiPrimaryUnit => case Ref.Kind is when VhpiArchBodyK => @@ -893,6 +897,7 @@ package body Grt.Avhpi is when others => return; end case; + when VhpiIterScheme => case Ref.Kind is when VhpiForGenerateK => @@ -910,19 +915,26 @@ package body Grt.Avhpi is when others => return; end case; + when VhpiSubtype => case Ref.Kind is when VhpiPortDeclK - | VhpiSigDeclK - | VhpiGenericDeclK - | VhpiConstDeclK => + | VhpiSigDeclK + | VhpiGenericDeclK + | VhpiConstDeclK => Res := (Kind => VhpiSubtypeIndicK, Ctxt => Ref.Ctxt, Atype => Ref.Obj.Obj_Type); Error := AvhpiErrorOk; + when VhpiIndexedNameK => + Res := (Kind => VhpiSubtypeIndicK, + Ctxt => Ref.Ctxt, + Atype => Ref.N_Type); + Error := AvhpiErrorOk; when others => return; end case; + when VhpiTypeMark => case Ref.Kind is when VhpiSubtypeIndicK => @@ -935,17 +947,19 @@ package body Grt.Avhpi is when others => return; end case; + when VhpiBaseType => declare Atype : Ghdl_Rti_Access; begin case Ref.Kind is when VhpiSubtypeIndicK - | VhpiSubtypeDeclK - | VhpiArrayTypeDeclK => + | VhpiSubtypeDeclK + | VhpiArrayTypeDeclK => Atype := Ref.Atype; when VhpiGenericDeclK - | VhpiConstDeclK => + | VhpiConstDeclK + | VhpiSigDeclK => Atype := Ref.Obj.Obj_Type; when VhpiIndexedNameK => Atype := Ref.N_Type; @@ -974,6 +988,7 @@ package body Grt.Avhpi is return; end case; end; + when VhpiElemSubtype => declare Base_Type : Ghdl_Rti_Access; @@ -993,14 +1008,25 @@ package body Grt.Avhpi is Error := AvhpiErrorOk; end if; end; + + when VhpiBaseName => + case Ref.Kind is + when VhpiIndexedNameK => + Rti_To_Handle + (To_Ghdl_Rti_Access (Ref.N_Obj), Ref.Ctxt, Res); + if Res.Kind /= VhpiUndefined then + Error := AvhpiErrorOk; + end if; + when others => + null; + end case; + when others => - Res := Null_Handle; - Error := AvhpiErrorNotImplemented; + null; end case; end Vhpi_Handle; - procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT; - Ref : VhpiHandleT; + procedure Constraints_By_Index (Ref : VhpiHandleT; Index : Natural; Res : out VhpiHandleT; Error : out AvhpiErrorT) is @@ -1008,92 +1034,166 @@ package body Grt.Avhpi is -- Default error. Error := AvhpiErrorNotImplemented; + case Ref.Kind is + when VhpiSubtypeIndicK => + if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then + declare + Arr_Subtype : constant Ghdl_Rtin_Subtype_Composite_Acc + := To_Ghdl_Rtin_Subtype_Composite_Acc (Ref.Atype); + Basetype : constant Ghdl_Rtin_Type_Array_Acc := + To_Ghdl_Rtin_Type_Array_Acc (Arr_Subtype.Basetype); + Idx : constant Ghdl_Index_Type := Ghdl_Index_Type (Index); + Layout : Address; + Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1); + Range_Basetype : Ghdl_Rti_Access; + begin + if Idx not in 1 .. Basetype.Nbr_Dim then + Res := Null_Handle; + Error := AvhpiErrorBadIndex; + return; + end if; + -- constraint type is basetype.indexes (idx - 1) + Layout := Loc_To_Addr (Arr_Subtype.Common.Depth, + Arr_Subtype.Layout, Ref.Ctxt); + Bound_To_Range + (Array_Layout_To_Bounds (Layout), Basetype, Bounds); + Res := (Kind => VhpiIntRangeK, + Ctxt => Ref.Ctxt, + Rng_Type => Basetype.Indexes (Idx - 1), + Rng_Addr => Bounds (Idx - 1)); + Range_Basetype := Get_Base_Type (Res.Rng_Type); + case Range_Basetype.Kind is + when Ghdl_Rtik_Type_I32 => + null; + when Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 => + Res := (Kind => VhpiEnumRangeK, + Ctxt => Ref.Ctxt, + Rng_Type => Res.Rng_Type, + Rng_Addr => Res.Rng_Addr); + when others => + Internal_Error ("vhpi_handle_by_index/constraint"); + end case; + Error := AvhpiErrorOk; + end; + end if; + when others => + return; + end case; + end Constraints_By_Index; + + procedure Indexed_Names_By_Index (Ref : VhpiHandleT; + Index : Natural; + Res : out VhpiHandleT; + Error : out AvhpiErrorT) + is + Base_Type, El_Type : VhpiHandleT; + begin + -- Default error. + Error := AvhpiErrorNotImplemented; + + Vhpi_Handle (VhpiBaseType, Ref, Base_Type, Error); + if Error /= AvhpiErrorOk then + return; + end if; + if Vhpi_Get_Kind (Base_Type) /= VhpiArrayTypeDeclK then + Error := AvhpiErrorBadRel; + return; + end if; + Vhpi_Handle (VhpiElemSubtype, Base_Type, El_Type, Error); + if Error /= AvhpiErrorOk then + return; + end if; + Res := (Kind => VhpiIndexedNameK, + Ctxt => Ref.Ctxt, + N_Addr => Avhpi_Get_Address (Ref), + N_Type => El_Type.Atype, + N_Idx => Ghdl_Index_Type (Index), + N_Obj => Ref.Obj); + if Res.N_Addr = Null_Address then + Error := AvhpiErrorBadRel; + return; + end if; + -- Note: the index is a flat index (ie an offset). + -- TODO: check with length ? + Res.N_Addr := Add_Index (Res.Ctxt, Res.N_Addr, Res.N_Obj, Res.N_Type, + Ghdl_Index_Type (Index)); + end Indexed_Names_By_Index; + + procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT; + Ref : VhpiHandleT; + Index : Natural; + Res : out VhpiHandleT; + Error : out AvhpiErrorT) is + begin case Rel is when VhpiConstraints => - case Ref.Kind is - when VhpiSubtypeIndicK => - if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then - declare - Arr_Subtype : constant Ghdl_Rtin_Subtype_Composite_Acc - := To_Ghdl_Rtin_Subtype_Composite_Acc (Ref.Atype); - Basetype : constant Ghdl_Rtin_Type_Array_Acc := - To_Ghdl_Rtin_Type_Array_Acc (Arr_Subtype.Basetype); - Idx : constant Ghdl_Index_Type := - Ghdl_Index_Type (Index); - Layout : Address; - Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1); - Range_Basetype : Ghdl_Rti_Access; - begin - if Idx not in 1 .. Basetype.Nbr_Dim then - Res := Null_Handle; - Error := AvhpiErrorBadIndex; - return; - end if; - -- constraint type is basetype.indexes (idx - 1) - Layout := Loc_To_Addr (Arr_Subtype.Common.Depth, - Arr_Subtype.Layout, Ref.Ctxt); - Bound_To_Range - (Array_Layout_To_Bounds (Layout), Basetype, Bounds); - Res := (Kind => VhpiIntRangeK, - Ctxt => Ref.Ctxt, - Rng_Type => Basetype.Indexes (Idx - 1), - Rng_Addr => Bounds (Idx - 1)); - Range_Basetype := Get_Base_Type (Res.Rng_Type); - case Range_Basetype.Kind is - when Ghdl_Rtik_Type_I32 => - null; - when Ghdl_Rtik_Type_E8 - | Ghdl_Rtik_Type_E32 => - Res := (Kind => VhpiEnumRangeK, - Ctxt => Ref.Ctxt, - Rng_Type => Res.Rng_Type, - Rng_Addr => Res.Rng_Addr); - when others => - Internal_Error - ("vhpi_handle_by_index/constraint"); - end case; - Error := AvhpiErrorOk; - end; - end if; - when others => - return; - end case; + Constraints_By_Index (Ref, Index, Res, Error); + when VhpiIndexedNames => - declare - Base_Type, El_Type : VhpiHandleT; - begin - Vhpi_Handle (VhpiBaseType, Ref, Base_Type, Error); - if Error /= AvhpiErrorOk then - return; - end if; - if Vhpi_Get_Kind (Base_Type) /= VhpiArrayTypeDeclK then - Error := AvhpiErrorBadRel; - return; - end if; - Vhpi_Handle (VhpiElemSubtype, Base_Type, El_Type, Error); - if Error /= AvhpiErrorOk then - return; - end if; - Res := (Kind => VhpiIndexedNameK, - Ctxt => Ref.Ctxt, - N_Addr => Avhpi_Get_Address (Ref), - N_Type => El_Type.Atype, - N_Idx => Ghdl_Index_Type (Index), - N_Obj => Ref.Obj); - if Res.N_Addr = Null_Address then - Error := AvhpiErrorBadRel; - return; - end if; - Res.N_Addr := Add_Index - (Res.Ctxt, Res.N_Addr, Res.N_Obj, Res.N_Type, - Ghdl_Index_Type (Index)); - end; + Indexed_Names_By_Index (Ref, Index, Res, Error); + when others => Res := Null_Handle; Error := AvhpiErrorNotImplemented; end case; end Vhpi_Handle_By_Index; + procedure Vhpi_Handle_By_Array_Index (Ref : VhpiHandleT; + Index : VhpiIntT; + Res : out VhpiHandleT; + Error : out AvhpiErrorT) + is + Typ : VhpiHandleT; + Rng : VhpiHandleT; + Is_Up : VhpiIntT; + Left, Right : VhpiIntT; + Off : Natural; + begin + -- Get object subtype. + Vhpi_Handle (VhpiSubtype, Ref, Typ, Error); + if Error /= AvhpiErrorOk then + return; + end if; + + -- Get the range + Vhpi_Handle_By_Index (VhpiConstraints, Typ, 1, Rng, Error); + if Error /= AvhpiErrorOk then + return; + end if; + + -- Get the range bounds + Vhpi_Get (VhpiIsUpP, Rng, Is_Up, Error); + if Error /= AvhpiErrorOk then + return; + end if; + Vhpi_Get (VhpiLeftBoundP, Rng, Left, Error); + if Error /= AvhpiErrorOk then + return; + end if; + Vhpi_Get (VhpiRightBoundP, Rng, Right, Error); + if Error /= AvhpiErrorOk then + return; + end if; + + -- Compute the offset + if Is_Up /= 0 then + if Index < Left or Index > Right then + Error := AvhpiErrorBadIndex; + return; + end if; + Off := Natural (Index - Left); + else + if Index > Left or Index < Right then + Error := AvhpiErrorBadIndex; + return; + end if; + Off := Natural (Left - Index); + end if; + + Indexed_Names_By_Index (Ref, Off, Res, Error); + end Vhpi_Handle_By_Array_Index; + procedure Vhpi_Get (Property : VhpiIntPropertyT; Obj : VhpiHandleT; Res : out VhpiIntT; @@ -1104,6 +1204,20 @@ package body Grt.Avhpi is Error := AvhpiErrorNotImplemented; case Property is + when VhpiIsUpP => + if Obj.Kind /= VhpiIntRangeK then + Res := 0; + Error := AvhpiErrorBadRel; + return; + end if; + Error := AvhpiErrorOk; + case Get_Base_Type (Obj.Rng_Type).Kind is + when Ghdl_Rtik_Type_I32 => + Res := Boolean'Pos (Obj.Rng_Addr.I32.Dir = Dir_To); + when others => + null; + end case; + when VhpiLeftBoundP => if Obj.Kind /= VhpiIntRangeK then Res := 0; @@ -1257,6 +1371,8 @@ package body Grt.Avhpi is return Loc_To_Addr (Obj.Ctxt.Block.Depth, Obj.Obj.Loc, Obj.Ctxt); + when VhpiIndexedNameK => + return Obj.N_Addr; when others => return Null_Address; end case; diff --git a/src/grt/grt-avhpi.ads b/src/grt/grt-avhpi.ads index ec5fce447..7675c9b1f 100644 --- a/src/grt/grt-avhpi.ads +++ b/src/grt/grt-avhpi.ads @@ -396,7 +396,10 @@ package Grt.Avhpi is VhpiAliasedName, VhpiCompDecl, VhpiProtectedTypeInst, - VhpiGenIndex + VhpiGenIndex, + + -- From indexedName to to base name. + VhpiBaseName ); for VhpiOneToOneT use @@ -491,7 +494,9 @@ package Grt.Avhpi is VhpiAliasedName => 1388, VhpiCompDecl => 1389, VhpiProtectedTypeInst => 1390, - VhpiGenIndex => 1391 + VhpiGenIndex => 1391, + + VhpiBaseName => 1490 ); -- Methods used to traverse 1 to many relationships. @@ -869,6 +874,8 @@ package Grt.Avhpi is type VhpiHandleT is private; + subtype VhpiIntT is Ghdl_I32; + -- A null handle. Null_Handle : constant VhpiHandleT; @@ -892,6 +899,13 @@ package Grt.Avhpi is Res : out VhpiHandleT; Error : out AvhpiErrorT); + -- Get the sub-object using the index within the range. + -- The implicit relation is VhpiIndexedNames. + procedure Vhpi_Handle_By_Array_Index (Ref : VhpiHandleT; + Index : VhpiIntT; + Res : out VhpiHandleT; + Error : out AvhpiErrorT); + procedure Vhpi_Iterator (Rel : VhpiOneToManyT; Ref : VhpiHandleT; Res : out VhpiHandleT; @@ -909,8 +923,6 @@ package Grt.Avhpi is Obj : VhpiHandleT; Res : out Ghdl_C_String); - subtype VhpiIntT is Ghdl_I32; - procedure Vhpi_Get (Property : VhpiIntPropertyT; Obj : VhpiHandleT; Res : out VhpiIntT; diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index 480da947c..85b149141 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -353,8 +353,20 @@ package body Grt.Vcd is when VhpiGenericDeclK | VhpiConstDeclK => return Vcd_Variable; + when VhpiIndexedNameK => + declare + Base : VhpiHandleT; + Err : AvhpiErrorT; + begin + Vhpi_Handle (VhpiBaseName, Sig, Base, Err); + if Err /= AvhpiErrorOk then + raise Program_Error; + end if; + return Get_Vcd_Value_Kind (Base); + end; when others => - return Vcd_Value_Bad; + raise Program_Error; + -- return Vcd_Value_Bad; end case; end Get_Vcd_Value_Kind; diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 8580478c9..a1dfb57ed 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -550,14 +550,14 @@ package body Grt.Vpi is begin case Vhpi_Get_Kind (Res) is when VhpiEntityDeclK - | VhpiArchBodyK - | VhpiBlockStmtK - | VhpiIfGenerateK - | VhpiForGenerateK - | VhpiCompInstStmtK => + | VhpiArchBodyK + | VhpiBlockStmtK + | VhpiIfGenerateK + | VhpiForGenerateK + | VhpiCompInstStmtK => return vpiModule; when VhpiPortDeclK - | VhpiSigDeclK => + | VhpiSigDeclK => declare Info : Verilog_Wire_Info; begin @@ -629,6 +629,18 @@ package body Grt.Vpi is end case; end Build_vpiHandle; + function Vhpi_Handle_To_Vpi (H : VhpiHandleT) return vpiHandle + is + Prop : Integer; + begin + Prop := Vhpi_Handle_To_Vpi_Prop (H); + if Prop /= vpiUndefined then + return Build_vpiHandle (H, Prop); + else + return null; + end if; + end Vhpi_Handle_To_Vpi; + ------------------------------------------------------------------------ -- vpiHandle vpi_scan(vpiHandle iter) -- Scan the Verilog HDL hierarchy for objects with a one-to-many @@ -682,7 +694,7 @@ package body Grt.Vpi is Kind := Vhpi_Handle_To_Vpi_Prop (Res); if Kind /= vpiUndefined and then (Kind = Expected_Kind - or(Kind = vpiPort and Expected_Kind = vpiNet)) + or (Kind = vpiPort and Expected_Kind = vpiNet)) then return Build_vpiHandle (Res, Kind); end if; @@ -868,11 +880,31 @@ package body Grt.Vpi is type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character; Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-"; + type Map_Type_E8_Int is array (Ghdl_E8 range 0..8) of Ghdl_I32; + Map_Std_E8_Int: constant Map_Type_E8_Int := (0, 0, 0, 1, 0, 0, 0, 1, 0); + type Map_Type_B1 is array (Ghdl_B1) of character; Map_Std_B1: constant Map_Type_B1 := "01"; - function ii_vpi_get_value_bin_str (Obj : VhpiHandleT) - return Ghdl_C_String + function Get_Value_Obj (Obj : VhpiHandleT) return Verilog_Wire_Info + is + Info : Verilog_Wire_Info; + begin + case Vhpi_Get_Kind (Obj) is + when VhpiPortDeclK + | VhpiSigDeclK + | VhpiGenericDeclK + | VhpiConstDeclK + | VhpiIndexedNameK => + Get_Verilog_Wire (Obj, Info); + return Info; + when others => + return (Vtype => Vcd_Bad, + Val => Vcd_Effective, Ptr => Null_Address); + end case; + end Get_Value_Obj; + + function Vpi_Get_Value_Bin (Obj : VhpiHandleT) return Ghdl_C_String is function E8_To_Char (Val : Ghdl_E8) return Character is begin @@ -886,26 +918,15 @@ package body Grt.Vpi is Info : Verilog_Wire_Info; Len : Ghdl_Index_Type; begin - case Vhpi_Get_Kind (Obj) is - when VhpiPortDeclK - | VhpiSigDeclK - | VhpiGenericDeclK - | VhpiConstDeclK => - null; - when others => - return null; - end case; - - -- Get verilog compat info. - Get_Verilog_Wire (Obj, Info); + Info := Get_Value_Obj (Obj); Reset (Buf_Value); -- reset string buffer case Info.Vtype is when Vcd_Bad - | Vcd_Float64 - | Vcd_Array - | Vcd_Struct => + | Vcd_Float64 + | Vcd_Array + | Vcd_Struct => return null; when Vcd_Enum8 => declare @@ -922,7 +943,7 @@ package body Grt.Vpi is Append_Bin (Ghdl_U64 (V), 32); end; when Vcd_Bit - | Vcd_Bool => + | Vcd_Bool => Append (Buf_Value, Map_Std_B1 (Verilog_Wire_Val (Info).B1)); when Vcd_Bitvector => Len := Get_Wire_Length (Info); @@ -939,7 +960,71 @@ package body Grt.Vpi is end case; Append (Buf_Value, NUL); return Get_C_String (Buf_Value); - end ii_vpi_get_value_bin_str; + end Vpi_Get_Value_Bin; + + function Vpi_Get_Value_Int (Obj : VhpiHandleT) return VhpiIntT + is + function E8_To_Int (Val : Ghdl_E8) return VhpiIntT is + begin + if Val not in Map_Type_E8_Int'range then + return 0; + else + return Map_Std_E8_Int (Val); + end if; + end E8_To_Int; + + Info : Verilog_Wire_Info; + Len : Ghdl_Index_Type; + Res : VhpiIntT; + begin + Info := Get_Value_Obj (Obj); + + Reset (Buf_Value); -- reset string buffer + + case Info.Vtype is + when Vcd_Bad + | Vcd_Float64 + | Vcd_Array + | Vcd_Struct => + -- FIXME: is it possible to return an error ? + dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType"); + return -1; + when Vcd_Enum8 => + declare + V : Ghdl_E8; + begin + V := Verilog_Wire_Val (Info).E8; + return Ghdl_E8'Pos (V); + end; + when Vcd_Integer32 => + declare + V : Ghdl_U32; + begin + V := Verilog_Wire_Val (Info).E32; + return To_Ghdl_I32 (V); + end; + when Vcd_Bit + | Vcd_Bool => + return Ghdl_B1'Pos (Verilog_Wire_Val (Info).B1); + when Vcd_Bitvector => + Res := 0; + Len := Get_Wire_Length (Info); + -- FIXME: handle overflow ? + for J in 0 .. Len - 1 loop + Res := Res * 2 + Ghdl_B1'Pos (Verilog_Wire_Val (Info, J).B1); + end loop; + return Res; + when Vcd_Stdlogic => + return E8_To_Int (Verilog_Wire_Val (Info).E8); + when Vcd_Stdlogic_Vector => + Len := Get_Wire_Length (Info); + Res := 0; + for J in 0 .. Len - 1 loop + Res := Res * 2 + E8_To_Int (Verilog_Wire_Val (Info, J).E8); + end loop; + return Res; + end case; + end Vpi_Get_Value_Int; function Vpi_Get_Value_Range (Expr : vpiHandle) return Integer is @@ -993,31 +1078,31 @@ package body Grt.Vpi is -- 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); + when vpiBinStrVal => + Value.Str := Vpi_Get_Value_Bin (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=> + 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=> + | vpiRightRange => Value.Integer_m := Vpi_Get_Value_Range (Expr); - when others=> - dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType"); + when others => + Value.Integer_m := Integer (Vpi_Get_Value_Int (Expr.Ref)); 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"); + 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; if Flag_Trace then @@ -1646,19 +1731,50 @@ package body Grt.Vpi is return 1; end vpi_get_vlog_info; - -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index) - function vpi_handle_by_index (aRef: vpiHandle; aIndex: integer) + function Vpi_Handle_By_Index_Internal (Ref: vpiHandle; Index: Integer) + return vpiHandle + is + Temp : VhpiHandleT; + Err : AvhpiErrorT; + begin + case Ref.mType is + when vpiNetArray => + Vhpi_Handle_By_Array_Index (Ref.Ref, VhpiIntT (Index), Temp, Err); + if Err = AvhpiErrorOk then + -- FIXME: can be an array or a struct. + return Build_vpiHandle (Temp, vpiNet); + end if; + when others => + null; + end case; + return null; + end Vpi_Handle_By_Index_Internal; + + function vpi_handle_by_index (Ref : vpiHandle; Index : Integer) return vpiHandle is - pragma Unreferenced (aRef); - pragma Unreferenced (aIndex); + Res : vpiHandle; begin if Flag_Trace then - Trace_Start ("vpi_handle_by_index UNIMPLEMENTED!"); + Trace_Start ("vpi_handle_by_index ("); + Trace (Ref); + Trace (", "); + Trace (Index); + Trace (") = "); + end if; + + if Ref = null then + Res := null; + else + Res := Vpi_Handle_By_Index_Internal (Ref, Index); + end if; + + if Flag_Trace then + Trace (Res); Trace_Newline; end if; - return null; + return Res; end vpi_handle_by_index; -- Return True iff L and R are equal. L must not have an element set to @@ -1715,8 +1831,6 @@ package body Grt.Vpi is B, E : Natural; Base, El : VhpiHandleT; Err : AvhpiErrorT; - Prop : Integer; - Res : vpiHandle; Escaped : Boolean; begin -- Extract the start point. @@ -1775,14 +1889,7 @@ package body Grt.Vpi is B := B + 1; end loop; - Prop := Vhpi_Handle_To_Vpi_Prop (Base); - if Prop /= vpiUndefined then - Res := Build_vpiHandle (Base, Prop); - else - Res := null; - end if; - - return Res; + return Vhpi_Handle_To_Vpi (Base); end Vpi_Handle_By_Name_Internal; function vpi_handle_by_name (Name : Ghdl_C_String; Scope : vpiHandle) diff --git a/src/grt/grt-vpi.ads b/src/grt/grt-vpi.ads index 8db022af9..48ee1a125 100644 --- a/src/grt/grt-vpi.ads +++ b/src/grt/grt-vpi.ads @@ -270,12 +270,12 @@ package Grt.Vpi is -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index) - function vpi_handle_by_index(aRef: vpiHandle; aIndex: Integer) - return vpiHandle; + function vpi_handle_by_index (Ref: vpiHandle; Index: Integer) + return vpiHandle; pragma Export (C, vpi_handle_by_index, "vpi_handle_by_index"); - function vpi_handle_by_name(Name : Ghdl_C_String; Scope : vpiHandle) - return vpiHandle; + function vpi_handle_by_name (Name : Ghdl_C_String; Scope : vpiHandle) + return vpiHandle; pragma Export (C, vpi_handle_by_name, "vpi_handle_by_name"); -- unsigned int vpi_mcd_close(unsigned int mcd) |