diff options
Diffstat (limited to 'src/grt/grt-disp_rti.adb')
| -rw-r--r-- | src/grt/grt-disp_rti.adb | 76 |
1 files changed, 50 insertions, 26 deletions
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; |