rtis/vcd/ghw: handle record subtypes.

8 files changed, 179 insertions, 101 deletions

diff --git a/src/grt/ghwlib.c b/src/grt/ghwlib.c
index eadb64cdd..996057ff6 100644
--- a/src/grt/ghwlib.c
+++ b/src/grt/ghwlib.c
@@ -411,6 +411,8 @@ get_nbr_elements (union ghw_type *t)
       return t->sa.nbr_el;
     case ghdl_rtik_type_record:
       return t->rec.nbr_el;
+    case ghdl_rtik_subtype_record:
+      return t->sr.base->nbr_el;
     default:
       fprintf (stderr, "get_nbr_elements: unhandled type %d\n", t->kind);
       abort ();
@@ -621,6 +623,19 @@ ghw_read_type (struct ghw_handler *h)
 	    h->types[i] = (union ghw_type *)rec;
 	  }
 	  break;
+	case ghdl_rtik_subtype_record:
+	  {
+	    struct ghw_subtype_record *sr;
+
+	    sr = malloc (sizeof (struct ghw_subtype_record));
+	    sr->kind = t;
+	    sr->name = ghw_read_strid (h);
+	    sr->base = (struct ghw_type_record *)ghw_read_typeid (h);
+	    if (h->flag_verbose > 1)
+	      printf ("subtype record: %s\n", sr->name);
+	    h->types[i] = (union ghw_type *)sr;
+	  }
+	  break;
 	default:
 	  fprintf (stderr, "ghw_read_type: unknown type %d\n", t);
 	  return -1;
@@ -723,6 +738,8 @@ ghw_read_signal (struct ghw_handler *h, unsigned int *sigs, union ghw_type *t)
 	  }
       }
       return 0;
+    case ghdl_rtik_subtype_record:
+      return ghw_read_signal (h, sigs, (union ghw_type *)t->sr.base);
     default:
       fprintf (stderr, "ghw_read_signal: type kind %d unhandled\n", t->kind);
       abort ();
@@ -1686,6 +1703,9 @@ ghw_disp_subtype_definition (struct ghw_handler *h, union ghw_type *t)
 	printf (")");
       }
       break;
+    case ghdl_rtik_subtype_record:
+      ghw_disp_typename (h, (union ghw_type *)t->sr.base);
+      break;
     default:
       printf ("ghw_disp_subtype_definition: unhandled type kind %d\n",
 	      t->kind);
@@ -1792,6 +1812,7 @@ ghw_disp_type (struct ghw_handler *h, union ghw_type *t)
     case ghdl_rtik_subtype_array:
     case ghdl_rtik_subtype_array_ptr:
     case ghdl_rtik_subtype_scalar:
+    case ghdl_rtik_subtype_record:
       {
 	struct ghw_type_common *c = &t->common;
 	printf ("subtype %s is ", c->name);
diff --git a/src/grt/ghwlib.h b/src/grt/ghwlib.h
index bcb4d9b2c..7e51376af 100644
--- a/src/grt/ghwlib.h
+++ b/src/grt/ghwlib.h
@@ -219,7 +219,15 @@ struct ghw_type_record
   int nbr_el;	/* Number of scalar signals.  */
   struct ghw_record_element *el;
 };
-  
+
+struct ghw_subtype_record
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  struct ghw_type_record *base;
+};
+
 union ghw_type
 {
   enum ghdl_rtik kind;
@@ -229,6 +237,7 @@ union ghw_type
   struct ghw_type_physical ph;
   struct ghw_subtype_scalar ss;
   struct ghw_subtype_array sa;
+  struct ghw_subtype_record sr;
   struct ghw_type_array ar;
   struct ghw_type_record rec;
 };
diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index bf77e56dc..898300c26 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -259,26 +259,7 @@ package body Grt.Disp_Rti is
          end if;
          Put (Stream, El.Name);
          Put (" => ");
