grt-vpi: improve support of arrays

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;