Improve SDF annotator

7 files changed, 783 insertions, 200 deletions

diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index 4b4086f..36826fe 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -108,12 +108,17 @@ package body Grt.Avhpi is
                when VhpiGenericDeclK =>
                   Res := (Kind => AvhpiNameIteratorK,
                           Ctxt => Ref.Ctxt,
-                          N_Addr => Loc_To_Addr (Ref.Obj.Common.Depth,
-                                                 Ref.Obj.Loc,
-                                                 Ref.Ctxt),
+                          N_Addr => Avhpi_Get_Address (Ref),
                           N_Type => Ref.Obj.Obj_Type,
                           N_Idx => 0,
                           N_Obj => Ref.Obj);
+               when VhpiIndexedNameK =>
+                  Res := (Kind => AvhpiNameIteratorK,
+                          Ctxt => Ref.Ctxt,
+                          N_Addr => Ref.N_Addr,
+                          N_Type => Ref.N_Type,
+                          N_Idx => 0,
+                          N_Obj => Ref.N_Obj);
                when others =>
                   Error := AvhpiErrorNotImplemented;
                   return;
@@ -143,16 +148,55 @@ package body Grt.Avhpi is
       Error := AvhpiErrorNotImplemented;
    end Vhpi_Iterator;
 
+   --  OBJ_RTI is the RTI for the base name.
+   function Add_Index (Ctxt : Rti_Context;
+                       Obj_Base : Address;
+                       Obj_Rti : Ghdl_Rtin_Object_Acc;
+                       El_Type : Ghdl_Rti_Access;
+                       Off : Ghdl_Index_Type) return Address
+   is
+      Is_Sig : Boolean;
+      El_Size : Ghdl_Index_Type;
+      El_Type1 : Ghdl_Rti_Access;
+   begin
+      case Obj_Rti.Common.Kind is
+         when Ghdl_Rtik_Generic =>
+            Is_Sig := False;
+         when others =>
+            Internal_Error ("add_index");
+      end case;
+
+      if El_Type.Kind = Ghdl_Rtik_Subtype_Scalar then
+         El_Type1 := Get_Base_Type (El_Type);
+      else
+         El_Type1 := El_Type;
+      end if;
+
+      case El_Type1.Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            if Is_Sig then
+               El_Size := Address'Size / Storage_Unit;
+            else
+               El_Size := Ghdl_I64'Size / Storage_Unit;
+            end if;
+         when Ghdl_Rtik_Subtype_Array =>
+            if Is_Sig then
+               El_Size :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize.Off;
+            else
+               El_Size :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize.Off;
+            end if;
+         when others =>
+            Internal_Error ("add_index");
+      end case;
+      return Obj_Base + Off * El_Size;
+   end Add_Index;
+
    procedure Vhpi_Scan_Indexed_Name (Iterator : in out VhpiHandleT;
                                      Res : out VhpiHandleT;
                                      Error : out AvhpiErrorT)
    is
-      procedure Update (S : Ghdl_Index_Type) is
-      begin
-         Iterator.N_Addr := Iterator.N_Addr + (S / Storage_Unit);
-      end Update;
-
-      Is_Sig : Boolean;
       El_Type : Ghdl_Rti_Access;
    begin
       if Iterator.N_Idx = 0 then
@@ -171,23 +215,9 @@ package body Grt.Avhpi is
               N_Obj => Iterator.N_Obj);
 
       --  Increment Address.
-      case Iterator.N_Obj.Common.Kind is
-         when Ghdl_Rtik_Generic =>
-            Is_Sig := False;
-         when others =>
-            Internal_Error ("vhpi_scan_indexed_name(1)");
-      end case;
+      Iterator.N_Addr := Add_Index
+        (Iterator.Ctxt, Iterator.N_Addr, Iterator.N_Obj, El_Type, 1);
 
