diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-10-18 06:27:49 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-10-21 08:03:37 +0200 |
commit | ffa1a498dc22b7758d096cd91c61f0d356879e47 (patch) | |
tree | 769d1ce78e9032983985b211c2044385f8426e09 /src/grt | |
parent | ed7ad157dbecc784bb2df44684442e88431db561 (diff) | |
download | ghdl-ffa1a498dc22b7758d096cd91c61f0d356879e47.tar.gz ghdl-ffa1a498dc22b7758d096cd91c61f0d356879e47.tar.bz2 ghdl-ffa1a498dc22b7758d096cd91c61f0d356879e47.zip |
grt rtis/wave: handle unbounded record subtypes.
Fix #668
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-disp_rti.adb | 18 | ||||
-rw-r--r-- | src/grt/grt-ghw.ads | 15 | ||||
-rw-r--r-- | src/grt/grt-rtis_utils.adb | 9 | ||||
-rw-r--r-- | src/grt/grt-waves.adb | 60 |
4 files changed, 83 insertions, 19 deletions
diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb index 81e7e2b4c..177093747 100644 --- a/src/grt/grt-disp_rti.adb +++ b/src/grt/grt-disp_rti.adb @@ -327,9 +327,21 @@ package body Grt.Disp_Rti is 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); + declare + Bt : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (Rti); + begin + Disp_Record_Value (Stream, Bt, Ctxt, Obj, Bounds, Is_Sig); + end; + when Ghdl_Rtik_Subtype_Unbounded_Record => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + Bt : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (St.Basetype); + begin + Disp_Record_Value (Stream, Bt, Ctxt, Obj, Bounds, Is_Sig); + end; when Ghdl_Rtik_Subtype_Record => declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := diff --git a/src/grt/grt-ghw.ads b/src/grt/grt-ghw.ads index 4a23fbf41..a605138e7 100644 --- a/src/grt/grt-ghw.ads +++ b/src/grt/grt-ghw.ads @@ -48,6 +48,14 @@ package Grt.Ghw is type Ghw_Rtik is new Unsigned_8; Ghw_Rtik_Error : constant Ghw_Rtik := 0; Ghw_Rtik_Eos : constant Ghw_Rtik := 15; -- End of scope. + + Ghw_Rtik_Signal : constant Ghw_Rtik := 16; -- Signal. + Ghw_Rtik_Port_In : constant Ghw_Rtik := 17; -- Port + Ghw_Rtik_Port_Out : constant Ghw_Rtik := 18; -- Port + Ghw_Rtik_Port_Inout : constant Ghw_Rtik := 19; -- Port + Ghw_Rtik_Port_Buffer : constant Ghw_Rtik := 20; -- Port + Ghw_Rtik_Port_Linkage : constant Ghw_Rtik := 21; -- Port + Ghw_Rtik_Type_B2 : constant Ghw_Rtik := 22; Ghw_Rtik_Type_E8 : constant Ghw_Rtik := 23; Ghw_Rtik_Type_E32 : constant Ghw_Rtik := 24; -- Not used in waves @@ -72,11 +80,4 @@ package Grt.Ghw is Ghw_Rtik_Subtype_P32 : constant Ghw_Rtik := 47; Ghw_Rtik_Subtype_P64 : constant Ghw_Rtik := 48; - Ghw_Rtik_Signal : constant Ghw_Rtik := 16; -- Signal. - Ghw_Rtik_Port_In : constant Ghw_Rtik := 17; -- Port - Ghw_Rtik_Port_Out : constant Ghw_Rtik := 18; -- Port - Ghw_Rtik_Port_Inout : constant Ghw_Rtik := 19; -- Port - Ghw_Rtik_Port_Buffer : constant Ghw_Rtik := 20; -- Port - Ghw_Rtik_Port_Linkage : constant Ghw_Rtik := 21; -- Port - end Grt.Ghw; diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb index ed4429744..f90ae47a6 100644 --- a/src/grt/grt-rtis_utils.adb +++ b/src/grt/grt-rtis_utils.adb @@ -445,6 +445,15 @@ package body Grt.Rtis_Utils is 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_Unbounded_Record => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + Bt : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (St.Basetype); + begin + Handle_Record (Bt); + end; when Ghdl_Rtik_Subtype_Record => declare St : constant Ghdl_Rtin_Subtype_Composite_Acc := diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index ffe174bf6..e1931bfa2 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -678,7 +678,7 @@ package body Grt.Waves is end loop; end; when Ghdl_Rtik_Type_Record - | Ghdl_Rtik_Type_Unbounded_Record => + | Ghdl_Rtik_Type_Unbounded_Record => declare Rec : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (Rti); @@ -699,6 +699,22 @@ package body Grt.Waves is Create_String_Id (Rec.Name); Create_Type (Rec.Basetype, N_Ctxt); end; + when Ghdl_Rtik_Subtype_Unbounded_Record => + -- Only the base type. + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + B_Ctxt : Rti_Context; + begin + if Rti_Complex_Type (Rti) then + B_Ctxt := Ctxt; + else + B_Ctxt := N_Ctxt; + end if; + Create_Type (St.Basetype, B_Ctxt); + + return; + end; when others => Internal_Error ("wave.create_type"); -- Internal_Error ("wave.create_type: does not handle " & @@ -729,7 +745,8 @@ 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_Type_Unbounded_Record + | Ghdl_Rtik_Subtype_Unbounded_Record => Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj)); when others => null; @@ -751,7 +768,8 @@ 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_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)); @@ -1291,7 +1309,7 @@ package body Grt.Waves is end Write_Array_Bounds; procedure Write_Record_Bounds (Rec : Ghdl_Rtin_Type_Record_Acc; - Bounds : in out Address) + Layout : Address) is El : Ghdl_Rtin_Element_Acc; begin @@ -1300,10 +1318,12 @@ package body Grt.Waves is case El.Eltype.Kind is when Ghdl_Rtik_Type_Array => Write_Array_Bounds - (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), Bounds); + (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), + Array_Layout_To_Bounds (Layout + El.Layout_Off)); when Ghdl_Rtik_Type_Unbounded_Record => Write_Record_Bounds - (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), Bounds); + (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), + Layout + El.Layout_Off); when others => null; end case; @@ -1354,15 +1374,29 @@ package body Grt.Waves is Rec : constant Ghdl_Rtin_Type_Record_Acc := To_Ghdl_Rtin_Type_Record_Acc (Obj_Rti.Obj_Type); Addr : Ghdl_Uc_Array_Acc; - Bounds : Address; begin Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Record)); Write_String_Id (null); Write_Type_Id (Obj_Rti.Obj_Type, Ctxt); Addr := To_Ghdl_Uc_Array_Acc (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt)); - Bounds := Addr.Bounds; - Write_Record_Bounds (Rec, Bounds); + Write_Record_Bounds (Rec, Addr.Bounds); + end; + when Ghdl_Rtik_Subtype_Unbounded_Record => + declare + St : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc + (Obj_Rti.Obj_Type); + Rec : constant Ghdl_Rtin_Type_Record_Acc := + To_Ghdl_Rtin_Type_Record_Acc (St.Basetype); + Addr : Ghdl_Uc_Array_Acc; + begin + Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Record)); + 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)); + Write_Record_Bounds (Rec, Addr.Bounds); end; when others => Internal_Error ("waves.write_types: unhandled obj kind"); @@ -1445,6 +1479,14 @@ package body Grt.Waves is Write_Record_Bounds (Base, Layout); end if; end; + when Ghdl_Rtik_Subtype_Unbounded_Record => + declare + Rec : constant Ghdl_Rtin_Subtype_Composite_Acc := + To_Ghdl_Rtin_Subtype_Composite_Acc (Rti); + begin + Write_String_Id (Rec.Name); + Write_Type_Id (Rec.Basetype, Ctxt); + end; when Ghdl_Rtik_Subtype_Scalar => declare Sub : constant Ghdl_Rtin_Subtype_Scalar_Acc := |