-         if Is_Sig then
-            El_Addr := Obj + El.Sig_Off;
-         else
-            El_Addr := Obj + El.Val_Off;
-         end if;
-         case El.Eltype.Kind is
-            when Ghdl_Rtik_Subtype_Array
-              | Ghdl_Rtik_Type_Record =>
-               --  Element is an offset.
-               if Rti_Complex_Type (El.Eltype) then
-                  El_Addr := Obj + To_Ghdl_Index_Acc (El_Addr).all;
-               end if;
-            when Ghdl_Rtik_Type_Array
-              | Ghdl_Rtik_Type_Unbounded_Record
-              | Ghdl_Rtik_Subtype_Unbounded_Record =>
-               --  Element is an offset.
-               El_Addr := Obj + To_Ghdl_Index_Acc (El_Addr).all;
-            when others =>
-               null;
-         end case;
+         Record_To_Element_Base (Obj, El, Is_Sig, El_Addr);
          Disp_Value (Stream, El.Eltype, Ctxt, El_Addr, Bounds, Is_Sig);
       end loop;
       Put (")");
@@ -868,25 +849,7 @@ package body Grt.Disp_Rti is
       Disp_Subtype_Indication (Obj_Type, Ctxt, Addr);
       Put (" := ");
 
-      --  FIXME: put this into a function.
-      Bounds := Null_Address;
-      case Obj_Type.Kind is
-         when  Ghdl_Rtik_Subtype_Array
-           | Ghdl_Rtik_Type_Record
-           | Ghdl_Rtik_Subtype_Record =>
-            --  Object is a pointer.
-            if Rti_Complex_Type (Obj_Type) then
-               Addr := To_Addr_Acc (Addr).all;
-            end if;
-         when Ghdl_Rtik_Type_Array
-           | Ghdl_Rtik_Type_Unbounded_Record
-           | Ghdl_Rtik_Subtype_Unbounded_Record =>
-            --  Object is a fat pointer.
-            Bounds := To_Ghdl_Uc_Array_Acc (Addr).Bounds;
-            Addr := To_Ghdl_Uc_Array_Acc (Addr).Base;
-         when others =>
-            null;
-      end case;
+      Object_To_Base_Bounds (Obj_Type, Addr, Addr, Bounds);
       Disp_Value (stdout, Obj_Type, Ctxt, Addr, Bounds, Is_Sig);
       New_Line;
    end Disp_Object;
diff --git a/src/grt/grt-ghw.ads b/src/grt/grt-ghw.ads
index 6dfc2c648..6ceb937d1 100644
--- a/src/grt/grt-ghw.ads
+++ b/src/grt/grt-ghw.ads
@@ -59,4 +59,5 @@ package Grt.Ghw is
    Ghw_Rtik_Type_Record    : constant Ghw_Rtik := 32;
    Ghw_Rtik_Subtype_Scalar : constant Ghw_Rtik := 34;
    Ghw_Rtik_Subtype_Array  : constant Ghw_Rtik := 35;
+   Ghw_Rtik_Subtype_Record : constant Ghw_Rtik := 38;
 end Grt.Ghw;
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index e520e5435..2c603106f 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -151,6 +151,59 @@ package body Grt.Rtis_Utils is
       Append (Vstr, Enum_Rti.Names (Val));
    end Get_Enum_Value;
 