-      case Get_Base_Type (El_Type).Kind is
-         when Ghdl_Rtik_Type_P64 =>
-            if Is_Sig then
-               Update (Address'Size);
-            else
-               Update (Ghdl_I64'Size);
-            end if;
-         when others =>
-            Internal_Error ("vhpi_scan_indexed_name");
-      end case;
       Iterator.N_Idx := Iterator.N_Idx - 1;
       Error := AvhpiErrorOk;
    end Vhpi_Scan_Indexed_Name;
@@ -328,12 +358,25 @@ package body Grt.Avhpi is
                           Atype => Rti);
                end if;
             end;
+         when Ghdl_Rtik_Type_Array =>
+            Res := (Kind => VhpiArrayTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
          when Ghdl_Rtik_Type_B2
            | Ghdl_Rtik_Type_E8
            | Ghdl_Rtik_Type_E32 =>
             Res := (Kind => VhpiEnumTypeDeclK,
                     Ctxt => Ctxt,
                     Atype => Rti);
+         when Ghdl_Rtik_Type_P32
+           | Ghdl_Rtik_Type_P64 =>
+            Res := (Kind => VhpiPhysTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Res := (Kind => VhpiSubtypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
          when others =>
             Res := (Kind => VhpiUndefined,
                     Ctxt => Ctxt);
@@ -385,17 +428,19 @@ package body Grt.Avhpi is
                when Ghdl_Rtik_Port
                  | Ghdl_Rtik_Generic
                  | 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 =>
+                 | Ghdl_Rtik_Type_B2
+                 | Ghdl_Rtik_Subtype_Scalar =>
                   Rti_To_Handle (Ch, Iterator.Ctxt, Res);
                   if Res.Kind /= VhpiUndefined then
                      Error := AvhpiErrorOk;
                      return;
                   else
-                     Internal_Error ("vhpi_handle");
+                     Internal_Error ("vhpi_scan_decls");
                   end if;
                when others =>
                   null;
@@ -533,6 +578,10 @@ package body Grt.Avhpi is
             case Obj.Kind is
                when VhpiEnumTypeDeclK =>
                   Add (To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name);
+               when VhpiSubtypeDeclK =>
+                  Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name);
+               when VhpiArrayTypeDeclK =>
+                  Add (To_Ghdl_Rtin_Type_Array_Acc (Obj.Atype).Name);
                when VhpiPackInstK
                  | VhpiArchBodyK
                  | VhpiEntityDeclK
@@ -554,8 +603,6 @@ package body Grt.Avhpi is
                  | VhpiPortDeclK
                  | VhpiGenericDeclK =>
                   Add (Obj.Obj.Name);
-               when VhpiSubtypeDeclK =>
-                  Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name);
                when VhpiForGenerateK =>
                   declare
                      Blk : Ghdl_Rtin_Block_Acc;
@@ -605,7 +652,7 @@ package body Grt.Avhpi is
                   declare
                      Comp : Ghdl_Rtin_Component_Acc;
                   begin
-                     Comp := To_Ghdl_Rtin_Component_Acc (Obj.Obj.Obj_Type);
+                     Comp := To_Ghdl_Rtin_Component_Acc (Obj.Inst.Instance);
                      if Comp.Common.Kind = Ghdl_Rtik_Component then
                         Add (Comp.Name);
                      end if;
@@ -748,12 +795,226 @@ package body Grt.Avhpi is
                when others =>
                   return;
             end case;
+         when VhpiBaseType =>
+            declare
+               Atype : Ghdl_Rti_Access;
+            begin
+               case Ref.Kind is
+                  when VhpiSubtypeIndicK
+                    | VhpiSubtypeDeclK
+                    | VhpiArrayTypeDeclK =>
+                     Atype := Ref.Atype;
+                  when VhpiGenericDeclK =>
+                     Atype := Ref.Obj.Obj_Type;
+                  when VhpiIndexedNameK =>
+                     Atype := Ref.N_Type;
+                  when others =>
+                     return;
+               end case;
+               case Atype.Kind is
+                  when Ghdl_Rtik_Subtype_Array =>
+                     Rti_To_Handle
+                       (To_Ghdl_Rti_Access (To_Ghdl_Rtin_Subtype_Array_Acc
+                                            (Atype).Basetype),
+                        Ref.Ctxt, Res);
+                     if Res.Kind /= VhpiUndefined then
+                        Error := AvhpiErrorOk;
+                     end if;
+                  when Ghdl_Rtik_Subtype_Scalar =>
+                     Rti_To_Handle
+                       (To_Ghdl_Rtin_Subtype_Scalar_Acc (Atype).Basetype,
+                        Ref.Ctxt, Res);
+                     if Res.Kind /= VhpiUndefined then
+                        Error := AvhpiErrorOk;
+                     end if;
+                  when Ghdl_Rtik_Type_Array =>
+                     Res := Ref;
+                     Error := AvhpiErrorOk;
+                  when others =>
+                     return;
+               end case;
+            end;
+         when VhpiElemSubtype =>
+            declare
+               Base_Type : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               case Ref.Atype.Kind is
+                  when Ghdl_Rtik_Subtype_Array =>
+                     Base_Type :=
+                       To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype).Basetype;
+                  when Ghdl_Rtik_Type_Array =>
+                     Base_Type := To_Ghdl_Rtin_Type_Array_Acc (Ref.Atype);
+                  when others =>
+                     return;
+               end case;
+               Rti_To_Handle (Base_Type.Element, Ref.Ctxt, Res);
+               if Res.Kind /= VhpiUndefined then
+                  Error := AvhpiErrorOk;
+               end if;
+            end;
          when others =>
             Res := Null_Handle;
             Error := AvhpiErrorNotImplemented;
       end case;
    end Vhpi_Handle;
 
+   procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT;
+                                   Ref : VhpiHandleT;
+                                   Index : Natural;
+                                   Res : out VhpiHandleT;
+                                   Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default error.
+      Error := AvhpiErrorNotImplemented;
+
+      case Rel is
+         when VhpiConstraints =>
+            case Ref.Kind is
+               when VhpiSubtypeIndicK =>
+                  if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then
+                     declare
+                        Arr_Subtype : Ghdl_Rtin_Subtype_Array_Acc :=
+                          To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype);
+                        Basetype : Ghdl_Rtin_Type_Array_Acc :=
+                          Arr_Subtype.Basetype;
+                        Idx : Ghdl_Index_Type := Ghdl_Index_Type (Index);
+                        Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1);
+                        Range_Basetype : Ghdl_Rti_Access;
+                     begin
+                        if Idx not in 1 .. Basetype.Nbr_Dim then
+                           Res := Null_Handle;
+                           Error := AvhpiErrorBadIndex;
+                           return;
+                        end if;
+                        --  constraint type is basetype.indexes (idx - 1)
+                        Bound_To_Range
+                          (Loc_To_Addr (Arr_Subtype.Common.Depth,
+                                        Arr_Subtype.Bounds, Ref.Ctxt),
+                           Basetype, Bounds);
+                        Res := (Kind => VhpiIntRangeK,
+                                Ctxt => Ref.Ctxt,
+                                Rng_Type => Basetype.Indexes (Idx - 1),
+                                Rng_Addr => Bounds (Idx - 1));
+                        Range_Basetype := Get_Base_Type (Res.Rng_Type);
+                        case Range_Basetype.Kind is
+                           when Ghdl_Rtik_Type_I32 =>
+                              null;
+                           when Ghdl_Rtik_Type_E8
+                             | Ghdl_Rtik_Type_E32 =>
+                              Res := (Kind => VhpiEnumRangeK,
+                                      Ctxt => Ref.Ctxt,
+                                      Rng_Type => Res.Rng_Type,
+                                      Rng_Addr => Res.Rng_Addr);
+                           when others =>
+                              Internal_Error
+                                ("vhpi_handle_by_index/constraint");
+                        end case;
+                        Error := AvhpiErrorOk;
+                     end;
+                  end if;
+               when others =>
+                  return;
+            end case;
+         when VhpiIndexedNames =>
+            declare
+               Base_Type, El_Type : VhpiHandleT;
+            begin
+               Vhpi_Handle (VhpiBaseType, Ref, Base_Type, Error);
+               if Error /= AvhpiErrorOk then
+                  return;
+               end if;
+               if Vhpi_Get_Kind (Base_Type) /= VhpiArrayTypeDeclK then
+                  Error := AvhpiErrorBadRel;
+                  return;
+               end if;
+               Vhpi_Handle (VhpiElemSubtype, Base_Type, El_Type, Error);
+               if Error /= AvhpiErrorOk then
+                  return;
+               end if;
+               Res := (Kind => VhpiIndexedNameK,
+                       Ctxt => Ref.Ctxt,
+                       N_Addr => Avhpi_Get_Address (Ref),
+                       N_Type => El_Type.Atype,
+                       N_Idx => Ghdl_Index_Type (Index),
+                       N_Obj => Ref.Obj);
+               if Res.N_Addr = Null_Address then
+                  Error := AvhpiErrorBadRel;
+                  return;
+               end if;
+               Res.N_Addr := Add_Index
+                 (Res.Ctxt, Res.N_Addr, Res.N_Obj, Res.N_Type,
+                  Ghdl_Index_Type (Index));
+            end;
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Handle_By_Index;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out VhpiIntT;
+                       Error : out AvhpiErrorT)
+   is
+   begin
+      case Property is
+         when VhpiLeftBoundP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Left;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when VhpiRightBoundP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Right;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when others =>
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Get;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out Boolean;
+                       Error : out AvhpiErrorT)
+   is
+   begin
+      case Property is
+         when VhpiIsUpP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Dir = Dir_To;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when others =>
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Get;
+
    function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
                                  return VhpiEntityClassT
    is
