From 39f80aecbff4af324432a3575de91e4562aad4f9 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 26 Sep 2017 20:49:24 +0200
Subject: name_table, ieee-vital_timing: reduce use of global variables.
---
src/name_table.adb | 70 +-
src/name_table.ads | 6 +-
src/types.ads | 9 +
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;
--
cgit v1.2.3