From ed7ad157dbecc784bb2df44684442e88431db561 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 17 Oct 2018 06:18:36 +0200 Subject: Rework translation of unbounded and complex types. --- src/grt/grt-avhpi.adb | 35 +++++++++++------- src/grt/grt-disp_rti.adb | 76 +++++++++++++++++++++++++------------- src/grt/grt-rtis.ads | 18 +++++++-- src/grt/grt-rtis_addr.adb | 5 +++ src/grt/grt-rtis_addr.ads | 6 +-- src/grt/grt-rtis_utils.adb | 92 +++++++++++++++++++++++++++++----------------- src/grt/grt-rtis_utils.ads | 10 +++-- src/grt/grt-types.ads | 10 +++++ src/grt/grt-vcd.adb | 3 +- src/grt/grt-waves.adb | 21 ++++++----- 10 files changed, 183 insertions(+), 93 deletions(-) (limited to 'src/grt') diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index 065d64ef1..1a6239f1a 100644 --- a/src/grt/grt-avhpi.adb +++ b/src/grt/grt-avhpi.adb @@ -151,10 +151,12 @@ package body Grt.Avhpi is Bt : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); + Layout : Address; begin + Layout := + Loc_To_Addr (St.Common.Depth, St.Layout, Res.Ctxt); Bound_To_Range - (Loc_To_Addr (St.Common.Depth, St.Bounds, Res.Ctxt), - Bt, Rngs); + (Array_Layout_To_Bounds (Layout), Bt, Rngs); Res.N_Idx := Ranges_To_Length (Rngs, Bt.Indexes); end; when others => @@ -176,7 +178,6 @@ package body Grt.Avhpi is El_Type : Ghdl_Rti_Access; Off : Ghdl_Index_Type) return Address is - pragma Unreferenced (Ctxt); Is_Sig : Boolean; El_Size : Ghdl_Index_Type; El_Type1 : Ghdl_Rti_Access; @@ -202,13 +203,20 @@ package body Grt.Avhpi is El_Size := Ghdl_I64'Size / Storage_Unit; end if; when Ghdl_Rtik_Subtype_Array => - if Is_Sig then - El_Size := Ghdl_Index_Type - (To_Ghdl_Rtin_Subtype_Composite_Acc (El_Type1).Sigsize); - else - El_Size := Ghdl_Index_Type - (To_Ghdl_Rtin_Subtype_Composite_Acc (El_Type1).Valsize); - end if; + declare + Sizes : Ghdl_Indexes_Ptr; + begin + Sizes := To_Ghdl_Indexes_Ptr + (Loc_To_Addr + (El_Type1.Depth, + To_Ghdl_Rtin_Subtype_Composite_Acc (El_Type1).Layout, + Ctxt)); + if Is_Sig then + El_Size := Sizes.Signal; + else + El_Size := Sizes.Value; + end if; + end; when others => Internal_Error ("add_index"); end case; @@ -1003,6 +1011,7 @@ package body Grt.Avhpi is 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 @@ -1012,10 +1021,10 @@ package body Grt.Avhpi is 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 - (Loc_To_Addr (Arr_Subtype.Common.Depth, - Arr_Subtype.Bounds, Ref.Ctxt), - Basetype, Bounds); + (Array_Layout_To_Bounds (Layout), Basetype, Bounds); Res := (Kind => VhpiIntRangeK, Ctxt => Ref.Ctxt, Rng_Type => Basetype.Indexes (Idx - 1), diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb index 7440480da..81e7e2b4c 100644 --- a/src/grt/grt-disp_rti.adb +++ b/src/grt/grt-disp_rti.adb @@ -245,11 +245,12 @@ package body Grt.Disp_Rti is Rti : Ghdl_Rtin_Type_Record_Acc; Ctxt : Rti_Context; Obj : Address; - Bounds : in out Address; + Obj_Layout : Address; Is_Sig : Boolean) is El : Ghdl_Rtin_Element_Acc; El_Addr : Address; + El_Bounds : Address; begin Put (Stream, "("); for I in 1 .. Rti.Nbrel loop @@ -259,8 +260,9 @@ package body Grt.Disp_Rti is end if; Put (Stream, El.Name); Put (" => "); - Record_To_Element_Base (Obj, El, Is_Sig, El_Addr); - Disp_Value (Stream, El.Eltype, Ctxt, El_Addr, Bounds, Is_Sig); + Record_To_Element + (Obj, El, Is_Sig, Obj_Layout, El_Addr, El_Bounds); + Disp_Value (Stream, El.Eltype, Ctxt, El_Addr, El_Bounds, Is_Sig); end loop; Put (")"); -- FIXME: update ADDR. @@ -294,9 +296,11 @@ package body Grt.Disp_Rti is To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); Bt : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); + Layout : Address; Bounds : Address; begin - Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt); + Layout := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt); + Bounds := Array_Layout_To_Bounds (Layout); Disp_Array_Value_1 (Stream, Bt, Ctxt, 0, Obj, Bounds, Is_Sig); end; when Ghdl_Rtik_Type_File => @@ -309,8 +313,20 @@ package body Grt.Disp_Rti is -- FIXME: update OBJ (not very useful since never in a -- composite type). end; - when Ghdl_Rtik_Type_Record - | Ghdl_Rtik_Type_Unbounded_Record => + when Ghdl_Rtik_Type_Record => + declare + Bt : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (Rti); + Rec_Layout : Address; + begin + if Rti_Complex_Type (Rti) then + Rec_Layout := Loc_To_Addr (Bt.Common.Depth, Bt.Layout, Ctxt); + else + Rec_Layout := Bounds; + end if; + Disp_Record_Value (Stream, Bt, Ctxt, Obj, Rec_Layout, Is_Sig); + end; + when Ghdl_Rtik_Type_Unbounded_Record => Disp_Record_Value (Stream, To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Obj, Bounds, Is_Sig); @@ -320,10 +336,10 @@ package body Grt.Disp_Rti is To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); Bt : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (St.Basetype); - Bounds : Address; + Layout : Address; begin - Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt); - Disp_Record_Value (Stream, Bt, Ctxt, Obj, Bounds, Is_Sig); + Layout := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt); + Disp_Record_Value (Stream, Bt, Ctxt, Obj, Layout, Is_Sig); end; when Ghdl_Rtik_Type_Protected => Put (Stream, "Unhandled protected type"); @@ -536,11 +552,13 @@ package body Grt.Disp_Rti is end Disp_Scalar_Type_Name; procedure Disp_Type_Array_Bounds (Def : Ghdl_Rtin_Type_Array_Acc; - Bounds : in out Address) + Bounds : Address) is Rng : Ghdl_Range_Ptr; Idx_Base : Ghdl_Rti_Access; + Bounds1 : Address; begin + Bounds1 := Bounds; Put (" ("); for I in 0 .. Def.Nbr_Dim - 1 loop if I /= 0 then @@ -551,16 +569,17 @@ package body Grt.Disp_Rti is Put (" range "); end if; Idx_Base := Get_Base_Type (Def.Indexes (I)); - Extract_Range (Bounds, Idx_Base, Rng); + Extract_Range (Bounds1, Idx_Base, Rng); Disp_Range (stdout, Idx_Base, Rng); end loop; Put (")"); end Disp_Type_Array_Bounds; procedure Disp_Type_Record_Bounds (Def : Ghdl_Rtin_Type_Record_Acc; - Bounds : in out Address) + Layout : Address) is El : Ghdl_Rtin_Element_Acc; + El_Layout : Address; First : Boolean; begin Put (" ("); @@ -576,13 +595,15 @@ package body Grt.Disp_Rti is Put (", "); end if; Put (El.Name); + El_Layout := Layout + El.Layout_Off; case El.Eltype.Kind is when Ghdl_Rtik_Type_Array => Disp_Type_Array_Bounds - (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), Bounds); + (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), + Array_Layout_To_Bounds (El_Layout)); when Ghdl_Rtik_Type_Unbounded_Record => Disp_Type_Record_Bounds - (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), Bounds); + (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), El_Layout); when others => raise Program_Error; end case; @@ -607,16 +628,16 @@ package body Grt.Disp_Rti is end Disp_Type_Array_Name; procedure Disp_Type_Record_Name (Def : Ghdl_Rtin_Type_Record_Acc; - Bounds_Ptr : Address) + Layout_Ptr : Address) is - Bounds : Address; + Layout : Address; begin Disp_Name (Def.Name); - if Bounds_Ptr = Null_Address then + if Layout_Ptr = Null_Address then return; end if; - Bounds := Bounds_Ptr; - Disp_Type_Record_Bounds (Def, Bounds); + Layout := Layout_Ptr; + Disp_Type_Record_Bounds (Def, Layout); end Disp_Type_Record_Name; procedure Disp_Subtype_Scalar_Range @@ -675,7 +696,7 @@ package body Grt.Disp_Rti is else Disp_Type_Record_Name (To_Ghdl_Rtin_Type_Record_Acc (Sdef.Basetype), - Loc_To_Addr (Sdef.Common.Depth, Sdef.Bounds, Ctxt)); + Loc_To_Addr (Sdef.Common.Depth, Sdef.Layout, Ctxt)); end if; end; when Ghdl_Rtik_Type_Array => @@ -694,13 +715,15 @@ package body Grt.Disp_Rti is declare Sdef : constant Ghdl_Rtin_Subtype_Composite_Acc := To_Ghdl_Rtin_Subtype_Composite_Acc (Def); + Layout : Address; begin if Sdef.Name /= null then Disp_Name (Sdef.Name); else + Layout := Loc_To_Addr (Sdef.Common.Depth, Sdef.Layout, Ctxt); Disp_Type_Array_Name (To_Ghdl_Rtin_Type_Array_Acc (Sdef.Basetype), - Loc_To_Addr (Sdef.Common.Depth, Sdef.Bounds, Ctxt)); + Array_Layout_To_Bounds (Layout)); end if; end; when Ghdl_Rtik_Type_Protected => @@ -1102,14 +1125,15 @@ package body Grt.Disp_Rti is is Basetype : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (Def.Basetype); + Layout : Address; begin Disp_Indent (Indent); Disp_Kind (Def.Common.Kind); Put (": "); Disp_Name (Def.Name); Put (" is "); - Disp_Type_Array_Name - (Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt)); + Layout := Loc_To_Addr (Def.Common.Depth, Def.Layout, Ctxt); + Disp_Type_Array_Name (Basetype, Array_Layout_To_Bounds (Layout)); if Rti_Anonymous_Type (To_Ghdl_Rti_Access (Basetype)) then Put (" of "); Disp_Subtype_Indication (Basetype.Element, Ctxt, Null_Address); @@ -1169,7 +1193,7 @@ package body Grt.Disp_Rti is is Basetype : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (Def.Basetype); - Bounds : Address; + Layout : Address; begin Disp_Indent (Indent); Disp_Kind (Def.Common.Kind); @@ -1178,8 +1202,8 @@ package body Grt.Disp_Rti is Put (" is "); Disp_Name (Basetype.Name); if Def.Common.Kind = Ghdl_Rtik_Subtype_Record then - Bounds := Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt); - Disp_Type_Record_Bounds (Basetype, Bounds); + Layout := Loc_To_Addr (Def.Common.Depth, Def.Layout, Ctxt); + Disp_Type_Record_Bounds (Basetype, Layout); end if; New_Line; end Disp_Subtype_Record_Decl; diff --git a/src/grt/grt-rtis.ads b/src/grt/grt-rtis.ads index afe9676c6..030cd7e04 100644 --- a/src/grt/grt-rtis.ads +++ b/src/grt/grt-rtis.ads @@ -120,6 +120,8 @@ package Grt.Rtis is -- bit 0: set for complex type -- bit 1: set for anonymous type definition -- bit 2: set only for physical type with non-static units (time) + -- * record elements: + -- bit 0: set for complex type (copy of the type complex bit). -- * signals: -- bit 0-3: mode (1: linkage, 2: buffer, 3 : out, 4 : inout, 5: in) -- bit 4-5: kind (0 : none, 1 : register, 2 : bus) @@ -311,9 +313,7 @@ package Grt.Rtis is Common : Ghdl_Rti_Common; Name : Ghdl_C_String; Basetype : Ghdl_Rti_Access; - Bounds : Ghdl_Rti_Loc; - Valsize : Ghdl_Rti_Loc; - Sigsize : Ghdl_Rti_Loc; + Layout : Ghdl_Rti_Loc; end record; pragma Convention (C, Ghdl_Rtin_Subtype_Composite); type Ghdl_Rtin_Subtype_Composite_Acc is access Ghdl_Rtin_Subtype_Composite; @@ -332,12 +332,22 @@ package Grt.Rtis is function To_Ghdl_Rtin_Type_Fileacc_Acc is new Ada.Unchecked_Conversion (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Fileacc_Acc); + -- Set in the mode field to know what Val_Off and Sig_Off are relative to. + -- This could also be extrated from the element type. + Ghdl_Rti_Element_Static : constant Ghdl_Rti_U8 := 0; + Ghdl_Rti_Element_Complex : constant Ghdl_Rti_U8 := 1; + Ghdl_Rti_Element_Unbounded : constant Ghdl_Rti_U8 := 2; + type Ghdl_Rtin_Element is record Common : Ghdl_Rti_Common; Name : Ghdl_C_String; Eltype : Ghdl_Rti_Access; + -- For static element: offset in the record. + -- For complex element: offset in the type layout or object layout. Val_Off : Ghdl_Index_Type; Sig_Off : Ghdl_Index_Type; + -- For unbounded records: element layout offset in the layout. + Layout_Off : Ghdl_Index_Type; end record; pragma Convention (C, Ghdl_Rtin_Element); type Ghdl_Rtin_Element_Acc is access Ghdl_Rtin_Element; @@ -349,6 +359,8 @@ package Grt.Rtis is Name : Ghdl_C_String; Nbrel : Ghdl_Index_Type; Elements : Ghdl_Rti_Arr_Acc; + -- Layout variable for the record, if it is complex. + Layout : Ghdl_Rti_Loc; end record; pragma Convention (C, Ghdl_Rtin_Type_Record); type Ghdl_Rtin_Type_Record_Acc is access Ghdl_Rtin_Type_Record; diff --git a/src/grt/grt-rtis_addr.adb b/src/grt/grt-rtis_addr.adb index 7be70eb02..4881a5abd 100644 --- a/src/grt/grt-rtis_addr.adb +++ b/src/grt/grt-rtis_addr.adb @@ -278,6 +278,11 @@ package body Grt.Rtis_Addr is end case; end Extract_Range; + function Array_Layout_To_Bounds (Layout : Address) return Address is + begin + return Layout + Ghdl_Index_Type'(Ghdl_Indexes_Type'Size / 8); + end Array_Layout_To_Bounds; + procedure Bound_To_Range (Bounds_Addr : Address; Def : Ghdl_Rtin_Type_Array_Acc; Res : out Ghdl_Range_Array) diff --git a/src/grt/grt-rtis_addr.ads b/src/grt/grt-rtis_addr.ads index 550576733..db8e15264 100644 --- a/src/grt/grt-rtis_addr.ads +++ b/src/grt/grt-rtis_addr.ads @@ -51,10 +51,6 @@ package Grt.Rtis_Addr is function To_Addr_Acc is new Ada.Unchecked_Conversion (Source => Address, Target => Addr_Acc); - type Ghdl_Index_Acc is access Ghdl_Index_Type; - function To_Ghdl_Index_Acc is new Ada.Unchecked_Conversion - (Source => Address, Target => Ghdl_Index_Acc); - -- Get the parent context of CTXT. -- The parent of an architecture is its entity. function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context; @@ -91,6 +87,8 @@ package Grt.Rtis_Addr is Def : Ghdl_Rti_Access; Rng : out Ghdl_Range_Ptr); + function Array_Layout_To_Bounds (Layout : Address) return Address; + -- Extract range of every dimension from bounds. procedure Bound_To_Range (Bounds_Addr : Address; Def : Ghdl_Rtin_Type_Array_Acc; diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb index 695de7315..ed4429744 100644 --- a/src/grt/grt-rtis_utils.adb +++ b/src/grt/grt-rtis_utils.adb @@ -22,7 +22,7 @@ -- covered by the GNU General Public License. This exception does not -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. ---with Grt.Disp; use Grt.Disp; + with Grt.Errors; use Grt.Errors; package body Grt.Rtis_Utils is @@ -178,32 +178,41 @@ package body Grt.Rtis_Utils is end case; end Object_To_Base_Bounds; - procedure Record_To_Element_Base (Obj : Address; - El : Ghdl_Rtin_Element_Acc; - Is_Sig : Boolean; - Addr : out Address) is + procedure Record_To_Element (Obj : Address; + El : Ghdl_Rtin_Element_Acc; + Is_Sig : Boolean; + Rec_Layout : Address; + El_Addr : out Address; + El_Bounds : out Address) + is + Off : Ghdl_Index_Type; + Off_Addr : Address; begin if Is_Sig then - Addr := Obj + El.Sig_Off; + Off := El.Sig_Off; else - Addr := Obj + El.Val_Off; + Off := El.Val_Off; end if; - case El.Eltype.Kind is - when Ghdl_Rtik_Subtype_Array - | Ghdl_Rtik_Type_Record => - -- Element is an offset. - if Rti_Complex_Type (El.Eltype) then - Addr := Obj + To_Ghdl_Index_Acc (Addr).all; + + case El.Common.Mode is + when Ghdl_Rti_Element_Static => + El_Addr := Obj + Off; + El_Bounds := Null_Address; + when Ghdl_Rti_Element_Complex => + Off_Addr := Rec_Layout + Off; + El_Addr := Obj + To_Ghdl_Index_Ptr (Off_Addr).all; + El_Bounds := Null_Address; + when Ghdl_Rti_Element_Unbounded => + 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; - when Ghdl_Rtik_Type_Array - | Ghdl_Rtik_Type_Unbounded_Record - | Ghdl_Rtik_Subtype_Unbounded_Record => - -- Element is an offset. - Addr := Obj + To_Ghdl_Index_Acc (Addr).all; when others => - null; + Internal_Error ("record_to_element"); end case; - end Record_To_Element_Base; + end Record_To_Element; procedure Foreach_Scalar (Ctxt : Rti_Context; Obj_Type : Ghdl_Rti_Access; @@ -360,26 +369,31 @@ package body Grt.Rtis_Utils is procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc) is + Rec_Addr : constant Address := Addr; + Rec_Bounds : constant Address := Bounds; + Sizes : constant Ghdl_Indexes_Ptr := + To_Ghdl_Indexes_Ptr (Bounds); El : Ghdl_Rtin_Element_Acc; - Obj_Addr : Address; - Last_Addr : Address; + El_Addr : Address; P : Natural; begin P := Length (Name); - Obj_Addr := Addr; - Last_Addr := Addr; for I in 1 .. Rti.Nbrel loop El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1)); - Record_To_Element_Base (Obj_Addr, El, Is_Sig, Addr); + Record_To_Element + (Rec_Addr, El, Is_Sig, Rec_Bounds, El_Addr, Bounds); Append (Name, '.'); Append (Name, El.Name); Handle_Any (El.Eltype); - if Addr > Last_Addr then - Last_Addr := Addr; - end if; Truncate (Name, P); end loop; - Addr := Last_Addr; + if Is_Sig then + Addr := Rec_Addr + Sizes.Signal; + else + Addr := Rec_Addr + Sizes.Value; + end if; + -- Bounds was fully used, no need to restore it. + Bounds := Null_Address; end Handle_Record; procedure Handle_Any (Rti : Ghdl_Rti_Access) is @@ -401,8 +415,10 @@ package body Grt.Rtis_Utils is Bt : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (St.Basetype); Prev_Bounds : constant Address := Bounds; + Layout : Address; begin - Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt); + Layout := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt); + Bounds := Array_Layout_To_Bounds (Layout); Handle_Array_1 (Bt, 0); Bounds := Prev_Bounds; end; @@ -416,8 +432,18 @@ package body Grt.Rtis_Utils is -- -- FIXME: update OBJ (not very useful since never in a -- -- composite type). -- end; - when Ghdl_Rtik_Type_Record - | Ghdl_Rtik_Type_Unbounded_Record => + when Ghdl_Rtik_Type_Record => + declare + Bt : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (Rti); + Prev_Bounds : constant Address := Bounds; + begin + Bounds := Loc_To_Addr (Bt.Common.Depth, Bt.Layout, Ctxt); + Handle_Record (Bt); + Bounds := Prev_Bounds; + end; + when Ghdl_Rtik_Type_Unbounded_Record => + -- Bounds (layout) must have been extracted. Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti)); when Ghdl_Rtik_Subtype_Record => declare @@ -427,7 +453,7 @@ package body Grt.Rtis_Utils is To_Ghdl_Rtin_Type_Record_Acc (St.Basetype); Prev_Bounds : constant Address := Bounds; begin - Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt); + Bounds := Loc_To_Addr (St.Common.Depth, St.Layout, Ctxt); Handle_Record (Bt); Bounds := Prev_Bounds; end; diff --git a/src/grt/grt-rtis_utils.ads b/src/grt/grt-rtis_utils.ads index 71d9e963b..537f1bff8 100644 --- a/src/grt/grt-rtis_utils.ads +++ b/src/grt/grt-rtis_utils.ads @@ -70,10 +70,12 @@ package Grt.Rtis_Utils is Bounds : out Address); -- Get address of element EL for record at OBJ. - procedure Record_To_Element_Base (Obj : Address; - El : Ghdl_Rtin_Element_Acc; - Is_Sig : Boolean; - Addr : out Address); + procedure Record_To_Element (Obj : Address; + El : Ghdl_Rtin_Element_Acc; + Is_Sig : Boolean; + Rec_Layout : Address; + El_Addr : out Address; + El_Bounds : out Address); procedure Get_Value (Str : in out Vstring; Value : Value_Union; diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads index d9b17f67e..f75711eeb 100644 --- a/src/grt/grt-types.ads +++ b/src/grt/grt-types.ads @@ -285,6 +285,16 @@ package Grt.Types is type Ghdl_Range_Array is array (Ghdl_Index_Type range <>) of Ghdl_Range_Ptr; + type Ghdl_Indexes_Type is record + Value : Ghdl_Index_Type; + Signal : Ghdl_Index_Type; + end record; + + type Ghdl_Indexes_Ptr is access all Ghdl_Indexes_Type; + + function To_Ghdl_Indexes_Ptr is new Ada.Unchecked_Conversion + (Source => Address, Target => Ghdl_Indexes_Ptr); + -- For PSL counters. type Ghdl_Index_Ptr is access all Ghdl_Index_Type; diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index 180bfeeb9..9050a26a4 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -360,8 +360,9 @@ package body Grt.Vcd is Get_Base_Type (Arr_Rti.Indexes (0)); begin Kind := Rti_To_Vcd_Kind (Arr_Rti); - Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, + 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 => diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index 74d764e67..ffe174bf6 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -1276,14 +1276,16 @@ package body Grt.Waves is end Write_Range; procedure Write_Array_Bounds (Arr : Ghdl_Rtin_Type_Array_Acc; - Bounds : in out Address) + Bounds : Address) is Rng : Ghdl_Range_Ptr; Index_Type : Ghdl_Rti_Access; + Bounds1 : Address; begin + Bounds1 := Bounds; for I in 0 .. Arr.Nbr_Dim - 1 loop Index_Type := Get_Base_Type (Arr.Indexes (I)); - Extract_Range (Bounds, Index_Type, Rng); + Extract_Range (Bounds1, Index_Type, Rng); Write_Range (Index_Type, Rng); end loop; end Write_Array_Bounds; @@ -1393,10 +1395,11 @@ package body Grt.Waves is declare Bt : constant Ghdl_Rtin_Type_Array_Acc := To_Ghdl_Rtin_Type_Array_Acc (Arr.Basetype); - Bounds : Address; + Layout : Address; begin - Bounds := Loc_To_Addr (Rti.Depth, Arr.Bounds, Ctxt); - Write_Array_Bounds (Bt, Bounds); + Layout := Loc_To_Addr (Rti.Depth, Arr.Layout, Ctxt); + Write_Array_Bounds + (Bt, Array_Layout_To_Bounds (Layout)); end; end; when Ghdl_Rtik_Type_Array => @@ -1432,14 +1435,14 @@ package body Grt.Waves is To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); Base : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (Rec.Basetype); - Bounds : Address; + Layout : Address; begin Write_String_Id (Rec.Name); Write_Type_Id (Rec.Basetype, Ctxt); if Base.Common.Kind = Ghdl_Rtik_Type_Unbounded_Record then - Bounds := Loc_To_Addr - (Rec.Common.Depth, Rec.Bounds, Ctxt); - Write_Record_Bounds (Base, Bounds); + Layout := Loc_To_Addr + (Rec.Common.Depth, Rec.Layout, Ctxt); + Write_Record_Bounds (Base, Layout); end if; end; when Ghdl_Rtik_Subtype_Scalar => -- cgit v1.2.3