From a8a33296493e609335177703349465712e8245e2 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 25 Jul 2020 11:29:56 +0200 Subject: grt: handle unbounded array subtype in rtis and waves --- src/grt/grt-disp_rti.adb | 22 ++++++++++++++++++++++ src/grt/grt-rtis.ads | 2 +- src/grt/grt-rtis_utils.adb | 25 ++++++++++++++++++++----- src/grt/grt-waves.adb | 36 +++++++++++++++++++++++++++++------- 4 files changed, 72 insertions(+), 13 deletions(-) (limited to 'src/grt') diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb index 823b9f1fe..045ac6fb5 100644 --- a/src/grt/grt-disp_rti.adb +++ b/src/grt/grt-disp_rti.adb @@ -294,6 +294,15 @@ package body Grt.Disp_Rti is Disp_Array_Value_1 (Stream, To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt, 0, Obj, Bounds, Is_Sig); + when Ghdl_Rtik_Subtype_Unbounded_Array => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + Bt : constant Ghdl_Rtin_Type_Array_Acc := + To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); + begin + Disp_Array_Value_1 (Stream, Bt, Ctxt, 0, Obj, Bounds, Is_Sig); + end; when Ghdl_Rtik_Subtype_Array => declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := @@ -441,6 +450,8 @@ package body Grt.Disp_Rti is Put ("ghdl_rtik_type_array"); when Ghdl_Rtik_Subtype_Array => Put ("ghdl_rtik_subtype_array"); + when Ghdl_Rtik_Subtype_Unbounded_Array => + Put ("ghdl_rtik_subtype_unbounded_array"); when Ghdl_Rtik_Type_Record => Put ("ghdl_rtik_type_record"); @@ -744,6 +755,17 @@ package body Grt.Disp_Rti is Array_Layout_To_Bounds (Layout)); end if; end; + when Ghdl_Rtik_Subtype_Unbounded_Array => + declare + Sdef : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Def); + begin + if Sdef.Name /= null then + Disp_Name (Sdef.Name); + else + Put ("??"); + end if; + end; when Ghdl_Rtik_Type_Protected => Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name); when others => diff --git a/src/grt/grt-rtis.ads b/src/grt/grt-rtis.ads index 182cbad73..7ec9570b3 100644 --- a/src/grt/grt-rtis.ads +++ b/src/grt/grt-rtis.ads @@ -79,7 +79,7 @@ package Grt.Rtis is Ghdl_Rtik_Type_File, -- Rtin_Type_Fileacc Ghdl_Rtik_Subtype_Scalar, -- Rtin_Subtype_Scalar Ghdl_Rtik_Subtype_Array, -- Rtin_Subtype_Composite - Ghdl_Rtik_Subtype_Unconstrained_Array, + Ghdl_Rtik_Subtype_Unbounded_Array, Ghdl_Rtik_Subtype_Record, -- 40 -- Rtin_Subtype_Composite Ghdl_Rtik_Subtype_Unbounded_Record, diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb index 09b9d434c..ad9d33563 100644 --- a/src/grt/grt-rtis_utils.adb +++ b/src/grt/grt-rtis_utils.adb @@ -171,8 +171,9 @@ package body Grt.Rtis_Utils is Addr := To_Addr_Acc (Obj_Loc).all; end if; when Ghdl_Rtik_Type_Array - | Ghdl_Rtik_Type_Unbounded_Record - | Ghdl_Rtik_Subtype_Unbounded_Record => + | Ghdl_Rtik_Subtype_Unbounded_Array + | Ghdl_Rtik_Type_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Record => -- If the type is unbounded then the location -- for the object containts a pointer to the bounds -- and a pointer to the data. @@ -211,9 +212,14 @@ package body Grt.Rtis_Utils is Off_Addr := Rec_Layout + Off; El_Addr := Obj + To_Ghdl_Index_Ptr (Off_Addr).all; El_Bounds := Rec_Layout + El.Layout_Off; - if El.Eltype.Kind = Ghdl_Rtik_Type_Array then - El_Bounds := Array_Layout_To_Bounds (El_Bounds); - end if; + case El.Eltype.Kind is + when Ghdl_Rtik_Type_Array + | Ghdl_Rtik_Subtype_Unbounded_Array => + El_Bounds := Array_Layout_To_Bounds (El_Bounds); + when others => + -- Keep layout. + null; + end case; when others => Internal_Error ("record_to_element"); end case; @@ -413,6 +419,15 @@ package body Grt.Rtis_Utils is Handle_Scalar (Rti); when Ghdl_Rtik_Type_Array => Handle_Array_1 (To_Ghdl_Rtin_Type_Array_Acc (Rti), 0); + when Ghdl_Rtik_Subtype_Unbounded_Array => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + Bt : constant Ghdl_Rtin_Type_Array_Acc := + To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); + begin + Handle_Array_1 (Bt, 0); + end; when Ghdl_Rtik_Subtype_Array => declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index c0d12993f..b03d7e0ec 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -700,7 +700,8 @@ package body Grt.Waves is Create_String_Id (Rec.Name); Create_Type (Rec.Basetype, N_Ctxt); end; - when Ghdl_Rtik_Subtype_Unbounded_Record => + when Ghdl_Rtik_Subtype_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Array => -- Only the base type. declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := @@ -714,7 +715,7 @@ package body Grt.Waves is end if; Create_Type (St.Basetype, B_Ctxt); - return; +-- return; end; when others => Internal_Error ("wave.create_type"); @@ -746,8 +747,9 @@ package body Grt.Waves is -- The real type will be written to the file. case Rti.Kind is when Ghdl_Rtik_Type_Array - | Ghdl_Rtik_Type_Unbounded_Record - | Ghdl_Rtik_Subtype_Unbounded_Record => + | Ghdl_Rtik_Subtype_Unbounded_Array + | Ghdl_Rtik_Type_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Record => Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); when others => null; @@ -769,8 +771,9 @@ package body Grt.Waves is Rti := Avhpi_Get_Rti (Obj_Type); case Rti.Kind is when Ghdl_Rtik_Type_Array - | Ghdl_Rtik_Type_Unbounded_Record - | Ghdl_Rtik_Subtype_Unbounded_Record => + | Ghdl_Rtik_Subtype_Unbounded_Array + | Ghdl_Rtik_Type_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Record => Write_Type_Id (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); when others => Write_Type_Id (Rti, Avhpi_Get_Context (Obj_Type)); @@ -1370,6 +1373,24 @@ package body Grt.Waves is Bounds := Addr.Bounds; Write_Array_Bounds (Arr, Bounds); end; + when Ghdl_Rtik_Subtype_Unbounded_Array => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc + (Obj_Rti.Obj_Type); + Arr : constant Ghdl_Rtin_Type_Array_Acc := + To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); + Addr : Ghdl_Uc_Array_Acc; + Bounds : Address; + begin + Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Array)); + Write_String_Id (null); + Write_Type_Id (St.Basetype, Ctxt); + Addr := To_Ghdl_Uc_Array_Acc + (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt)); + Bounds := Addr.Bounds; + Write_Array_Bounds (Arr, Bounds); + end; when Ghdl_Rtik_Type_Unbounded_Record => declare Rec : constant Ghdl_Rtin_Type_Record_Acc := @@ -1480,7 +1501,8 @@ package body Grt.Waves is Write_Record_Bounds (Base, Layout); end if; end; - when Ghdl_Rtik_Subtype_Unbounded_Record => + when Ghdl_Rtik_Subtype_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Array => declare Rec : constant Ghdl_Rtin_Subtype_Composite_Acc := To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); -- cgit v1.2.3