+   procedure Object_To_Base_Bounds (Obj_Type : Ghdl_Rti_Access;
+                                    Obj_Loc : Address;
+                                    Addr : out Address;
+                                    Bounds : out Address) is
+   begin
+      --  FIXME: put this into a function.
+      Bounds := Null_Address;
+      Addr := Obj_Loc;
+      case Obj_Type.Kind is
+         when  Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Type_Record
+           | Ghdl_Rtik_Subtype_Record =>
+            --  Object is a pointer.
+            if Rti_Complex_Type (Obj_Type) then
+               Addr := To_Addr_Acc (Obj_Loc).all;
+            end if;
+         when Ghdl_Rtik_Type_Array
+           | Ghdl_Rtik_Type_Unbounded_Record
+           | Ghdl_Rtik_Subtype_Unbounded_Record =>
+            --  Object is a fat pointer.
+            Bounds := To_Ghdl_Uc_Array_Acc (Obj_Loc).Bounds;
+            Addr := To_Ghdl_Uc_Array_Acc (Obj_Loc).Base;
+         when others =>
+            null;
+      end case;
+   end Object_To_Base_Bounds;
+
+   procedure Record_To_Element_Base (Obj : Address;
+                                     El : Ghdl_Rtin_Element_Acc;
+                                     Is_Sig : Boolean;
+                                     Addr : out Address) is
+   begin
+      if Is_Sig then
+         Addr := Obj + El.Sig_Off;
+      else
+         Addr := Obj + El.Val_Off;
+      end if;
+      case El.Eltype.Kind is
+         when Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Type_Record =>
+            --  Element is an offset.
+            if Rti_Complex_Type (El.Eltype) then
+               Addr := Obj + To_Ghdl_Index_Acc (Addr).all;
+            end if;
+         when Ghdl_Rtik_Type_Array
+           | Ghdl_Rtik_Type_Unbounded_Record
+           | Ghdl_Rtik_Subtype_Unbounded_Record =>
+            --  Element is an offset.
+            Addr := Obj + To_Ghdl_Index_Acc (Addr).all;
+         when others =>
+            null;
+      end case;
+   end Record_To_Element_Base;
 
    procedure Foreach_Scalar (Ctxt : Rti_Context;
                              Obj_Type : Ghdl_Rti_Access;
@@ -160,6 +213,7 @@ package body Grt.Rtis_Utils is
    is
       --  Current address.
       Addr : Address;
+      Bounds : Address;
 
       Name : Vstring;
 
@@ -268,7 +322,6 @@ package body Grt.Rtis_Utils is
       end Pos_To_Vstring;
 
       procedure Handle_Array_1 (Arr_Rti : Ghdl_Rtin_Type_Array_Acc;
-                                Bounds : in out Address;
                                 Index : Ghdl_Index_Type)
       is
          Idx_Rti : constant Ghdl_Rti_Access := Arr_Rti.Indexes (Index);
@@ -278,6 +331,7 @@ package body Grt.Rtis_Utils is
          Rng : Ghdl_Range_Ptr;
          Len : Ghdl_Index_Type;
          P : Natural;
+         Cur_Bounds : Address;
       begin
          P := Length (Name);
          if Index = 0 then
@@ -289,29 +343,21 @@ package body Grt.Rtis_Utils is
          Extract_Range (Bounds, Base_Type, Rng);
          Len := Range_To_Length (Rng, Base_Type);
 
+         Cur_Bounds := Bounds;
          for I in 1 .. Len loop
+            Bounds := Cur_Bounds;
             Pos_To_Vstring (Name, Base_Type, Rng, I - 1);
             if Index = Last_Index then
                Append (Name, ')');
                Handle_Any (El_Rti);
             else
-               Handle_Array_1 (Arr_Rti, Bounds, Index + 1);
+               Handle_Array_1 (Arr_Rti, Index + 1);
             end if;
             Truncate (Name, P + 1);
          end loop;
          Truncate (Name, P);
       end Handle_Array_1;
 
-      procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc;
-                              Vals : Ghdl_Uc_Array_Acc)
-      is
-         Bounds : Address;
-      begin
-         Addr := Vals.Base;
-         Bounds := Vals.Bounds;
-         Handle_Array_1 (Rti, Bounds, 0);
-      end Handle_Array;
-
       procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc)
       is
          El : Ghdl_Rtin_Element_Acc;
@@ -324,14 +370,7 @@ package body Grt.Rtis_Utils is
          Last_Addr := Addr;
          for I in 1 .. Rti.Nbrel loop
             El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
-            if Is_Sig then
-               Addr := Obj_Addr + El.Sig_Off;
-            else
-               Addr := Obj_Addr + El.Val_Off;
-            end if;
-            if Rti_Complex_Type (El.Eltype) then
-               Addr := Obj_Addr + To_Ghdl_Index_Acc (Addr).all;
-            end if;
+            Record_To_Element_Base (Obj_Addr, El, Is_Sig, Addr);
             Append (Name, '.');
             Append (Name, El.Name);
             Handle_Any (El.Eltype);
@@ -354,18 +393,18 @@ package body Grt.Rtis_Utils is
               | Ghdl_Rtik_Type_B1 =>
                Handle_Scalar (Rti);
             when Ghdl_Rtik_Type_Array =>
