aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-disp_rti.adb57
-rw-r--r--translate/grt/grt-images.adb25
-rw-r--r--translate/grt/grt-rtis.ads36
-rw-r--r--translate/grt/grt-rtis_addr.adb8
-rw-r--r--translate/grt/grt-rtis_addr.ads5
-rw-r--r--translate/grt/grt-rtis_utils.adb26
-rw-r--r--translate/grt/grt-rtis_utils.ads3
-rw-r--r--translate/grt/grt-values.adb62
-rw-r--r--translate/grt/grt-waves.adb60
9 files changed, 150 insertions, 132 deletions
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index c89dd01f4..b2010f2ad 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 d6efba0c3..a90e9517a 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 c1907110d..01dc7c72e 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 f846f382a..adbedf7f7 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 33efc0b28..8f79126f1 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 f8ff5d62f..1c526c360 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 232016d67..602c99dec 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 97a36ae17..94c13ccd6 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 fb43fd17a..03c171385 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 =>
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-10 05:38:39 +0000