@@ -771,7 +1032,7 @@ package body Grt.Avhpi is
       return Obj.Kind;
    end Vhpi_Get_Kind;
 
-   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP is
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeT is
    begin
       case Obj.Kind is
          when VhpiPortDeclK =>
@@ -838,7 +1099,8 @@ package body Grt.Avhpi is
       case Hdl1.Kind is
          when VhpiSubtypeIndicK
            | VhpiSubtypeDeclK
-           | VhpiArrayTypeDeclK =>
+           | VhpiArrayTypeDeclK
+           | VhpiPhysTypeDeclK =>
             return Hdl1.Atype = Hdl2.Atype;
          when others =>
             -- FIXME: todo
diff --git a/translate/grt/grt-avhpi.ads b/translate/grt/grt-avhpi.ads
index 8242d5b..771bfb8 100644
--- a/translate/grt/grt-avhpi.ads
+++ b/translate/grt/grt-avhpi.ads
@@ -294,6 +294,80 @@ package Grt.Avhpi is
       VhpiLibraryDecls
      );
 
+   type VhpiIntPropertyT is
+     (
+      VhpiAccessP,
+      VhpiArgcP,
+      VhpiAttrKindP,
+      VhpiBaseIndexP,
+      VhpiBeginLineNoP,
+      VhpiEndLineNoP,
+      VhpiEntityClassP,
+      VhpiForeignKindP,
+      VhpiFrameLevelP,
+      VhpiGenerateIndexP,
+      VhpiIntValP,
+      VhpiIsAnonymousP,
+      VhpiIsBasicP,
+      VhpiIsCompositeP,
+      VhpiIsDefaultP,
+      VhpiIsDeferredP,
+      VhpiIsDiscreteP,
+      VhpiIsForcedP,
+      VhpiIsForeignP,
+      VhpiIsGuardedP,
+      VhpiIsImplicitDeclP,
+      VhpiIsInvalidP_DEPRECATED,
+      VhpiIsLocalP,
+      VhpiIsNamedP,
+      VhpiIsNullP,
+      VhpiIsOpenP,
+      VhpiIsPLIP,
+      VhpiIsPassiveP,
+      VhpiIsPostponedP,
+      VhpiIsProtectedTypeP,
+      VhpiIsPureP,
+      VhpiIsResolvedP,
+      VhpiIsScalarP,
+      VhpiIsSeqStmtP,
+      VhpiIsSharedP,
+      VhpiIsTransportP,
+      VhpiIsUnaffectedP,
+      VhpiIsUnconstrainedP,
+      VhpiIsUninstantiatedP,
+      VhpiIsUpP,
+      VhpiIsVitalP,
+      VhpiIteratorTypeP,
+      VhpiKindP,
+      VhpiLeftBoundP,
+      VhpiLevelP_DEPRECATED,
+      VhpiLineNoP,
+      VhpiLineOffsetP,
+      VhpiLoopIndexP,
+      VhpiModeP,
+      VhpiNumDimensionsP,
+      VhpiNumFieldsP_DEPRECATED,
+      VhpiNumGensP,
+      VhpiNumLiteralsP,
+      VhpiNumMembersP,
+      VhpiNumParamsP,
+      VhpiNumPortsP,
+      VhpiOpenModeP,
+      VhpiPhaseP,
+      VhpiPositionP,
+      VhpiPredefAttrP,
+      VhpiReasonP,
+      VhpiRightBoundP,
+      VhpiSigKindP,
+      VhpiSizeP,
+      VhpiStartLineNoP,
+      VhpiStateP,
+      VhpiStaticnessP,
+      VhpiVHDLversionP,
+      VhpiIdP,
+      VhpiCapabilitiesP
+     );
+
    --  String properties.
    type VhpiStrPropertyT is
      (
@@ -323,7 +397,8 @@ package Grt.Avhpi is
       AvhpiErrorBadRel,
       AvhpiErrorHandle,
       AvhpiErrorNotImplemented,
-      AvhpiErrorIteratorEnd
+      AvhpiErrorIteratorEnd,
+      AvhpiErrorBadIndex
      );
 
    type VhpiHandleT is private;
