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; |