-- 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 Sem_Specs; 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. 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; -- 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 Nam_Buffer (1) = '/' then Error_Vital ("VITAL entity port shall not be an extended identifier", Decl); end if; for I in 1 .. Nam_Length loop if Nam_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_Guarded_Signal_Flag (Decl) 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 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; if Nam_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 ("'" & Nam_Buffer (1 .. Nam_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 ("'" & Nam_Buffer (1 .. Nam_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 ("'" & Nam_Buffer (1 .. Nam_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 := 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; 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; -- ::= -- -- | -- | _ 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; -- ::= -- [_] -- -- ::= -- [_] -- | [_]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 Nam_Length < Length or Nam_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 := Nam_Length; Gen_Decl := Decl; return True; end Check_Timing_Generic_Prefix; -- IEEE 1076.4 4.3.2.1.3.1 Propagation Delay -- ::= -- TPD__[_] 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 '_'. 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 ("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 .. Nam_Length); El : Iir; Offset : Natural; procedure Check_Not_Clock is S : Natural; begin S := Offset; loop Offset := Offset + 1; exit when Offset > Nam_Length or else Nam_Buffer (Offset) = '_'; end loop; if Offset - S = Port'Length and then Nam_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 := 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_" 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 Nam_Buffer (1) = 't' and Nam_Length >= 3 then -- Timing generic names. if Nam_Buffer (2) = 'p' then if Nam_Buffer (3) = 'd' then Check_Propagation_Delay_Name (Decl); -- tpd return; elsif Nam_Buffer (3) = 'w' then Check_Pulse_Width_Name (Decl); -- tpw return; elsif Nam_Length >= 7 and then Nam_Buffer (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' then if Nam_Buffer (3) = 'p' then Check_Interconnect_Path_Delay_Name (Decl); -- tipd return; elsif Nam_Buffer (3) = 's' then Check_Internal_Signal_Delay_Name (Decl); -- tisd return; elsif Nam_Buffer (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 Check_Input_Setup_Time_Name (Decl); -- tsetup return; elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "hold" then Check_Input_Hold_Time_Name (Decl); -- thold return; elsif Nam_Length >= 9 and then Nam_Buffer (2 .. 9) = "recovery" then Check_Input_Recovery_Time_Name (Decl); -- trecovery return; elsif Nam_Length >= 8 and then Nam_Buffer (2 .. 8) = "removal" then Check_Input_Removal_Time_Name (Decl); -- tremoval return; elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "skew" then Check_Input_Skew_Time_Name (Decl); -- tskew return; elsif Nam_Length >= 8 and then Nam_Buffer (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 Check_No_Change_Hold_Time_Name (Decl); -- tnchold return; elsif Nam_Length >= 7 and then Nam_Buffer (2 .. 7) = "device" then Check_Device_Delay_Name (Decl); -- tdevice return; elsif Nam_Length >= 4 and then Nam_Buffer (2 .. 4) = "bpd" then Check_Biased_Propagation_Delay_Name (Decl); -- tbpd return; end if; end if; if Id = InstancePath_Id then if Get_Base_Type (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. Push_Interpretations; 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; Pop_Interpretations; 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 := Sem_Specs.Find_Attribute_Value (Unit, Std_Names.Name_VITAL_Level0); if Value = Null_Iir then return False; end if; Spec := Get_Attribute_Specification (Value); return Get_Named_Entity (Get_Attribute_Designator (Spec)) = Vital_Level0_Attribute; 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;