aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-avhpi.adb4
-rw-r--r--translate/grt/grt-disp_rti.adb45
-rw-r--r--translate/grt/grt-disp_signals.adb2
-rw-r--r--translate/grt/grt-rtis.ads28
-rw-r--r--translate/grt/grt-rtis_addr.adb22
-rw-r--r--translate/grt/grt-rtis_addr.ads15
-rw-r--r--translate/grt/grt-rtis_utils.adb56
-rw-r--r--translate/grt/grt-vcd.adb11
-rw-r--r--translate/grt/grt-waves.adb59
9 files changed, 122 insertions, 120 deletions
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index a6565cf5d..58b9870e4 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -341,8 +341,7 @@ package body Grt.Avhpi is
Res := (Kind => VhpiGenericDeclK,
Ctxt => Ctxt,
Obj => To_Ghdl_Rtin_Object_Acc (Rti));
- when Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr =>
+ when Ghdl_Rtik_Subtype_Array =>
declare
Atype : Ghdl_Rtin_Subtype_Array_Acc;
Bt : Ghdl_Rtin_Type_Array_Acc;
@@ -429,7 +428,6 @@ package body Grt.Avhpi is
| Ghdl_Rtik_Signal
| Ghdl_Rtik_Type_Array
| Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr
| Ghdl_Rtik_Type_E8
| Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index 8a5405f95..942a59588 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -225,20 +225,6 @@ package body Grt.Disp_Rti is
Disp_Array_Value_1
(Stream, Bt.Element, Ctxt, Rngs, Bt.Indexes, 0, B, Is_Sig);
end;
- when Ghdl_Rtik_Subtype_Array_Ptr =>
- declare
- St : constant Ghdl_Rtin_Subtype_Array_Acc :=
- To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
- Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
- B : Address;
- begin
- Bound_To_Range
- (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
- B := To_Addr_Acc (Obj).all;
- Disp_Array_Value_1
- (Stream, Bt.Element, Ctxt, Rngs, Bt.Indexes, 0, B, Is_Sig);
- end;
when Ghdl_Rtik_Type_File =>
declare
Vptr : Ghdl_Value_Ptr;
@@ -328,8 +314,6 @@ package body Grt.Disp_Rti is
Put ("ghdl_rtik_type_array");
when Ghdl_Rtik_Subtype_Array =>
Put ("ghdl_rtik_subtype_array");
- when Ghdl_Rtik_Subtype_Array_Ptr =>
- Put ("ghdl_rtik_subtype_array_ptr");
when Ghdl_Rtik_Type_Record =>
Put ("ghdl_rtik_type_record");
@@ -534,8 +518,7 @@ package body Grt.Disp_Rti is
Disp_Type_Array_Name (To_Ghdl_Rtin_Type_Array_Acc (Def),
Bounds);
end;
- when Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr =>
+ when Ghdl_Rtik_Subtype_Array =>
declare
Sdef : Ghdl_Rtin_Subtype_Array_Acc;
begin
@@ -649,7 +632,7 @@ package body Grt.Disp_Rti is
-- FIXME: put this into a function.
if (Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
or Obj_Type.Kind = Ghdl_Rtik_Type_Record)
- and then Obj_Type.Mode = 1
+ and then Rti_Complex_Type (Obj_Type)
then
Addr := To_Addr_Acc (Addr).all;
end if;
@@ -811,16 +794,16 @@ package body Grt.Disp_Rti is
Put (" = ");
case Bt.Kind is
when Ghdl_Rtik_Type_P64 =>
- if Bt.Mode = 0 then
- Put_I64 (stdout, Unit.Value.Unit_64);
- else
+ 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 Bt.Mode = 0 then
- Put_I32 (stdout, Unit.Value.Unit_32);
- else
+ 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;
when others =>
null;
@@ -861,6 +844,7 @@ package body Grt.Disp_Rti is
Ctxt : Rti_Context;
Indent : Natural)
is
+ Basetype : constant Ghdl_Rtin_Type_Array_Acc := Def.Basetype;
begin
Disp_Indent (Indent);
Disp_Kind (Def.Common.Kind);
@@ -868,9 +852,11 @@ package body Grt.Disp_Rti is
Disp_Name (Def.Name);
Put (" is ");
Disp_Type_Array_Name
- (Def.Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt));
- -- FIXME: If the subtype array contains a type array, then the
- -- definition is not complete: display the element type.
+ (Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt));
+ if Rti_Anonymous_Type (To_Ghdl_Rti_Access (Basetype)) then
+ Put (" of ");
+ Disp_Subtype_Indication (Basetype.Element, Ctxt, Null_Address);
+ end if;
New_Line;
end Disp_Subtype_Array_Decl;
@@ -970,8 +956,7 @@ package body Grt.Disp_Rti is
when Ghdl_Rtik_Type_Array =>
Disp_Type_Array_Decl
(To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt, Indent);
- when Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr =>
+ when Ghdl_Rtik_Subtype_Array =>
Disp_Subtype_Array_Decl
(To_Ghdl_Rtin_Subtype_Array_Acc (Rti), Ctxt, Indent);
when Ghdl_Rtik_Type_Access
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
index 47f67c264..8a754c9a3 100644
--- a/translate/grt/grt-disp_signals.adb
+++ b/translate/grt/grt-disp_signals.adb
@@ -245,7 +245,7 @@ package body Grt.Disp_Signals is
when Ghdl_Rtik_Attribute_Transaction =>
Put (stdout, Ctxt);
Put (".");
- Put (Stream, " 'quiet");
+ Put (Stream, " 'transaction");
when others =>
null;
end case;
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 2276adf47..c1907110d 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -59,7 +59,6 @@ package Grt.Rtis is
Ghdl_Rtik_Type_File,
Ghdl_Rtik_Subtype_Scalar,
Ghdl_Rtik_Subtype_Array,
- Ghdl_Rtik_Subtype_Array_Ptr,
Ghdl_Rtik_Subtype_Unconstrained_Array,
Ghdl_Rtik_Subtype_Record,
Ghdl_Rtik_Subtype_Access,
@@ -78,10 +77,27 @@ package Grt.Rtis is
type Ghdl_Rti_U8 is mod 2 ** 8;
for Ghdl_Rti_U8'Size use 8;
+ -- This structure is common to all RTI nodes.
type Ghdl_Rti_Common is record
+ -- Kind of the RTI, list is above.
Kind : Ghdl_Rtik;
+
Depth : Ghdl_Rti_Depth;
+
+ -- * array types and subtypes, record types, protected types:
+ -- 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)
+ -- * 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)
+ -- bit 6: set if has 'active attributes
Mode : Ghdl_Rti_U8;
+
+ -- * Types and subtypes definition:
+ -- maximum depth of all RTIs referenced.
+ -- * Others:
+ -- 0
Max_Depth : Ghdl_Rti_Depth;
end record;
@@ -202,6 +218,14 @@ package Grt.Rtis is
Ghdl_Rti_Type_Complex_Mask : constant Ghdl_Rti_U8 := 1;
Ghdl_Rti_Type_Complex : constant Ghdl_Rti_U8 := 1;
+ -- True if the type is anonymous
+ 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;
@@ -282,7 +306,7 @@ package Grt.Rtis is
function To_Ghdl_Rtin_Unit_Acc is new Ada.Unchecked_Conversion
(Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit_Acc);
- -- Mode field is set to 1 if units value is per address. Otherwise,
+ -- Mode field is set to 4 if units value is per address. Otherwise,
-- mode is 0.
type Ghdl_Rtin_Type_Physical is record
Common : Ghdl_Rti_Common;
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index 784698d35..f846f382a 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -260,6 +260,28 @@ package body Grt.Rtis_Addr is
end case;
end Get_Base_Type;
+ function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean
+ is
+ begin
+ return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask)
+ = Ghdl_Rti_Type_Complex;
+ end Rti_Complex_Type;
+
+ function Rti_Anonymous_Type (Atype : Ghdl_Rti_Access) return Boolean
+ is
+ begin
+ return (Atype.Mode and Ghdl_Rti_Type_Anonymous_Mask)
+ = 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 15a05a48c..33efc0b28 100644
--- a/translate/grt/grt-rtis_addr.ads
+++ b/translate/grt/grt-rtis_addr.ads
@@ -83,6 +83,21 @@ package Grt.Rtis_Addr is
-- Get the base type of ATYPE.
function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access;
+ -- Return true iff ATYPE is anonymous.
+ -- Valid only on type and subtype definitions.
+ function Rti_Anonymous_Type (Atype : Ghdl_Rti_Access) return Boolean;
+ pragma Inline (Rti_Anonymous_Type);
+
+ -- Return true iff ATYPE is complex.
+ -- Valid only on type and subtype definitions.
+ 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 dbc70c2c6..52b86001d 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -148,13 +148,6 @@ package body Grt.Rtis_Utils is
return Traverse_Instance (Ctxt);
end Traverse_Blocks;
- function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean
- is
- begin
- return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask)
- = Ghdl_Rti_Type_Complex;
- end Rti_Complex_Type;
-
-- Disp value stored at ADDR and whose type is described by RTI.
procedure Get_Enum_Value
(Vstr : in out Vstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
@@ -328,10 +321,12 @@ package body Grt.Rtis_Utils is
is
El : Ghdl_Rtin_Element_Acc;
Obj_Addr : Address;
+ Last_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));
if Is_Sig then
@@ -339,18 +334,21 @@ package body Grt.Rtis_Utils is
else
Addr := Obj_Addr + El.Val_Off;
end if;
+ if Rti_Complex_Type (El.Eltype) then
+ Addr := To_Addr_Acc (Addr).all;
+ end if;
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;
- -- FIXME
- --Addr := Obj_Addr + Rti.Xx;
+ Addr := Last_Addr;
end Handle_Record;
- procedure Handle_Any (Rti : Ghdl_Rti_Access)
- is
- Save_Addr : Address;
+ procedure Handle_Any (Rti : Ghdl_Rti_Access) is
begin
case Rti.Kind is
when Ghdl_Rtik_Subtype_Scalar =>
@@ -372,28 +370,7 @@ package body Grt.Rtis_Utils is
begin
Bound_To_Range
(Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
- if Rti_Complex_Type (Rti) then
- Save_Addr := Addr;
- Addr := To_Addr_Acc (Addr).all;
- end if;
- Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
- if Rti_Complex_Type (Rti) then
- Addr := Save_Addr + (Address'Size / Storage_Unit);
- end if;
- end;
- when Ghdl_Rtik_Subtype_Array_Ptr =>
- declare
- St : constant Ghdl_Rtin_Subtype_Array_Acc :=
- To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
- Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
- begin
- Bound_To_Range
- (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
- Save_Addr := Addr;
- Addr := To_Addr_Acc (Addr).all;
Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
- Addr := Save_Addr + (Address'Size / Storage_Unit);
end;
-- when Ghdl_Rtik_Type_File =>
-- declare
@@ -406,20 +383,17 @@ package body Grt.Rtis_Utils is
-- -- composite type).
-- end;
when Ghdl_Rtik_Type_Record =>
- if Rti_Complex_Type (Rti) then
- Save_Addr := Addr;
- Addr := To_Addr_Acc (Addr).all;
- end if;
Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
- if Rti_Complex_Type (Rti) then
- Addr := Save_Addr + (Address'Size / Storage_Unit);
- end if;
when others =>
Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
end case;
end Handle_Any;
begin
- Addr := Obj_Addr;
+ if Rti_Complex_Type (Obj_Type) then
+ Addr := To_Addr_Acc (Obj_Addr).all;
+ else
+ Addr := Obj_Addr;
+ end if;
Handle_Any (Obj_Type);
Free (Name);
end Foreach_Scalar;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
index aa7f352ea..b78b417e5 100644
--- a/translate/grt/grt-vcd.adb
+++ b/translate/grt/grt-vcd.adb
@@ -325,17 +325,6 @@ package body Grt.Vcd is
(Loc_To_Addr (St.Common.Depth, St.Bounds,
Avhpi_Get_Context (Sig)));
end;
- when Ghdl_Rtik_Subtype_Array_Ptr =>
- declare
- St : Ghdl_Rtin_Subtype_Array_Acc;
- begin
- St := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
- Info.Kind := Rti_To_Vcd_Kind (St.Basetype);
- Info.Addr := To_Addr_Acc (Sig_Addr).all;
- Info.Irange := To_Ghdl_Range_Ptr
- (Loc_To_Addr (St.Common.Depth, St.Bounds,
- Avhpi_Get_Context (Sig)));
- end;
when Ghdl_Rtik_Type_Array =>
declare
Uc : Ghdl_Uc_Array_Acc;
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index 7bcb0df6f..fb43fd17a 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -629,15 +629,14 @@ package body Grt.Waves is
Create_String_Id (Enum.Names (I - 1));
end loop;
end;
- when Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr =>
+ when Ghdl_Rtik_Subtype_Array =>
declare
Arr : Ghdl_Rtin_Subtype_Array_Acc;
B_Ctxt : Rti_Context;
begin
Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
Create_String_Id (Arr.Name);
- if Rti.Mode = Ghdl_Rti_Type_Complex then
+ if Rti_Complex_Type (Rti) then
B_Ctxt := Ctxt;
else
B_Ctxt := N_Ctxt;
@@ -1271,8 +1270,7 @@ package body Grt.Waves is
Write_String_Id (Enum.Names (I - 1));
end loop;
end;
- when Ghdl_Rtik_Subtype_Array
- | Ghdl_Rtik_Subtype_Array_Ptr =>
+ when Ghdl_Rtik_Subtype_Array =>
declare
Arr : Ghdl_Rtin_Subtype_Array_Acc;
begin
@@ -1351,33 +1349,30 @@ package body Grt.Waves is
for I in 1 .. Base.Nbr loop
Unit := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1));
Write_String_Id (Unit.Name);
- case Base.Common.Mode is
- when 0 =>
- -- 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;
- when 1 =>
- 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;
- when others =>
- Internal_Error ("wave.write_types(P32/P64)");
- end case;
+ 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;
end loop;
end;
when others =>
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-30 05:39:01 +0000