@@ -342,6 +417,12 @@ package Grt.Avhpi is
                           Res : out VhpiHandleT;
                           Error : out AvhpiErrorT);
 
+   procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT;
+                                   Ref : VhpiHandleT;
+                                   Index : Natural;
+                                   Res : out VhpiHandleT;
+                                   Error : out AvhpiErrorT);
+
    procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
                             Ref : VhpiHandleT;
                             Res : out VhpiHandleT;
@@ -355,6 +436,17 @@ package Grt.Avhpi is
                            Res : out String;
                            Len : out Natural);
 
+   subtype VhpiIntT is Ghdl_I32;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out VhpiIntT;
+                       Error : out AvhpiErrorT);
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out Boolean;
+                       Error : out AvhpiErrorT);
+
    --  Almost the same as Vhpi_Get_Str (VhpiName, OBJ), but there is not
    --  indexes for generate stmt.
    function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String;
@@ -392,7 +484,7 @@ package Grt.Avhpi is
    function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
                                  return VhpiEntityClassT;
 
-   type VhpiModeP is
+   type VhpiModeT is
      (
       VhpiErrorMode,
       VhpiInMode,
@@ -401,7 +493,7 @@ package Grt.Avhpi is
       VhpiBufferMode,
       VhpiLinkageMode
      );
-   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP;
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeT;
 
    function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access;
 
@@ -438,10 +530,17 @@ private
          when VhpiSubtypeIndicK
            | VhpiSubtypeDeclK
            | VhpiArrayTypeDeclK
-           | VhpiEnumTypeDeclK =>
+           | VhpiEnumTypeDeclK
+           | VhpiPhysTypeDeclK =>
             Atype : Ghdl_Rti_Access;
          when VhpiCompInstStmtK =>
             Inst : Ghdl_Rtin_Instance_Acc;
+         when VhpiIntRangeK
+           | VhpiEnumRangeK
+           | VhpiFloatRangeK
+           | VhpiPhysRangeK =>
+            Rng_Type : Ghdl_Rti_Access;
+            Rng_Addr : Ghdl_Range_Ptr;
          when others =>
             null;
       end case;
diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads
index 3f6b73e..15a05a4 100644
--- a/translate/grt/grt-rtis_addr.ads
+++ b/translate/grt/grt-rtis_addr.ads
@@ -43,6 +43,10 @@ package Grt.Rtis_Addr is
    function To_Addr_Acc is new Ada.Unchecked_Conversion
      (Source => Address, Target => Addr_Acc);
 
+   type Ghdl_Index_Acc is access Ghdl_Index_Type;
+   function To_Ghdl_Index_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Index_Acc);
+
    --  Get the parent context of CTXT.
    --  The parent of an architecture is its entity.
    function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context;
diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
index 360b461..b564017 100644
--- a/translate/grt/grt-sdf.adb
+++ b/translate/grt/grt-sdf.adb
@@ -267,7 +267,7 @@ package body Grt.Sdf is
       Pos := 1;
    end Refill_Buf;
 
-   function Get_Token return Sdf_Token_Type
+   procedure Skip_Spaces
    is
       use Ada.Characters.Latin_1;
    begin
@@ -277,21 +277,20 @@ package body Grt.Sdf is
       end loop;
 
       loop
-         --  Be sure there is at least 4 characters.
-         if Pos + 4 >= Buf_Len then
+         --  Be sure there is at least 1 character.
+         if Pos + 1 >= Buf_Len then
             Refill_Buf;
          end if;
 
          case Buf (Pos) is
             when EOT =>
                if Pos /= Buf_Len then
-                  Error_Bad_Character;
-                  return Tok_Error;
+                  return;
                end if;
                Pos := 1;
                Read_Sdf;
                if Buf_Len = 1 then
-                  return Tok_Eof;
+                  return;
                end if;
             when LF =>
                Pos := Pos + 1;
@@ -307,16 +306,12 @@ package body Grt.Sdf is
                end if;
                Line_Start := Pos;
                Sdf_Line := Sdf_Line + 1;
-            when '"' => -- "
-               Scan_Qstring;
-               return Tok_Qstring;
             when ' '
               | HT =>
                Pos := Pos + 1;
             when '/' =>
-               Pos := Pos + 1;
-               if Buf (Pos) = '/' then
-                  Pos := Pos + 1;
+               if Buf (Pos + 1) = '/' then
+                  Pos := Pos + 2;
                   --  Skip line comment.
                   loop
                      exit when Buf (Pos) = CR;
@@ -328,31 +323,62 @@ package body Grt.Sdf is
                      end if;
                   end loop;
                else
-                  return Tok_Div;
+                  return;
                end if;
