diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/grt/grt-disp_rti.adb | 57 | ||||
| -rw-r--r-- | translate/grt/grt-images.adb | 25 | ||||
| -rw-r--r-- | translate/grt/grt-rtis.ads | 36 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.adb | 8 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.ads | 5 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_utils.adb | 26 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_utils.ads | 3 | ||||
| -rw-r--r-- | translate/grt/grt-values.adb | 62 | ||||
| -rw-r--r-- | translate/grt/grt-waves.adb | 60 | ||||
| -rw-r--r-- | translate/translation.adb | 116 |
10 files changed, 203 insertions, 195 deletions
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index c89dd01..b2010f2 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -18,6 +18,7 @@ with Grt.Astdio; use Grt.Astdio; with Grt.Errors; use Grt.Errors; with Grt.Hooks; use Grt.Hooks; +with Grt.Rtis_Utils; use Grt.Rtis_Utils; package body Grt.Disp_Rti is procedure Disp_Kind (Kind : Ghdl_Rtik); @@ -92,8 +93,8 @@ package body Grt.Disp_Rti is Put_I64 (Stream, Vptr.I64); Put (Stream, " "); Put (Stream, - To_Ghdl_Rtin_Unit_Acc - (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)).Name); + Get_Physical_Unit_Name + (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0))); if not Is_Sig then Update (64); end if; @@ -101,8 +102,8 @@ package body Grt.Disp_Rti is Put_I32 (Stream, Vptr.I32); Put (Stream, " "); Put (Stream, - To_Ghdl_Rtin_Unit_Acc - (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)).Name); + Get_Physical_Unit_Name + (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0))); if not Is_Sig then Update (32); end if; @@ -343,8 +344,10 @@ package body Grt.Disp_Rti is when Ghdl_Rtik_Element => Put ("ghdl_rtik_element"); - when Ghdl_Rtik_Unit => - Put ("ghdl_rtik_unit"); + when Ghdl_Rtik_Unit64 => + Put ("ghdl_rtik_unit64"); + when Ghdl_Rtik_Unitptr => + Put ("ghdl_rtik_unitptr"); when others => Put ("ghdl_rtik_#"); @@ -792,7 +795,7 @@ package body Grt.Disp_Rti is | Ghdl_Rtik_Type_P32 => declare Bdef : Ghdl_Rtin_Type_Physical_Acc; - Unit : Ghdl_Rtin_Unit_Acc; + Unit : Ghdl_Rti_Access; begin Bdef := To_Ghdl_Rtin_Type_Physical_Acc (Bt); if Bdef.Name /= Def.Name then @@ -803,28 +806,34 @@ package body Grt.Disp_Rti is Disp_Subtype_Scalar_Range (stdout, Def, Ctxt); if Bdef.Name = Def.Name then for I in 0 .. Bdef.Nbr - 1 loop - Unit := To_Ghdl_Rtin_Unit_Acc (Bdef.Units (I)); + Unit := Bdef.Units (I); New_Line; Disp_Indent (Indent + 1); - Disp_Kind (Unit.Common.Kind); + Disp_Kind (Unit.Kind); Put (": "); - Disp_Name (Unit.Name); + Disp_Name (Get_Physical_Unit_Name (Unit)); Put (" = "); - case Bt.Kind is - when Ghdl_Rtik_Type_P64 => - if Rti_Non_Static_Physical_Type (Bt) then - Put_I64 (stdout, Unit.Value.Unit_Addr.I64); - else - Put_I64 (stdout, Unit.Value.Unit_64); - end if; - when Ghdl_Rtik_Type_P32 => - if Rti_Non_Static_Physical_Type (Bt) then - Put_I32 (stdout, Unit.Value.Unit_Addr.I32); - else - Put_I32 (stdout, Unit.Value.Unit_32); - end if; + case Unit.Kind is + when Ghdl_Rtik_Unit64 => + Put_I64 (stdout, + To_Ghdl_Rtin_Unit64_Acc (Unit).Value); + when Ghdl_Rtik_Unitptr => + case Bt.Kind is + when Ghdl_Rtik_Type_P64 => + Put_I64 + (stdout, + To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I64); + when Ghdl_Rtik_Type_P32 => + Put_I32 + (stdout, + To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I32); + when others => + Internal_Error + ("disp_rti.subtype.scalar_decl(P32/P64)"); + end case; when others => - null; + Internal_Error + ("disp_rti.subtype.scalar_decl(P32/P64)"); end case; end loop; end if; diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index d6efba0..a90e951 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -19,6 +19,7 @@ with System; use System; with System.Storage_Elements; -- Work around GNAT bug. pragma Unreferenced (System.Storage_Elements); with Ada.Unchecked_Conversion; +with Grt.Rtis_Utils; use Grt.Rtis_Utils; with Grt.Processes; use Grt.Processes; with Grt.Vstrings; use Grt.Vstrings; @@ -90,21 +91,21 @@ package body Grt.Images is is Str : String (1 .. 21); First : Natural; - Unit : Ghdl_C_String; - Phys : Ghdl_Rtin_Type_Physical_Acc; + Phys : constant Ghdl_Rtin_Type_Physical_Acc + := To_Ghdl_Rtin_Type_Physical_Acc (Rti); + Unit_Name : Ghdl_C_String; Unit_Len : Natural; begin To_String (Str, First, Val); - Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti); - Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name; - Unit_Len := strlen (Unit); + Unit_Name := Get_Physical_Unit_Name (Phys.Units (0)); + Unit_Len := strlen (Unit_Name); declare L : constant Natural := Str'Last + 1 - First; Str2 : String (1 .. L + 1 + Unit_Len); begin Str2 (1 .. L) := Str (First .. Str'Last); Str2 (L + 1) := ' '; - Str2 (L + 2 .. Str2'Last) := Unit (1 .. Unit_Len); + Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len); Return_String (Res, Str2); end; end Ghdl_Image_P64; @@ -114,21 +115,21 @@ package body Grt.Images is is Str : String (1 .. 11); First : Natural; - Unit : Ghdl_C_String; - Phys : Ghdl_Rtin_Type_Physical_Acc; + Phys : constant Ghdl_Rtin_Type_Physical_Acc + := To_Ghdl_Rtin_Type_Physical_Acc (Rti); + Unit_Name : Ghdl_C_String; Unit_Len : Natural; begin To_String (Str, First, Val); - Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti); - Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name; - Unit_Len := strlen (Unit); + Unit_Name := Get_Physical_Unit_Name (Phys.Units (0)); + Unit_Len := strlen (Unit_Name); declare L : constant Natural := Str'Last + 1 - First; Str2 : String (1 .. L + 1 + Unit_Len); begin Str2 (1 .. L) := Str (First .. Str'Last); Str2 (L + 1) := ' '; - Str2 (L + 2 .. Str2'Last) := Unit (1 .. Unit_Len); + Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len); Return_String (Res, Str2); end; end Ghdl_Image_P32; diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads index c190711..01dc7c7 100644 --- a/translate/grt/grt-rtis.ads +++ b/translate/grt/grt-rtis.ads @@ -64,7 +64,8 @@ package Grt.Rtis is Ghdl_Rtik_Subtype_Access, Ghdl_Rtik_Type_Protected, Ghdl_Rtik_Element, - Ghdl_Rtik_Unit, + Ghdl_Rtik_Unit64, + Ghdl_Rtik_Unitptr, Ghdl_Rtik_Attribute_Transaction, Ghdl_Rtik_Attribute_Quiet, Ghdl_Rtik_Attribute_Stable, @@ -222,10 +223,6 @@ package Grt.Rtis is Ghdl_Rti_Type_Anonymous_Mask : constant Ghdl_Rti_U8 := 2; Ghdl_Rti_Type_Anonymous : constant Ghdl_Rti_U8 := 2; - -- True if the physical type is not static - Ghdl_Rti_Type_Non_Static_Mask : constant Ghdl_Rti_U8 := 4; - Ghdl_Rti_Type_Non_Static : constant Ghdl_Rti_U8 := 4; - type Ghdl_Rtin_Type_Array is record Common : Ghdl_Rti_Common; Name : Ghdl_C_String; @@ -283,28 +280,23 @@ package Grt.Rtis is function To_Ghdl_Rtin_Type_Record_Acc is new Ada.Unchecked_Conversion (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Record_Acc); - -- MODE is never used. Refer to mode field of physical type. - type Ghdl_Rti_Unit_Mode is (Unit_Mode_32, Unit_Mode_64, Unit_Mode_Addr); - type Ghdl_Rti_Unit_Val (Mode : Ghdl_Rti_Unit_Mode := Unit_Mode_64) is record - case Mode is - when Unit_Mode_32 => - Unit_32 : Ghdl_I32; - when Unit_Mode_64 => - Unit_64 : Ghdl_I64; - when Unit_Mode_Addr => - Unit_Addr : Ghdl_Value_Ptr; - end case; + type Ghdl_Rtin_Unit64 is record + Common : Ghdl_Rti_Common; + Name : Ghdl_C_String; + Value : Ghdl_I64; end record; - pragma Unchecked_Union (Ghdl_Rti_Unit_Val); + type Ghdl_Rtin_Unit64_Acc is access Ghdl_Rtin_Unit64; + function To_Ghdl_Rtin_Unit64_Acc is new Ada.Unchecked_Conversion + (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit64_Acc); - type Ghdl_Rtin_Unit is record + type Ghdl_Rtin_Unitptr is record Common : Ghdl_Rti_Common; Name : Ghdl_C_String; - Value : Ghdl_Rti_Unit_Val; + Addr : Ghdl_Value_Ptr; end record; - type Ghdl_Rtin_Unit_Acc is access Ghdl_Rtin_Unit; - function To_Ghdl_Rtin_Unit_Acc is new Ada.Unchecked_Conversion - (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit_Acc); + type Ghdl_Rtin_Unitptr_Acc is access Ghdl_Rtin_Unitptr; + function To_Ghdl_Rtin_Unitptr_Acc is new Ada.Unchecked_Conversion + (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unitptr_Acc); -- Mode field is set to 4 if units value is per address. Otherwise, -- mode is 0. diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index f846f38..adbedf7 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -274,14 +274,6 @@ package body Grt.Rtis_Addr is = Ghdl_Rti_Type_Anonymous; end Rti_Anonymous_Type; - function Rti_Non_Static_Physical_Type (Atype : Ghdl_Rti_Access) - return Boolean - is - begin - return (Atype.Mode and Ghdl_Rti_Type_Non_Static_Mask) - = Ghdl_Rti_Type_Non_Static; - end Rti_Non_Static_Physical_Type; - function Get_Top_Context return Rti_Context is Ctxt : Rti_Context; diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads index 33efc0b..8f79126 100644 --- a/translate/grt/grt-rtis_addr.ads +++ b/translate/grt/grt-rtis_addr.ads @@ -93,11 +93,6 @@ package Grt.Rtis_Addr is function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean; pragma Inline (Rti_Complex_Type); - -- Return true iff physical type ATYPE is non-static (std.standard.time) - function Rti_Non_Static_Physical_Type (Atype : Ghdl_Rti_Access) - return Boolean; - pragma Inline (Rti_Non_Static_Physical_Type); - -- Get the top context. function Get_Top_Context return Rti_Context; diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index f8ff5d6..1c526c3 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -446,9 +446,9 @@ package body Grt.Rtis_Utils is begin To_String (S, F, Value.I32); Append (Str, S (F .. S'Last)); - Append (Str, - To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc - (Type_Rti).Units (0)).Name); + Append + (Str, Get_Physical_Unit_Name + (To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0))); end; when Ghdl_Rtik_Type_P64 => declare @@ -457,9 +457,9 @@ package body Grt.Rtis_Utils is begin To_String (S, F, Value.I64); Append (Str, S (F .. S'Last)); - Append (Str, - To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc - (Type_Rti).Units (0)).Name); + Append + (Str, Get_Physical_Unit_Name + (To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0))); end; when others => Internal_Error ("grt.rtis_utils.get_value"); @@ -477,6 +477,20 @@ package body Grt.Rtis_Utils is Free (Name); end Disp_Value; + function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access) + return Ghdl_C_String + is + begin + case Unit.Kind is + when Ghdl_Rtik_Unit64 => + return To_Ghdl_Rtin_Unit64_Acc (Unit).Name; + when Ghdl_Rtik_Unitptr => + return To_Ghdl_Rtin_Unitptr_Acc (Unit).Name; + when others => + Internal_Error ("rtis_utils.physical_unit_name"); + end case; + end Get_Physical_Unit_Name; + procedure Get_Enum_Value (Rstr : in out Rstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type) is diff --git a/translate/grt/grt-rtis_utils.ads b/translate/grt/grt-rtis_utils.ads index 232016d..602c99d 100644 --- a/translate/grt/grt-rtis_utils.ads +++ b/translate/grt/grt-rtis_utils.ads @@ -59,6 +59,9 @@ package Grt.Rtis_Utils is Value : Value_Union; Type_Rti : Ghdl_Rti_Access); + -- Get the name of a physical unit. + function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access) + return Ghdl_C_String; -- Disp a value. procedure Disp_Value (Stream : FILEs; Value : Value_Union; diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb index 97a36ae..94c13cc 100644 --- a/translate/grt/grt-values.adb +++ b/translate/grt/grt-values.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Grt.Errors; use Grt.Errors; +with Grt.Rtis_Utils; with System; with Ada.Unchecked_Conversion; @@ -342,63 +343,74 @@ package body Grt.Values is Found_Real : Boolean := false; Phys_Rti : Ghdl_Rtin_Type_Physical_Acc; - Unit : Ghdl_Rtin_Unit_Acc; - Multiple : Ghdl_Rti_Unit_Val; + Unit_Name : Ghdl_C_String; + Multiple : Ghdl_Rti_Access; Mult : Ghdl_I64; begin Phys_Rti := To_Ghdl_Rtin_Type_Physical_Acc (Rti); - S.Bounds := To_Std_String_Boundp(Bound'Address); + S.Bounds := To_Std_String_Boundp (Bound'Address); -- find characters at the end... Finish := Bound.Dim_1.Length - 1; - while White(S.Base.all(Finish)) loop + while White (S.Base (Finish)) loop Finish := Finish - 1; end loop; Start := Finish; - while not White(S.Base.all(Start - 1)) loop + while not White (S.Base (Start - 1)) loop Start := Start - 1; end loop; -- shorten Bounds to exclude non-numeric part Bound.Dim_1.Right := Bound.Dim_1.Right - - Std_Integer(Bound.Dim_1.Length - Start); + - Std_Integer (Bound.Dim_1.Length - Start); Bound.Dim_1.Length := Start; -- does the string represent a Real? for i in 0 .. Start loop - if S.Base.all(i) = '.' then + if S.Base (i) = '.' then Found_Real := true; end if; end loop; declare - Unit_Str : String(1 .. Natural(1 + Finish - Start)); - Found : Boolean := False; + Unit_Str : String (1 .. Natural (1 + Finish - Start)); begin - Make_LC_String(Str.Base, Start, Unit_Str); + Make_LC_String (Str.Base, Start, Unit_Str); + Multiple := null; for i in 0 .. Phys_Rti.Nbr - 1 loop - Unit := To_Ghdl_Rtin_Unit_Acc(Phys_Rti.Units(i)); - if StringMatch(Unit_Str, Unit.Name) then - Found := True; - Multiple := To_Ghdl_Rtin_Unit_Acc (Phys_Rti.Units (i)).Value; + Unit_Name := + Rtis_Utils.Get_Physical_Unit_Name (Phys_Rti.Units (i)); + if StringMatch (Unit_Str, Unit_Name) then + Multiple := Phys_Rti.Units (i); exit; end if; end loop; - if not Found then + if Multiple = null then Error_E ("'value: Unit " & Unit_Str & " not in physical type" & - Phys_Rti.Name.all(1..strlen(Phys_Rti.Name))); + Phys_Rti.Name.all (1 .. strlen (Phys_Rti.Name))); end if; end; - if Rti.Kind = Ghdl_Rtik_Type_P64 then - Mult := Multiple.Unit_64; - else - Mult := Ghdl_I64(Multiple.Unit_32); - end if; + case Multiple.Kind is + when Ghdl_Rtik_Unit64 => + Mult := To_Ghdl_Rtin_Unit64_Acc (Multiple).Value; + when Ghdl_Rtik_Unitptr => + case Rti.Kind is + when Ghdl_Rtik_Type_P64 => + Mult := To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I64; + when Ghdl_Rtik_Type_P32 => + Mult := Ghdl_I64 + (To_Ghdl_Rtin_Unitptr_Acc (Multiple).Addr.I32); + when others => + Internal_Error ("values.physical_type(P32/P64-1)"); + end case; + when others => + Internal_Error ("values.physical_type(P32/P64-2)"); + end case; if Found_Real then - return Ghdl_I64 (Ghdl_Value_F64 (To_Std_String_Ptr(S'Address)) + return Ghdl_I64 (Ghdl_Value_F64 (To_Std_String_Ptr (S'Address)) * Ghdl_F64 (Mult)); else - return Ghdl_Value_I64 (To_Std_String_Ptr(S'Address)) * Mult; + return Ghdl_Value_I64 (To_Std_String_Ptr (S'Address)) * Mult; end if; end Ghdl_Value_Physical_Type; @@ -409,7 +421,7 @@ package body Grt.Values is if Rti.Kind /= Ghdl_Rtik_Type_P64 then Error_E ("Physical_Type_64'value: incorrect RTI"); end if; - return Ghdl_Value_Physical_Type(Str, Rti); + return Ghdl_Value_Physical_Type (Str, Rti); end Ghdl_Value_P64; function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) @@ -419,7 +431,7 @@ package body Grt.Values is if Rti.Kind /= Ghdl_Rtik_Type_P32 then Error_E ("Physical_Type_32'value: incorrect RTI"); end if; - return Ghdl_I32(Ghdl_Value_Physical_Type(Str, Rti)); + return Ghdl_I32 (Ghdl_Value_Physical_Type (Str, Rti)); end Ghdl_Value_P32; -- From patch attached to https://gna.org/bugs/index.php?18352 diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb index fb43fd1..03c1713 100644 --- a/translate/grt/grt-waves.adb +++ b/translate/grt/grt-waves.adb @@ -675,13 +675,14 @@ package body Grt.Waves is | Ghdl_Rtik_Type_P64 => declare Base : Ghdl_Rtin_Type_Physical_Acc; - Unit : Ghdl_Rtin_Unit_Acc; + Unit_Name : Ghdl_C_String; begin Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti); Create_String_Id (Base.Name); for I in 1 .. Base.Nbr loop - Unit := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1)); - Create_String_Id (Unit.Name); + Unit_Name := + Rtis_Utils.Get_Physical_Unit_Name (Base.Units (I - 1)); + Create_String_Id (Unit_Name); end loop; end; when Ghdl_Rtik_Type_Record => @@ -1341,38 +1342,37 @@ package body Grt.Waves is | Ghdl_Rtik_Type_P64 => declare Base : Ghdl_Rtin_Type_Physical_Acc; - Unit : Ghdl_Rtin_Unit_Acc; + Unit : Ghdl_Rti_Access; begin Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti); Write_String_Id (Base.Name); Wave_Put_ULEB128 (Ghdl_U32 (Base.Nbr)); for I in 1 .. Base.Nbr loop - Unit := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1)); - Write_String_Id (Unit.Name); - if Rti_Non_Static_Physical_Type (Rti) then - case Rti.Kind is - when Ghdl_Rtik_Type_P32 => - Wave_Put_SLEB128 - (Unit.Value.Unit_Addr.I32); - when Ghdl_Rtik_Type_P64 => - Wave_Put_LSLEB128 - (Unit.Value.Unit_Addr.I64); - when others => - Internal_Error - ("wave.write_types(P32/P64-1)"); - end case; - else - -- Value is locally static. - case Base.Common.Kind is - when Ghdl_Rtik_Type_P32 => - Wave_Put_SLEB128 (Unit.Value.Unit_32); - when Ghdl_Rtik_Type_P64 => - Wave_Put_LSLEB128 (Unit.Value.Unit_64); - when others => - Internal_Error - ("wave.write_types(P32/P64-0)"); - end case; - end if; + Unit := Base.Units (I - 1); + Write_String_Id + (Rtis_Utils.Get_Physical_Unit_Name (Unit)); + case Unit.Kind is + when Ghdl_Rtik_Unit64 => + Wave_Put_LSLEB128 + (To_Ghdl_Rtin_Unit64_Acc (Unit).Value); + when Ghdl_Rtik_Unitptr => + case Rti.Kind is + when Ghdl_Rtik_Type_P64 => + Wave_Put_LSLEB128 + (To_Ghdl_Rtin_Unitptr_Acc (Unit). + Addr.I64); + when Ghdl_Rtik_Type_P32 => + Wave_Put_SLEB128 + (To_Ghdl_Rtin_Unitptr_Acc (Unit). + Addr.I32); + when others => + Internal_Error + ("wave.write_types(P32/P64-1)"); + end case; + when others => + Internal_Error + ("wave.write_types(P32/P64-2)"); + end case; end loop; end; when others => diff --git a/translate/translation.adb b/translate/translation.adb index c995f46..d6f85bf 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -666,7 +666,8 @@ package body Translation is Ghdl_Rtik_Subtype_Access : O_Cnode; Ghdl_Rtik_Type_Protected : O_Cnode; Ghdl_Rtik_Element : O_Cnode; - Ghdl_Rtik_Unit : O_Cnode; + Ghdl_Rtik_Unit64 : O_Cnode; + Ghdl_Rtik_Unitptr : O_Cnode; Ghdl_Rtik_Attribute_Transaction : O_Cnode; Ghdl_Rtik_Attribute_Quiet : O_Cnode; Ghdl_Rtik_Attribute_Stable : O_Cnode; @@ -25447,17 +25448,17 @@ package body Translation is Ghdl_Rtin_Type_Enum_Nbr : O_Fnode; Ghdl_Rtin_Type_Enum_Lits : O_Fnode; - -- Node for an unit value. - Ghdl_Rti_Unit_Val : O_Tnode; - Ghdl_Rti_Unit_32 : O_Fnode; - Ghdl_Rti_Unit_64 : O_Fnode; - Ghdl_Rti_Unit_Addr : O_Fnode; + -- Node for an unit64. + Ghdl_Rtin_Unit64 : O_Tnode; + Ghdl_Rtin_Unit64_Common : O_Fnode; + Ghdl_Rtin_Unit64_Name : O_Fnode; + Ghdl_Rtin_Unit64_Value : O_Fnode; - -- Node for an unit. - Ghdl_Rtin_Unit : O_Tnode; - Ghdl_Rtin_Unit_Common : O_Fnode; - Ghdl_Rtin_Unit_Name : O_Fnode; - Ghdl_Rtin_Unit_Value : O_Fnode; + -- Node for an unitptr. + Ghdl_Rtin_Unitptr : O_Tnode; + Ghdl_Rtin_Unitptr_Common : O_Fnode; + Ghdl_Rtin_Unitptr_Name : O_Fnode; + Ghdl_Rtin_Unitptr_Value : O_Fnode; -- Node for a physical type Ghdl_Rtin_Type_Physical : O_Tnode; @@ -25669,8 +25670,10 @@ package body Translation is New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_element"), Ghdl_Rtik_Element); - New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unit"), - Ghdl_Rtik_Unit); + New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unit64"), + Ghdl_Rtik_Unit64); + New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unitptr"), + Ghdl_Rtik_Unitptr); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_attribute_transaction"), @@ -25851,37 +25854,36 @@ package body Translation is Ghdl_Rtin_Subtype_Scalar); end; + -- Unit64 declare Constr : O_Element_List; begin - Start_Union_Type (Constr); - New_Union_Field (Constr, Ghdl_Rti_Unit_32, - Get_Identifier ("unit_32"), Ghdl_I32_Type); - if not Flag_Only_32b then - New_Union_Field (Constr, Ghdl_Rti_Unit_64, - Get_Identifier ("unit_64"), Ghdl_I64_Type); - end if; - New_Union_Field (Constr, Ghdl_Rti_Unit_Addr, - Get_Identifier ("addr"), Ghdl_Ptr_Type); - Finish_Union_Type (Constr, Ghdl_Rti_Unit_Val); - New_Type_Decl (Get_Identifier ("__ghdl_rti_unit_val"), - Ghdl_Rti_Unit_Val); + Start_Record_Type (Constr); + New_Record_Field (Constr, Ghdl_Rtin_Unit64_Common, + Get_Identifier ("common"), Ghdl_Rti_Common); + New_Record_Field (Constr, Ghdl_Rtin_Unit64_Name, + Get_Identifier ("name"), Char_Ptr_Type); + New_Record_Field (Constr, Ghdl_Rtin_Unit64_Value, + Get_Identifier ("value"), Ghdl_I64_Type); + Finish_Record_Type (Constr, Ghdl_Rtin_Unit64); + New_Type_Decl (Get_Identifier ("__ghdl_rtin_unit64"), + Ghdl_Rtin_Unit64); end; - -- Unit + -- Unitptr declare Constr : O_Element_List; begin Start_Record_Type (Constr); - New_Record_Field (Constr, Ghdl_Rtin_Unit_Common, + New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Common, Get_Identifier ("common"), Ghdl_Rti_Common); - New_Record_Field (Constr, Ghdl_Rtin_Unit_Name, + New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Name, Get_Identifier ("name"), Char_Ptr_Type); - New_Record_Field (Constr, Ghdl_Rtin_Unit_Value, - Get_Identifier ("value"), Ghdl_Rti_Unit_Val); - Finish_Record_Type (Constr, Ghdl_Rtin_Unit); - New_Type_Decl (Get_Identifier ("__ghdl_rtin_unit"), - Ghdl_Rtin_Unit); + New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Value, + Get_Identifier ("addr"), Ghdl_Ptr_Type); + Finish_Record_Type (Constr, Ghdl_Rtin_Unitptr); + New_Type_Decl (Get_Identifier ("__ghdl_rtin_unitptr"), + Ghdl_Rtin_Unitptr); end; -- Physical type. @@ -26458,43 +26460,37 @@ package body Translation is Mark : Id_Mark_Type; Aggr : O_Record_Aggr_List; Val : O_Cnode; - Field : O_Fnode; Const : O_Dnode; - Conv_Type : O_Tnode; - Unit_Type : Type_Info_Acc; - Info : Object_Info_Acc; + Info : constant Object_Info_Acc := Get_Info (Unit); + Rti_Type : O_Tnode; + Rtik : O_Cnode; begin Push_Identifier_Prefix (Mark, Get_Identifier (Unit)); Name := Generate_Name (Unit); + if Info /= null then + -- Non-static units. The only possibility is a unit of + -- std.standard.time. + Rti_Type := Ghdl_Rtin_Unitptr; + Rtik := Ghdl_Rtik_Unitptr; + else + Rti_Type := Ghdl_Rtin_Unit64; + Rtik := Ghdl_Rtik_Unit64; + end if; New_Const_Decl (Const, Create_Identifier ("RTI"), - Global_Storage, Ghdl_Rtin_Unit); + Global_Storage, Rti_Type); Start_Const_Value (Const); - Start_Record_Aggr (Aggr, Ghdl_Rtin_Unit); - New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Unit)); + Start_Record_Aggr (Aggr, Rti_Type); + New_Record_Aggr_El (Aggr, Generate_Common (Rtik)); New_Record_Aggr_El (Aggr, New_Name_Address (Name)); - Info := Get_Info (Unit); if Info /= null then -- Handle non-static units. The only possibility is a unit of -- std.standard.time. - Field := Ghdl_Rti_Unit_Addr; Val := New_Global_Unchecked_Address (Get_Var_Label (Info.Object_Var), Ghdl_Ptr_Type); else - Unit_Type := Get_Info (Get_Type (Unit)); - case Unit_Type.Type_Mode is - when Type_Mode_P64 => - Field := Ghdl_Rti_Unit_64; - Conv_Type := Ghdl_I64_Type; - when Type_Mode_P32 => - Field := Ghdl_Rti_Unit_32; - Conv_Type := Ghdl_I32_Type; - when others => - raise Internal_Error; - end case; - Val := Chap7.Translate_Numeric_Literal (Unit, Conv_Type); + Val := Chap7.Translate_Numeric_Literal (Unit, Ghdl_I64_Type); end if; - New_Record_Aggr_El - (Aggr, New_Union_Aggr (Ghdl_Rti_Unit_Val, Field, Val)); + New_Record_Aggr_El (Aggr, Val); Finish_Record_Aggr (Aggr, Val); Finish_Const_Value (Const, Val); Add_Rti_Node (Const); @@ -26510,7 +26506,6 @@ package body Translation is Unit : Iir_Unit_Declaration; Nbr_Units : Integer; Unit_Arr : O_Dnode; - Mode : Integer; Rti_Kind : O_Cnode; begin Info := Get_Info (Atype); @@ -26523,11 +26518,6 @@ package body Translation is Push_Rti_Node (Prev, False); Unit := Get_Unit_Chain (Atype); - if Get_Info (Unit) /= null then - Mode := 4; - else - Mode := 0; - end if; Nbr_Units := 0; while Unit /= Null_Iir loop Generate_Unit_Declaration (Unit); @@ -26548,7 +26538,7 @@ package body Translation is raise Internal_Error; end case; New_Record_Aggr_El - (List, Generate_Common_Type (Rti_Kind, 0, 0, Mode)); + (List, Generate_Common_Type (Rti_Kind, 0, 0, 0)); New_Record_Aggr_El (List, New_Name_Address (Name)); New_Record_Aggr_El (List, |