-               Handle_Array (To_Ghdl_Rtin_Type_Array_Acc (Rti),
-                             To_Ghdl_Uc_Array_Acc (Addr));
+               Handle_Array_1 (To_Ghdl_Rtin_Type_Array_Acc (Rti), 0);
             when Ghdl_Rtik_Subtype_Array =>
                declare
                   St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
                     To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
                   Bt : constant Ghdl_Rtin_Type_Array_Acc :=
                     To_Ghdl_Rtin_Type_Array_Acc (St.Basetype);
-                  Bounds : Address;
+                  Prev_Bounds : constant Address := Bounds;
                begin
                   Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt);
-                  Handle_Array_1 (Bt, Bounds, 0);
+                  Handle_Array_1 (Bt, 0);
+                  Bounds := Prev_Bounds;
                end;
 --          when Ghdl_Rtik_Type_File =>
 --             declare
@@ -379,16 +418,24 @@ package body Grt.Rtis_Utils is
 --             end;
             when Ghdl_Rtik_Type_Record =>
                Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+            when Ghdl_Rtik_Subtype_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);
+                  Prev_Bounds : constant Address := Bounds;
+               begin
+                  Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt);
+                  Handle_Record (Bt);
+                  Bounds := Prev_Bounds;
+               end;
             when others =>
                Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
          end case;
       end Handle_Any;
    begin
-      if Rti_Complex_Type (Obj_Type) then
-         Addr := To_Addr_Acc (Obj_Addr).all;
-      else
-         Addr := Obj_Addr;
-      end if;
+      Object_To_Base_Bounds (Obj_Type, Obj_Addr, Addr, Bounds);
       Handle_Any (Obj_Type);
       Free (Name);
    end Foreach_Scalar;
diff --git a/src/grt/grt-rtis_utils.ads b/src/grt/grt-rtis_utils.ads
index eecf390a2..71d9e963b 100644
--- a/src/grt/grt-rtis_utils.ads
+++ b/src/grt/grt-rtis_utils.ads
@@ -62,6 +62,19 @@ package Grt.Rtis_Utils is
                              Is_Sig : Boolean;
                              Param : Param_Type);
 
+   --  Convert object address OBJ_LOC (got from RTIs) to ADDR and BOUNDS.
+   --  Deals with complex types and fat pointers.
+   procedure Object_To_Base_Bounds (Obj_Type : Ghdl_Rti_Access;
+                                    Obj_Loc : Address;
+                                    Addr : out Address;
+                                    Bounds : out Address);
+
+   --  Get address of element EL for record at OBJ.
+   procedure Record_To_Element_Base (Obj : Address;
+                                     El : Ghdl_Rtin_Element_Acc;
+                                     Is_Sig : Boolean;
+                                     Addr : out Address);
+
    procedure Get_Value (Str : in out Vstring;
                         Value : Value_Union;
                         Type_Rti : Ghdl_Rti_Access);
diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb
index ca0d7c6e5..7a0abde52 100644
--- a/src/grt/grt-vcd.adb
+++ b/src/grt/grt-vcd.adb
@@ -47,6 +47,7 @@ with Grt.C; use Grt.C;
 with Grt.Hooks; use Grt.Hooks;
 with Grt.Rtis; use Grt.Rtis;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
 with Grt.Rtis_Types; use Grt.Rtis_Types;
 with Grt.Vstrings;
 with Grt.Wave_Opt; use Grt.Wave_Opt;
@@ -325,6 +326,7 @@ package body Grt.Vcd is
       Rti : Ghdl_Rti_Access;
       Error : AvhpiErrorT;
       Sig_Addr : Address;
+      Bounds : Address;
 
       Kind : Vcd_Var_Type;
       Irange : Ghdl_Range_Ptr;
@@ -339,42 +341,46 @@ package body Grt.Vcd is
 
       Rti := Avhpi_Get_Rti (Sig_Type);
       Sig_Addr := Avhpi_Get_Address (Sig);
-      if Rti_Complex_Type (Rti) then
-         Sig_Addr := To_Addr_Acc (Sig_Addr).all;
-      end if;
+      Object_To_Base_Bounds (Rti, Sig_Addr, Sig_Addr, Bounds);
 