-            when '.' =>
-               Pos := Pos + 1;
-               return Tok_Dot;
-            when ':' =>
-               Pos := Pos + 1;
-               return Tok_Cln;
-            when '(' =>
-               Pos := Pos + 1;
-               return Tok_Oparen;
-            when ')' =>
-               Pos := Pos + 1;
-               return Tok_Cparen;
-            when 'a' .. 'z'
-              | 'A' .. 'Z' =>
-               Scan_Identifier;
-               return Tok_Identifier;
-            when '0' .. '9' =>
-               return Scan_Number;
             when others =>
-               Error_Bad_Character;
-               return Tok_Error;
+               return;
          end case;
       end loop;
+   end Skip_Spaces;
+
+   function Get_Token return Sdf_Token_Type
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      Skip_Spaces;
+
+      --  Be sure there is at least 4 characters.
+      if Pos + 4 >= Buf_Len then
+         Refill_Buf;
+      end if;
+
+      case Buf (Pos) is
+         when EOT =>
+            if Buf_Len = 1 then
+               return Tok_Eof;
+            else
+               Error_Bad_Character;
+               return Tok_Error;
+            end if;
+         when '"' => -- "
+            Scan_Qstring;
+            return Tok_Qstring;
+         when '/' =>
+            --  Skip_Spaces has already handled line comments.
+            Pos := Pos + 1;
+            return Tok_Div;
+         when '.' =>
+            Pos := Pos + 1;
+            return Tok_Dot;
+         when ':' =>
+            Pos := Pos + 1;
+            return Tok_Cln;
+         when '(' =>
+            Pos := Pos + 1;
+            return Tok_Oparen;
+         when ')' =>
+            Pos := Pos + 1;
+            return Tok_Cparen;
+         when 'a' .. 'z'
+           | 'A' .. 'Z' =>
+            Scan_Identifier;
+            return Tok_Identifier;
+         when '0' .. '9' =>
+            return Scan_Number;
+         when others =>
+            Error_Bad_Character;
+            return Tok_Error;
+      end case;
    end Get_Token;
 
    function Is_White_Space (C : Character) return Boolean
@@ -374,90 +400,57 @@ package body Grt.Sdf is
    is
       use Ada.Characters.Latin_1;
    begin
-      loop
-         --  Be sure there is at least 4 characters.
-         if Pos + 4 >= Buf_Len then
-            Refill_Buf;
-         end if;
+      Skip_Spaces;
 
-         case Buf (Pos) is
-            when EOT =>
-               if Pos /= Buf_Len then
-                  exit;
-               end if;
-               Pos := 1;
-               Read_Sdf;
-               if Buf_Len = 1 then
-                  exit;
-               end if;
-            when LF =>
-               Pos := Pos + 1;
-               if Buf (Pos) = CR then
-                  Pos := Pos + 1;
-               end if;
-               Line_Start := Pos;
-               Sdf_Line := Sdf_Line + 1;
-            when CR =>
-               Pos := Pos + 1;
-               if Buf (Pos) = LF then
-                  Pos := Pos + 1;
-               end if;
-               Line_Start := Pos;
-               Sdf_Line := Sdf_Line + 1;
-            when ' '
-              | HT =>
-               Pos := Pos + 1;
-            when '0' =>
-               if Is_White_Space (Buf (Pos + 2)) then
-                  if Buf (Pos + 1) = 'z' then
-                     Pos := Pos + 2;
-                     return Edge_0z;
-                  elsif Buf (Pos + 1) = '1' then
-                     Pos := Pos + 2;
-                     return Edge_01;
-                  end if;
-               end if;
-               exit;
-            when '1' =>
-               if Is_White_Space (Buf (Pos + 2)) then
-                  if Buf (Pos + 1) = 'z' then
-                     Pos := Pos + 2;
-                     return Edge_1z;
-                  elsif Buf (Pos + 1) = '0' then
-                     Pos := Pos + 2;
-                     return Edge_10;
-                  end if;
-               end if;
-               exit;
-            when 'z' =>
-               if Is_White_Space (Buf (Pos + 2)) then
-                  if Buf (Pos + 1) = '0' then
-                     Pos := Pos + 2;
-                     return Edge_Z0;
-                  elsif Buf (Pos + 1) = '1' then
-                     Pos := Pos + 2;
-                     return Edge_Z1;
-                  end if;
+      --  Be sure there is at least 4 characters.
+      if Pos + 4 >= Buf_Len then
+         Refill_Buf;
+      end if;
+
+      case Buf (Pos) is
+         when '0' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = 'z' then
+                  Pos := Pos + 2;
+                  return Edge_0z;
+               elsif Buf (Pos + 1) = '1' then
+                  Pos := Pos + 2;
+                  return Edge_01;
                end if;
-               exit;
-            when 'p' =>
-               Scan_Identifier;
-               if Is_Ident ("posedge") then
-                  return Edge_Posedge;
-               else
-                  exit;
+            end if;
+         when '1' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = 'z' then
+                  Pos := Pos + 2;
+                  return Edge_1z;
+               elsif Buf (Pos + 1) = '0' then
+                  Pos := Pos + 2;
+                  return Edge_10;
                end if;
-            when 'n' =>
-               Scan_Identifier;
-               if Is_Ident ("negedge") then
-                  return Edge_Negedge;
-               else
-                  exit;
+            end if;
+         when 'z' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = '0' then
+                  Pos := Pos + 2;
+                  return Edge_Z0;
+               elsif Buf (Pos + 1) = '1' then
+                  Pos := Pos + 2;
+                  return Edge_Z1;
                end if;
-            when others =>
-               exit;
-         end case;
-      end loop;
+            end if;
+         when 'p' =>
+            Scan_Identifier;
+            if Is_Ident ("posedge") then
+               return Edge_Posedge;
+            end if;
+         when 'n' =>
+            Scan_Identifier;
+            if Is_Ident ("negedge") then
+               return Edge_Negedge;
+            end if;
+         when others =>
+            null;
+      end case;
       Error_Sdf ("edge_identifier expected");
       return Edge_Error;
    end Get_Edge_Token;
