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