diff options
| author | Tristan Gingold <tgingold@free.fr> | 2017-09-26 20:49:24 +0200 | 
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2017-09-26 20:49:24 +0200 | 
| commit | 39f80aecbff4af324432a3575de91e4562aad4f9 (patch) | |
| tree | 2b4f211ef2aca93c9266514b096e00c488243c64 | |
| parent | 685526e22ad509c82bc43e72b1780e000b0430b1 (diff) | |
| download | ghdl-39f80aecbff4af324432a3575de91e4562aad4f9.tar.gz ghdl-39f80aecbff4af324432a3575de91e4562aad4f9.tar.bz2 ghdl-39f80aecbff4af324432a3575de91e4562aad4f9.zip  | |
name_table, ieee-vital_timing: reduce use of global variables.
| -rw-r--r-- | src/name_table.adb | 70 | ||||
| -rw-r--r-- | src/name_table.ads | 6 | ||||
| -rw-r--r-- | src/types.ads | 9 | ||||
| -rw-r--r-- | src/vhdl/ieee-vital_timing.adb | 1759 | 
4 files changed, 924 insertions, 920 deletions
diff --git a/src/name_table.adb b/src/name_table.adb index 3d0010bce..3332f755b 100644 --- a/src/name_table.adb +++ b/src/name_table.adb @@ -79,14 +79,14 @@ package body Name_Table is     --  Allocate place in the strings_table, and store the name_buffer into it.     --  Also append a NUL. -   function Store return Natural +   function Store (Str : Fat_String_Acc; Len : Natural) return Natural     is        Res: Natural;     begin -      Res := Strings_Table.Allocate (Nam_Length + 1); -      Strings_Table.Table (Res .. Res + Nam_Length - 1) := -        Strings_Table.Table_Type (Nam_Buffer (1 .. Nam_Length)); -      Strings_Table.Table (Res + Nam_Length) := NUL; +      Res := Strings_Table.Allocate (Len + 1); +      Strings_Table.Table (Res .. Res + Len - 1) := +        Strings_Table.Table_Type (Str (1 .. Len)); +      Strings_Table.Table (Res + Len) := NUL;        return Res;     end Store; @@ -146,17 +146,18 @@ package body Name_Table is     --  Compute the hash value of a string.  In case of algorithm change, check     --  the performance using Disp_Stats. -   function Hash return Hash_Value_Type +   function Compute_Hash (Str : Fat_String_Acc; Len : Natural) +                         return Hash_Value_Type     is        use Interfaces;        Res : Unsigned_32;     begin -      Res := Unsigned_32 (Nam_Length); -      for I in 1 .. Nam_Length loop -         Res := Rotate_Left (Res, 4) + Res + Character'Pos (Nam_Buffer (I)); +      Res := Unsigned_32 (Len); +      for I in 1 .. Len loop +         Res := Rotate_Left (Res, 4) + Res + Character'Pos (Str (I));        end loop;        return Hash_Value_Type (Res); -   end Hash; +   end Compute_Hash;     --  Get the string associed to an identifier.     function Image (Id : Name_Id) return String @@ -236,15 +237,14 @@ package body Name_Table is        Names_Table.Table (Id).Info := Info;     end Set_Info; -   --  Compare ID with Name_Buffer / Name_Length.  Length of ID must be equal -   --  to Name_Length. -   function Compare_Name_Buffer_With_Name (Id : Name_Id) return Boolean +   --  Compare ID with Str / Len.  Length of ID must be equal to Len. +   function Compare_Name_Buffer_With_Name +     (Id : Name_Id; Str : Fat_String_Acc; Len : Natural) return Boolean     is        Ne: Identifier renames Names_Table.Table (Id);     begin -      return String -        (Strings_Table.Table (Ne.Name .. Ne.Name + Nam_Length - 1)) -        = Nam_Buffer (1 .. Nam_Length); +      return String (Strings_Table.Table (Ne.Name .. Ne.Name + Len - 1)) +        = Str (1 .. Len);     end Compare_Name_Buffer_With_Name;     --  Expand the hash table (double the size). @@ -280,22 +280,22 @@ package body Name_Table is     end Expand;     --  Get or create an entry in the name table. -   --  The string is taken from NAME_BUFFER and NAME_LENGTH. -   function Get_Identifier return Name_Id +   function Get_Identifier_With_Len (Str : Fat_String_Acc; Len : Natural) +                                    return Name_Id     is        Hash_Value : Hash_Value_Type;        Hash_Index : Hash_Value_Type;        Res : Name_Id;     begin -      Hash_Value := Hash; +      Hash_Value := Compute_Hash (Str, Len);        Hash_Index := Hash_Value and (Hash_Table_Size - 1);        --  Find the name.        Res := Hash_Table (Hash_Index);        while Res /= Null_Identifier loop           if Names_Table.Table (Res).Hash = Hash_Value -           and then Get_Name_Length (Res) = Nam_Length -           and then Compare_Name_Buffer_With_Name (Res) +           and then Get_Name_Length (Res) = Len +           and then Compare_Name_Buffer_With_Name (Res, Str, Len)           then              return Res;           end if; @@ -312,43 +312,55 @@ package body Name_Table is        --  Insert new entry.        Res := Names_Table.Last;        Names_Table.Table (Res) := (Hash => Hash_Value, -                                  Name => Store, +                                  Name => Store (Str, Len),                                    Next => Hash_Table (Hash_Index),                                    Info => 0);        Hash_Table (Hash_Index) := Res;        Append_Terminator;        return Res; +   end Get_Identifier_With_Len; + +   function Get_Identifier return Name_Id is +   begin +      return Get_Identifier_With_Len +        (To_Fat_String_Acc (Nam_Buffer'Address), Nam_Length);     end Get_Identifier; -   function Get_Identifier_No_Create return Name_Id +   function Get_Identifier_No_Create_With_Len +     (Str : Fat_String_Acc; Len : Natural) return Name_Id     is        Hash_Value : Hash_Value_Type;        Hash_Index : Hash_Value_Type;        Res: Name_Id;     begin -      Hash_Value := Hash; +      Hash_Value := Compute_Hash (Str, Len);        Hash_Index := Hash_Value and (Hash_Table_Size - 1);        Res := Hash_Table (Hash_Index);        while Res /= Null_Identifier loop           if Names_Table.Table (Res).Hash = Hash_Value -           and then Get_Name_Length (Res) = Nam_Length -           and then Compare_Name_Buffer_With_Name (Res) +           and then Get_Name_Length (Res) = Len +           and then Compare_Name_Buffer_With_Name (Res, Str, Len)           then              return Res;           end if;           Res := Names_Table.Table (Res).Next;        end loop;        return Null_Identifier; +   end Get_Identifier_No_Create_With_Len; + +   function Get_Identifier_No_Create (Str : String) return Name_Id is +   begin +      return Get_Identifier_No_Create_With_Len +        (To_Fat_String_Acc (Str'Address), Str'Length);     end Get_Identifier_No_Create;     --  Get or create an entry in the name table.     function Get_Identifier (Str : String) return Name_Id is     begin -      Nam_Length := Str'Length; -      Nam_Buffer (1 .. Nam_Length) := Str; -      return Get_Identifier; +      return Get_Identifier_With_Len +        (To_Fat_String_Acc (Str'Address), Str'Length);     end Get_Identifier;     function Get_Identifier (Char : Character) return Name_Id is diff --git a/src/name_table.ads b/src/name_table.ads index 000b98b2a..2eb5f06b9 100644 --- a/src/name_table.ads +++ b/src/name_table.ads @@ -39,7 +39,7 @@ package Name_Table is     --    backslashes are simplified.     function Get_Identifier (Str: String) return Name_Id; -   --  Get the string associed to a name. +   --  Get the string associed to a name.  The first bound is 1.     --  If the name is a character, then single quote are added.     function Image (Id: Name_Id) return String; @@ -71,7 +71,9 @@ package Name_Table is     --  Like GET_IDENTIFIER, but return NULL_IDENTIFIER if the identifier     --  is not found (and do not create an entry for it). -   function Get_Identifier_No_Create return Name_Id; +   function Get_Identifier_No_Create (Str : String) return Name_Id; +   function Get_Identifier_No_Create_With_Len +     (Str : Fat_String_Acc; Len : Natural) return Name_Id;     --  Get and set the info field associated with each identifier.     --  Used to store interpretations of the name. diff --git a/src/types.ads b/src/types.ads index 406b1284b..8a53d112e 100644 --- a/src/types.ads +++ b/src/types.ads @@ -16,6 +16,8 @@  --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA  --  02111-1307, USA.  with Interfaces; +with System; +with Ada.Unchecked_Conversion;  package Types is     pragma Preelaborate (Types); @@ -54,6 +56,13 @@ package Types is     type String_Cst is access constant String;     type String_Acc_Array is array (Natural range <>) of String_Acc; +   --  Fat strings, for compatibility with C. +   subtype Fat_String is String (Positive); +   type Fat_String_Acc is access Fat_String; +   pragma Convention (C, Fat_String_Acc); +   function To_Fat_String_Acc is new Ada.Unchecked_Conversion +     (System.Address, Fat_String_Acc); +     --  The name table is defined in Name_Table package.  This is an hash table     --  that associate a uniq Name_Id to a string.  Name_Id are allocated in     --  increasing numbers, so it is possible to create a parallel table diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb index 0b176cdba..c47ffb445 100644 --- a/src/vhdl/ieee-vital_timing.adb +++ b/src/vhdl/ieee-vital_timing.adb @@ -40,10 +40,21 @@ package body Ieee.Vital_Timing is     --  Extract declarations from package IEEE.VITAL_Timing.     procedure Extract_Declarations (Pkg : Iir_Package_Declaration)     is -      use Name_Table; -        Ill_Formed : exception; +      function Try_Get_Identifier (Str : String) return Name_Id +      is +         Id : Name_Id; +      begin +         Id := Name_Table.Get_Identifier_No_Create (Str); +         if Id = Null_Identifier then +            raise Ill_Formed; +         end if; +         return Id; +      end Try_Get_Identifier; + +      use Name_Table; +        Decl : Iir;        Id : Name_Id; @@ -58,49 +69,19 @@ package body Ieee.Vital_Timing is        VitalDelayArrayType01ZX_Id : Name_Id;     begin        --  Get Vital delay type identifiers. -      Nam_Buffer (1 .. 18) := "vitaldelaytype01zx"; -      Nam_Length := 14; -      VitalDelayType_Id := Get_Identifier_No_Create; -      if VitalDelayType_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 16; -      VitalDelayType01_Id := Get_Identifier_No_Create; -      if VitalDelayType01_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 17; -      VitalDelayType01Z_Id := Get_Identifier_No_Create; -      if VitalDelayType01Z_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 18; -      VitalDelayType01ZX_Id := Get_Identifier_No_Create; -      if VitalDelayType01ZX_Id = Null_Identifier then -         raise Ill_Formed; -      end if; - -      Nam_Buffer (1 .. 23) := "vitaldelayarraytype01zx"; -      Nam_Length := 19; -      VitalDelayArrayType_Id := Get_Identifier_No_Create; -      if VitalDelayArrayType_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 21; -      VitalDelayArrayType01_Id := Get_Identifier_No_Create; -      if VitalDelayArrayType01_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 22; -      VitalDelayArrayType01Z_Id := Get_Identifier_No_Create; -      if VitalDelayArrayType01Z_Id = Null_Identifier then -         raise Ill_Formed; -      end if; -      Nam_Length := 23; -      VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create; -      if VitalDelayArrayType01ZX_Id = Null_Identifier then -         raise Ill_Formed; -      end if; +      VitalDelayType_Id     := Try_Get_Identifier ("vitaldelaytype"); +      VitalDelayType01_Id   := Try_Get_Identifier ("vitaldelaytype01"); +      VitalDelayType01Z_Id  := Try_Get_Identifier ("vitaldelaytype01z"); +      VitalDelayType01ZX_Id := Try_Get_Identifier ("vitaldelaytype01zx"); + +      VitalDelayArrayType_Id    := +        Try_Get_Identifier ("vitaldelayarraytype"); +      VitalDelayArrayType01_Id  := +        Try_Get_Identifier ("vitaldelayarraytype01"); +      VitalDelayArrayType01Z_Id := +        Try_Get_Identifier ("vitaldelayarraytype01z"); +      VitalDelayArrayType01ZX_Id := +        Try_Get_Identifier ("vitaldelayarraytype01zx");        --  Iterate on every declaration.        --  Do name-matching. @@ -185,9 +166,10 @@ package body Ieee.Vital_Timing is              VitalDelayArrayType01ZX := Null_Iir;     end Extract_Declarations; -   procedure Error_Vital (Loc : Location_Type; Msg : String) is +   procedure Error_Vital +     (Loc : Location_Type; Msg : String; Args : Earg_Arr := No_Eargs) is     begin -      Error_Msg_Sem (Loc, Msg); +      Error_Msg_Sem (Loc, Msg, Args);     end Error_Vital;     procedure Warning_Vital @@ -242,6 +224,7 @@ package body Ieee.Vital_Timing is     is        use Name_Table; +      Name : constant String := Image (Get_Identifier (Decl));        Atype : Iir;        Base_Type : Iir;        Type_Decl : Iir; @@ -249,13 +232,13 @@ package body Ieee.Vital_Timing is        --  IEEE 1076.4 4.3.1        --  The identifiers in an entity port declaration shall not contain        --  underscore characters. -      Image (Get_Identifier (Decl)); -      if Nam_Buffer (1) = '/' then +      pragma Assert (Name'First = 1); +      if Name (1) = '/' then           Error_Vital             (+Decl, "VITAL entity port shall not be an extended identifier");        end if; -      for I in 1 .. Nam_Length loop -         if Nam_Buffer (I) = '_' then +      for I in Name'Range loop +         if Name (I) = '_' then              Error_Vital                (+Decl, "VITAL entity port shall not contain underscore");              exit; @@ -304,940 +287,937 @@ package body Ieee.Vital_Timing is        end if;     end Check_Entity_Port_Declaration; -   --  Current position in the generic name, stored into -   --  name_table.name_buffer. -   Gen_Name_Pos : Natural; +   procedure Check_Entity_Generic_Declaration +     (Decl : Iir_Interface_Constant_Declaration; Gen_Chain : Iir) +   is +      Id : constant Name_Id := Get_Identifier (Decl); +      Name : String := Name_Table.Image (Id); +      Len : constant Natural := Name'Last; -   --  Length of the generic name. -   Gen_Name_Length : Natural; +      --  Current position in the generic name, stored into Name. +      Gen_Name_Pos : Natural; -   --  The generic being analyzed. -   Gen_Decl : Iir; -   Gen_Chain : Iir; +      --  Length of the generic name. +      Gen_Name_Length : Natural; -   procedure Error_Vital_Name (Str : String) -   is -      Loc : Location_Type; -   begin -      Loc := Get_Location (Gen_Decl); -      Error_Vital (Loc + Location_Type (Gen_Name_Pos - 1), Str); -   end Error_Vital_Name; +      --  The generic being analyzed. +      Gen_Decl : Iir; -   --  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; +      Port_Length : Natural; -      C : Character; -      Res : Iir; -      Id : Name_Id; -      Inter : Name_Interpretation_Type; -   begin -      Nam_Length := 0; -      while Gen_Name_Pos <= Gen_Name_Length loop -         C := Nam_Buffer (Gen_Name_Pos); -         Gen_Name_Pos := Gen_Name_Pos + 1; -         exit when C = '_'; -         Nam_Length := Nam_Length + 1; -         Nam_Buffer (Nam_Length) := C; -      end loop; +      procedure Error_Vital_Name (Str : String) +      is +         Loc : Location_Type; +      begin +         Loc := Get_Location (Gen_Decl); +         Error_Vital (Loc + Location_Type (Gen_Name_Pos - 1), Str); +      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; -      if Nam_Length = 0 then -         Error_Vital_Name ("port expected in VITAL generic name"); -         return Null_Iir; -      end if; +         C : Character; +         Res : Iir; +         Id : Name_Id; +         Inter : Name_Interpretation_Type; +      begin +         Port_Length := 0; +         while Gen_Name_Pos <= Gen_Name_Length loop +            C := Name (Gen_Name_Pos); +            Gen_Name_Pos := Gen_Name_Pos + 1; +            exit when C = '_'; +            Port_Length := Port_Length + 1; +            Name (Port_Length) := C; +         end loop; -      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); +         if Port_Length = 0 then +            Error_Vital_Name ("port expected in VITAL generic name"); +            return Null_Iir;           end if; -      end if; -      if Res = Null_Iir then -         Warning_Vital (Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length) -                          & "' is not a port name (in VITAL generic name)"); -      end if; -      return Res; -   end Check_Port; -   --  Checks the port is an input port. -   function Check_Input_Port return Iir -   is -      use Name_Table; +         Id := Get_Identifier_No_Create (Name (1 .. Port_Length)); +         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 (Gen_Decl, "'" & Name (1 .. Port_Length) +                             & "' is not a port name (in VITAL generic name)"); +         end if; +         return Res; +      end Check_Port; -      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 (+Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length) -                            & "' must be an input port"); -         end case; -      end if; -      return Res; -   end Check_Input_Port; +      --  Checks the port is an input port. +      function Check_Input_Port return Iir +      is +         use Name_Table; -   --  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 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 +                    (+Gen_Decl, "%i must be an input port", (1 => +Res)); +            end case; +         end if; +         return Res; +      end Check_Input_Port; -      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 (+Gen_Decl, "'" & Nam_Buffer (1 .. Nam_Length) -                            & "' must be an output port"); -         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; +      --  Checks the port is an output port. +      function Check_Output_Port return Iir +      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 := Nam_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; +         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 +                    (+Gen_Decl, "%i must be an output port", (1 => +Res)); +            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; -      case Nam_Buffer (P) is -         when '0' => -            if Len = 2 and then (Nam_Buffer (P + 1) = '1' -                                 or Nam_Buffer (P + 1) = 'z') -            then -               return Suffix_Edge; -            else -               return Suffix_Num_Name; -            end if; -         when '1' => -            if Len = 2 and then (Nam_Buffer (P + 1) = '0' -                                 or Nam_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 (Nam_Buffer (P + 1) = '0' -                                 or Nam_Buffer (P + 1) = '1') -            then -               return Suffix_Edge; -            else -               return Suffix_Name; -            end if; -         when 'p' => -            if Len = 7 and then Nam_Buffer (P .. P + 6) = "posedge" then -               return Suffix_Edge; -            else -               return Suffix_Name; -            end if; -         when 'n' => -            if Len = 7 and then Nam_Buffer (P .. P + 6) = "negedge" then -               return Suffix_Edge; -            elsif Len = 6 and then Nam_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; +         Len : Natural; +         P : constant Natural := Gen_Name_Pos; +         C : Character; +      begin +         Len := 0; +         while Gen_Name_Pos <= Gen_Name_Length loop +            C := Name (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; -   --  <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"); +         case Name (P) is +            when '0' => +               if Len = 2 and then (Name (P + 1) = '1' or Name (P + 1) = 'z') +               then +                  return Suffix_Edge; +               else +                  return Suffix_Num_Name;                 end if; -               return; -            when Suffix_Num_Name => -               if First then -                  Error_Vital_Name ("condition is a simple name"); +            when '1' => +               if Len = 2 and then (Name (P + 1) = '0' or Name (P + 1) = 'z') +               then +                  return Suffix_Edge; +               else +                  return Suffix_Num_Name;                 end if; -            when Suffix_Noedge => -               Error_Vital_Name ("'noedge' not allowed in simple condition"); -            when Suffix_Name => -               null; +            when '2' .. '9' => +               return Suffix_Num_Name; +            when 'z' => +               if Len = 2 and then (Name (P + 1) = '0' or Name (P + 1) = '1') +               then +                  return Suffix_Edge; +               else +                  return Suffix_Name; +               end if; +            when 'p' => +               if Len = 7 and then Name (P .. P + 6) = "posedge" then +                  return Suffix_Edge; +               else +                  return Suffix_Name; +               end if; +            when 'n' => +               if Len = 7 and then Name (P .. P + 6) = "negedge" then +                  return Suffix_Edge; +               elsif Len = 6 and then Name (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; -         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 +      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 => -               Error_Vital_Name ("missing edge or noedge"); +               --  FullCondition is always optional.                 return;              when Suffix_Edge                | Suffix_Noedge =>                 Check_Simple_Condition_And_Or_Edge;                 return; -            when Suffix_Num_Name -              | Suffix_Name => +            when Suffix_Num_Name => +               Error_Vital_Name ("condition is a simple name"); +            when 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; +         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; -         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 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 : constant Iir := Get_Type (P); +         Itype : Iir; +      begin +         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; -         when others => -            null; -      end case; -      Error_Vital (+Gen_Decl, -                   "type of timing generic is not a VITAL delay type"); -      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 -                    (+Gen_Decl, "VITAL simple scalar timing type expected"); -                  return; +            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 : constant Iir := Get_Type (Gen_Decl); +         Btype : constant Iir := Get_Base_Type (Gtype); +      begin +         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 => -               Error_Vital (+Gen_Decl, "VITAL scalar timing type expected"); -               return; +               null;           end case; -      elsif Len >= Port_Length_Unknown then -         if Is_Scalar then -            Error_Vital (+Gen_Decl, "VITAL scalar timing type expected"); +         Error_Vital (+Gen_Decl, +                      "type of timing generic is not a VITAL delay type"); +         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; - -         case Kind is -            when Timing_Type_Simple_Vector => -               null; -            when Timing_Type_Trans_Vector => -               if Is_Simple then -                  Error_Vital -                    (+Gen_Decl, "VITAL simple vector timing type expected"); +         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 +                       (+Gen_Decl, "VITAL simple scalar timing type expected"); +                     return; +                  end if; +               when others => +                  Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");                    return; -               end if; -            when others => -               Error_Vital (+Gen_Decl, "VITAL vector timing type expected"); +            end case; +         elsif Len >= Port_Length_Unknown then +            if Is_Scalar then +               Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");                 return; -         end case; -         Len1 := Get_Timing_Generic_Type_Length; -         if Len1 /= Len then -            Error_Vital (+Gen_Decl, "length of port and VITAL vector timing " -                           & "subtype does not match"); +            end if; + +            case Kind is +               when Timing_Type_Simple_Vector => +                  null; +               when Timing_Type_Trans_Vector => +                  if Is_Simple then +                     Error_Vital +                       (+Gen_Decl, "VITAL simple vector timing type expected"); +                     return; +                  end if; +               when others => +                  Error_Vital (+Gen_Decl, "VITAL vector timing type expected"); +                  return; +            end case; +            Len1 := Get_Timing_Generic_Type_Length; +            if Len1 /= Len then +               Error_Vital +                 (+Gen_Decl, "length of port and VITAL vector timing " +                    & "subtype does not match"); +            end if;           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 -                    (+Gen_Decl, "VITAL simple scalar timing type expected"); +      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 +                       (+Gen_Decl, "VITAL simple scalar timing type expected"); +                     return; +                  end if; +               when others => +                  Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");                    return; -               end if; -            when others => +            end case; +         elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then +            if Is_Scalar then                 Error_Vital (+Gen_Decl, "VITAL scalar timing type expected");                 return; -         end case; -      elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then -         if Is_Scalar then -            Error_Vital (+Gen_Decl, "VITAL scalar timing type expected"); -            return; -         end if; -         case Kind is -            when Timing_Type_Simple_Vector => -               null; -            when Timing_Type_Trans_Vector => -               if Is_Simple then -                  Error_Vital -                    (+Gen_Decl, "VITAL simple vector timing type expected"); +            end if; +            case Kind is +               when Timing_Type_Simple_Vector => +                  null; +               when Timing_Type_Trans_Vector => +                  if Is_Simple then +                     Error_Vital +                       (+Gen_Decl, "VITAL simple vector timing type expected"); +                     return; +                  end if; +               when others => +                  Error_Vital (+Gen_Decl, "VITAL vector timing type expected");                    return; -               end if; -            when others => -               Error_Vital (+Gen_Decl, "VITAL vector timing type expected"); +            end case; +            if Len1 = Port_Length_Scalar then +               Len1 := 1; +            elsif Len1 = Port_Length_Error then                 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 +                 (+Gen_Decl, "length of port and VITAL vector timing " +                    & "subtype does not match"); +            end if;           end if; -         if Len2 = Port_Length_Scalar then -            Len2 := 1; -         elsif Len2 = Port_Length_Error then +      end Check_Vital_Delay_Type; + +      function Check_Timing_Generic_Prefix +        (Decl : Iir_Interface_Constant_Declaration; Prefix_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 Len < Prefix_Length or else Name (Prefix_Length) /= '_' then +            Error_Vital +              (+Decl, "invalid use of a VITAL timing generic prefix"); +            return False; +         end if; +         Gen_Name_Pos := Prefix_Length + 1; +         Gen_Name_Length := Len; +         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; -         Lenp := Get_Timing_Generic_Type_Length; -         if Lenp /= Len1 * Len2 then -            Error_Vital (+Gen_Decl, "length of port and VITAL vector timing " -                           & "subtype does not match"); +         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; -      end if; -   end Check_Vital_Delay_Type; +         Check_Test_Reference; +      end Check_Input_Setup_Time_Name; -   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 Nam_Length < Length or Nam_Buffer (Length) /= '_' then -         Error_Vital (+Decl, "invalid use of a VITAL timing generic prefix"); -         return False; -      end if; -      Gen_Name_Pos := Length + 1; -      Gen_Name_Length := Nam_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; +      --  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; -   --  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; +      --  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; -   --  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; +      --  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; -   --  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; +      --  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; -      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; +         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 -         Image (Get_Identifier (Decl)); -         Tpd_Name (1) := 't'; -         --  The part before '_<ClockPort>'. -         Tpd_Name (2 .. Clock_Start - 2) := Nam_Buffer (3 .. Clock_Start - 1); -         Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) := -           Nam_Buffer (Clock_End .. Nam_Length); - -         Tpd_Decl := Gen_Chain; -         loop -            exit when Tpd_Decl = Null_Iir; -            Image (Get_Identifier (Tpd_Decl)); -            exit when Nam_Length = Tpd_Name'Length -              and then Nam_Buffer (1 .. Nam_Length) = Tpd_Name; -            Tpd_Decl := Get_Chain (Tpd_Decl); -         end loop; - -         if Tpd_Decl = Null_Iir then -            Error_Vital -              (+Decl, -               "no matching 'tpd' generic for VITAL 'tbpd' timing generic"); -         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 -                 (+Decl, "type of VITAL 'tbpd' generic mismatch type of " -                  & "'tpd' generic"); -               Error_Vital -                 (+Tpd_Decl, "(corresponding 'tpd' timing generic)"); -            end if; +         if not Check_Timing_Generic_Prefix (Decl, 8) then +            return;           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 .. Nam_Length); -         El : Iir; -         Offset : Natural; - -         procedure Check_Not_Clock -         is -            S : Natural; +         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; + +            Decl_Name : constant String := Image (Get_Identifier (Decl)); + +            --  '-1' is for the missing 'b' in 'tpd'. +            Tpd_Name : String +              (1 .. Gen_Name_Length - 1 - (Clock_End - Clock_Start)); +            Tpd_Decl : Iir; +            Tpd_Id : Name_Id;           begin -            S := Offset; +            Tpd_Name (1) := 't'; +            --  The part before '_<ClockPort>'. +            Tpd_Name (2 .. Clock_Start - 2) := +              Decl_Name (3 .. Clock_Start - 1); +            Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) := +              Decl_Name (Clock_End .. Decl_Name'Last); + +            Tpd_Id := Get_Identifier_No_Create (Tpd_Name); +            Tpd_Decl := Gen_Chain;              loop -               Offset := Offset + 1; -               exit when Offset > Nam_Length -                 or else Nam_Buffer (Offset) = '_'; +               exit when Tpd_Decl = Null_Iir; +               exit when Get_Identifier (Tpd_Decl) = Tpd_Id; +               Tpd_Decl := Get_Chain (Tpd_Decl);              end loop; -            if Offset - S = Port'Length -              and then Nam_Buffer (S .. Offset - 1) = Port -            then -               Error_Vital -                 (+El, "clock port name of 'ticd' VITAL generic must not" -                    & " appear here"); -            end if; -         end Check_Not_Clock; -      begin -         Port := Nam_Buffer (P_Start .. Gen_Name_Length); -         El := Gen_Chain; -         while El /= Null_Iir loop -            Image (Get_Identifier (El)); -            if Nam_Length > 5 -              and then Nam_Buffer (1) = 't' -            then -               if Nam_Buffer (2 .. 5) = "bpd_" then -                  Offset := 6; -                  Check_Not_Clock; -- input -                  Check_Not_Clock; -- output -               elsif Nam_Buffer (2 .. 5) = "isd_" then -                  Offset := 6; -                  Check_Not_Clock; -- input -               elsif Nam_Length > 10 -                 and then Nam_Buffer (2 .. 10) = "recovery_" -               then -                  Offset := 11; -                  Check_Not_Clock; -- test port -               elsif Nam_Length > 9 -                 and then Nam_Buffer (2 .. 9) = "removal_" +            if Tpd_Decl = Null_Iir then +               Error_Vital +                 (+Decl, +                  "no matching 'tpd' generic for VITAL 'tbpd' timing generic"); +            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 -                  Offset := 10; -                  Check_Not_Clock; +                  Error_Vital +                    (+Decl, "type of VITAL 'tbpd' generic mismatch type of " +                       & "'tpd' generic"); +                  Error_Vital +                    (+Tpd_Decl, "(corresponding 'tpd' timing generic)");                 end if;              end if; -            El := Get_Chain (El); -         end loop; -      end; -   end Check_Internal_Clock_Delay_Generic_Name; +         end; +      end Check_Biased_Propagation_Delay_Name; + +      --  ticd +      procedure Check_Internal_Clock_Delay_Generic_Name +        (Decl : Iir_Interface_Constant_Declaration) +      is +         Cport : Iir; +         P_End : Natural; +      begin +         if not Check_Timing_Generic_Prefix (Decl, 5) then +            return; +         end if; +         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 : constant String := Image (Get_Identifier (Cport)); +            El : Iir; +         begin +            El := Gen_Chain; +            while El /= Null_Iir loop +               declare +                  Gen_Name : constant String := Image (Get_Identifier (El)); +                  pragma Assert (Gen_Name'First = 1); +                  Offset : Natural; + +                  procedure Check_Not_Clock +                  is +                     S : Natural; +                  begin +                     S := Offset; +                     loop +                        Offset := Offset + 1; +                        exit when Offset > Gen_Name'Last +                          or else Gen_Name (Offset) = '_'; +                     end loop; +                     if Offset - S = Port'Length +                       and then Gen_Name (S .. Offset - 1) = Port +                     then +                        Error_Vital +                          (+El, "clock port name of 'ticd' VITAL generic must" +                             & " not appear here"); +                     end if; +                  end Check_Not_Clock; +               begin +                  if Gen_Name'Last > 5 +                    and then Gen_Name (1) = 't' +                  then +                     if Gen_Name (2 .. 5) = "bpd_" then +                        Offset := 6; +                        Check_Not_Clock; -- input +                        Check_Not_Clock; -- output +                     elsif Gen_Name (2 .. 5) = "isd_" then +                        Offset := 6; +                        Check_Not_Clock; -- input +                     elsif Gen_Name'Last > 10 +                       and then Gen_Name (2 .. 10) = "recovery_" +                     then +                        Offset := 11; +                        Check_Not_Clock; -- test port +                     elsif Gen_Name'Last > 9 +                       and then Gen_Name (2 .. 9) = "removal_" +                     then +                        Offset := 10; +                        Check_Not_Clock; +                     end if; +                  end if; +               end; +               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); +      pragma Assert (Name'First = 1);        --  Extract prefix. -      if Nam_Buffer (1) = 't' and Nam_Length >= 3 then +      if Name (1) = 't' and Len >= 3 then           --  Timing generic names. -         if Nam_Buffer (2) = 'p' then -            if Nam_Buffer (3) = 'd' then +         if Name (2) = 'p' then +            if Name (3) = 'd' then                 Check_Propagation_Delay_Name (Decl); --  tpd                 return; -            elsif Nam_Buffer (3) = 'w' then +            elsif Name (3) = 'w' then                 Check_Pulse_Width_Name (Decl); -- tpw                 return; -            elsif Nam_Length >= 7 -              and then Nam_Buffer (3 .. 7) = "eriod" +            elsif Len >= 7 +              and then Name (3 .. 7) = "eriod"              then                 Check_Input_Period_Name (Decl); --  tperiod                 return;              end if; -         elsif Nam_Buffer (2) = 'i' -           and then Nam_Length >= 4 -           and then Nam_Buffer (4) = 'd' +         elsif Name (2) = 'i' +           and then Len >= 4 +           and then Name (4) = 'd'           then -            if Nam_Buffer (3) = 'p' then +            if Name (3) = 'p' then                 Check_Interconnect_Path_Delay_Name (Decl); --  tipd                 return; -            elsif Nam_Buffer (3) = 's' then +            elsif Name (3) = 's' then                 Check_Internal_Signal_Delay_Name (Decl); --  tisd                 return; -            elsif Nam_Buffer (3) = 'c' then +            elsif Name (3) = 'c' then                 Check_Internal_Clock_Delay_Generic_Name (Decl); --  ticd                 return;              end if; -         elsif Nam_Length >= 6 and then Nam_Buffer (2 .. 6) = "setup" then +         elsif Len >= 6 and then Name (2 .. 6) = "setup" then              Check_Input_Setup_Time_Name (Decl); --  tsetup              return; -         elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "hold" then +         elsif Len >= 5 and then Name (2 .. 5) = "hold" then              Check_Input_Hold_Time_Name (Decl); -- thold              return; -         elsif Nam_Length >= 9 and then Nam_Buffer (2 .. 9) = "recovery" then +         elsif Len >= 9 and then Name (2 .. 9) = "recovery" then              Check_Input_Recovery_Time_Name (Decl); -- trecovery              return; -         elsif Nam_Length >= 8 and then Nam_Buffer (2 .. 8) = "removal" then +         elsif Len >= 8 and then Name (2 .. 8) = "removal" then              Check_Input_Removal_Time_Name (Decl); -- tremoval              return; -         elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "skew" then +         elsif Len >= 5 and then Name (2 .. 5) = "skew" then              Check_Input_Skew_Time_Name (Decl); -- tskew              return; -         elsif Nam_Length >= 8 and then Nam_Buffer (2 .. 8) = "ncsetup" then +         elsif Len >= 8 and then Name (2 .. 8) = "ncsetup" then              Check_No_Change_Setup_Time_Name (Decl); -- tncsetup              return; -         elsif Nam_Length >= 7 and then Nam_Buffer (2 .. 7) = "nchold" then +         elsif Len >= 7 and then Name (2 .. 7) = "nchold" then              Check_No_Change_Hold_Time_Name (Decl); -- tnchold              return; -         elsif Nam_Length >= 7 and then Nam_Buffer (2 .. 7) = "device" then +         elsif Len >= 7 and then Name (2 .. 7) = "device" then              Check_Device_Delay_Name (Decl); -- tdevice              return; -         elsif Nam_Length >= 4 and then Nam_Buffer (2 .. 4) = "bpd" then +         elsif Len >= 4 and then Name (2 .. 4) = "bpd" then              Check_Biased_Propagation_Delay_Name (Decl); -- tbpd              return;           end if; @@ -1255,7 +1235,7 @@ package body Ieee.Vital_Timing is        then           if Get_Type (Decl) /= Boolean_Type_Definition then              Error_Vital -              (+Decl, Image (Id) & " VITAL generic must be of type Boolean"); +              (+Decl, "%i VITAL generic must be of type Boolean", (1 => +Id));           end if;           return;        end if; @@ -1270,6 +1250,7 @@ package body Ieee.Vital_Timing is     is        use Sem_Scopes;        Decl : Iir; +      Gen_Chain : Iir;     begin        --  IEEE 1076.4 4.3.1        --  The only form of declaration allowed in the entity declarative part @@ -1308,7 +1289,7 @@ package body Ieee.Vital_Timing is        Gen_Chain := Get_Generic_Chain (Ent);        Decl := Gen_Chain;        while Decl /= Null_Iir loop -         Check_Entity_Generic_Declaration (Decl); +         Check_Entity_Generic_Declaration (Decl, Gen_Chain);           Decl := Get_Chain (Decl);        end loop;        Close_Declarative_Region;  | 
