From 3fa8d9eb8b700044d149bdf12da6cb023568b8c0 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 5 May 2019 08:00:35 +0200 Subject: vhdl: move ieee packages to vhdl children. --- src/ghdldrv/ghdldrv.adb | 6 +- src/ghdldrv/ghdlrun.adb | 6 +- src/synth/synth-context.adb | 6 +- src/synth/synth-expr.adb | 26 +- src/synth/synth-stmts.adb | 22 +- src/synth/synth-types.adb | 6 +- src/vhdl/ieee-numeric.adb | 259 ----- src/vhdl/ieee-numeric.ads | 26 - src/vhdl/ieee-std_logic_1164.adb | 319 ------- src/vhdl/ieee-std_logic_1164.ads | 47 - src/vhdl/ieee-vital_timing.adb | 1355 --------------------------- src/vhdl/ieee-vital_timing.ads | 40 - src/vhdl/ieee.adb | 50 - src/vhdl/ieee.ads | 26 - src/vhdl/simulate/simul-simulation-main.adb | 4 +- src/vhdl/translate/ortho_front.adb | 6 +- src/vhdl/translate/trans-chap9.adb | 4 +- src/vhdl/vhdl-ieee-numeric.adb | 259 +++++ src/vhdl/vhdl-ieee-numeric.ads | 26 + src/vhdl/vhdl-ieee-std_logic_1164.adb | 319 +++++++ src/vhdl/vhdl-ieee-std_logic_1164.ads | 47 + src/vhdl/vhdl-ieee-vital_timing.adb | 1355 +++++++++++++++++++++++++++ src/vhdl/vhdl-ieee-vital_timing.ads | 40 + src/vhdl/vhdl-ieee.adb | 50 + src/vhdl/vhdl-ieee.ads | 26 + src/vhdl/vhdl-post_sems.adb | 21 +- src/vhdl/vhdl-sem.adb | 4 +- src/vhdl/vhdl-sem_psl.adb | 4 +- src/vhdl/vhdl-sem_types.adb | 6 +- src/vhdl/vhdl-sem_utils.adb | 2 +- 30 files changed, 2184 insertions(+), 2183 deletions(-) delete mode 100644 src/vhdl/ieee-numeric.adb delete mode 100644 src/vhdl/ieee-numeric.ads delete mode 100644 src/vhdl/ieee-std_logic_1164.adb delete mode 100644 src/vhdl/ieee-std_logic_1164.ads delete mode 100644 src/vhdl/ieee-vital_timing.adb delete mode 100644 src/vhdl/ieee-vital_timing.ads delete mode 100644 src/vhdl/ieee.adb delete mode 100644 src/vhdl/ieee.ads create mode 100644 src/vhdl/vhdl-ieee-numeric.adb create mode 100644 src/vhdl/vhdl-ieee-numeric.ads create mode 100644 src/vhdl/vhdl-ieee-std_logic_1164.adb create mode 100644 src/vhdl/vhdl-ieee-std_logic_1164.ads create mode 100644 src/vhdl/vhdl-ieee-vital_timing.adb create mode 100644 src/vhdl/vhdl-ieee-vital_timing.ads create mode 100644 src/vhdl/vhdl-ieee.adb create mode 100644 src/vhdl/vhdl-ieee.ads (limited to 'src') diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index d6e2210ac..0d14c8035 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -23,7 +23,7 @@ with Tables; with GNAT.Dynamic_Tables; with Libraries; with Name_Table; use Name_Table; -with Std_Package; +with Vhdl.Std_Package; with Types; use Types; with Iirs; use Iirs; with Files_Map; @@ -1570,7 +1570,7 @@ package body Ghdldrv is while Is_Valid (Files_It) loop File := Get_Element (Files_It); - if File = Std_Package.Std_Standard_File then + if File = Vhdl.Std_Package.Std_Standard_File then Need_Analyze := False; elsif Missing_Object_File (File) or else Source_File_Modified (File) @@ -1710,7 +1710,7 @@ package body Ghdldrv is function Is_Makeable_File (File : Iir_Design_File) return Boolean is begin - if File = Std_Package.Std_Standard_File then + if File = Vhdl.Std_Package.Std_Standard_File then return False; end if; return True; diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index f8b3adaaf..fc59d0e7e 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -40,7 +40,7 @@ with Vhdl.Canon; with Vhdl.Configuration; with Trans_Be; with Translation; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Lists; with Str_Table; @@ -738,9 +738,9 @@ package body Ghdlrun is Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); Grtlink.Std_Standard_Bit_RTI_Ptr := Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Bit_Rti); - if Ieee.Std_Logic_1164.Resolved /= Null_Iir then + if Vhdl.Ieee.Std_Logic_1164.Resolved /= Null_Iir then Decl := Translation.Get_Resolv_Ortho_Decl - (Ieee.Std_Logic_1164.Resolved); + (Vhdl.Ieee.Std_Logic_1164.Resolved); if Decl /= O_Dnode_Null then Grtlink.Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Ortho_Jit.Get_Address (Decl); diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 607c94555..95eb09baa 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -26,7 +26,7 @@ with Errorout; use Errorout; with Iirs_Utils; with Vhdl.Std_Package; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Simul.Annotations; use Simul.Annotations; with Simul.Execution; @@ -90,8 +90,8 @@ package body Synth.Context is end if; when Iir_Kind_Array_Type_Definition => -- Well known array types. - if Btype = Ieee.Std_Logic_1164.Std_Logic_Vector_Type - or else Btype = Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type + if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type + or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type then return Alloc_Wire (Kind, Obj, Bounds_To_Range (Val.Bounds.D (1))); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index cbc9f87d2..7a682dbff 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -21,7 +21,7 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Std_Names; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Std_Package; with Errorout; use Errorout; with Simul.Execution; @@ -85,21 +85,21 @@ package body Synth.Expr is when Iir_Value_E8 => -- Std_logic. case Lit.E8 is - when Ieee.Std_Logic_1164.Std_Logic_0_Pos - | Ieee.Std_Logic_1164.Std_Logic_L_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos => Val := 0; Zx := 0; - when Ieee.Std_Logic_1164.Std_Logic_1_Pos - | Ieee.Std_Logic_1164.Std_Logic_H_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => Val := 1; Zx := 0; - when Ieee.Std_Logic_1164.Std_Logic_U_Pos - | Ieee.Std_Logic_1164.Std_Logic_X_Pos - | Ieee.Std_Logic_1164.Std_Logic_D_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos => Val := 1; Zx := 1; - when Ieee.Std_Logic_1164.Std_Logic_Z_Pos - | Ieee.Std_Logic_1164.Std_Logic_W_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos => Val := 0; Zx := 1; when others => @@ -696,11 +696,11 @@ package body Synth.Expr is end if; Lit := Get_Named_Entity (Right); if Lit = Vhdl.Std_Package.Bit_0 - or else Lit = Ieee.Std_Logic_1164.Std_Ulogic_0 + or else Lit = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_0 then Posedge := False; elsif Lit = Vhdl.Std_Package.Bit_1 - or else Lit = Ieee.Std_Logic_1164.Std_Ulogic_1 + or else Lit = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_1 then Posedge := True; else @@ -851,7 +851,7 @@ package body Synth.Expr is Imp : constant Iir := Get_Implementation (Expr); Clk : Net; begin - if Imp = Ieee.Std_Logic_1164.Rising_Edge then + if Imp = Vhdl.Ieee.Std_Logic_1164.Rising_Edge then Clk := Get_Net (Synth_Assoc_In (Syn_Inst, Get_Parameter_Association_Chain (Expr))); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 3889cde3c..6acf95fac 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -27,7 +27,7 @@ with Errorout; use Errorout; with Vhdl.Sem_Expr; with Iirs_Utils; use Iirs_Utils; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Evaluation; with Synth.Types; use Synth.Types; @@ -195,7 +195,7 @@ package body Synth.Stmts is El_Type : constant Iir := Get_Base_Type (Get_Element_Subtype (Get_Type (Expr))); begin - if El_Type = Ieee.Std_Logic_1164.Std_Ulogic_Type then + if El_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then declare use Evaluation.String_Utils; @@ -210,17 +210,17 @@ package body Synth.Stmts is Val := Shift_Left (Val, 1); Dc := Shift_Left (Dc, 1); case Get_Pos (Info, I) is - when Ieee.Std_Logic_1164.Std_Logic_0_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos => Val := Val or 0; - when Ieee.Std_Logic_1164.Std_Logic_1_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos => Val := Val or 1; - when Ieee.Std_Logic_1164.Std_Logic_U_Pos - | Ieee.Std_Logic_1164.Std_Logic_X_Pos - | Ieee.Std_Logic_1164.Std_Logic_Z_Pos - | Ieee.Std_Logic_1164.Std_Logic_W_Pos - | Ieee.Std_Logic_1164.Std_Logic_D_Pos - | Ieee.Std_Logic_1164.Std_Logic_L_Pos - | Ieee.Std_Logic_1164.Std_Logic_H_Pos => + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => Dc := Dc or 1; when others => raise Internal_Error; diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb index 88542ab6b..f1478fb18 100644 --- a/src/synth/synth-types.adb +++ b/src/synth/synth-types.adb @@ -20,7 +20,7 @@ with Types; use Types; with Vhdl.Std_Package; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Iirs_Utils; use Iirs_Utils; with Simul.Environments; use Simul.Environments; @@ -30,8 +30,8 @@ with Errorout; use Errorout; package body Synth.Types is function Is_Bit_Type (Atype : Iir) return Boolean is begin - return Atype = Ieee.Std_Logic_1164.Std_Ulogic_Type - or else Atype = Ieee.Std_Logic_1164.Std_Logic_Type + return Atype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type + or else Atype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type or else Atype = Vhdl.Std_Package.Boolean_Type_Definition or else Atype = Vhdl.Std_Package.Bit_Type_Definition; end Is_Bit_Type; diff --git a/src/vhdl/ieee-numeric.adb b/src/vhdl/ieee-numeric.adb deleted file mode 100644 index c6dfcb17a..000000000 --- a/src/vhdl/ieee-numeric.adb +++ /dev/null @@ -1,259 +0,0 @@ --- Nodes recognizer for ieee.numeric_std and ieee.numeric_bit. --- Copyright (C) 2016 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 Vhdl.Std_Package; -with Std_Names; use Std_Names; -with Errorout; use Errorout; -with Ieee.Std_Logic_1164; - -package body Ieee.Numeric is - type Pkg_Kind is (Pkg_Std, Pkg_Bit); - type Sign_Kind is (Type_Signed, Type_Unsigned, - Type_Log, Type_Slv, Type_Suv); - subtype Sign_Num_Kind is Sign_Kind range Type_Signed .. Type_Unsigned; - type Arg_Kind is (Arg_Vect, Arg_Scal); - type Args_Kind is (Arg_Vect_Vect, Arg_Vect_Scal, Arg_Scal_Vect, - Arg_Vect_Log, Arg_Log_Vect); - - type Binary_Pattern_Type is array (Pkg_Kind, Sign_Num_Kind, Args_Kind) - of Iir_Predefined_Functions; - - Add_Patterns : constant Binary_Pattern_Type := - (Pkg_Std => - (Type_Unsigned => - (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns, - Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat, - Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Nat_Uns, - Arg_Vect_Log => Iir_Predefined_None, - Arg_Log_Vect => Iir_Predefined_None), - Type_Signed => - (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn, - Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Int, - Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Int_Sgn, - Arg_Vect_Log => Iir_Predefined_None, - Arg_Log_Vect => Iir_Predefined_None)), - Pkg_Bit => - (others => - (others => Iir_Predefined_None))); - - Eq_Patterns : constant Binary_Pattern_Type := - (Pkg_Std => - (Type_Unsigned => - (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Uns, - Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat, - Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Nat_Uns, - Arg_Vect_Log => Iir_Predefined_None, - Arg_Log_Vect => Iir_Predefined_None), - Type_Signed => - (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Sgn, - Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Int, - Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Int_Sgn, - Arg_Vect_Log => Iir_Predefined_None, - Arg_Log_Vect => Iir_Predefined_None)), - Pkg_Bit => - (others => - (others => Iir_Predefined_None))); - - Error : exception; - - procedure Extract_Declarations (Pkg_Decl : Iir_Package_Declaration; - Pkg : Pkg_Kind; - Unsigned_Type : out Iir; - Signed_Type : out Iir) - is - procedure Classify_Arg - (Arg : Iir; Sign : out Sign_Kind; Kind : out Arg_Kind) - is - Arg_Type : constant Iir := Get_Type (Arg); - begin - if Arg_Type = Signed_Type then - Sign := Type_Signed; - Kind := Arg_Vect; - elsif Arg_Type = Unsigned_Type then - Sign := Type_Unsigned; - Kind := Arg_Vect; - elsif Arg_Type = Vhdl.Std_Package.Integer_Subtype_Definition then - Sign := Type_Signed; - Kind := Arg_Scal; - elsif Arg_Type = Vhdl.Std_Package.Natural_Subtype_Definition then - Sign := Type_Unsigned; - Kind := Arg_Scal; - elsif Arg_Type = Ieee.Std_Logic_1164.Std_Ulogic_Type then - Sign := Type_Log; - Kind := Arg_Scal; - elsif Arg_Type = Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type then - Sign := Type_Suv; - Kind := Arg_Vect; - elsif Arg_Type = Ieee.Std_Logic_1164.Std_Logic_Type then - Sign := Type_Log; - Kind := Arg_Scal; - elsif Arg_Type = Ieee.Std_Logic_1164.Std_Logic_Vector_Type then - Sign := Type_Slv; - Kind := Arg_Vect; - else - raise Error; - end if; - end Classify_Arg; - - Decl : Iir; - Def : Iir; - - Arg1, Arg2 : Iir; - Arg1_Sign, Arg2_Sign : Sign_Kind; - Arg1_Kind, Arg2_Kind : Arg_Kind; - - procedure Handle_Binary (Pats : Binary_Pattern_Type) - is - Kind : Args_Kind; - Sign : Sign_Kind; - begin - if Arg1_Sign = Arg2_Sign then - Sign := Arg1_Sign; - case Arg1_Kind is - when Arg_Vect => - case Arg2_Kind is - when Arg_Vect => Kind := Arg_Vect_Vect; - when Arg_Scal => Kind := Arg_Vect_Scal; - end case; - when Arg_Scal => - case Arg2_Kind is - when Arg_Vect => Kind := Arg_Scal_Vect; - when Arg_Scal => raise Error; - end case; - end case; - elsif Arg1_Kind = Arg_Vect and Arg2_Sign = Type_Log then - Sign := Arg1_Sign; - Kind := Arg_Vect_Log; - elsif Arg1_Sign = Type_Log and Arg2_Kind = Arg_Vect then - Sign := Arg2_Sign; - Kind := Arg_Log_Vect; - else - raise Error; - end if; - - Set_Implicit_Definition (Decl, Pats (Pkg, Sign, Kind)); - end Handle_Binary; - - begin - Decl := Get_Declaration_Chain (Pkg_Decl); - - -- Skip a potential copyright constant. - if Decl /= Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration - and then (Get_Base_Type (Get_Type (Decl)) - = Vhdl.Std_Package.String_Type_Definition) - then - Decl := Get_Chain (Decl); - end if; - - -- The first declaration should be type Unsigned or Unresolved_Unsigned - if not (Decl /= Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Type_Declaration - and then (Get_Identifier (Decl) = Name_Unsigned - or else - Get_Identifier (Decl) = Name_Unresolved_Unsigned)) - then - raise Error; - end if; - - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then - raise Error; - end if; - Unsigned_Type := Def; - - -- The second declaration should be type Signed. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if not (Decl /= Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Type_Declaration - and then (Get_Identifier (Decl) = Name_Signed - or else - Get_Identifier (Decl) = Name_Unresolved_Signed)) - then - raise Error; - end if; - - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then - raise Error; - end if; - Signed_Type := Def; - - -- For vhdl 2008, skip subtypes - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - while Is_Valid (Decl) loop - exit when Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration; - Decl := Get_Chain (Decl); - end loop; - - -- Handle functions. - while Is_Valid (Decl) loop - case Get_Kind (Decl) is - when Iir_Kind_Function_Declaration => - Arg1 := Get_Interface_Declaration_Chain (Decl); - if Is_Null (Arg1) then - raise Error; - end if; - - Classify_Arg (Arg1, Arg1_Sign, Arg1_Kind); - Arg2 := Get_Chain (Arg1); - if Is_Valid (Arg2) then - Classify_Arg (Arg2, Arg2_Sign, Arg2_Kind); - - case Get_Identifier (Decl) is - when Name_Op_Plus => - Handle_Binary (Add_Patterns); - when Name_Op_Equality => - Handle_Binary (Eq_Patterns); - when Name_To_Bstring - | Name_To_Ostring - | Name_To_Hstring => - null; - when others => - null; - end case; - end if; - - when Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Procedure_Declaration => - null; - - when others => - raise Error; - end case; - Decl := Get_Chain (Decl); - end loop; - end Extract_Declarations; - - procedure Extract_Std_Declarations (Pkg : Iir_Package_Declaration) is - begin - Numeric_Std_Pkg := Pkg; - - Extract_Declarations - (Pkg, Pkg_Std, Numeric_Std_Unsigned_Type, Numeric_Std_Signed_Type); - exception - when Error => - Error_Msg_Sem (+Pkg, "package ieee.numeric_std is ill-formed"); - Numeric_Std_Pkg := Null_Iir; - Numeric_Std_Unsigned_Type := Null_Iir; - Numeric_Std_Signed_Type := Null_Iir; - end Extract_Std_Declarations; -end Ieee.Numeric; diff --git a/src/vhdl/ieee-numeric.ads b/src/vhdl/ieee-numeric.ads deleted file mode 100644 index 04213bea7..000000000 --- a/src/vhdl/ieee-numeric.ads +++ /dev/null @@ -1,26 +0,0 @@ --- Nodes recognizer for ieee.numeric_std and ieee.numeric_bit. --- Copyright (C) 2016 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. - -package Ieee.Numeric is - Numeric_Std_Pkg : Iir_Package_Declaration := Null_Iir; - Numeric_Std_Unsigned_Type : Iir_Array_Type_Definition := Null_Iir; - Numeric_Std_Signed_Type : Iir_Array_Type_Definition := Null_Iir; - - -- Extract declarations from PKG (ieee.numeric_std). - procedure Extract_Std_Declarations (Pkg : Iir_Package_Declaration); -end Ieee.Numeric; diff --git a/src/vhdl/ieee-std_logic_1164.adb b/src/vhdl/ieee-std_logic_1164.adb deleted file mode 100644 index 9d66942f9..000000000 --- a/src/vhdl/ieee-std_logic_1164.adb +++ /dev/null @@ -1,319 +0,0 @@ --- Nodes recognizer for ieee.std_logic_1164. --- 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 Name_Table; -with Std_Names; use Std_Names; -with Errorout; use Errorout; - -package body Ieee.Std_Logic_1164 is - function Is_Scalar_Parameter (Inter : Iir) return Boolean is - begin - return Get_Base_Type (Get_Type (Inter)) = Std_Ulogic_Type; - end Is_Scalar_Parameter; - - function Is_Vector_Parameter (Inter : Iir) return Boolean - is - Base_Type : constant Iir := Get_Base_Type (Get_Type (Inter)); - begin - return Base_Type = Std_Ulogic_Vector_Type - or Base_Type = Std_Logic_Vector_Type; - end Is_Vector_Parameter; - - -- Return True iff the profile of FUNC is: (l, r : std_ulogic) - function Is_Scalar_Scalar_Function (Func : Iir) return Boolean - is - Inter : constant Iir := Get_Interface_Declaration_Chain (Func); - Inter2 : Iir; - begin - if Get_Implicit_Definition (Func) /= Iir_Predefined_None then - return False; - end if; - if Inter = Null_Iir or else not Is_Scalar_Parameter (Inter) then - return False; - end if; - Inter2 := Get_Chain (Inter); - if Inter2 = Null_Iir or else not Is_Scalar_Parameter (Inter2) then - return False; - end if; - if Get_Chain (Inter2) /= Null_Iir then - return False; - end if; - - return True; - end Is_Scalar_Scalar_Function; - - -- Return True iff the profile of FUNC is: (l : std_ulogic) - function Is_Scalar_Function (Func : Iir) return Boolean - is - Inter : constant Iir := Get_Interface_Declaration_Chain (Func); - begin - if Get_Implicit_Definition (Func) /= Iir_Predefined_None then - return False; - end if; - if Inter = Null_Iir or else not Is_Scalar_Parameter (Inter) then - return False; - end if; - if Get_Chain (Inter) /= Null_Iir then - return False; - end if; - - return True; - end Is_Scalar_Function; - - -- Return True iff the profile of FUNC is: (l, r : std_[u]logic_vector) - function Is_Vector_Vector_Function (Func : Iir) return Boolean - is - Inter : constant Iir := Get_Interface_Declaration_Chain (Func); - Inter2 : Iir; - begin - if Get_Implicit_Definition (Func) /= Iir_Predefined_None then - return False; - end if; - if Inter = Null_Iir or else not Is_Vector_Parameter (Inter) then - return False; - end if; - Inter2 := Get_Chain (Inter); - if Inter2 = Null_Iir or else not Is_Vector_Parameter (Inter2) then - return False; - end if; - if Get_Chain (Inter2) /= Null_Iir then - return False; - end if; - - return True; - end Is_Vector_Vector_Function; - - -- Return True iff the profile of FUNC is: (l : std_[u]logic_vector) - function Is_Vector_Function (Func : Iir) return Boolean - is - Inter : constant Iir := Get_Interface_Declaration_Chain (Func); - begin - if Get_Implicit_Definition (Func) /= Iir_Predefined_None then - return False; - end if; - if Inter = Null_Iir or else not Is_Vector_Parameter (Inter) then - return False; - end if; - if Get_Chain (Inter) /= Null_Iir then - return False; - end if; - - return True; - end Is_Vector_Function; - - procedure Extract_Declarations (Pkg : Iir_Package_Declaration) - is - Error : exception; - - Decl : Iir; - Def : Iir; - begin - Std_Logic_1164_Pkg := Pkg; - - Decl := Get_Declaration_Chain (Pkg); - - -- Skip a potential copyright constant. - Decl := Skip_Copyright_Notice (Decl); - - -- The first declaration should be type std_ulogic. - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration - or else Get_Identifier (Decl) /= Name_Std_Ulogic - then - raise Error; - end if; - - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then - raise Error; - end if; - Std_Ulogic_Type := Def; - - -- Get node of some literals. - declare - use Name_Table; - Lit_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); - begin - if Get_Nbr_Elements (Lit_List) /= 9 then - raise Error; - end if; - Std_Ulogic_0 := Get_Nth_Element (Lit_List, 2); - Std_Ulogic_1 := Get_Nth_Element (Lit_List, 3); - if Get_Identifier (Std_Ulogic_0) /= Get_Identifier ('0') - or else Get_Identifier (Std_Ulogic_1) /= Get_Identifier ('1') - then - raise Error; - end if; - end; - - -- The second declaration should be std_ulogic_vector. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration - or else Get_Identifier (Decl) /= Name_Std_Ulogic_Vector - then - raise Error; - end if; - Def := Get_Type_Definition (Decl); - if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then - raise Error; - end if; - Std_Ulogic_Vector_Type := Def; - - -- The third declaration should be resolved. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Function_Declaration - then - -- FIXME: check name ? - raise Error; - end if; - Resolved := Decl; - - -- The fourth declaration should be std_logic. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration - or else Get_Identifier (Decl) /= Name_Std_Logic - then - raise Error; - end if; - Def := Get_Type (Decl); - if Get_Kind (Def) /= Iir_Kind_Enumeration_Subtype_Definition then - raise Error; - end if; - Std_Logic_Type := Def; - - -- The fifth declaration should be std_logic_vector. - Decl := Get_Chain (Decl); - Decl := Skip_Implicit (Decl); - if Decl = Null_Iir - or else (Get_Kind (Decl) /= Iir_Kind_Type_Declaration - and then Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration) - or else Get_Identifier (Decl) /= Name_Std_Logic_Vector - then - raise Error; - end if; - Def := Get_Type (Decl); --- if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then --- raise Error; --- end if; - Std_Logic_Vector_Type := Def; - - -- Skip any declarations but functions. - loop - Decl := Get_Chain (Decl); - exit when Decl = Null_Iir; - - if Get_Kind (Decl) = Iir_Kind_Function_Declaration then - if Get_Identifier (Decl) = Name_Rising_Edge then - Rising_Edge := Decl; - elsif Get_Identifier (Decl) = Name_Falling_Edge then - Falling_Edge := Decl; - elsif Is_Scalar_Scalar_Function (Decl) then - declare - Predefined : Iir_Predefined_Functions; - begin - case Get_Identifier (Decl) is - when Name_And => - Predefined := Iir_Predefined_Ieee_1164_Scalar_And; - when Name_Nand => - Predefined := Iir_Predefined_Ieee_1164_Scalar_Nand; - when Name_Or => - Predefined := Iir_Predefined_Ieee_1164_Scalar_Or; - when Name_Nor => - Predefined := Iir_Predefined_Ieee_1164_Scalar_Nor; - when Name_Xor => - Predefined := Iir_Predefined_Ieee_1164_Scalar_Xor; - when Name_Xnor => - Predefined := Iir_Predefined_Ieee_1164_Scalar_Xnor; - when others => - Predefined := Iir_Predefined_None; - end case; - Set_Implicit_Definition (Decl, Predefined); - end; - elsif Is_Scalar_Function (Decl) - and then Get_Identifier (Decl) = Name_Not - then - Set_Implicit_Definition - (Decl, Iir_Predefined_Ieee_1164_Scalar_Not); - elsif Is_Vector_Vector_Function (Decl) then - declare - Predefined : Iir_Predefined_Functions; - begin - case Get_Identifier (Decl) is - when Name_And => - Predefined := Iir_Predefined_Ieee_1164_Vector_And; - when Name_Nand => - Predefined := Iir_Predefined_Ieee_1164_Vector_Nand; - when Name_Or => - Predefined := Iir_Predefined_Ieee_1164_Vector_Or; - when Name_Nor => - Predefined := Iir_Predefined_Ieee_1164_Vector_Nor; - when Name_Xor => - Predefined := Iir_Predefined_Ieee_1164_Vector_Xor; - when Name_Xnor => - Predefined := Iir_Predefined_Ieee_1164_Vector_Xnor; - when others => - Predefined := Iir_Predefined_None; - end case; - Set_Implicit_Definition (Decl, Predefined); - end; - elsif Is_Vector_Function (Decl) - and then Get_Identifier (Decl) = Name_Not - then - Set_Implicit_Definition - (Decl, Iir_Predefined_Ieee_1164_Vector_Not); - end if; - end if; - end loop; - - -- Since rising_edge and falling_edge do not read activity of its - -- parameter, clear the flag to allow more optimizations. - if Rising_Edge /= Null_Iir then - Set_Has_Active_Flag - (Get_Interface_Declaration_Chain (Rising_Edge), False); - else - raise Error; - end if; - if Falling_Edge /= Null_Iir then - Set_Has_Active_Flag - (Get_Interface_Declaration_Chain (Falling_Edge), False); - else - raise Error; - end if; - - exception - when Error => - Error_Msg_Sem (+Pkg, "package ieee.std_logic_1164 is ill-formed"); - - -- Clear all definitions. - Std_Logic_1164_Pkg := Null_Iir; - Std_Ulogic_Type := Null_Iir; - Std_Ulogic_Vector_Type := Null_Iir; - Std_Logic_Type := Null_Iir; - Std_Logic_Vector_Type := Null_Iir; - Std_Ulogic_0 := Null_Iir; - Std_Ulogic_1 := Null_Iir; - Rising_Edge := Null_Iir; - Falling_Edge := Null_Iir; - end Extract_Declarations; -end Ieee.Std_Logic_1164; diff --git a/src/vhdl/ieee-std_logic_1164.ads b/src/vhdl/ieee-std_logic_1164.ads deleted file mode 100644 index 8e2a6846c..000000000 --- a/src/vhdl/ieee-std_logic_1164.ads +++ /dev/null @@ -1,47 +0,0 @@ --- Nodes recognizer for ieee.std_logic_1164. --- 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. - -package Ieee.Std_Logic_1164 is - -- Nodes corresponding to declarations in the package. - Std_Logic_1164_Pkg : Iir_Package_Declaration := Null_Iir; - Std_Ulogic_Type : Iir_Enumeration_Type_Definition := Null_Iir; - Std_Ulogic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; - Std_Ulogic_0 : Iir_Enumeration_Literal := Null_Iir; - Std_Ulogic_1 : Iir_Enumeration_Literal := Null_Iir; - Std_Logic_Type : Iir_Enumeration_Subtype_Definition := Null_Iir; - Std_Logic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; - Resolved : Iir_Function_Declaration := Null_Iir; - Rising_Edge : Iir_Function_Declaration := Null_Iir; - Falling_Edge : Iir_Function_Declaration := Null_Iir; - - -- Position of literals (D represents '-' ie dont-care). - Std_Logic_U_Pos : constant := 0; - Std_Logic_X_Pos : constant := 1; - Std_Logic_0_Pos : constant := 2; - Std_Logic_1_Pos : constant := 3; - Std_Logic_Z_Pos : constant := 4; - Std_Logic_L_Pos : constant := 5; - Std_Logic_H_Pos : constant := 6; - Std_Logic_W_Pos : constant := 7; - Std_Logic_D_Pos : constant := 8; - - -- Extract declarations from PKG. - -- PKG is the package declaration for ieee.std_logic_1164 package. - -- Fills the node aboves. - procedure Extract_Declarations (Pkg : Iir_Package_Declaration); -end Ieee.Std_Logic_1164; diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb deleted file mode 100644 index d4777d651..000000000 --- a/src/vhdl/ieee-vital_timing.adb +++ /dev/null @@ -1,1355 +0,0 @@ --- 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 Vhdl.Std_Package; use Vhdl.Std_Package; -with Vhdl.Tokens; use Vhdl.Tokens; -with Name_Table; -with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164; -with Vhdl.Sem_Scopes; -with Vhdl.Sem_Specs; -with Evaluation; -with Vhdl.Sem; -with Iirs_Utils; - -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 - 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; - - 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. - 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. - 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 (+Pkg, "package ieee.vital_timing is ill-formed"); - - 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 - (Loc : Location_Type; Msg : String; Args : Earg_Arr := No_Eargs) is - begin - Error_Msg_Sem (Loc, Msg, Args); - end Error_Vital; - - procedure Warning_Vital - (Loc : Iir; Msg : String; Args : Earg_Arr := No_Eargs) is - begin - Warning_Msg_Sem (Warnid_Vital_Generic, +Loc, Msg, Args); - end Warning_Vital; - - -- 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 - (+Decl, - "first declaration must be the VITAL attribute specification"); - 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 - (+Decl, "the expression in the VITAL_Level0 attribute " - & "specification shall be the Boolean literal TRUE"); - 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 (+Decl, "VITAL attribute specification does not " - & "decorate the enclosing entity or architecture"); - end case; - end Check_Level0_Attribute_Specification; - - procedure Check_Entity_Port_Declaration - (Decl : Iir_Interface_Signal_Declaration) - is - use Name_Table; - - Name : constant String := Image (Get_Identifier (Decl)); - 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. - 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 Name'Range loop - if Name (I) = '_' then - Error_Vital - (+Decl, "VITAL entity port shall not contain underscore"); - 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 (+Decl, "VITAL entity port shall not be of mode LINKAGE"); - 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 - (+Decl, - "VITAL array port type cannot override resolution function"); - 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 - (+Decl, - "VITAL entity port type mark shall be one of Std_Logic_1164"); - end if; - else - Error_Vital - (+Decl, "VITAL port type must be Std_Logic_Vector or Std_Ulogic"); - end if; - - if Get_Guarded_Signal_Flag (Decl) then - Error_Vital (+Decl, "VITAL entity port cannot be guarded"); - end if; - end Check_Entity_Port_Declaration; - - 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; - - -- Current position in the generic name, stored into Name. - Gen_Name_Pos : Natural; - - -- Length of the generic name. - Gen_Name_Length : Natural; - - -- The generic being analyzed. - Gen_Decl : Iir; - - Port_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; - - -- Check the next sub-string in the generic name is a port. - -- Returns the port. - function Check_Port return Iir - is - use Vhdl.Sem_Scopes; - use Name_Table; - - 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; - - if Port_Length = 0 then - Error_Vital_Name ("port expected in VITAL generic name"); - return Null_Iir; - end if; - - 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; - - -- Checks the port is an input port. - function Check_Input_Port return Iir - is - 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; - - -- Checks the port is an output port. - function Check_Output_Port return Iir - is - 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 - 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; - - 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; - 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 '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; - 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 : 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_Nth_Element (Get_Index_Subtype_List (Ptype), 0); - 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 : 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 => - 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_Nth_Element - (Get_Index_Subtype_List (Get_Type (Gen_Decl)), 0); - 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; - end if; - when others => - Error_Vital (+Gen_Decl, "VITAL scalar timing type expected"); - return; - end case; - elsif Len >= 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"); - 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 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 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"); - return; - end if; - when others => - Error_Vital (+Gen_Decl, "VITAL vector timing type expected"); - 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; - end Check_Vital_Delay_Type; - - function Check_Timing_Generic_Prefix - (Decl : Iir_Interface_Constant_Declaration; Prefix_Length : Natural) - return Boolean - is - 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 - -- ::= - -- 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; - - 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 - Tpd_Name (1) := 't'; - -- The part before '_'. - 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 - exit when Tpd_Decl = Null_Iir; - exit when Get_Identifier (Tpd_Decl) = Tpd_Id; - 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 Vhdl.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; - 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_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; - - begin - pragma Assert (Name'First = 1); - - -- Extract prefix. - if Name (1) = 't' and Len >= 3 then - -- Timing generic names. - if Name (2) = 'p' then - if Name (3) = 'd' then - Check_Propagation_Delay_Name (Decl); -- tpd - return; - elsif Name (3) = 'w' then - Check_Pulse_Width_Name (Decl); -- tpw - return; - elsif Len >= 7 - and then Name (3 .. 7) = "eriod" - then - Check_Input_Period_Name (Decl); -- tperiod - return; - end if; - elsif Name (2) = 'i' - and then Len >= 4 - and then Name (4) = 'd' - then - if Name (3) = 'p' then - Check_Interconnect_Path_Delay_Name (Decl); -- tipd - return; - elsif Name (3) = 's' then - Check_Internal_Signal_Delay_Name (Decl); -- tisd - return; - elsif Name (3) = 'c' then - Check_Internal_Clock_Delay_Generic_Name (Decl); -- ticd - return; - end if; - elsif Len >= 6 and then Name (2 .. 6) = "setup" then - Check_Input_Setup_Time_Name (Decl); -- tsetup - return; - elsif Len >= 5 and then Name (2 .. 5) = "hold" then - Check_Input_Hold_Time_Name (Decl); -- thold - return; - elsif Len >= 9 and then Name (2 .. 9) = "recovery" then - Check_Input_Recovery_Time_Name (Decl); -- trecovery - return; - elsif Len >= 8 and then Name (2 .. 8) = "removal" then - Check_Input_Removal_Time_Name (Decl); -- tremoval - return; - elsif Len >= 5 and then Name (2 .. 5) = "skew" then - Check_Input_Skew_Time_Name (Decl); -- tskew - return; - elsif Len >= 8 and then Name (2 .. 8) = "ncsetup" then - Check_No_Change_Setup_Time_Name (Decl); -- tncsetup - return; - elsif Len >= 7 and then Name (2 .. 7) = "nchold" then - Check_No_Change_Hold_Time_Name (Decl); -- tnchold - return; - elsif Len >= 7 and then Name (2 .. 7) = "device" then - Check_Device_Delay_Name (Decl); -- tdevice - return; - elsif Len >= 4 and then Name (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 - (+Decl, "InstancePath VITAL generic must be of type String"); - 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 - (+Decl, "%i VITAL generic must be of type Boolean", (1 => +Id)); - end if; - return; - end if; - - if Is_Warning_Enabled (Warnid_Vital_Generic) then - Warning_Vital (Decl, "%n is not a VITAL generic", (1 => +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 Vhdl.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 - -- 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 (+Decl, "VITAL entity declarative part must only contain " - & "the attribute specification"); - 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 - (+Decl, "VITAL entity must not have concurrent statement"); - 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, Gen_Chain); - 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 := Vhdl.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 (+Arch, "entity associated with a VITAL level 0 " - & "architecture shall be a VITAL level 0 entity"); - 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 - (+Lib_Unit, "only entity or architecture can be VITAL_Level0"); - 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 (+Arch, "only architecture can be VITAL_Level1"); - return; - end if; - -- FIXME: todo - end Check_Vital_Level1; - -end Ieee.Vital_Timing; diff --git a/src/vhdl/ieee-vital_timing.ads b/src/vhdl/ieee-vital_timing.ads deleted file mode 100644 index 59edf35b0..000000000 --- a/src/vhdl/ieee-vital_timing.ads +++ /dev/null @@ -1,40 +0,0 @@ --- 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. - -package Ieee.Vital_Timing is - -- Attribute declarations. - Vital_Level0_Attribute : Iir_Attribute_Declaration := Null_Iir; - Vital_Level1_Attribute : Iir_Attribute_Declaration := Null_Iir; - - -- Vital delay types. - VitalDelayType : Iir := Null_Iir; - VitalDelayType01 : Iir_Array_Type_Definition := Null_Iir; - VitalDelayType01Z : Iir_Array_Type_Definition := Null_Iir; - VitalDelayType01ZX : Iir_Array_Type_Definition := Null_Iir; - - VitalDelayArrayType : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01 : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01Z : Iir_Array_Type_Definition := Null_Iir; - VitalDelayArrayType01ZX : Iir_Array_Type_Definition := Null_Iir; - - -- Extract declarations from IEEE.VITAL_Timing package. - procedure Extract_Declarations (Pkg : Iir_Package_Declaration); - - procedure Check_Vital_Level0 (Unit : Iir_Design_Unit); - procedure Check_Vital_Level1 (Unit : Iir_Design_Unit); -end Ieee.Vital_Timing; diff --git a/src/vhdl/ieee.adb b/src/vhdl/ieee.adb deleted file mode 100644 index 393a05d32..000000000 --- a/src/vhdl/ieee.adb +++ /dev/null @@ -1,50 +0,0 @@ --- Nodes recognizer for ieee packages - utilities. --- Copyright (C) 2016 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 Iirs_Utils; use Iirs_Utils; -with Vhdl.Std_Package; - -package body Ieee is - function Skip_Copyright_Notice (Decl : Iir) return Iir - is - begin - if Decl /= Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration - and then (Get_Base_Type (Get_Type (Decl)) - = Vhdl.Std_Package.String_Type_Definition) - then - return Get_Chain (Decl); - else - return Decl; - end if; - end Skip_Copyright_Notice; - - function Skip_Implicit (Decl : Iir) return Iir - is - Res : Iir; - begin - Res := Decl; - loop - exit when Res = Null_Iir; - exit when not (Get_Kind (Res) = Iir_Kind_Function_Declaration - and then Is_Implicit_Subprogram (Res)); - Res := Get_Chain (Res); - end loop; - return Res; - end Skip_Implicit; -end Ieee; diff --git a/src/vhdl/ieee.ads b/src/vhdl/ieee.ads deleted file mode 100644 index e29e50f4d..000000000 --- a/src/vhdl/ieee.ads +++ /dev/null @@ -1,26 +0,0 @@ --- Nodes recognizer for ieee packages - utilities. --- Copyright (C) 2016 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 Iirs; use Iirs; - -package Ieee is - -- Skip constant string declaration for a copyright, if present. - function Skip_Copyright_Notice (Decl : Iir) return Iir; - - -- Return the next node after implicit subprogram declarations. - function Skip_Implicit (Decl : Iir) return Iir; -end Ieee; diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb index 2d0558308..141e1fd2d 100644 --- a/src/vhdl/simulate/simul-simulation-main.adb +++ b/src/vhdl/simulate/simul-simulation-main.adb @@ -29,7 +29,7 @@ with Trans_Analyzes; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; with Simul.Annotations; use Simul.Annotations; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Grt.Main; with Simul.Debugger; use Simul.Debugger; with Simul.Debugger.AMS; @@ -381,7 +381,7 @@ package body Simul.Simulation.Main is Res := Execute_Expression (Instance, E); if Rtype = Vhdl.Std_Package.Boolean_Type_Definition then return Res.B1 = True; - elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then + elsif Rtype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then return Res.E8 = 3 or Res.E8 = 7; -- 1 or H else Error_Kind ("execute_psl_expr", Expr); diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 6db015494..2ce7a34a4 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -25,7 +25,7 @@ with Interning; with Iirs; use Iirs; with Libraries; with Iirs_Utils; use Iirs_Utils; -with Std_Package; +with Vhdl.Std_Package; with Flags; with Vhdl.Configuration; with Translation; @@ -327,8 +327,8 @@ package body Ortho_Front is Vhdl.Configuration.Flag_Load_All_Design_Units := False; -- Exclude std.standard - Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); - Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Mark_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); Dep_List := Create_Iir_List; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 0bf153ebf..f4dc4a422 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -27,7 +27,7 @@ with Nodes_Meta; with PSL.Nodes; with PSL.NFAs; with PSL.NFAs.Utils; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Trans.Chap1; with Trans.Chap3; with Trans.Chap4; @@ -389,7 +389,7 @@ package body Trans.Chap9 is Res, New_Lit (Get_Ortho_Literal (Bit_1)), Get_Ortho_Type (Boolean_Type_Definition, Mode_Value)); - elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then + elsif Rtype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then return New_Value (New_Indexed_Element (New_Obj (Ghdl_Std_Ulogic_To_Boolean_Array), diff --git a/src/vhdl/vhdl-ieee-numeric.adb b/src/vhdl/vhdl-ieee-numeric.adb new file mode 100644 index 000000000..49f1ee4fb --- /dev/null +++ b/src/vhdl/vhdl-ieee-numeric.adb @@ -0,0 +1,259 @@ +-- Nodes recognizer for ieee.numeric_std and ieee.numeric_bit. +-- Copyright (C) 2016 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 Vhdl.Std_Package; +with Std_Names; use Std_Names; +with Errorout; use Errorout; +with Vhdl.Ieee.Std_Logic_1164; + +package body Vhdl.Ieee.Numeric is + type Pkg_Kind is (Pkg_Std, Pkg_Bit); + type Sign_Kind is (Type_Signed, Type_Unsigned, + Type_Log, Type_Slv, Type_Suv); + subtype Sign_Num_Kind is Sign_Kind range Type_Signed .. Type_Unsigned; + type Arg_Kind is (Arg_Vect, Arg_Scal); + type Args_Kind is (Arg_Vect_Vect, Arg_Vect_Scal, Arg_Scal_Vect, + Arg_Vect_Log, Arg_Log_Vect); + + type Binary_Pattern_Type is array (Pkg_Kind, Sign_Num_Kind, Args_Kind) + of Iir_Predefined_Functions; + + Add_Patterns : constant Binary_Pattern_Type := + (Pkg_Std => + (Type_Unsigned => + (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns, + Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat, + Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Nat_Uns, + Arg_Vect_Log => Iir_Predefined_None, + Arg_Log_Vect => Iir_Predefined_None), + Type_Signed => + (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn, + Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Int, + Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Add_Int_Sgn, + Arg_Vect_Log => Iir_Predefined_None, + Arg_Log_Vect => Iir_Predefined_None)), + Pkg_Bit => + (others => + (others => Iir_Predefined_None))); + + Eq_Patterns : constant Binary_Pattern_Type := + (Pkg_Std => + (Type_Unsigned => + (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Uns, + Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat, + Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Nat_Uns, + Arg_Vect_Log => Iir_Predefined_None, + Arg_Log_Vect => Iir_Predefined_None), + Type_Signed => + (Arg_Vect_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Sgn, + Arg_Vect_Scal => Iir_Predefined_Ieee_Numeric_Std_Eq_Sgn_Int, + Arg_Scal_Vect => Iir_Predefined_Ieee_Numeric_Std_Eq_Int_Sgn, + Arg_Vect_Log => Iir_Predefined_None, + Arg_Log_Vect => Iir_Predefined_None)), + Pkg_Bit => + (others => + (others => Iir_Predefined_None))); + + Error : exception; + + procedure Extract_Declarations (Pkg_Decl : Iir_Package_Declaration; + Pkg : Pkg_Kind; + Unsigned_Type : out Iir; + Signed_Type : out Iir) + is + procedure Classify_Arg + (Arg : Iir; Sign : out Sign_Kind; Kind : out Arg_Kind) + is + Arg_Type : constant Iir := Get_Type (Arg); + begin + if Arg_Type = Signed_Type then + Sign := Type_Signed; + Kind := Arg_Vect; + elsif Arg_Type = Unsigned_Type then + Sign := Type_Unsigned; + Kind := Arg_Vect; + elsif Arg_Type = Vhdl.Std_Package.Integer_Subtype_Definition then + Sign := Type_Signed; + Kind := Arg_Scal; + elsif Arg_Type = Vhdl.Std_Package.Natural_Subtype_Definition then + Sign := Type_Unsigned; + Kind := Arg_Scal; + elsif Arg_Type = Ieee.Std_Logic_1164.Std_Ulogic_Type then + Sign := Type_Log; + Kind := Arg_Scal; + elsif Arg_Type = Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type then + Sign := Type_Suv; + Kind := Arg_Vect; + elsif Arg_Type = Ieee.Std_Logic_1164.Std_Logic_Type then + Sign := Type_Log; + Kind := Arg_Scal; + elsif Arg_Type = Ieee.Std_Logic_1164.Std_Logic_Vector_Type then + Sign := Type_Slv; + Kind := Arg_Vect; + else + raise Error; + end if; + end Classify_Arg; + + Decl : Iir; + Def : Iir; + + Arg1, Arg2 : Iir; + Arg1_Sign, Arg2_Sign : Sign_Kind; + Arg1_Kind, Arg2_Kind : Arg_Kind; + + procedure Handle_Binary (Pats : Binary_Pattern_Type) + is + Kind : Args_Kind; + Sign : Sign_Kind; + begin + if Arg1_Sign = Arg2_Sign then + Sign := Arg1_Sign; + case Arg1_Kind is + when Arg_Vect => + case Arg2_Kind is + when Arg_Vect => Kind := Arg_Vect_Vect; + when Arg_Scal => Kind := Arg_Vect_Scal; + end case; + when Arg_Scal => + case Arg2_Kind is + when Arg_Vect => Kind := Arg_Scal_Vect; + when Arg_Scal => raise Error; + end case; + end case; + elsif Arg1_Kind = Arg_Vect and Arg2_Sign = Type_Log then + Sign := Arg1_Sign; + Kind := Arg_Vect_Log; + elsif Arg1_Sign = Type_Log and Arg2_Kind = Arg_Vect then + Sign := Arg2_Sign; + Kind := Arg_Log_Vect; + else + raise Error; + end if; + + Set_Implicit_Definition (Decl, Pats (Pkg, Sign, Kind)); + end Handle_Binary; + + begin + Decl := Get_Declaration_Chain (Pkg_Decl); + + -- Skip a potential copyright constant. + if Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration + and then (Get_Base_Type (Get_Type (Decl)) + = Vhdl.Std_Package.String_Type_Definition) + then + Decl := Get_Chain (Decl); + end if; + + -- The first declaration should be type Unsigned or Unresolved_Unsigned + if not (Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Type_Declaration + and then (Get_Identifier (Decl) = Name_Unsigned + or else + Get_Identifier (Decl) = Name_Unresolved_Unsigned)) + then + raise Error; + end if; + + Def := Get_Type_Definition (Decl); + if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then + raise Error; + end if; + Unsigned_Type := Def; + + -- The second declaration should be type Signed. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if not (Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Type_Declaration + and then (Get_Identifier (Decl) = Name_Signed + or else + Get_Identifier (Decl) = Name_Unresolved_Signed)) + then + raise Error; + end if; + + Def := Get_Type_Definition (Decl); + if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then + raise Error; + end if; + Signed_Type := Def; + + -- For vhdl 2008, skip subtypes + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + while Is_Valid (Decl) loop + exit when Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration; + Decl := Get_Chain (Decl); + end loop; + + -- Handle functions. + while Is_Valid (Decl) loop + case Get_Kind (Decl) is + when Iir_Kind_Function_Declaration => + Arg1 := Get_Interface_Declaration_Chain (Decl); + if Is_Null (Arg1) then + raise Error; + end if; + + Classify_Arg (Arg1, Arg1_Sign, Arg1_Kind); + Arg2 := Get_Chain (Arg1); + if Is_Valid (Arg2) then + Classify_Arg (Arg2, Arg2_Sign, Arg2_Kind); + + case Get_Identifier (Decl) is + when Name_Op_Plus => + Handle_Binary (Add_Patterns); + when Name_Op_Equality => + Handle_Binary (Eq_Patterns); + when Name_To_Bstring + | Name_To_Ostring + | Name_To_Hstring => + null; + when others => + null; + end case; + end if; + + when Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Procedure_Declaration => + null; + + when others => + raise Error; + end case; + Decl := Get_Chain (Decl); + end loop; + end Extract_Declarations; + + procedure Extract_Std_Declarations (Pkg : Iir_Package_Declaration) is + begin + Numeric_Std_Pkg := Pkg; + + Extract_Declarations + (Pkg, Pkg_Std, Numeric_Std_Unsigned_Type, Numeric_Std_Signed_Type); + exception + when Error => + Error_Msg_Sem (+Pkg, "package ieee.numeric_std is ill-formed"); + Numeric_Std_Pkg := Null_Iir; + Numeric_Std_Unsigned_Type := Null_Iir; + Numeric_Std_Signed_Type := Null_Iir; + end Extract_Std_Declarations; +end Vhdl.Ieee.Numeric; diff --git a/src/vhdl/vhdl-ieee-numeric.ads b/src/vhdl/vhdl-ieee-numeric.ads new file mode 100644 index 000000000..873cb8370 --- /dev/null +++ b/src/vhdl/vhdl-ieee-numeric.ads @@ -0,0 +1,26 @@ +-- Nodes recognizer for ieee.numeric_std and ieee.numeric_bit. +-- Copyright (C) 2016 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. + +package Vhdl.Ieee.Numeric is + Numeric_Std_Pkg : Iir_Package_Declaration := Null_Iir; + Numeric_Std_Unsigned_Type : Iir_Array_Type_Definition := Null_Iir; + Numeric_Std_Signed_Type : Iir_Array_Type_Definition := Null_Iir; + + -- Extract declarations from PKG (ieee.numeric_std). + procedure Extract_Std_Declarations (Pkg : Iir_Package_Declaration); +end Vhdl.Ieee.Numeric; diff --git a/src/vhdl/vhdl-ieee-std_logic_1164.adb b/src/vhdl/vhdl-ieee-std_logic_1164.adb new file mode 100644 index 000000000..6932dc9ef --- /dev/null +++ b/src/vhdl/vhdl-ieee-std_logic_1164.adb @@ -0,0 +1,319 @@ +-- Nodes recognizer for ieee.std_logic_1164. +-- 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 Name_Table; +with Std_Names; use Std_Names; +with Errorout; use Errorout; + +package body Vhdl.Ieee.Std_Logic_1164 is + function Is_Scalar_Parameter (Inter : Iir) return Boolean is + begin + return Get_Base_Type (Get_Type (Inter)) = Std_Ulogic_Type; + end Is_Scalar_Parameter; + + function Is_Vector_Parameter (Inter : Iir) return Boolean + is + Base_Type : constant Iir := Get_Base_Type (Get_Type (Inter)); + begin + return Base_Type = Std_Ulogic_Vector_Type + or Base_Type = Std_Logic_Vector_Type; + end Is_Vector_Parameter; + + -- Return True iff the profile of FUNC is: (l, r : std_ulogic) + function Is_Scalar_Scalar_Function (Func : Iir) return Boolean + is + Inter : constant Iir := Get_Interface_Declaration_Chain (Func); + Inter2 : Iir; + begin + if Get_Implicit_Definition (Func) /= Iir_Predefined_None then + return False; + end if; + if Inter = Null_Iir or else not Is_Scalar_Parameter (Inter) then + return False; + end if; + Inter2 := Get_Chain (Inter); + if Inter2 = Null_Iir or else not Is_Scalar_Parameter (Inter2) then + return False; + end if; + if Get_Chain (Inter2) /= Null_Iir then + return False; + end if; + + return True; + end Is_Scalar_Scalar_Function; + + -- Return True iff the profile of FUNC is: (l : std_ulogic) + function Is_Scalar_Function (Func : Iir) return Boolean + is + Inter : constant Iir := Get_Interface_Declaration_Chain (Func); + begin + if Get_Implicit_Definition (Func) /= Iir_Predefined_None then + return False; + end if; + if Inter = Null_Iir or else not Is_Scalar_Parameter (Inter) then + return False; + end if; + if Get_Chain (Inter) /= Null_Iir then + return False; + end if; + + return True; + end Is_Scalar_Function; + + -- Return True iff the profile of FUNC is: (l, r : std_[u]logic_vector) + function Is_Vector_Vector_Function (Func : Iir) return Boolean + is + Inter : constant Iir := Get_Interface_Declaration_Chain (Func); + Inter2 : Iir; + begin + if Get_Implicit_Definition (Func) /= Iir_Predefined_None then + return False; + end if; + if Inter = Null_Iir or else not Is_Vector_Parameter (Inter) then + return False; + end if; + Inter2 := Get_Chain (Inter); + if Inter2 = Null_Iir or else not Is_Vector_Parameter (Inter2) then + return False; + end if; + if Get_Chain (Inter2) /= Null_Iir then + return False; + end if; + + return True; + end Is_Vector_Vector_Function; + + -- Return True iff the profile of FUNC is: (l : std_[u]logic_vector) + function Is_Vector_Function (Func : Iir) return Boolean + is + Inter : constant Iir := Get_Interface_Declaration_Chain (Func); + begin + if Get_Implicit_Definition (Func) /= Iir_Predefined_None then + return False; + end if; + if Inter = Null_Iir or else not Is_Vector_Parameter (Inter) then + return False; + end if; + if Get_Chain (Inter) /= Null_Iir then + return False; + end if; + + return True; + end Is_Vector_Function; + + procedure Extract_Declarations (Pkg : Iir_Package_Declaration) + is + Error : exception; + + Decl : Iir; + Def : Iir; + begin + Std_Logic_1164_Pkg := Pkg; + + Decl := Get_Declaration_Chain (Pkg); + + -- Skip a potential copyright constant. + Decl := Skip_Copyright_Notice (Decl); + + -- The first declaration should be type std_ulogic. + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration + or else Get_Identifier (Decl) /= Name_Std_Ulogic + then + raise Error; + end if; + + Def := Get_Type_Definition (Decl); + if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then + raise Error; + end if; + Std_Ulogic_Type := Def; + + -- Get node of some literals. + declare + use Name_Table; + Lit_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); + begin + if Get_Nbr_Elements (Lit_List) /= 9 then + raise Error; + end if; + Std_Ulogic_0 := Get_Nth_Element (Lit_List, 2); + Std_Ulogic_1 := Get_Nth_Element (Lit_List, 3); + if Get_Identifier (Std_Ulogic_0) /= Get_Identifier ('0') + or else Get_Identifier (Std_Ulogic_1) /= Get_Identifier ('1') + then + raise Error; + end if; + end; + + -- The second declaration should be std_ulogic_vector. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration + or else Get_Identifier (Decl) /= Name_Std_Ulogic_Vector + then + raise Error; + end if; + Def := Get_Type_Definition (Decl); + if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then + raise Error; + end if; + Std_Ulogic_Vector_Type := Def; + + -- The third declaration should be resolved. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Function_Declaration + then + -- FIXME: check name ? + raise Error; + end if; + Resolved := Decl; + + -- The fourth declaration should be std_logic. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration + or else Get_Identifier (Decl) /= Name_Std_Logic + then + raise Error; + end if; + Def := Get_Type (Decl); + if Get_Kind (Def) /= Iir_Kind_Enumeration_Subtype_Definition then + raise Error; + end if; + Std_Logic_Type := Def; + + -- The fifth declaration should be std_logic_vector. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else (Get_Kind (Decl) /= Iir_Kind_Type_Declaration + and then Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration) + or else Get_Identifier (Decl) /= Name_Std_Logic_Vector + then + raise Error; + end if; + Def := Get_Type (Decl); +-- if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then +-- raise Error; +-- end if; + Std_Logic_Vector_Type := Def; + + -- Skip any declarations but functions. + loop + Decl := Get_Chain (Decl); + exit when Decl = Null_Iir; + + if Get_Kind (Decl) = Iir_Kind_Function_Declaration then + if Get_Identifier (Decl) = Name_Rising_Edge then + Rising_Edge := Decl; + elsif Get_Identifier (Decl) = Name_Falling_Edge then + Falling_Edge := Decl; + elsif Is_Scalar_Scalar_Function (Decl) then + declare + Predefined : Iir_Predefined_Functions; + begin + case Get_Identifier (Decl) is + when Name_And => + Predefined := Iir_Predefined_Ieee_1164_Scalar_And; + when Name_Nand => + Predefined := Iir_Predefined_Ieee_1164_Scalar_Nand; + when Name_Or => + Predefined := Iir_Predefined_Ieee_1164_Scalar_Or; + when Name_Nor => + Predefined := Iir_Predefined_Ieee_1164_Scalar_Nor; + when Name_Xor => + Predefined := Iir_Predefined_Ieee_1164_Scalar_Xor; + when Name_Xnor => + Predefined := Iir_Predefined_Ieee_1164_Scalar_Xnor; + when others => + Predefined := Iir_Predefined_None; + end case; + Set_Implicit_Definition (Decl, Predefined); + end; + elsif Is_Scalar_Function (Decl) + and then Get_Identifier (Decl) = Name_Not + then + Set_Implicit_Definition + (Decl, Iir_Predefined_Ieee_1164_Scalar_Not); + elsif Is_Vector_Vector_Function (Decl) then + declare + Predefined : Iir_Predefined_Functions; + begin + case Get_Identifier (Decl) is + when Name_And => + Predefined := Iir_Predefined_Ieee_1164_Vector_And; + when Name_Nand => + Predefined := Iir_Predefined_Ieee_1164_Vector_Nand; + when Name_Or => + Predefined := Iir_Predefined_Ieee_1164_Vector_Or; + when Name_Nor => + Predefined := Iir_Predefined_Ieee_1164_Vector_Nor; + when Name_Xor => + Predefined := Iir_Predefined_Ieee_1164_Vector_Xor; + when Name_Xnor => + Predefined := Iir_Predefined_Ieee_1164_Vector_Xnor; + when others => + Predefined := Iir_Predefined_None; + end case; + Set_Implicit_Definition (Decl, Predefined); + end; + elsif Is_Vector_Function (Decl) + and then Get_Identifier (Decl) = Name_Not + then + Set_Implicit_Definition + (Decl, Iir_Predefined_Ieee_1164_Vector_Not); + end if; + end if; + end loop; + + -- Since rising_edge and falling_edge do not read activity of its + -- parameter, clear the flag to allow more optimizations. + if Rising_Edge /= Null_Iir then + Set_Has_Active_Flag + (Get_Interface_Declaration_Chain (Rising_Edge), False); + else + raise Error; + end if; + if Falling_Edge /= Null_Iir then + Set_Has_Active_Flag + (Get_Interface_Declaration_Chain (Falling_Edge), False); + else + raise Error; + end if; + + exception + when Error => + Error_Msg_Sem (+Pkg, "package ieee.std_logic_1164 is ill-formed"); + + -- Clear all definitions. + Std_Logic_1164_Pkg := Null_Iir; + Std_Ulogic_Type := Null_Iir; + Std_Ulogic_Vector_Type := Null_Iir; + Std_Logic_Type := Null_Iir; + Std_Logic_Vector_Type := Null_Iir; + Std_Ulogic_0 := Null_Iir; + Std_Ulogic_1 := Null_Iir; + Rising_Edge := Null_Iir; + Falling_Edge := Null_Iir; + end Extract_Declarations; +end Vhdl.Ieee.Std_Logic_1164; diff --git a/src/vhdl/vhdl-ieee-std_logic_1164.ads b/src/vhdl/vhdl-ieee-std_logic_1164.ads new file mode 100644 index 000000000..f5c92b5f1 --- /dev/null +++ b/src/vhdl/vhdl-ieee-std_logic_1164.ads @@ -0,0 +1,47 @@ +-- Nodes recognizer for ieee.std_logic_1164. +-- 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. + +package Vhdl.Ieee.Std_Logic_1164 is + -- Nodes corresponding to declarations in the package. + Std_Logic_1164_Pkg : Iir_Package_Declaration := Null_Iir; + Std_Ulogic_Type : Iir_Enumeration_Type_Definition := Null_Iir; + Std_Ulogic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; + Std_Ulogic_0 : Iir_Enumeration_Literal := Null_Iir; + Std_Ulogic_1 : Iir_Enumeration_Literal := Null_Iir; + Std_Logic_Type : Iir_Enumeration_Subtype_Definition := Null_Iir; + Std_Logic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; + Resolved : Iir_Function_Declaration := Null_Iir; + Rising_Edge : Iir_Function_Declaration := Null_Iir; + Falling_Edge : Iir_Function_Declaration := Null_Iir; + + -- Position of literals (D represents '-' ie dont-care). + Std_Logic_U_Pos : constant := 0; + Std_Logic_X_Pos : constant := 1; + Std_Logic_0_Pos : constant := 2; + Std_Logic_1_Pos : constant := 3; + Std_Logic_Z_Pos : constant := 4; + Std_Logic_L_Pos : constant := 5; + Std_Logic_H_Pos : constant := 6; + Std_Logic_W_Pos : constant := 7; + Std_Logic_D_Pos : constant := 8; + + -- Extract declarations from PKG. + -- PKG is the package declaration for ieee.std_logic_1164 package. + -- Fills the node aboves. + procedure Extract_Declarations (Pkg : Iir_Package_Declaration); +end Vhdl.Ieee.Std_Logic_1164; diff --git a/src/vhdl/vhdl-ieee-vital_timing.adb b/src/vhdl/vhdl-ieee-vital_timing.adb new file mode 100644 index 000000000..3a343858f --- /dev/null +++ b/src/vhdl/vhdl-ieee-vital_timing.adb @@ -0,0 +1,1355 @@ +-- 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 Vhdl.Std_Package; use Vhdl.Std_Package; +with Vhdl.Tokens; use Vhdl.Tokens; +with Name_Table; +with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164; +with Vhdl.Sem_Scopes; +with Vhdl.Sem_Specs; +with Evaluation; +with Vhdl.Sem; +with Iirs_Utils; + +package body Vhdl.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 + 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; + + 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. + 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. + 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 (+Pkg, "package ieee.vital_timing is ill-formed"); + + 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 + (Loc : Location_Type; Msg : String; Args : Earg_Arr := No_Eargs) is + begin + Error_Msg_Sem (Loc, Msg, Args); + end Error_Vital; + + procedure Warning_Vital + (Loc : Iir; Msg : String; Args : Earg_Arr := No_Eargs) is + begin + Warning_Msg_Sem (Warnid_Vital_Generic, +Loc, Msg, Args); + end Warning_Vital; + + -- 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 + (+Decl, + "first declaration must be the VITAL attribute specification"); + 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 + (+Decl, "the expression in the VITAL_Level0 attribute " + & "specification shall be the Boolean literal TRUE"); + 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 (+Decl, "VITAL attribute specification does not " + & "decorate the enclosing entity or architecture"); + end case; + end Check_Level0_Attribute_Specification; + + procedure Check_Entity_Port_Declaration + (Decl : Iir_Interface_Signal_Declaration) + is + use Name_Table; + + Name : constant String := Image (Get_Identifier (Decl)); + 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. + 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 Name'Range loop + if Name (I) = '_' then + Error_Vital + (+Decl, "VITAL entity port shall not contain underscore"); + 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 (+Decl, "VITAL entity port shall not be of mode LINKAGE"); + 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 + (+Decl, + "VITAL array port type cannot override resolution function"); + 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 + (+Decl, + "VITAL entity port type mark shall be one of Std_Logic_1164"); + end if; + else + Error_Vital + (+Decl, "VITAL port type must be Std_Logic_Vector or Std_Ulogic"); + end if; + + if Get_Guarded_Signal_Flag (Decl) then + Error_Vital (+Decl, "VITAL entity port cannot be guarded"); + end if; + end Check_Entity_Port_Declaration; + + 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; + + -- Current position in the generic name, stored into Name. + Gen_Name_Pos : Natural; + + -- Length of the generic name. + Gen_Name_Length : Natural; + + -- The generic being analyzed. + Gen_Decl : Iir; + + Port_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; + + -- Check the next sub-string in the generic name is a port. + -- Returns the port. + function Check_Port return Iir + is + use Vhdl.Sem_Scopes; + use Name_Table; + + 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; + + if Port_Length = 0 then + Error_Vital_Name ("port expected in VITAL generic name"); + return Null_Iir; + end if; + + 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; + + -- Checks the port is an input port. + function Check_Input_Port return Iir + is + 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; + + -- Checks the port is an output port. + function Check_Output_Port return Iir + is + 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 + 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; + + 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; + 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 '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; + 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 : 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_Nth_Element (Get_Index_Subtype_List (Ptype), 0); + 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 : 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 => + 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_Nth_Element + (Get_Index_Subtype_List (Get_Type (Gen_Decl)), 0); + 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; + end if; + when others => + Error_Vital (+Gen_Decl, "VITAL scalar timing type expected"); + return; + end case; + elsif Len >= 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"); + 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 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 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"); + return; + end if; + when others => + Error_Vital (+Gen_Decl, "VITAL vector timing type expected"); + 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; + end Check_Vital_Delay_Type; + + function Check_Timing_Generic_Prefix + (Decl : Iir_Interface_Constant_Declaration; Prefix_Length : Natural) + return Boolean + is + 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 + -- ::= + -- 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; + + 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 + Tpd_Name (1) := 't'; + -- The part before '_'. + 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 + exit when Tpd_Decl = Null_Iir; + exit when Get_Identifier (Tpd_Decl) = Tpd_Id; + 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 Vhdl.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; + 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_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; + + begin + pragma Assert (Name'First = 1); + + -- Extract prefix. + if Name (1) = 't' and Len >= 3 then + -- Timing generic names. + if Name (2) = 'p' then + if Name (3) = 'd' then + Check_Propagation_Delay_Name (Decl); -- tpd + return; + elsif Name (3) = 'w' then + Check_Pulse_Width_Name (Decl); -- tpw + return; + elsif Len >= 7 + and then Name (3 .. 7) = "eriod" + then + Check_Input_Period_Name (Decl); -- tperiod + return; + end if; + elsif Name (2) = 'i' + and then Len >= 4 + and then Name (4) = 'd' + then + if Name (3) = 'p' then + Check_Interconnect_Path_Delay_Name (Decl); -- tipd + return; + elsif Name (3) = 's' then + Check_Internal_Signal_Delay_Name (Decl); -- tisd + return; + elsif Name (3) = 'c' then + Check_Internal_Clock_Delay_Generic_Name (Decl); -- ticd + return; + end if; + elsif Len >= 6 and then Name (2 .. 6) = "setup" then + Check_Input_Setup_Time_Name (Decl); -- tsetup + return; + elsif Len >= 5 and then Name (2 .. 5) = "hold" then + Check_Input_Hold_Time_Name (Decl); -- thold + return; + elsif Len >= 9 and then Name (2 .. 9) = "recovery" then + Check_Input_Recovery_Time_Name (Decl); -- trecovery + return; + elsif Len >= 8 and then Name (2 .. 8) = "removal" then + Check_Input_Removal_Time_Name (Decl); -- tremoval + return; + elsif Len >= 5 and then Name (2 .. 5) = "skew" then + Check_Input_Skew_Time_Name (Decl); -- tskew + return; + elsif Len >= 8 and then Name (2 .. 8) = "ncsetup" then + Check_No_Change_Setup_Time_Name (Decl); -- tncsetup + return; + elsif Len >= 7 and then Name (2 .. 7) = "nchold" then + Check_No_Change_Hold_Time_Name (Decl); -- tnchold + return; + elsif Len >= 7 and then Name (2 .. 7) = "device" then + Check_Device_Delay_Name (Decl); -- tdevice + return; + elsif Len >= 4 and then Name (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 + (+Decl, "InstancePath VITAL generic must be of type String"); + 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 + (+Decl, "%i VITAL generic must be of type Boolean", (1 => +Id)); + end if; + return; + end if; + + if Is_Warning_Enabled (Warnid_Vital_Generic) then + Warning_Vital (Decl, "%n is not a VITAL generic", (1 => +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 Vhdl.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 + -- 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 (+Decl, "VITAL entity declarative part must only contain " + & "the attribute specification"); + 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 + (+Decl, "VITAL entity must not have concurrent statement"); + 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, Gen_Chain); + 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 := Vhdl.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 (+Arch, "entity associated with a VITAL level 0 " + & "architecture shall be a VITAL level 0 entity"); + 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 + (+Lib_Unit, "only entity or architecture can be VITAL_Level0"); + 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 (+Arch, "only architecture can be VITAL_Level1"); + return; + end if; + -- FIXME: todo + end Check_Vital_Level1; + +end Vhdl.Ieee.Vital_Timing; diff --git a/src/vhdl/vhdl-ieee-vital_timing.ads b/src/vhdl/vhdl-ieee-vital_timing.ads new file mode 100644 index 000000000..4dbd64bdf --- /dev/null +++ b/src/vhdl/vhdl-ieee-vital_timing.ads @@ -0,0 +1,40 @@ +-- 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. + +package Vhdl.Ieee.Vital_Timing is + -- Attribute declarations. + Vital_Level0_Attribute : Iir_Attribute_Declaration := Null_Iir; + Vital_Level1_Attribute : Iir_Attribute_Declaration := Null_Iir; + + -- Vital delay types. + VitalDelayType : Iir := Null_Iir; + VitalDelayType01 : Iir_Array_Type_Definition := Null_Iir; + VitalDelayType01Z : Iir_Array_Type_Definition := Null_Iir; + VitalDelayType01ZX : Iir_Array_Type_Definition := Null_Iir; + + VitalDelayArrayType : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01 : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01Z : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01ZX : Iir_Array_Type_Definition := Null_Iir; + + -- Extract declarations from IEEE.VITAL_Timing package. + procedure Extract_Declarations (Pkg : Iir_Package_Declaration); + + procedure Check_Vital_Level0 (Unit : Iir_Design_Unit); + procedure Check_Vital_Level1 (Unit : Iir_Design_Unit); +end Vhdl.Ieee.Vital_Timing; diff --git a/src/vhdl/vhdl-ieee.adb b/src/vhdl/vhdl-ieee.adb new file mode 100644 index 000000000..8d1021efb --- /dev/null +++ b/src/vhdl/vhdl-ieee.adb @@ -0,0 +1,50 @@ +-- Nodes recognizer for ieee packages - utilities. +-- Copyright (C) 2016 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 Iirs_Utils; use Iirs_Utils; +with Vhdl.Std_Package; + +package body Vhdl.Ieee is + function Skip_Copyright_Notice (Decl : Iir) return Iir + is + begin + if Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration + and then (Get_Base_Type (Get_Type (Decl)) + = Vhdl.Std_Package.String_Type_Definition) + then + return Get_Chain (Decl); + else + return Decl; + end if; + end Skip_Copyright_Notice; + + function Skip_Implicit (Decl : Iir) return Iir + is + Res : Iir; + begin + Res := Decl; + loop + exit when Res = Null_Iir; + exit when not (Get_Kind (Res) = Iir_Kind_Function_Declaration + and then Is_Implicit_Subprogram (Res)); + Res := Get_Chain (Res); + end loop; + return Res; + end Skip_Implicit; +end Vhdl.Ieee; diff --git a/src/vhdl/vhdl-ieee.ads b/src/vhdl/vhdl-ieee.ads new file mode 100644 index 000000000..53a094ea7 --- /dev/null +++ b/src/vhdl/vhdl-ieee.ads @@ -0,0 +1,26 @@ +-- Nodes recognizer for ieee packages - utilities. +-- Copyright (C) 2016 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 Iirs; use Iirs; + +package Vhdl.Ieee is + -- Skip constant string declaration for a copyright, if present. + function Skip_Copyright_Notice (Decl : Iir) return Iir; + + -- Return the next node after implicit subprogram declarations. + function Skip_Implicit (Decl : Iir) return Iir; +end Vhdl.Ieee; diff --git a/src/vhdl/vhdl-post_sems.adb b/src/vhdl/vhdl-post_sems.adb index 6c653e4fc..4a8c96697 100644 --- a/src/vhdl/vhdl-post_sems.adb +++ b/src/vhdl/vhdl-post_sems.adb @@ -18,9 +18,9 @@ with Types; use Types; with Std_Names; use Std_Names; with Vhdl.Sem_Specs; -with Ieee.Std_Logic_1164; -with Ieee.Vital_Timing; -with Ieee.Numeric; +with Vhdl.Ieee.Std_Logic_1164; +with Vhdl.Ieee.Vital_Timing; +with Vhdl.Ieee.Numeric; with Flags; use Flags; package body Vhdl.Post_Sems is @@ -51,11 +51,11 @@ package body Vhdl.Post_Sems is if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then case Id is when Name_Std_Logic_1164 => - Ieee.Std_Logic_1164.Extract_Declarations (Lib_Unit); + Vhdl.Ieee.Std_Logic_1164.Extract_Declarations (Lib_Unit); when Name_VITAL_Timing => - Ieee.Vital_Timing.Extract_Declarations (Lib_Unit); + Vhdl.Ieee.Vital_Timing.Extract_Declarations (Lib_Unit); when Name_Numeric_Std => - Ieee.Numeric.Extract_Std_Declarations (Lib_Unit); + Vhdl.Ieee.Numeric.Extract_Std_Declarations (Lib_Unit); when others => null; end case; @@ -69,10 +69,11 @@ package body Vhdl.Post_Sems is while Value /= Null_Iir loop Spec := Get_Attribute_Specification (Value); Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Spec)); - if Attr_Decl = Ieee.Vital_Timing.Vital_Level0_Attribute then - Ieee.Vital_Timing.Check_Vital_Level0 (Unit); - elsif Attr_Decl = Ieee.Vital_Timing.Vital_Level1_Attribute then - Ieee.Vital_Timing.Check_Vital_Level1 (Unit); + if Attr_Decl = Vhdl.Ieee.Vital_Timing.Vital_Level0_Attribute then + Vhdl.Ieee.Vital_Timing.Check_Vital_Level0 (Unit); + elsif Attr_Decl = Vhdl.Ieee.Vital_Timing.Vital_Level1_Attribute + then + Vhdl.Ieee.Vital_Timing.Check_Vital_Level1 (Unit); end if; Value := Get_Value_Chain (Value); diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 878713ce6..0af9db861 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Errorout; use Errorout; with Vhdl.Std_Package; use Vhdl.Std_Package; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Libraries; with Std_Names; with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes; @@ -2661,7 +2661,7 @@ package body Vhdl.Sem is and then (Get_Identifier (Get_Library (Get_Design_File (Unit))) = Std_Names.Name_Ieee) then - Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Pkg; + Vhdl.Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Pkg; end if; -- LRM93 10.1 Declarative Region diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index a528da0be..fb812706a 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -29,7 +29,7 @@ with Std_Names; with Iirs_Utils; use Iirs_Utils; with Evaluation; use Evaluation; with Vhdl.Std_Package; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Errorout; use Errorout; with Xrefs; use Xrefs; @@ -48,7 +48,7 @@ package body Vhdl.Sem_Psl is Btype := Get_Base_Type (Atype); return Btype = Vhdl.Std_Package.Boolean_Type_Definition or else Btype = Vhdl.Std_Package.Bit_Type_Definition - or else Btype = Ieee.Std_Logic_1164.Std_Ulogic_Type; + or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type; end Is_Psl_Bool_Type; -- Return TRUE if EXPR type is a PSL boolean type. diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index f56ba309b..7f2bcd6aa 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -30,7 +30,7 @@ with Name_Table; with Std_Names; with Iirs_Utils; use Iirs_Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Xrefs; use Xrefs; package body Vhdl.Sem_Types is @@ -837,9 +837,9 @@ package body Vhdl.Sem_Types is -- Identifier IEEE.Std_Logic_1164.Std_Ulogic. if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic and then - Get_Parent (Decl) = Ieee.Std_Logic_1164.Std_Logic_1164_Pkg + Get_Parent (Decl) = Vhdl.Ieee.Std_Logic_1164.Std_Logic_1164_Pkg then - Ieee.Std_Logic_1164.Std_Ulogic_Type := Def; + Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type := Def; end if; return Def; diff --git a/src/vhdl/vhdl-sem_utils.adb b/src/vhdl/vhdl-sem_utils.adb index a82628dde..11585bb90 100644 --- a/src/vhdl/vhdl-sem_utils.adb +++ b/src/vhdl/vhdl-sem_utils.adb @@ -21,7 +21,7 @@ with Flags; use Flags; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Iir_Chains; use Iir_Chains; -with Ieee.Std_Logic_1164; +with Vhdl.Ieee.Std_Logic_1164; with Std_Names; with Vhdl.Std_Package; use Vhdl.Std_Package; -- cgit v1.2.3