@@ -524,6 +517,8 @@ package body Grt.Sdf is
    begin
       Sdf_Context.Kind := Kind;
       Sdf_Context.Port_Num := 0;
+      Sdf_Context.Ports (1).L := Invalid_Dnumber;
+      Sdf_Context.Ports (2).L := Invalid_Dnumber;
       Sdf_Context.Ports (1).Edge := Edge_None;
       Sdf_Context.Ports (2).Edge := Edge_None;
    end Start_Generic_Name;
@@ -665,6 +660,35 @@ package body Grt.Sdf is
          Port_Spec.Name (Len) := To_Lower (Buf (I));
       end loop;
       Port_Spec.Name_Len := Len;
+
+      --  Parse   [ DNUMBER ]
+      --        | [ DNUMBER : DNUMBER ]
+      Skip_Spaces;
+      if Buf (Pos) = '[' then
+         Port_Spec.R := Invalid_Dnumber;
+         Pos := Pos + 1;
+         if Get_Token /= Tok_Dnumber then
+            Error_Sdf (Tok);
+         else
+            Port_Spec.L := Ghdl_I32 (Scan_Int);
+         end if;
+         Skip_Spaces;
+         if Buf (Pos) = ':' then
+            Pos := Pos + 1;
+            if Get_Token /= Tok_Dnumber then
+               Error_Sdf (Tok);
+            else
+               Port_Spec.R := Ghdl_I32 (Scan_Int);
+            end if;
+            Skip_Spaces;
+         end if;
+         if Buf (Pos) /= ']' then
+            Error_Sdf ("']' expected");
+         else
+            Pos := Pos + 1;
+         end if;
+      end if;
+
       return True;
    end Parse_Port_Path1;
 
@@ -1115,20 +1139,24 @@ package body Grt.Sdf is
             exit when not Is_Ident ("INSTANCE");
             Tok := Get_Token;
             if Tok /= Tok_Cparen then
-               if Tok /= Tok_Identifier then
-                  Error_Sdf ("instance identifier expected");
-                  return False;
-               end if;
-               for I in Ident_Start .. Ident_End loop
-                  Buf (I) := To_Lower (Buf (I));
+               loop
+                  if Tok /= Tok_Identifier then
+                     Error_Sdf ("instance identifier expected");
+                     return False;
+                  end if;
+                  for I in Ident_Start .. Ident_End loop
+                     Buf (I) := To_Lower (Buf (I));
+                  end loop;
+                  Vital_Annotate.Sdf_Instance
+                    (Sdf_Context.all, Buf (Ident_Start .. Ident_End), Ok);
+                  if not Ok then
+                     Error_Sdf ("cannot find instance");
+                     return False;
+                  end if;
+                  Tok := Get_Token;
+                  exit when Tok /= Tok_Dot;
+                  Tok := Get_Token;
                end loop;
-               Vital_Annotate.Sdf_Instance
-                 (Sdf_Context.all, Buf (Ident_Start .. Ident_End), Ok);
-               if not Ok then
-                  Error_Sdf ("cannot find instance");
-                  return False;
-               end if;
-               Tok := Get_Token;
             end if;
             if Tok /= Tok_Cparen
               or else Get_Token /= Tok_Oparen
diff --git a/translate/grt/grt-sdf.ads b/translate/grt/grt-sdf.ads
index 9e24776..c6d0514 100644
--- a/translate/grt/grt-sdf.ads
+++ b/translate/grt/grt-sdf.ads
@@ -68,11 +68,22 @@ package Grt.Sdf is
    Read_Size : constant Natural := 4096;
    Buf_Size : constant Natural := Read_Size + 1024 + 1;
 
+   Invalid_Dnumber : constant Ghdl_I32 := -1;
+
    type Port_Spec_Type is record
-      Name : String (1 .. 1024);
+      --  Port identifier.
+      Name : String (1 .. 128);
       Name_Len : Natural;
+
+      --  Left and Right range.
+      --  If L = R = Invalid_Dnumber, this is a simple scalar port.
+      --  If R = Invalid_Dnumber, this is a scalar port (from a vector)
+      --  Otherwise, this is a bus port.
+      L, R : Ghdl_I32;
+
    -- Cond : String (1 .. 1024);
    -- Cond_Len : Natural;
+
       Edge : Edge_Type;
    end record;
 
diff --git a/translate/grt/grt-vital_annotate.adb b/translate/grt/grt-vital_annotate.adb
index 9a31bf4..5c8c1d0 100644
--- a/translate/grt/grt-vital_annotate.adb
+++ b/translate/grt/grt-vital_annotate.adb
@@ -78,27 +78,66 @@ package body Grt.Vital_Annotate is
 --       New_Line;
    end Find_Instance;
 
-   procedure Find_Generic
-     (Name : String; Res : out VhpiHandleT; Ok : out Boolean)
+   procedure Find_Generic (Gen_Name : String;
+                           Gen_Handle : out VhpiHandleT;
+                           Port1_Name : String;
+                           Port1_Handle : out VhpiHandleT;
+                           Port2_Name : String;
+                           Port2_Handle : out VhpiHandleT)
    is
       Error : AvhpiErrorT;
       It : VhpiHandleT;
+      Decl : VhpiHandleT;
    begin
-      Ok := False;
+      Gen_Handle := Null_Handle;
+      Port1_Handle := Null_Handle;
+      Port2_Handle := Null_Handle;
+
       Vhpi_Iterator (VhpiDecls, Sdf_Inst, It, Error);
       if Error /= AvhpiErrorOk then
          return;
       end if;
