Create src/vhdl subdirectory.

1 files changed, 1377 insertions, 0 deletions

diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
new file mode 100644
index 0000000..d6429e2
--- /dev/null
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -0,0 +1,1377 @@
+--  Nodes recognizer for ieee.vital_timing.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Std_Names;
+with Errorout; use Errorout;
+with Std_Package; use Std_Package;
+with Tokens; use Tokens;
+with Name_Table;
+with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164;
+with Sem_Scopes;
+with Evaluation;
+with Sem;
+with Iirs_Utils;
+with Flags;
+
+package body Ieee.Vital_Timing is
+   --  This package is based on IEEE 1076.4 1995.
+
+   --  Control generics identifier.
+   InstancePath_Id : Name_Id;
+   TimingChecksOn_Id : Name_Id;
+   XOn_Id : Name_Id;
+   MsgOn_Id : Name_Id;
+
+   --  Extract declarations from package IEEE.VITAL_Timing.
+   procedure Extract_Declarations (Pkg : Iir_Package_Declaration)
+   is
+      use Name_Table;
+
+      Ill_Formed : exception;
+
+      Decl : Iir;
+      Id : Name_Id;
+
+      VitalDelayType_Id : Name_Id;
+      VitalDelayType01_Id   : Name_Id;
+      VitalDelayType01Z_Id  : Name_Id;
+      VitalDelayType01ZX_Id : Name_Id;
+
+      VitalDelayArrayType_Id     : Name_Id;
+      VitalDelayArrayType01_Id   : Name_Id;
+      VitalDelayArrayType01Z_Id  : Name_Id;
+      VitalDelayArrayType01ZX_Id : Name_Id;
+   begin
+      --  Get Vital delay type identifiers.
+      Name_Buffer (1 .. 18) := "vitaldelaytype01zx";
+      Name_Length := 14;
+      VitalDelayType_Id := Get_Identifier_No_Create;
+      if VitalDelayType_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 16;
+      VitalDelayType01_Id := Get_Identifier_No_Create;
+      if VitalDelayType01_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 17;
+      VitalDelayType01Z_Id := Get_Identifier_No_Create;
+      if VitalDelayType01Z_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 18;
+      VitalDelayType01ZX_Id := Get_Identifier_No_Create;
+      if VitalDelayType01ZX_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+
+      Name_Buffer (1 .. 23) := "vitaldelayarraytype01zx";
+      Name_Length := 19;
+      VitalDelayArrayType_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 21;
+      VitalDelayArrayType01_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 22;
+      VitalDelayArrayType01Z_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01Z_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 23;
+      VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01ZX_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+
+      --  Iterate on every declaration.
+      --  Do name-matching.
+      Decl := Get_Declaration_Chain (Pkg);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Attribute_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = Std_Names.Name_VITAL_Level0 then
+                  Vital_Level0_Attribute := Decl;
+               elsif Id = Std_Names.Name_VITAL_Level1 then
+                  Vital_Level1_Attribute := Decl;
+               end if;
+            when Iir_Kind_Subtype_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayType_Id then
+                  VitalDelayType := Get_Type (Decl);
+               end if;
+            when Iir_Kind_Type_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayArrayType_Id then
+                  VitalDelayArrayType := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01_Id then
+                  VitalDelayArrayType01 := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01Z_Id then
+                  VitalDelayArrayType01Z := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01ZX_Id then
+                  VitalDelayArrayType01ZX := Get_Type_Definition (Decl);
+               end if;
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayType01_Id then
+                  VitalDelayType01 := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayType01Z_Id then
+                  VitalDelayType01Z := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayType01ZX_Id then
+                  VitalDelayType01ZX := Get_Type_Definition (Decl);
+               end if;
+            when others =>
+               null;
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      --  If a declaration was not found, then the package is not the expected
+      --  one.
+      if Vital_Level0_Attribute = Null_Iir
+        or Vital_Level1_Attribute = Null_Iir
+        or VitalDelayType = Null_Iir
+        or VitalDelayType01 = Null_Iir
+        or VitalDelayType01Z = Null_Iir
+        or VitalDelayType01ZX = Null_Iir
+        or VitalDelayArrayType = Null_Iir
+        or VitalDelayArrayType01 = Null_Iir
+        or VitalDelayArrayType01Z = Null_Iir
+        or VitalDelayArrayType01ZX = Null_Iir
+      then
+         raise Ill_Formed;
+      end if;
+
+      --  Create identifier for control generics.
+      InstancePath_Id := Get_Identifier ("instancepath");
+      TimingChecksOn_Id := Get_Identifier ("timingcheckson");
+      XOn_Id := Get_Identifier ("xon");
+      MsgOn_Id := Get_Identifier ("msgon");
+
+      exception
+         when Ill_Formed =>
+            Error_Msg_Sem ("package ieee.vital_timing is ill-formed", Pkg);
+
+            Vital_Level0_Attribute := Null_Iir;
+            Vital_Level1_Attribute := Null_Iir;
+
+            VitalDelayType := Null_Iir;
+            VitalDelayType01 := Null_Iir;
+            VitalDelayType01Z := Null_Iir;
+            VitalDelayType01ZX := Null_Iir;
+
+            VitalDelayArrayType := Null_Iir;
+            VitalDelayArrayType01 := Null_Iir;
+            VitalDelayArrayType01Z := Null_Iir;
+            VitalDelayArrayType01ZX := Null_Iir;
+   end Extract_Declarations;
+
+   procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem;
+   procedure Error_Vital (Msg : String; Loc : Location_Type)
+     renames Error_Msg_Sem;
+   procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem;
+
+   --  Check DECL is the VITAL level 0 attribute specification.
+   procedure Check_Level0_Attribute_Specification (Decl : Iir)
+   is
+      Expr : Iir;
+   begin
+      if Get_Kind (Decl) /= Iir_Kind_Attribute_Specification
+        or else (Get_Named_Entity (Get_Attribute_Designator (Decl))
+                   /= Vital_Level0_Attribute)
+      then
+         Error_Vital
+           ("first declaration must be the VITAL attribute specification",
+            Decl);
+         return;
+      end if;
+
+      --  IEEE 1076.4 4.1
+      --  The expression in the VITAL_Level0 attribute specification shall be
+      --  the Boolean literal TRUE.
+      Expr := Get_Expression (Decl);
+      if Get_Kind (Expr) not in Iir_Kinds_Denoting_Name
+        or else Get_Named_Entity (Expr) /= Boolean_True
+      then
+         Error_Vital
+           ("the expression in the VITAL_Level0 attribute specification shall "
+            & "be the Boolean literal TRUE", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.1
+      --  The entity specification of the decorating attribute specification
+      --  shall be such that the enclosing entity or architecture inherits the
+      --  VITAL_Level0 attribute.
+      case Get_Entity_Class (Decl) is
+         when Tok_Entity
+           | Tok_Architecture =>
+            null;
+         when others =>
+            Error_Vital ("VITAL attribute specification does not decorate the "
+                         & "enclosing entity or architecture", Decl);
+      end case;
+   end Check_Level0_Attribute_Specification;
+
+   procedure Check_Entity_Port_Declaration
+     (Decl : Iir_Interface_Signal_Declaration)
+   is
+      use Name_Table;
+
+      Atype : Iir;
+      Base_Type : Iir;
+      Type_Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  The identifiers in an entity port declaration shall not contain
+      --  underscore characters.
+      Image (Get_Identifier (Decl));
+      if Name_Buffer (1) = '/' then
+         Error_Vital ("VITAL entity port shall not be an extended identifier",
+                      Decl);
+      end if;
+      for I in 1 .. Name_Length loop
+         if Name_Buffer (I) = '_' then
+            Error_Vital
+              ("VITAL entity port shall not contain underscore", Decl);
+            exit;
+         end if;
+      end loop;
+
+      --  IEEE 1076.4 4.3.1
+      --  A port that is declared in an entity port declaration shall not be
+      --  of mode LINKAGE.
+      if Get_Mode (Decl) = Iir_Linkage_Mode then
+         Error_Vital ("VITAL entity port shall not be of mode LINKAGE", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.3.1
+      --  The type mark in an entity port declaration shall denote a type or
+      --  a subtype that is declared in package Std_Logic_1164.  The type
+      --  mark in the declaration of a scalar port shall denote the subtype
+      --  Std_Ulogic or a subtype of Std_Ulogic.  The type mark in the
+      --  declaration of an array port shall denote the type Std_Logic_Vector.
+      Atype := Get_Type (Decl);
+      Base_Type := Get_Base_Type (Atype);
+      Type_Decl := Get_Type_Declarator (Atype);
+      if Base_Type = Std_Logic_Vector_Type then
+         if Get_Resolution_Indication (Atype) /= Null_Iir then
+            Error_Vital
+              ("VITAL array port type cannot override resolution function",
+               Decl);
+         end if;
+         --  FIXME: is an unconstrained array port allowed ?
+         --  FIXME: what about staticness of the index_constraint ?
+      elsif Base_Type = Std_Ulogic_Type then
+         if Type_Decl = Null_Iir
+           or else Get_Parent (Type_Decl) /= Std_Logic_1164_Pkg
+         then
+            Error_Vital
+              ("VITAL entity port type mark shall be one of Std_Logic_1164",
+               Decl);
+         end if;
+      else
+         Error_Vital ("VITAL port type must be Std_Logic_Vector or Std_Ulogic",
+                      Decl);
+      end if;
+
+      if Get_Signal_Kind (Decl) /= Iir_No_Signal_Kind then
+         Error_Vital ("VITAL entity port cannot be guarded", Decl);
+      end if;
+   end Check_Entity_Port_Declaration;
+
+   --  Current position in the generic name, stored into
+   --  name_table.name_buffer.
+   Gen_Name_Pos : Natural;
+
+   --  Length of the generic name.
+   Gen_Name_Length : Natural;
+
+   --  The generic being analyzed.
+   Gen_Decl : Iir;
+   Gen_Chain : Iir;
+
+   procedure Error_Vital_Name (Str : String)
+   is
+      Loc : Location_Type;
+   begin
+      Loc := Get_Location (Gen_Decl);
+      Error_Vital (Str, Loc + Location_Type (Gen_Name_Pos - 1));
+   end Error_Vital_Name;
+
+   --  Check the next sub-string in the generic name is a port.
+   --  Returns the port.
+   function Check_Port return Iir
+   is
+      use Sem_Scopes;
+      use Name_Table;
+
+      C : Character;
+      Res : Iir;
+      Id : Name_Id;
+      Inter : Name_Interpretation_Type;
+   begin
+      Name_Length := 0;
+      while Gen_Name_Pos <= Gen_Name_Length loop
+         C := Name_Buffer (Gen_Name_Pos);
+         Gen_Name_Pos := Gen_Name_Pos + 1;
+         exit when C = '_';
+         Name_Length := Name_Length + 1;
+         Name_Buffer (Name_Length) := C;
+      end loop;
+
+      if Name_Length = 0 then
+         Error_Vital_Name ("port expected in VITAL generic name");
+         return Null_Iir;
+      end if;
+
+      Id := Get_Identifier_No_Create;
+      Res := Null_Iir;
+      if Id /= Null_Identifier then
+         Inter := Get_Interpretation (Id);
+         if Valid_Interpretation (Inter) then
+            Res := Get_Declaration (Inter);
+         end if;
+      end if;
+      if Res = Null_Iir then
+         Warning_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                        & "' is not a port name (in VITAL generic name)",
+                        Gen_Decl);
+      end if;
+      return Res;
+   end Check_Port;
+
+   --  Checks the port is an input port.
+   function Check_Input_Port return Iir
+   is
+      use Name_Table;
+
+      Res : Iir;
+   begin
+      Res := Check_Port;
+      if Res /= Null_Iir then
+         --  IEEE 1076.4 4.3.2.1.3
+         --  an input port is a VHDL port of mode IN or INOUT.
+         case Get_Mode (Res) is
+            when Iir_In_Mode
+              | Iir_Inout_Mode =>
+               null;
+            when others =>
+               Error_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                            & "' must be an input port", Gen_Decl);
+         end case;
+      end if;
+      return Res;
+   end Check_Input_Port;
+
+   --  Checks the port is an output port.
+   function Check_Output_Port return Iir
+   is
+      use Name_Table;
+
+      Res : Iir;
+   begin
+      Res := Check_Port;
+      if Res /= Null_Iir then
+         --  IEEE 1076.4 4.3.2.1.3
+         --  An output port is a VHDL port of mode OUT, INOUT or BUFFER.
+         case Get_Mode (Res) is
+            when Iir_Out_Mode
+              | Iir_Inout_Mode
+              | Iir_Buffer_Mode =>
+               null;
+            when others =>
+               Error_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                            & "' must be an output port", Gen_Decl);
+         end case;
+      end if;
+      return Res;
+   end Check_Output_Port;
+
+   --  Extract a suffix from the generic name.
+   type Suffixes_Kind is
+     (
+      Suffix_Name,     --  [a-z]*
+      Suffix_Num_Name,  --  [0-9]*
+      Suffix_Edge,     --  posedge, negedge, 01, 10, 0z, z1, 1z, z0
+      Suffix_Noedge,   --  noedge
+      Suffix_Eon       --  End of name
+     );
+
+   function Get_Next_Suffix_Kind return Suffixes_Kind
+   is
+      use Name_Table;
+
+      Len : Natural;
+      P : constant Natural := Gen_Name_Pos;
+      C : Character;
+   begin
+      Len := 0;
+      while Gen_Name_Pos <= Gen_Name_Length loop
+         C := Name_Buffer (Gen_Name_Pos);
+         Gen_Name_Pos := Gen_Name_Pos + 1;
+         exit when C = '_';
+         Len := Len + 1;
+      end loop;
+      if Len = 0 then
+         return Suffix_Eon;
+      end if;
+
+      case Name_Buffer (P) is
+         when '0' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '1'
+                                 or Name_Buffer (P + 1) = 'z')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Num_Name;
+            end if;
+         when '1' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '0'
+                                 or Name_Buffer (P + 1) = 'z')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Num_Name;
+            end if;
+         when '2' .. '9' =>
+            return Suffix_Num_Name;
+         when 'z' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '0'
+                                 or Name_Buffer (P + 1) = '1')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'p' =>
+            if Len = 7 and then Name_Buffer (P .. P + 6) = "posedge" then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'n' =>
+            if Len = 7 and then Name_Buffer (P .. P + 6) = "negedge" then
+               return Suffix_Edge;
+            elsif Len = 6 and then Name_Buffer (P .. P + 5) = "noedge" then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'a' .. 'm'
+           | 'o'
+           | 'q' .. 'y' =>
+            return Suffix_Name;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Next_Suffix_Kind;
+
+   --  <SDFSimpleConditionAndOrEdge> ::=
+   --     <ConditionName>
+   --   | <Edge>
+   --   | <ConditionName>_<Edge>
+   procedure Check_Simple_Condition_And_Or_Edge
+   is
+      First : Boolean := True;
+   begin
+      loop
+         case Get_Next_Suffix_Kind is
+            when Suffix_Eon =>
+               --  Simple condition is optional.
+               return;
+            when Suffix_Edge =>
+               if Get_Next_Suffix_Kind /= Suffix_Eon then
+                  Error_Vital_Name ("garbage after edge");
+               end if;
+               return;
+            when Suffix_Num_Name =>
+               if First then
+                  Error_Vital_Name ("condition is a simple name");
+               end if;
+            when Suffix_Noedge =>
+               Error_Vital_Name ("'noedge' not allowed in simple condition");
+            when Suffix_Name =>
+               null;
+         end case;
+         First := False;
+      end loop;
+   end Check_Simple_Condition_And_Or_Edge;
+
+   --  <SDFFullConditionAndOrEdge> ::=
+   --    <ConditionNameEdge>[_<SDFSimpleConditionAndOrEdge>]
+   --
+   --  <ConditionNameEdge> ::=
+   --      [<ConditionName>_]<Edge>
+   --    | [<ConditionName>_]noedge
+   procedure Check_Full_Condition_And_Or_Edge
+   is
+   begin
+      case Get_Next_Suffix_Kind is
+         when Suffix_Eon =>
+            --  FullCondition is always optional.
+            return;
+         when Suffix_Edge
+           | Suffix_Noedge =>
+            Check_Simple_Condition_And_Or_Edge;
+            return;
+         when Suffix_Num_Name =>
+            Error_Vital_Name ("condition is a simple name");
+         when Suffix_Name =>
+            null;
+      end case;
+
+      loop
+         case Get_Next_Suffix_Kind is
+            when Suffix_Eon =>
+               Error_Vital_Name ("missing edge or noedge");
+               return;
+            when Suffix_Edge
+              | Suffix_Noedge =>
+               Check_Simple_Condition_And_Or_Edge;
+               return;
+            when Suffix_Num_Name
+              | Suffix_Name =>
+               null;
+         end case;
+      end loop;
+   end Check_Full_Condition_And_Or_Edge;
+
+   procedure Check_End is
+   begin
+      if Get_Next_Suffix_Kind /= Suffix_Eon then
+         Error_Vital_Name ("garbage at end of name");
+      end if;
+   end Check_End;
+
+   --  Return the length of a port P.
+   --  If P is a scalar port, return PORT_LENGTH_SCALAR
+   --  If P is a vector, return the length of the vector (>= 0)
+   --  Otherwise, return PORT_LENGTH_ERROR.
+   Port_Length_Unknown : constant Iir_Int64 := -1;
+   Port_Length_Scalar  : constant Iir_Int64 := -2;
+   Port_Length_Error   : constant Iir_Int64 := -3;
+   function Get_Port_Length (P : Iir) return Iir_Int64
+   is
+      Ptype : Iir;
+      Itype : Iir;
+   begin
+      Ptype := Get_Type (P);
+      if Get_Base_Type (Ptype) = Std_Ulogic_Type then
+         return Port_Length_Scalar;
+      elsif Get_Kind (Ptype) = Iir_Kind_Array_Subtype_Definition
+        and then Get_Base_Type (Ptype) = Std_Logic_Vector_Type
+      then
+         Itype := Get_First_Element (Get_Index_Subtype_List (Ptype));
+         if Get_Type_Staticness (Itype) /= Locally then
+            return Port_Length_Unknown;
+         end if;
+         return Evaluation.Eval_Discrete_Type_Length (Itype);
+      else
+         return Port_Length_Error;
+      end if;
+   end Get_Port_Length;
+
+   --  IEEE 1076.4  9.1  VITAL delay types and subtypes.
+   --  The transition dependent delay types are
+   --  VitalDelayType01, VitalDelayType01Z, VitalDelayType01ZX,
+   --  VitalDelayArrayType01, VitalDelayArrayType01Z, VitalDelayArrayType01ZX.
+   --  The first three are scalar forms, the last three are vector forms.
+   --
+   --  The simple delay types and subtypes include
+   --  Time, VitalDelayType, and VitalDelayArrayType.
+   --  The first two are scalar forms, and the latter is the vector form.
+   type Timing_Generic_Type_Kind is
+     (
+      Timing_Type_Simple_Scalar,
+      Timing_Type_Simple_Vector,
+      Timing_Type_Trans_Scalar,
+      Timing_Type_Trans_Vector,
+      Timing_Type_Bad
+     );
+
+   function Get_Timing_Generic_Type_Kind return Timing_Generic_Type_Kind
+   is
+      Gtype : Iir;
+      Btype : Iir;
+   begin
+      Gtype := Get_Type (Gen_Decl);
+      Btype := Get_Base_Type (Gtype);
+      case Get_Kind (Gtype) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Btype = VitalDelayArrayType then
+               return Timing_Type_Simple_Vector;
+            end if;
+            if Btype = VitalDelayType01
+              or Btype = VitalDelayType01Z
+              or Btype = VitalDelayType01ZX
+            then
+               return Timing_Type_Trans_Scalar;
+            end if;
+            if Btype = VitalDelayArrayType01
+              or Btype = VitalDelayArrayType01Z
+              or Btype = VitalDelayArrayType01ZX
+            then
+               return Timing_Type_Trans_Vector;
+            end if;
+         when Iir_Kind_Physical_Subtype_Definition =>
+            if Gtype = Time_Subtype_Definition
+              or else Gtype = VitalDelayType
+            then
+               return Timing_Type_Simple_Scalar;
+            end if;
+         when others =>
+            null;
+      end case;
+      Error_Vital ("type of timing generic is not a VITAL delay type",
+                   Gen_Decl);
+      return Timing_Type_Bad;
+   end Get_Timing_Generic_Type_Kind;
+
+   function Get_Timing_Generic_Type_Length return Iir_Int64
+   is
+      Itype : Iir;
+   begin
+      Itype := Get_First_Element
+        (Get_Index_Subtype_List (Get_Type (Gen_Decl)));
+      if Get_Type_Staticness (Itype) /= Locally then
+         return Port_Length_Unknown;
+      else
+         return Evaluation.Eval_Discrete_Type_Length (Itype);
+      end if;
+   end Get_Timing_Generic_Type_Length;
+
+   --  IEEE 1076.4  4.3.2.1.2  Timing generic subtypes
+   --  *  If the timing generic is associated with a single port and that port
+   --     is a scalar, then the type of the timing generic shall be a scalar
+   --     form of delay type.
+   --  *  If such a timing generic is associated with a single port and that
+   --     port is a vector, then the type of the timing generic shall be a
+   --     vector form of delay type, and the constraint on the generic shall
+   --     match that on the associated port.
+   procedure Check_Vital_Delay_Type (P : Iir;
+                                     Is_Simple : Boolean := False;
+                                     Is_Scalar : Boolean := False)
+   is
+      Kind : Timing_Generic_Type_Kind;
+      Len : Iir_Int64;
+      Len1 : Iir_Int64;
+   begin
+      Kind := Get_Timing_Generic_Type_Kind;
+      if P = Null_Iir or Kind = Timing_Type_Bad then
+         return;
+      end if;
+      Len := Get_Port_Length (P);
+      if Len = Port_Length_Scalar then
+         case Kind is
+            when Timing_Type_Simple_Scalar =>
+               null;
+            when Timing_Type_Trans_Scalar =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple scalar timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+               return;
+         end case;
+      elsif Len >= Port_Length_Unknown then
+         if Is_Scalar then
+            Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+            return;
+         end if;
+
+         case Kind is
+            when Timing_Type_Simple_Vector =>
+               null;
+            when Timing_Type_Trans_Vector =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple vector timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+               return;
+         end case;
+         Len1 := Get_Timing_Generic_Type_Length;
+         if Len1 /= Len then
+            Error_Vital ("length of port and VITAL vector timing subtype "
+                         & "does not match", Gen_Decl);
+         end if;
+      end if;
+   end Check_Vital_Delay_Type;
+
+   --  IEEE 1076.4  4.3.2.1.2  Timing generic subtypes
+   --  * If the timing generic is associated with two scalar ports, then the
+   --    type of the timing generic shall be a scalar form of delay type.
+   --  * If the timing generic is associated with two ports, one or more of
+   --    which is a vector, then the type of the timing generic shall be a
+   --    vector form of delay type, and the length of the index range of the
+   --    generic shall be equal to the product of the number of scalar
+   --    subelements in the first port and the number of scalar subelements
+   --    in the second port.
+   procedure Check_Vital_Delay_Type
+     (P1, P2 : Iir;
+      Is_Simple : Boolean := False;
+      Is_Scalar : Boolean := False)
+   is
+      Kind : Timing_Generic_Type_Kind;
+      Len1 : Iir_Int64;
+      Len2 : Iir_Int64;
+      Lenp : Iir_Int64;
+   begin
+      Kind := Get_Timing_Generic_Type_Kind;
+      if P1 = Null_Iir or P2 = Null_Iir or Kind = Timing_Type_Bad then
+         return;
+      end if;
+      Len1 := Get_Port_Length (P1);
+      Len2 := Get_Port_Length (P2);
+      if Len1 = Port_Length_Scalar and Len2 = Port_Length_Scalar then
+         case Kind is
+            when Timing_Type_Simple_Scalar =>
+               null;
+            when Timing_Type_Trans_Scalar =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple scalar timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+               return;
+         end case;
+      elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then
+         if Is_Scalar then
+            Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+            return;
+         end if;
+         case Kind is
+            when Timing_Type_Simple_Vector =>
+               null;
+            when Timing_Type_Trans_Vector =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple vector timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+               return;
+         end case;
+         if Len1 = Port_Length_Scalar then
+            Len1 := 1;
+         elsif Len1 = Port_Length_Error then
+            return;
+         end if;
+         if Len2 = Port_Length_Scalar then
+            Len2 := 1;
+         elsif Len2 = Port_Length_Error then
+            return;
+         end if;
+         Lenp := Get_Timing_Generic_Type_Length;
+         if Lenp /= Len1 * Len2 then
+            Error_Vital ("length of port and VITAL vector timing subtype "
+                         & "does not match", Gen_Decl);
+         end if;
+      end if;
+   end Check_Vital_Delay_Type;
+
+   function Check_Timing_Generic_Prefix
+     (Decl : Iir_Interface_Constant_Declaration; Length : Natural)
+     return Boolean
+   is
+      use Name_Table;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  It is an error for a model to use a timing generic prefix to begin
+      --  the simple name of an entity generic that is not a timing generic.
+      if Name_Length < Length or Name_Buffer (Length) /= '_' then
+         Error_Vital ("invalid use of a VITAL timing generic prefix", Decl);
+         return False;
+      end if;
+      Gen_Name_Pos := Length + 1;
+      Gen_Name_Length := Name_Length;
+      Gen_Decl := Decl;
+      return True;
+   end Check_Timing_Generic_Prefix;
+
+   --  IEEE 1076.4 4.3.2.1.3.1 Propagation Delay
+   --  <VITALPropagationDelayName> ::=
+   --     TPD_<InputPort>_<OutputPort>[_<SDFSimpleConditionAndOrEdge>]
+   procedure Check_Propagation_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Oport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 4) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Oport := Check_Output_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Oport);
+   end Check_Propagation_Delay_Name;
+
+   procedure Check_Test_Reference
+   is
+      Tport : Iir;
+      Rport : Iir;
+   begin
+      Tport := Check_Input_Port;
+      Rport := Check_Input_Port;
+      Check_Full_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Tport, Rport, Is_Simple => True);
+   end Check_Test_Reference;
+
+   --  tsetup
+   procedure Check_Input_Setup_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 7) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Setup_Time_Name;
+
+   --  thold
+   procedure Check_Input_Hold_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 6) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Hold_Time_Name;
+
+   --  trecovery
+   procedure Check_Input_Recovery_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 10) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Recovery_Time_Name;
+
+   --  tremoval
+   procedure Check_Input_Removal_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 9) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Removal_Time_Name;
+
+   --  tperiod
+   procedure Check_Input_Period_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Is_Simple => True);
+   end Check_Input_Period_Name;
+
+   --  tpw
+   procedure Check_Pulse_Width_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 4) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Is_Simple => True);
+   end Check_Pulse_Width_Name;
+
+   --  tskew
+   procedure Check_Input_Skew_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Fport : Iir;
+      Sport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 6) then
+         return;
+      end if;
+      Fport := Check_Port;
+      Sport := Check_Port;
+      Check_Full_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Fport, Sport, Is_Simple => True);
+   end Check_Input_Skew_Time_Name;
+
+   --  tncsetup
+   procedure Check_No_Change_Setup_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 9) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_No_Change_Setup_Time_Name;
+
+   --  tnchold
+   procedure Check_No_Change_Hold_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_No_Change_Hold_Time_Name;
+
+   --  tipd
+   procedure Check_Interconnect_Path_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_End;
+      Check_Vital_Delay_Type (Iport);
+   end Check_Interconnect_Path_Delay_Name;
+
+   --  tdevice
+   procedure Check_Device_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Oport : Iir;
+      pragma Unreferenced (Oport);
+      Pos : Natural;
+      Kind : Timing_Generic_Type_Kind;
+      pragma Unreferenced (Kind);
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      if Get_Next_Suffix_Kind /= Suffix_Name then
+         Error_Vital_Name ("instance_name expected in VITAL generic name");
+         return;
+      end if;
+      Pos := Gen_Name_Pos;
+      if Get_Next_Suffix_Kind /= Suffix_Eon then
+         Gen_Name_Pos := Pos;
+         Oport := Check_Output_Port;
+         Check_End;
+      end if;
+      Kind := Get_Timing_Generic_Type_Kind;
+   end Check_Device_Delay_Name;
+
+   --  tisd
+   procedure Check_Internal_Signal_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Cport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Cport := Check_Input_Port;
+      Check_End;
+      Check_Vital_Delay_Type (Iport, Cport,
+                              Is_Simple => True, Is_Scalar => True);
+   end Check_Internal_Signal_Delay_Name;
+
+   --  tbpd
+   procedure Check_Biased_Propagation_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Oport : Iir;
+      Cport : Iir;
+      pragma Unreferenced (Cport);
+      Clock_Start : Natural;
+      Clock_End : Natural;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Oport := Check_Output_Port;
+      Clock_Start := Gen_Name_Pos - 1; -- At the '_'.
+      Cport := Check_Input_Port;
+      Clock_End := Gen_Name_Pos;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Oport);
+
+      --  IEEE 1076.4  4.3.2.1.3.14  Biased propagation delay
+      --  There shall exist, in the same entity generic clause, a corresponding
+      --  propagation delay generic denoting the same ports, condition name,
+      --  and edge.
+      declare
+         use Name_Table;
+
+         --  '-1' is for the missing 'b' in 'tpd'.
+         Tpd_Name : String
+           (1 .. Gen_Name_Length - 1 - (Clock_End - Clock_Start));
+         Tpd_Decl : Iir;
+      begin
+         Image (Get_Identifier (Decl));
+         Tpd_Name (1) := 't';
+         --  The part before '_<ClockPort>'.
+         Tpd_Name (2 .. Clock_Start - 2) := Name_Buffer (3 .. Clock_Start - 1);
+         Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) :=
+           Name_Buffer (Clock_End .. Name_Length);
+
+         Tpd_Decl := Gen_Chain;
+         loop
+            exit when Tpd_Decl = Null_Iir;
+            Image (Get_Identifier (Tpd_Decl));
+            exit when Name_Length = Tpd_Name'Length
+              and then Name_Buffer (1 .. Name_Length) = Tpd_Name;
+            Tpd_Decl := Get_Chain (Tpd_Decl);
+         end loop;
+
+         if Tpd_Decl = Null_Iir then
+            Error_Vital
+              ("no matching 'tpd' generic for VITAL 'tbpd' timing generic",
+               Decl);
+         else
+            --  IEEE 1076.4  4.3.2.1.3.14  Biased propagation delay
+            --  Furthermore, the type of the biased propagation generic shall
+            --  be the same as the type of the corresponding delay generic.
+            if not Sem.Are_Trees_Equal (Get_Type (Decl), Get_Type (Tpd_Decl))
+            then
+               Error_Vital
+                 ("type of VITAL 'tbpd' generic mismatch type of "
+                  & "'tpd' generic", Decl);
+               Error_Vital
+                 ("(corresponding 'tpd' timing generic)", Tpd_Decl);
+            end if;
+         end if;
+      end;
+   end Check_Biased_Propagation_Delay_Name;
+
+   --  ticd
+   procedure Check_Internal_Clock_Delay_Generic_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Cport : Iir;
+      P_Start : Natural;
+      P_End : Natural;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      P_Start := Gen_Name_Pos;
+      Cport := Check_Input_Port;
+      P_End := Gen_Name_Pos;
+      Check_End;
+      Check_Vital_Delay_Type (Cport, Is_Simple => True, Is_Scalar => True);
+
+      --  IEEE 1076.4  4.3.2.1.3.15  Internal clock delay
+      --  It is an error for a clocks signal name to appear as one of the
+      --  following elements in the name of a timing generic:
+      --  * As either the input port in the name of a biased propagation
+      --    delay generic.
+      --  * As the input signal name in an internal delay timing generic.
+      --  * As the test port in a timing check or recovery removal timing
+      --    generic.
+      --  FIXME: recovery OR removal ?
+
+      if P_End - 1 /= Gen_Name_Length then
+         --  Do not check in case of error.
+         return;
+      end if;
+      declare
+         use Name_Table;
+         Port : String (1 .. Name_Length);
+         El : Iir;
+         Offset : Natural;
+
+         procedure Check_Not_Clock
+         is
+            S : Natural;
+         begin
+            S := Offset;
+            loop
+               Offset := Offset + 1;
+               exit when Offset > Name_Length
+                 or else Name_Buffer (Offset) = '_';
+            end loop;
+            if Offset - S = Port'Length
+              and then Name_Buffer (S .. Offset - 1) = Port
+            then
+               Error_Vital ("clock port name of 'ticd' VITAL generic must not"
+                            & " appear here", El);
+            end if;
+         end Check_Not_Clock;
+      begin
+         Port := Name_Buffer (P_Start .. Gen_Name_Length);
+
+         El := Gen_Chain;
+         while El /= Null_Iir loop
+            Image (Get_Identifier (El));
+            if Name_Length > 5
+              and then Name_Buffer (1) = 't'
+            then
+               if Name_Buffer (2 .. 5) = "bpd_" then
+                  Offset := 6;
+                  Check_Not_Clock; -- input
+                  Check_Not_Clock; -- output
+               elsif Name_Buffer (2 .. 5) = "isd_" then
+                  Offset := 6;
+                  Check_Not_Clock; -- input
+               elsif Name_Length > 10
+                 and then Name_Buffer (2 .. 10) = "recovery_"
+               then
+                  Offset := 11;
+                  Check_Not_Clock; -- test port
+               elsif Name_Length > 9
+                 and then Name_Buffer (2 .. 9) = "removal_"
+               then
+                  Offset := 10;
+                  Check_Not_Clock;
+               end if;
+            end if;
+            El := Get_Chain (El);
+         end loop;
+      end;
+   end Check_Internal_Clock_Delay_Generic_Name;
+
+   procedure Check_Entity_Generic_Declaration
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      use Name_Table;
+      Id : Name_Id;
+   begin
+      Id := Get_Identifier (Decl);
+      Image (Id);
+
+      --  Extract prefix.
+      if Name_Buffer (1) = 't' and Name_Length >= 3 then
+         --  Timing generic names.
+         if Name_Buffer (2) = 'p' then
+            if Name_Buffer (3) = 'd' then
+               Check_Propagation_Delay_Name (Decl); --  tpd
+               return;
+            elsif Name_Buffer (3) = 'w' then
+               Check_Pulse_Width_Name (Decl); -- tpw
+               return;
+            elsif Name_Length >= 7
+              and then Name_Buffer (3 .. 7) = "eriod"
+            then
+               Check_Input_Period_Name (Decl); --  tperiod
+               return;
+            end if;
+         elsif Name_Buffer (2) = 'i'
+           and then Name_Length >= 4
+           and then Name_Buffer (4) = 'd'
+         then
+            if Name_Buffer (3) = 'p' then
+               Check_Interconnect_Path_Delay_Name (Decl); --  tipd
+               return;
+            elsif Name_Buffer (3) = 's' then
+               Check_Internal_Signal_Delay_Name (Decl); --  tisd
+               return;
+            elsif Name_Buffer (3) = 'c' then
+               Check_Internal_Clock_Delay_Generic_Name (Decl); --  ticd
+               return;
+            end if;
+         elsif Name_Length >= 6 and then Name_Buffer (2 .. 6) = "setup" then
+            Check_Input_Setup_Time_Name (Decl); --  tsetup
+            return;
+         elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "hold" then
+            Check_Input_Hold_Time_Name (Decl); -- thold
+            return;
+         elsif Name_Length >= 9 and then Name_Buffer (2 .. 9) = "recovery" then
+            Check_Input_Recovery_Time_Name (Decl); -- trecovery
+            return;
+         elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "removal" then
+            Check_Input_Removal_Time_Name (Decl); -- tremoval
+            return;
+         elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "skew" then
+            Check_Input_Skew_Time_Name (Decl); -- tskew
+            return;
+         elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "ncsetup" then
+            Check_No_Change_Setup_Time_Name (Decl); -- tncsetup
+            return;
+         elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "nchold" then
+            Check_No_Change_Hold_Time_Name (Decl); -- tnchold
+            return;
+         elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "device" then
+            Check_Device_Delay_Name (Decl); -- tdevice
+            return;
+         elsif Name_Length >= 4 and then Name_Buffer (2 .. 4) = "bpd" then
+            Check_Biased_Propagation_Delay_Name (Decl); -- tbpd
+            return;
+         end if;
+      end if;
+
+      if Id = InstancePath_Id then
+         if Get_Type (Decl) /= String_Type_Definition then
+            Error_Vital
+              ("InstancePath VITAL generic must be of type String", Decl);
+         end if;
+         return;
+      elsif Id = TimingChecksOn_Id
+        or Id = XOn_Id
+        or Id = MsgOn_Id
+      then
+         if Get_Type (Decl) /= Boolean_Type_Definition then
+            Error_Vital
+              (Image (Id) & " VITAL generic must be of type Boolean", Decl);
+         end if;
+         return;
+      end if;
+
+      if Flags.Warn_Vital_Generic then
+         Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl);
+      end if;
+   end Check_Entity_Generic_Declaration;
+
+   --  Checks rules for a VITAL level 0 entity.
+   procedure Check_Vital_Level0_Entity (Ent : Iir_Entity_Declaration)
+   is
+      use Sem_Scopes;
+      Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  The only form of declaration allowed in the entity declarative part
+      --  is the specification of the VITAL_Level0 attribute.
+      Decl := Get_Declaration_Chain (Ent);
+      if Decl = Null_Iir then
+         --  Cannot happen, since there is at least the attribute spec.
+         raise Internal_Error;
+      end if;
+      Check_Level0_Attribute_Specification (Decl);
+      Decl := Get_Chain (Decl);
+      if Decl /= Null_Iir then
+         Error_Vital ("VITAL entity declarative part must only contain the "
+                      & "attribute specification", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.3.1
+      --  No statements are allowed in the entity statement part.
+      Decl := Get_Concurrent_Statement_Chain (Ent);
+      if Decl /= Null_Iir then
+         Error_Vital ("VITAL entity must not have concurrent statement", Decl);
+      end if;
+
+      --  Check ports.
+      Name_Table.Assert_No_Infos;
+      Open_Declarative_Region;
+      Decl := Get_Port_Chain (Ent);
+      while Decl /= Null_Iir loop
+         Check_Entity_Port_Declaration (Decl);
+         Add_Name (Decl);
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      --  Check generics.
+      Gen_Chain := Get_Generic_Chain (Ent);
+      Decl := Gen_Chain;
+      while Decl /= Null_Iir loop
+         Check_Entity_Generic_Declaration (Decl);
+         Decl := Get_Chain (Decl);
+      end loop;
+      Close_Declarative_Region;
+   end Check_Vital_Level0_Entity;
+
+   --  Return TRUE if UNIT was decorated with attribute VITAL_Level0.
+   function Is_Vital_Level0 (Unit : Iir_Entity_Declaration) return Boolean
+   is
+      Value : Iir_Attribute_Value;
+      Spec : Iir_Attribute_Specification;
+   begin
+      Value := Get_Attribute_Value_Chain (Unit);
+      while Value /= Null_Iir loop
+         Spec := Get_Attribute_Specification (Value);
+         if Get_Named_Entity (Get_Attribute_Designator (Spec))
+           = Vital_Level0_Attribute
+         then
+            return True;
+         end if;
+         Value := Get_Chain (Value);
+      end loop;
+
+      return False;
+   end Is_Vital_Level0;
+
+   procedure Check_Vital_Level0_Architecture (Arch : Iir_Architecture_Body)
+   is
+      Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.1
+      --  The entity associated with a Level 0 architecture shall be a VITAL
+      --  Level 0 entity.
+      if not Is_Vital_Level0 (Iirs_Utils.Get_Entity (Arch)) then
+         Error_Vital ("entity associated with a VITAL level 0 architecture "
+                      & "shall be a VITAL level 0 entity", Arch);
+      end if;
+
+      --  VITAL_Level_0_architecture_declarative_part ::=
+      --    VITAL_Level0_attribute_specification { block_declarative_item }
+      Decl := Get_Declaration_Chain (Arch);
+      Check_Level0_Attribute_Specification (Decl);
+   end Check_Vital_Level0_Architecture;
+
+   --  Check a VITAL level 0 decorated design unit.
+   procedure Check_Vital_Level0 (Unit : Iir_Design_Unit)
+   is
+      Lib_Unit : Iir;
+   begin
+      Lib_Unit := Get_Library_Unit (Unit);
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            Check_Vital_Level0_Entity (Lib_Unit);
+         when Iir_Kind_Architecture_Body =>
+            Check_Vital_Level0_Architecture (Lib_Unit);
+         when others =>
+            Error_Vital
+              ("only entity or architecture can be VITAL_Level0", Lib_Unit);
+      end case;
+   end Check_Vital_Level0;
+
+   procedure Check_Vital_Level1 (Unit : Iir_Design_Unit)
+   is
+      Arch : Iir;
+   begin
+      Arch := Get_Library_Unit (Unit);
+      if Get_Kind (Arch) /= Iir_Kind_Architecture_Body then
+         Error_Vital ("only architecture can be VITAL_Level1", Arch);
+         return;
+      end if;
+      --  FIXME: todo
+   end Check_Vital_Level1;
+
+end Ieee.Vital_Timing;