-      Kind := Vcd_Bad;
-      Irange := null;
       case Rti.Kind is
          when Ghdl_Rtik_Type_B1
            | Ghdl_Rtik_Type_E8
            | Ghdl_Rtik_Subtype_Scalar =>
             Kind := Rti_To_Vcd_Kind (Rti);
+            Irange := null;
          when Ghdl_Rtik_Subtype_Array =>
             declare
                St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
                  To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+               Arr_Rti : constant Ghdl_Rtin_Type_Array_Acc :=
+                 To_Ghdl_Rtin_Type_Array_Acc (St.Basetype);
+               Idx_Rti : constant Ghdl_Rti_Access :=
+                 Get_Base_Type (Arr_Rti.Indexes (0));
             begin
-               Kind := Rti_To_Vcd_Kind (St.Basetype);
-               Irange := To_Ghdl_Range_Ptr
-                 (Loc_To_Addr (St.Common.Depth, St.Bounds,
-                               Avhpi_Get_Context (Sig)));
+               Kind := Rti_To_Vcd_Kind (Arr_Rti);
+               Bounds := Loc_To_Addr (St.Common.Depth, St.Bounds,
+                                      Avhpi_Get_Context (Sig));
+               Extract_Range (Bounds, Idx_Rti, Irange);
             end;
          when Ghdl_Rtik_Type_Array =>
             declare
-               Uc : Ghdl_Uc_Array_Acc;
+               Arr_Rti : constant Ghdl_Rtin_Type_Array_Acc :=
+                 To_Ghdl_Rtin_Type_Array_Acc (Rti);
+               Idx_Rti : constant Ghdl_Rti_Access :=
+                 Get_Base_Type (Arr_Rti.Indexes (0));
             begin
-               Kind := Rti_To_Vcd_Kind (To_Ghdl_Rtin_Type_Array_Acc (Rti));
-               Uc := To_Ghdl_Uc_Array_Acc (Sig_Addr);
-               Sig_Addr := Uc.Base;
-               Irange := To_Ghdl_Range_Ptr (Uc.Bounds);
+               Kind := Rti_To_Vcd_Kind (Arr_Rti);
+               Extract_Range (Bounds, Idx_Rti, Irange);
             end;
          when others =>
-            null;
+            Kind := Vcd_Bad;
       end case;
 
       --  Do not allow null-array.
-      if Irange /= null and then Irange.I32.Len = 0 then
+      if Kind = Vcd_Bad
+        or else (Irange /= null and then Irange.I32.Len = 0)
+      then
          Info := (Vtype => Vcd_Bad, Val => Vcd_Effective, Ptr => Null_Address);
          return;
       end if;
diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb
index 43ae4ec73..8e2751268 100644
--- a/src/grt/grt-waves.adb
+++ b/src/grt/grt-waves.adb
@@ -637,9 +637,9 @@ package body Grt.Waves is
             end;
          when Ghdl_Rtik_Type_Array =>
             declare
-               Arr : Ghdl_Rtin_Type_Array_Acc;
+               Arr : constant Ghdl_Rtin_Type_Array_Acc :=
+                 To_Ghdl_Rtin_Type_Array_Acc (Rti);
             begin
-               Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
                Create_String_Id (Arr.Name);
                Create_Type (Arr.Element, N_Ctxt);
                for I in 1 .. Arr.Nbr_Dim loop
@@ -648,9 +648,9 @@ package body Grt.Waves is
             end;
          when Ghdl_Rtik_Subtype_Scalar =>
             declare
-               Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+               Sub : constant Ghdl_Rtin_Subtype_Scalar_Acc :=
+                 To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
             begin
-               Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
                Create_String_Id (Sub.Name);
                Create_Type (Sub.Basetype, N_Ctxt);
             end;
@@ -690,6 +690,14 @@ package body Grt.Waves is
                   Create_Type (El.Eltype, N_Ctxt);
                end loop;
             end;