+
+      --  Look for the generic.
       loop
-         Vhpi_Scan (It, Res, Error);
-         exit when Error /= AvhpiErrorOk;
-         exit when Vhpi_Get_Kind (Res) /= VhpiGenericDeclK;
-         if Name_Compare (Res, Name) then
-            Ok := True;
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
             return;
          end if;
+         exit when Vhpi_Get_Kind (Decl) /= VhpiGenericDeclK;
+         if Name_Compare (Decl, Gen_Name) then
+            Gen_Handle := Decl;
+            exit;
+         end if;
       end loop;
-      return;
+
+      --  Skip generics.
+      while Vhpi_Get_Kind (Decl) = VhpiGenericDeclK loop
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
+            return;
+         end if;
+      end loop;
+
+      --  Look for ports.
+      loop
+         exit when Vhpi_Get_Kind (Decl) /= VhpiPortDeclK;
+         if Name_Compare (Decl, Port1_Name) then
+            Port1_Handle := Decl;
+            exit when Port2_Name'Length = 0;
+         end if;
+         if Port2_Name'Length > 0
+           and then Name_Compare (Decl, Port2_Name)
+         then
+            Port2_Handle := Decl;
+            exit when Vhpi_Get_Kind (Port1_Handle) /= VhpiUndefined;
+         end if;
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
+            return;
+         end if;
+      end loop;
+
    end Find_Generic;
 
    procedure Sdf_Header (Context : in out Sdf_Context_Type)
@@ -191,6 +230,9 @@ package body Grt.Vital_Annotate is
    end Sdf_Instance_End;
 
    VitalDelayType01 : VhpiHandleT;
+   VitalDelayArrayType01 : VhpiHandleT;
+   VitalDelayType : VhpiHandleT;
+   VitalDelayArrayType : VhpiHandleT;
 
    type Map_Type is array (1 .. 12) of Natural;
    Map_1 : constant Map_Type := (1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0);
@@ -233,12 +275,88 @@ package body Grt.Vital_Annotate is
       return True;
    end Write_Td_Delay_Generic;
 
+   function Write_Td_Delay_Generic (Context : Sdf_Context_Type;
+                                    Gen : VhpiHandleT)
+                                   return Boolean
+   is
+      Gen_Basetype : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("write_td_delay_generic: vhpiBaseType");
+         return False;
+      end if;
+      if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) then
+         case Context.Timing_Nbr is
+            when 1 =>
+               return Write_Td_Delay_Generic (Context, Gen, 2, Map_1);
+            when 2 =>
+               return Write_Td_Delay_Generic (Context, Gen, 2, Map_2);
+            when others =>
+               Errors.Error
+                 ("timing generic type mismatch SDF timing specification");
+         end case;
+      elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType) then
+         if Vhpi_Put_Value (Gen, Context.Timing (1) * 1000) /= AvhpiErrorOk
+         then
+            Internal_Error ("vhpi_put_value (vitaldelaytype)");
+         else
+            return True;
+         end if;
+      else
+         Internal_Error ("write_td_delay_generic: unhandled generic type");
+      end if;
+   end Write_Td_Delay_Generic;
+
+   procedure Generic_Get_Bounds (Port : VhpiHandleT;
+                                 Left : out Ghdl_I32;
+                                 Len : out Ghdl_Index_Type;
+                                 Up : out Boolean)
+   is
+      Port_Type, Port_Range : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Right : VhpiIntT;
+   begin
+      Vhpi_Handle (VhpiSubtype, Port, Port_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiSubtype - port");
+         return;
+      end if;
+      Vhpi_Handle_By_Index (VhpiConstraints, Port_Type, 1, Port_Range, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIndexConstraints - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiLeftBoundP, Port_Range, Left, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiLeftBoundP - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiRightBoundP, Port_Range, Right, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiRightBoundP - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiIsUpP, Port_Range, Up, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIsUpP - port");
+         return;
+      end if;
+      if Up then
+         Len := Ghdl_Index_Type (Right - Left) + 1;
+      else
+         Len := Ghdl_Index_Type (Left - Right) + 1;
+      end if;
+   end Generic_Get_Bounds;
+
    procedure Sdf_Generic (Context : in out Sdf_Context_Type;
                           Name : String;
                           Ok : out Boolean)
    is
       Gen : VhpiHandleT;
-      Gen_Type : VhpiHandleT;
+      Gen_Basetype : VhpiHandleT;
+      Port1, Port2 : VhpiHandleT;
       Error : AvhpiErrorT;
    begin
       if Flag_Dump then
@@ -263,36 +381,75 @@ package body Grt.Vital_Annotate is
          return;
       end if;
 
-      Find_Generic (Name, Gen, Ok);
-      if not Ok then
-         return;
-      end if;
-
       Ok := False;
 
-      --  Extract subtype.
-      Vhpi_Handle (VhpiSubtype, Gen, Gen_Type, Error);
-      if Error /= AvhpiErrorOk then
-         Internal_Error ("vhpiSubtype");
+      if Context.Port_Num = 1 then
+         Context.Ports (2).Name_Len := 0;
+      end if;
+      Find_Generic
+        (Name, Gen,
+         Context.Ports (1).Name (1 .. Context.Ports (1).Name_Len), Port1,
+         Context.Ports (2).Name (1 .. Context.Ports (2).Name_Len), Port2);
+      if Vhpi_Get_Kind (Gen) = VhpiUndefined
+        or else Vhpi_Get_Kind (Port1) = VhpiUndefined
+        or else (Context.Port_Num = 2
+                 and then Vhpi_Get_Kind (Port2) = VhpiUndefined)
+      then
          return;
       end if;
-      Vhpi_Handle (VhpiTypeMark, Gen_Type, Gen_Type, Error);
+
+      --  Extract subtype.
+      Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error);
       if Error /= AvhpiErrorOk then
-         Internal_Error ("vhpiTypeMark");
+         Internal_Error ("vhpiBaseType");
          return;
       end if;
-      if Vhpi_Compare_Handles (Gen_Type, VitalDelayType01) then
-         case Context.Timing_Nbr is
-            when 1 =>
-               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_1);
-            when 2 =>
-               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_2);
-            when others =>
-               Errors.Error
-                 ("timing generic type mismatch SDF timing specification");
-         end case;
+      if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) then
+         Ok := Write_Td_Delay_Generic (Context, Gen);
+      elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType01)
+        or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType)
+      then
+         declare
+            Left_Gen, Left1, Left2 : Ghdl_I32;
+            Len_Gen, Len1, Len2 : Ghdl_Index_Type;
+            Up_Gen, Up1, Up2 : Boolean;
+            Pos : Ghdl_Index_Type;
+            Gen_El : VhpiHandleT;
+         begin
+            Generic_Get_Bounds (Gen, Left_Gen, Len_Gen, Up_Gen);
+            if Context.Port_Num >= 1
+              and then Context.Ports (1).L /= Invalid_Dnumber
+            then
+               Generic_Get_Bounds (Port1, Left1, Len1, Up1);
+               if Up1 then
+                  Pos := Ghdl_Index_Type (Context.Ports (1).L - Left1);
+               else
+                  Pos := Ghdl_Index_Type (Left1 - Context.Ports (1).L);
+               end if;
+            else
+               Pos := 0;
+            end if;
+            if Context.Port_Num >= 2
+              and then Context.Ports (2).L /= Invalid_Dnumber
+            then
+               Generic_Get_Bounds (Port2, Left2, Len2, Up2);
+               Pos := Pos * Len2;
+               if Up1 then
+                  Pos := Pos + Ghdl_Index_Type (Context.Ports (2).L - Left2);
+               else
+                  Pos := Pos + Ghdl_Index_Type (Left1 - Context.Ports (2).L);
+               end if;
+            end if;
+            Vhpi_Handle_By_Index
+              (VhpiIndexedNames, Gen, Integer (Pos), Gen_El, Error);
+            if Error /= AvhpiErrorOk then
+               Internal_Error ("vhpiIndexedNames - gen_el");
+               return;
+            end if;
+            Ok := Write_Td_Delay_Generic (Context, Gen_El);
+         end;
       else
