diff options
author | Tristan Gingold <tgingold@free.fr> | 2021-06-07 06:02:42 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2021-06-07 06:02:42 +0200 |
commit | c9bab05d5af5da3e42af6f08b0a8000391ce0766 (patch) | |
tree | 7792b1213143ea0020a998770d947980c221ef54 | |
parent | 2cf1465a532c8f089215193a5f9f189f5684eaf0 (diff) | |
download | ghdl-c9bab05d5af5da3e42af6f08b0a8000391ce0766.tar.gz ghdl-c9bab05d5af5da3e42af6f08b0a8000391ce0766.tar.bz2 ghdl-c9bab05d5af5da3e42af6f08b0a8000391ce0766.zip |
grt-vpi: improve support of arrays
-rw-r--r-- | src/grt/grt-rtis_addr.adb | 22 | ||||
-rw-r--r-- | src/grt/grt-rtis_addr.ads | 4 | ||||
-rw-r--r-- | src/grt/grt-vcd.adb | 32 | ||||
-rw-r--r-- | src/grt/grt-vcd.ads | 2 | ||||
-rw-r--r-- | src/grt/grt-vpi.adb | 28 |
5 files changed, 66 insertions, 22 deletions
diff --git a/src/grt/grt-rtis_addr.adb b/src/grt/grt-rtis_addr.adb index 25b0c64a9..7aaf9d38b 100644 --- a/src/grt/grt-rtis_addr.adb +++ b/src/grt/grt-rtis_addr.adb @@ -279,6 +279,7 @@ package body Grt.Rtis_Addr is function Array_Layout_To_Bounds (Layout : Address) return Address is begin + -- Skip the 2 size fields (1 for objects size, 1 for signals size). return Layout + Ghdl_Index_Type'(Ghdl_Indexes_Type'Size / 8); end Array_Layout_To_Bounds; @@ -310,7 +311,7 @@ package body Grt.Rtis_Addr is Idx_Def : Ghdl_Rti_Access; begin if Res'Length /= Def.Nbr_Dim or else Res'First /= 0 then - Internal_Error ("disp_rti.bound_to_range"); + Internal_Error ("rtis_addr.bound_to_range"); end if; Bounds := Bounds_Addr; @@ -355,6 +356,25 @@ package body Grt.Rtis_Addr is end loop; end Get_Base_Type; + function Get_Base_Array_Type (Atype : Ghdl_Rti_Access) + return Ghdl_Rtin_Type_Array_Acc + is + Res : Ghdl_Rti_Access; + begin + Res := Atype; + loop + case Res.Kind is + when Ghdl_Rtik_Type_Array => + return To_Ghdl_Rtin_Type_Array_Acc (Res); + when Ghdl_Rtik_Subtype_Array + | Ghdl_Rtik_Subtype_Unbounded_Array => + Res := To_Ghdl_Rtin_Subtype_Composite_Acc (Res).Basetype; + when others => + Internal_Error ("rtis_addr.get_base_array_type"); + end case; + end loop; + end Get_Base_Array_Type; + function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean is begin return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask) diff --git a/src/grt/grt-rtis_addr.ads b/src/grt/grt-rtis_addr.ads index b7c19bea9..1e275e21d 100644 --- a/src/grt/grt-rtis_addr.ads +++ b/src/grt/grt-rtis_addr.ads @@ -109,6 +109,10 @@ package Grt.Rtis_Addr is -- Get the base type of ATYPE. function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access; + -- Likewise, but for an array type. + function Get_Base_Array_Type (Atype : Ghdl_Rti_Access) + return Ghdl_Rtin_Type_Array_Acc; + -- Return true iff ATYPE is anonymous. -- Valid only on type and subtype definitions. function Rti_Anonymous_Type (Atype : Ghdl_Rti_Access) return Boolean; diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index ff0d69424..c08176a27 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -343,6 +343,7 @@ package body Grt.Vcd is Bounds : Address; Kind : Vcd_Var_Type; + Arr_Rti : Ghdl_Rtin_Type_Array_Acc; Irange : Ghdl_Range_Ptr; Val : Vcd_Value_Kind; begin @@ -363,32 +364,21 @@ package body Grt.Vcd is | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Subtype_Scalar => Kind := Rti_To_Vcd_Kind (Rti); - Irange := null; when Ghdl_Rtik_Subtype_Array => declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); - Arr_Rti : constant Ghdl_Rtin_Type_Array_Acc := - To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); - Idx_Rti : constant Ghdl_Rti_Access := - Get_Base_Type (Arr_Rti.Indexes (0)); begin + Arr_Rti := To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); Kind := Rti_Array_To_Vcd_Kind (Arr_Rti); + pragma Assert (Bounds = Null_Address); Bounds := Loc_To_Addr (St.Common.Depth, St.Layout, Avhpi_Get_Context (Sig)); Bounds := Array_Layout_To_Bounds (Bounds); - Extract_Range (Bounds, Idx_Rti, Irange); end; when Ghdl_Rtik_Type_Array => - declare - Arr_Rti : constant Ghdl_Rtin_Type_Array_Acc := - To_Ghdl_Rtin_Type_Array_Acc (Rti); - Idx_Rti : constant Ghdl_Rti_Access := - Get_Base_Type (Arr_Rti.Indexes (0)); - begin - Kind := Rti_Array_To_Vcd_Kind (Arr_Rti); - Extract_Range (Bounds, Idx_Rti, Irange); - end; + Arr_Rti := To_Ghdl_Rtin_Type_Array_Acc (Rti); + Kind := Rti_Array_To_Vcd_Kind (Arr_Rti); when others => Kind := Vcd_Bad; end case; @@ -425,6 +415,18 @@ package body Grt.Vcd is return; end case; + -- For vectors: extract range. + Irange := null; + if Kind in Vcd_Var_Vectors then + declare + Idx_Rti : constant Ghdl_Rti_Access := + Get_Base_Type (Arr_Rti.Indexes (0)); + begin + Extract_Range (Bounds, Idx_Rti, Irange); + end; + end if; + + -- Build the info. case Kind is when Vcd_Bad | Vcd_Struct => diff --git a/src/grt/grt-vcd.ads b/src/grt/grt-vcd.ads index 5ab3b7636..261c5b5d4 100644 --- a/src/grt/grt-vcd.ads +++ b/src/grt/grt-vcd.ads @@ -92,7 +92,7 @@ package Grt.Vcd is Rti : Rtis.Ghdl_Rti_Access; when Vcd_Array => Arr_Rti : Rtis.Ghdl_Rti_Access; - Arr_Layout : System.Address; + Arr_Bounds : System.Address; when others => null; end case; diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 4b8ee9b91..5d75db2c1 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -37,8 +37,7 @@ ------------------------------------------------------------------------------- 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; @@ -49,7 +48,9 @@ with Grt.Hooks; use Grt.Hooks; with Grt.Options; with Grt.Vcd; use Grt.Vcd; with Grt.Errors; use Grt.Errors; +with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Types; +with Grt.Rtis_Addr; with Grt.Std_Logic_1164; use Grt.Std_Logic_1164; with Grt.Callbacks; use Grt.Callbacks; with Grt.Vstrings; use Grt.Vstrings; @@ -943,13 +944,30 @@ package body Grt.Vpi is function Vpi_Get_Value_Range (Expr : vpiHandle) return Integer is Info : Verilog_Wire_Info; + Rng : Ghdl_Range_Ptr; begin Get_Verilog_Wire (Expr.Ref, Info); - if Info.Vec_Range /= null then + case Info.Vtype is + when Vcd_Var_Vectors => + Rng := Info.Vec_Range; + when Vcd_Array => + declare + use Grt.Rtis_Addr; + Arr_Rti : constant Ghdl_Rtin_Type_Array_Acc := + Get_Base_Array_Type (Info.Arr_Rti); + Rngs : Ghdl_Range_Array (0 .. 0); + begin + Bound_To_Range (Info.Arr_Bounds, Arr_Rti, Rngs); + Rng := Rngs (0); + end; + when others => + Rng := null; + end case; + if Rng /= null then if Expr.mType = vpiLeftRange then - return Integer (Info.Vec_Range.I32.Left); + return Integer (Rng.I32.Left); else - return Integer (Info.Vec_Range.I32.Right); + return Integer (Rng.I32.Right); end if; else return 0; |