+         when Ghdl_Rtik_Subtype_Record =>
+            declare
+               Rec : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                 To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+            begin
+               Create_String_Id (Rec.Name);
+               Create_Type (Rec.Basetype, N_Ctxt);
+            end;
          when others =>
             Internal_Error ("wave.create_type");
 --              Internal_Error ("wave.create_type: does not handle " &
@@ -1200,6 +1208,8 @@ package body Grt.Waves is
             return Ghw_Rtik_Type_Array;
          when Ghdl_Rtik_Type_Record =>
             return Ghw_Rtik_Type_Record;
+         when Ghdl_Rtik_Subtype_Record =>
+            return Ghw_Rtik_Subtype_Record;
          when Ghdl_Rtik_Subtype_Scalar =>
             return Ghw_Rtik_Subtype_Scalar;
          when Ghdl_Rtik_Type_I32 =>
@@ -1302,9 +1312,9 @@ package body Grt.Waves is
                when Ghdl_Rtik_Type_B1
                  | Ghdl_Rtik_Type_E8 =>
                   declare
-                     Enum : Ghdl_Rtin_Type_Enum_Acc;
+                     Enum : constant Ghdl_Rtin_Type_Enum_Acc :=
+                       To_Ghdl_Rtin_Type_Enum_Acc (Rti);
                   begin
-                     Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
                      Write_String_Id (Enum.Name);
                      Wave_Put_ULEB128 (Ghdl_E32 (Enum.Nbr));
                      for I in 1 .. Enum.Nbr loop
@@ -1333,9 +1343,9 @@ package body Grt.Waves is
                   end;
                when Ghdl_Rtik_Type_Array =>
                   declare
-                     Arr : Ghdl_Rtin_Type_Array_Acc;
+                     Arr : constant Ghdl_Rtin_Type_Array_Acc :=
+                       To_Ghdl_Rtin_Type_Array_Acc (Rti);
                   begin
-                     Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
                      Write_String_Id (Arr.Name);
                      Write_Type_Id (Arr.Element, Ctxt);
                      Wave_Put_ULEB128 (Ghdl_E32 (Arr.Nbr_Dim));
@@ -1345,10 +1355,10 @@ package body Grt.Waves is
                   end;
                when Ghdl_Rtik_Type_Record =>
                   declare
-                     Rec : Ghdl_Rtin_Type_Record_Acc;
+                     Rec : constant Ghdl_Rtin_Type_Record_Acc :=
+                       To_Ghdl_Rtin_Type_Record_Acc (Rti);
                      El : Ghdl_Rtin_Element_Acc;
                   begin
-                     Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti);
                      Write_String_Id (Rec.Name);
                      Wave_Put_ULEB128 (Ghdl_E32 (Rec.Nbrel));
                      for I in 1 .. Rec.Nbrel loop
@@ -1357,11 +1367,19 @@ package body Grt.Waves is
                         Write_Type_Id (El.Eltype, Ctxt);
                      end loop;
                   end;
+               when Ghdl_Rtik_Subtype_Record =>
+                  declare
+                     Arr : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                       To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+                  begin
+                     Write_String_Id (Arr.Name);
+                     Write_Type_Id (Arr.Basetype, Ctxt);
+                  end;
                when Ghdl_Rtik_Subtype_Scalar =>
                   declare
-                     Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+                     Sub : constant Ghdl_Rtin_Subtype_Scalar_Acc :=
+                       To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
                   begin
-                     Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
                      Write_String_Id (Sub.Name);
                      Write_Type_Id (Sub.Basetype, Ctxt);
                      Write_Range
@@ -1374,18 +1392,18 @@ package body Grt.Waves is
                  | Ghdl_Rtik_Type_I64
                  | Ghdl_Rtik_Type_F64 =>
                   declare
-                     Base : Ghdl_Rtin_Type_Scalar_Acc;
+                     Base : constant Ghdl_Rtin_Type_Scalar_Acc :=
+                       To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
                   begin
-                     Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
                      Write_String_Id (Base.Name);
                   end;
                when Ghdl_Rtik_Type_P32
                  | Ghdl_Rtik_Type_P64 =>
                   declare
-                     Base : Ghdl_Rtin_Type_Physical_Acc;
+                     Base : constant Ghdl_Rtin_Type_Physical_Acc :=
+                       To_Ghdl_Rtin_Type_Physical_Acc (Rti);
                      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