-         Errors.Error ("bad generic type");
+         Errors.Error ("vital: unhandled generic type");
       end if;
    end Sdf_Generic;
 
@@ -357,6 +514,7 @@ package body Grt.Vital_Annotate is
       It : VhpiHandleT;
       Pkg : VhpiHandleT;
       Decl : VhpiHandleT;
+      Basetype : VhpiHandleT;
       Status : AvhpiErrorT;
    begin
       Get_Package_Inst (It);
@@ -378,12 +536,33 @@ package body Grt.Vital_Annotate is
       loop
          Vhpi_Scan (It, Decl, Status);
          exit when Status /= AvhpiErrorOk;
-         if Name_Compare (Decl, "vitaldelaytype01") then
-            VitalDelayType01 := Decl;
+         if Vhpi_Get_Kind (Decl) = VhpiSubtypeDeclK
+           or else Vhpi_Get_Kind (Decl) = VhpiArrayTypeDeclK
+         then
+            Vhpi_Handle (VhpiBaseType, Decl, Basetype, Status);
+            if Status = AvhpiErrorOk then
+               if Name_Compare (Decl, "vitaldelaytype01") then
+                  VitalDelayType01 := Basetype;
+               elsif Name_Compare (Decl, "vitaldelayarraytype01") then
+                  VitalDelayArrayType01 := Basetype;
+               elsif Name_Compare (Decl, "vitaldelaytype") then
+                  VitalDelayType := Basetype;
+               elsif Name_Compare (Decl, "vitaldelayarraytype") then
+                  VitalDelayArrayType := Basetype;
+               end if;
+            end if;
          end if;
       end loop;
       if Vhpi_Get_Kind (VitalDelayType01) = VhpiUndefined then
-         Error ("cannot found VitalDelayType01 in ieee.vital_timing");
+         Error ("cannot find VitalDelayType01 in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayArrayType01) = VhpiUndefined then
+         Error ("cannot find VitalDelayArrayType01 in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayType) = VhpiUndefined then
+         Error ("cannot find VitalDelayType in ieee.vital_timing");
          return;
       end if;
    end Extract_Vital_Delay_Type;
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index fed4086..c2c0138 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -62,7 +62,7 @@ package body Grt.Waves is
    Ghw_Hie_Port_Buffer  : constant Unsigned_8 := 20; --  Port
    Ghw_Hie_Port_Linkage : constant Unsigned_8 := 21; --  Port
 
-   --  Return TRUE if OPT is an option for VCD.
+   --  Return TRUE if OPT is an option for wave.
    function Wave_Option (Opt : String) return Boolean
    is
       F : Natural := Opt'First;
@@ -842,7 +842,7 @@ package body Grt.Waves is
 
    procedure Write_Hierarchy_El (Decl : VhpiHandleT)
    is
-      Mode2hie : constant array (VhpiModeP) of Unsigned_8 :=
+      Mode2hie : constant array (VhpiModeT) of Unsigned_8 :=
         (VhpiErrorMode => Ghw_Hie_Signal,
          VhpiInMode => Ghw_Hie_Port_In,
          VhpiOutMode => Ghw_Hie_Port_Out,