From f325fa6fc787f23239d8de2a41a6d9c37d23b991 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 6 May 2019 08:05:20 +0200 Subject: vhdl: move iirs_utils to vhdl.utils --- src/ghdldrv/ghdllocal.adb | 2 +- src/ghdldrv/ghdlprint.adb | 2 +- src/ghdldrv/ghdlsimul.adb | 4 +- src/libraries.adb | 6 +- src/synth/synth-context.adb | 4 +- src/synth/synth-stmts.adb | 2 +- src/synth/synth-types.adb | 2 +- src/synth/synthesis.adb | 2 +- src/vhdl/errorout.adb | 2 +- src/vhdl/iirs_utils.adb | 1688 --------------------------- src/vhdl/iirs_utils.ads | 375 ------ src/vhdl/iirs_walk.adb | 2 +- src/vhdl/simulate/simul-annotations.adb | 2 +- src/vhdl/simulate/simul-debugger-ams.adb | 2 +- src/vhdl/simulate/simul-debugger.adb | 2 +- src/vhdl/simulate/simul-elaboration.adb | 2 +- src/vhdl/simulate/simul-execution.adb | 2 +- src/vhdl/simulate/simul-simulation-main.adb | 2 +- src/vhdl/translate/ortho_front.adb | 2 +- src/vhdl/translate/trans-chap1.adb | 2 +- src/vhdl/translate/trans-chap12.adb | 2 +- src/vhdl/translate/trans-chap14.adb | 2 +- src/vhdl/translate/trans-chap2.adb | 2 +- src/vhdl/translate/trans-chap3.adb | 2 +- src/vhdl/translate/trans-chap4.adb | 2 +- src/vhdl/translate/trans-chap5.adb | 2 +- src/vhdl/translate/trans-chap6.adb | 2 +- src/vhdl/translate/trans-chap7.adb | 2 +- src/vhdl/translate/trans-chap8.adb | 2 +- src/vhdl/translate/trans-chap9.adb | 2 +- src/vhdl/translate/trans-rtis.adb | 2 +- src/vhdl/translate/trans_analyzes.adb | 2 +- src/vhdl/translate/translation.adb | 2 +- src/vhdl/vhdl-canon.adb | 2 +- src/vhdl/vhdl-canon_psl.adb | 2 +- src/vhdl/vhdl-configuration.adb | 2 +- src/vhdl/vhdl-disp_vhdl.adb | 8 +- src/vhdl/vhdl-evaluation.adb | 2 +- src/vhdl/vhdl-ieee-vital_timing.adb | 4 +- src/vhdl/vhdl-ieee.adb | 2 +- src/vhdl/vhdl-parse.adb | 2 +- src/vhdl/vhdl-sem.adb | 2 +- src/vhdl/vhdl-sem_assocs.adb | 2 +- src/vhdl/vhdl-sem_decls.adb | 2 +- src/vhdl/vhdl-sem_expr.adb | 4 +- src/vhdl/vhdl-sem_inst.adb | 2 +- src/vhdl/vhdl-sem_lib.adb | 4 +- src/vhdl/vhdl-sem_names.adb | 2 +- src/vhdl/vhdl-sem_psl.adb | 2 +- src/vhdl/vhdl-sem_scopes.adb | 2 +- src/vhdl/vhdl-sem_specs.adb | 2 +- src/vhdl/vhdl-sem_stmts.adb | 2 +- src/vhdl/vhdl-sem_types.adb | 2 +- src/vhdl/vhdl-sem_utils.adb | 2 +- src/vhdl/vhdl-std_package.adb | 18 +- src/vhdl/vhdl-utils.adb | 1688 +++++++++++++++++++++++++++ src/vhdl/vhdl-utils.ads | 375 ++++++ 57 files changed, 2134 insertions(+), 2134 deletions(-) delete mode 100644 src/vhdl/iirs_utils.adb delete mode 100644 src/vhdl/iirs_utils.ads create mode 100644 src/vhdl/vhdl-utils.adb create mode 100644 src/vhdl/vhdl-utils.ads diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 8b261279b..e5fe38401 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -32,7 +32,7 @@ with Errorout; with Vhdl.Configuration; with Files_Map; with Options; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; package body Ghdllocal is -- Version of the IEEE library to use. This just change paths. diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 1795a39f6..73f386f4a 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -26,7 +26,7 @@ with Name_Table; use Name_Table; with Files_Map; with Libraries; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Tokens; with Vhdl.Scanner; with Vhdl.Parse; diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index b465ed8cc..e3c9ced5b 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -30,7 +30,7 @@ with Vhdl.Std_Package; with Libraries; with Vhdl.Canon; with Vhdl.Configuration; -with Iirs_Utils; +with Vhdl.Utils; with Simul.Annotations; with Simul.Elaboration; with Simul.Simulation.Main; @@ -113,7 +113,7 @@ package body Ghdlsimul is Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf); Arch : constant Iir := Get_Named_Entity (Get_Block_Specification (Get_Block_Configuration (Conf_Unit))); - Entity : constant Iir := Iirs_Utils.Get_Entity (Arch); + Entity : constant Iir := Vhdl.Utils.Get_Entity (Arch); begin Vhdl.Configuration.Check_Entity_Declaration_Top (Entity); if Nbr_Errors > 0 then diff --git a/src/libraries.adb b/src/libraries.adb index 716438ca6..0f552e911 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -22,7 +22,7 @@ with Logging; use Logging; with Tables; with Errorout; use Errorout; with Vhdl.Scanner; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Name_Table; use Name_Table; with Str_Table; with Vhdl.Tokens; @@ -722,7 +722,7 @@ package body Libraries is end if; -- Check if the library has already been loaded. - Library := Iirs_Utils.Find_Name_In_Chain (Libraries_Chain, Ident); + Library := Vhdl.Utils.Find_Name_In_Chain (Libraries_Chain, Ident); if Library /= Null_Iir then return Library; end if; @@ -918,7 +918,7 @@ package body Libraries is -- Keep direct reference (for speed-up). if Get_Kind (El) /= Iir_Kind_Design_Unit then - Iirs_Utils.Free_Recursive (El); + Vhdl.Utils.Free_Recursive (El); Set_Element (It, Unit); end if; diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 95eb09baa..a84f56e38 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -23,7 +23,7 @@ with Ada.Unchecked_Deallocation; with Types; use Types; with Grt.Types; use Grt.Types; with Errorout; use Errorout; -with Iirs_Utils; +with Vhdl.Utils; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; @@ -97,7 +97,7 @@ package body Synth.Context is (Kind, Obj, Bounds_To_Range (Val.Bounds.D (1))); end if; if Is_Bit_Type (Get_Element_Subtype (Btype)) - and then Iirs_Utils.Get_Nbr_Dimensions (Btype) = 1 + and then Vhdl.Utils.Get_Nbr_Dimensions (Btype) = 1 then -- A vector of bits. return Alloc_Wire diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 8453b58fa..613bcdbdd 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -26,7 +26,7 @@ with Areapools; with Errorout; use Errorout; with Vhdl.Sem_Expr; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Evaluation; diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb index f1478fb18..19e9677ec 100644 --- a/src/synth/synth-types.adb +++ b/src/synth/synth-types.adb @@ -21,7 +21,7 @@ with Types; use Types; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Simul.Environments; use Simul.Environments; with Simul.Execution; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index a32ce2fd2..770fb52c9 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -24,7 +24,7 @@ with Name_Table; use Name_Table; with Netlists.Builders; use Netlists.Builders; with Netlists.Utils; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Simul.Environments; use Simul.Environments; with Simul.Elaboration; use Simul.Elaboration; diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index cc292b4b2..2dd867246 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -19,7 +19,7 @@ with Logging; use Logging; with Vhdl.Scanner; with Name_Table; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Files_Map; use Files_Map; with Ada.Strings.Unbounded; with Std_Names; diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb deleted file mode 100644 index 960a85c40..000000000 --- a/src/vhdl/iirs_utils.adb +++ /dev/null @@ -1,1688 +0,0 @@ --- Common operations on nodes. --- 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 Vhdl.Scanner; use Vhdl.Scanner; -with Vhdl.Tokens; use Vhdl.Tokens; -with Errorout; use Errorout; -with Name_Table; -with Str_Table; -with Std_Names; use Std_Names; -with Vhdl.Std_Package; -with Flags; use Flags; -with PSL.Nodes; - -package body Iirs_Utils is - -- Transform the current token into an iir literal. - -- The current token must be either a character or an identifier. - function Current_Text return Iir is - Res: Iir; - begin - case Current_Token is - when Tok_Identifier => - Res := Create_Iir (Iir_Kind_Simple_Name); - when Tok_Character => - Res := Create_Iir (Iir_Kind_Character_Literal); - when others => - raise Internal_Error; - end case; - Set_Identifier (Res, Current_Identifier); - Invalidate_Current_Identifier; - Invalidate_Current_Token; - Set_Location (Res, Get_Token_Location); - return Res; - end Current_Text; - - function Is_Error (N : Iir) return Boolean is - begin - return Get_Kind (N) = Iir_Kind_Error; - end Is_Error; - - function Is_Overflow_Literal (N : Iir) return Boolean is - begin - return Get_Kind (N) = Iir_Kind_Overflow_Literal; - end Is_Overflow_Literal; - - function List_To_Flist (L : Iir_List) return Iir_Flist - is - Len : constant Natural := Get_Nbr_Elements (L); - It : List_Iterator; - Temp_L : Iir_List; - Res : Iir_Flist; - begin - Res := Create_Iir_Flist (Len); - It := List_Iterate (L); - for I in 0 .. Len - 1 loop - pragma Assert (Is_Valid (It)); - Set_Nth_Element (Res, I, Get_Element (It)); - Next (It); - end loop; - pragma Assert (not Is_Valid (It)); - - Temp_L := L; - Destroy_Iir_List (Temp_L); - - return Res; - end List_To_Flist; - - function Truncate_Flist (L : Iir_Flist; Len : Natural) return Iir_Flist - is - Res : Iir_Flist; - Temp_L : Iir_Flist; - begin - Res := Create_Iir_Flist (Len); - for I in 0 .. Len - 1 loop - Set_Nth_Element (Res, I, Get_Nth_Element (L, I)); - end loop; - Temp_L := L; - Destroy_Iir_Flist (Temp_L); - return Res; - end Truncate_Flist; - - function Get_Operator_Name (Op : Iir) return Name_Id is - begin - case Get_Kind (Op) is - when Iir_Kind_And_Operator - | Iir_Kind_Reduction_And_Operator => - return Name_And; - when Iir_Kind_Or_Operator - | Iir_Kind_Reduction_Or_Operator => - return Name_Or; - when Iir_Kind_Nand_Operator - | Iir_Kind_Reduction_Nand_Operator => - return Name_Nand; - when Iir_Kind_Nor_Operator - | Iir_Kind_Reduction_Nor_Operator => - return Name_Nor; - when Iir_Kind_Xor_Operator - | Iir_Kind_Reduction_Xor_Operator => - return Name_Xor; - when Iir_Kind_Xnor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - return Name_Xnor; - - when Iir_Kind_Equality_Operator => - return Name_Op_Equality; - when Iir_Kind_Inequality_Operator => - return Name_Op_Inequality; - when Iir_Kind_Less_Than_Operator => - return Name_Op_Less; - when Iir_Kind_Less_Than_Or_Equal_Operator => - return Name_Op_Less_Equal; - when Iir_Kind_Greater_Than_Operator => - return Name_Op_Greater; - when Iir_Kind_Greater_Than_Or_Equal_Operator => - return Name_Op_Greater_Equal; - - when Iir_Kind_Match_Equality_Operator => - return Name_Op_Match_Equality; - when Iir_Kind_Match_Inequality_Operator => - return Name_Op_Match_Inequality; - when Iir_Kind_Match_Less_Than_Operator => - return Name_Op_Match_Less; - when Iir_Kind_Match_Less_Than_Or_Equal_Operator => - return Name_Op_Match_Less_Equal; - when Iir_Kind_Match_Greater_Than_Operator => - return Name_Op_Match_Greater; - when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => - return Name_Op_Match_Greater_Equal; - - when Iir_Kind_Sll_Operator => - return Name_Sll; - when Iir_Kind_Sla_Operator => - return Name_Sla; - when Iir_Kind_Srl_Operator => - return Name_Srl; - when Iir_Kind_Sra_Operator => - return Name_Sra; - when Iir_Kind_Rol_Operator => - return Name_Rol; - when Iir_Kind_Ror_Operator => - return Name_Ror; - when Iir_Kind_Addition_Operator => - return Name_Op_Plus; - when Iir_Kind_Substraction_Operator => - return Name_Op_Minus; - when Iir_Kind_Concatenation_Operator => - return Name_Op_Concatenation; - when Iir_Kind_Multiplication_Operator => - return Name_Op_Mul; - when Iir_Kind_Division_Operator => - return Name_Op_Div; - when Iir_Kind_Modulus_Operator => - return Name_Mod; - when Iir_Kind_Remainder_Operator => - return Name_Rem; - when Iir_Kind_Exponentiation_Operator => - return Name_Op_Exp; - when Iir_Kind_Not_Operator => - return Name_Not; - when Iir_Kind_Negation_Operator => - return Name_Op_Minus; - when Iir_Kind_Identity_Operator => - return Name_Op_Plus; - when Iir_Kind_Absolute_Operator => - return Name_Abs; - when Iir_Kind_Condition_Operator - | Iir_Kind_Implicit_Condition_Operator => - return Name_Op_Condition; - when others => - raise Internal_Error; - end case; - end Get_Operator_Name; - - function Get_Longuest_Static_Prefix (Expr: Iir) return Iir is - Adecl: Iir; - begin - Adecl := Expr; - loop - case Get_Kind (Adecl) is - when Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration => - return Adecl; - when Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration => - return Adecl; - when Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration => - return Adecl; - when Iir_Kind_Object_Alias_Declaration => - -- LRM 4.3.3.1 Object Aliases - -- 2. The name must be a static name [...] - return Adecl; - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - if Get_Name_Staticness (Adecl) >= Globally then - return Adecl; - else - Adecl := Get_Prefix (Adecl); - end if; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Adecl := Get_Named_Entity (Adecl); - when Iir_Kind_Type_Conversion => - return Null_Iir; - when others => - Error_Kind ("get_longuest_static_prefix", Adecl); - end case; - end loop; - end Get_Longuest_Static_Prefix; - - function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) - return Iir - is - Adecl : Iir; - begin - Adecl := Name; - loop - case Get_Kind (Adecl) is - when Iir_Kind_Variable_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Interface_Type_Declaration - | Iir_Kind_Interface_Package_Declaration - | Iir_Kind_Interface_Function_Declaration - | Iir_Kind_Interface_Procedure_Declaration - | Iir_Kind_External_Signal_Name - | Iir_Kind_External_Constant_Name - | Iir_Kind_External_Variable_Name => - return Adecl; - when Iir_Kind_Object_Alias_Declaration => - if With_Alias then - Adecl := Get_Name (Adecl); - else - return Adecl; - end if; - when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Selected_By_All_Name => - Adecl := Get_Base_Name (Adecl); - when Iir_Kinds_Literal - | Iir_Kind_Overflow_Literal - | Iir_Kind_Enumeration_Literal - | Iir_Kinds_Monadic_Operator - | Iir_Kinds_Dyadic_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Parenthesis_Expression - | Iir_Kinds_Attribute - | Iir_Kind_Attribute_Value - | Iir_Kind_Aggregate - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Unit_Declaration - | Iir_Kind_Psl_Expression - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement - | Iir_Kind_Simple_Simultaneous_Statement => - return Adecl; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - Adecl := Get_Named_Entity (Adecl); - when Iir_Kind_Attribute_Name => - return Get_Named_Entity (Adecl); - when Iir_Kind_Error - | Iir_Kind_Unused - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Conditional_Expression - | Iir_Kind_Character_Literal - | Iir_Kind_Operator_Symbol - | Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Context_Reference - | Iir_Kind_Library_Declaration - | Iir_Kinds_Library_Unit - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kinds_Type_Declaration - | Iir_Kinds_Type_And_Subtype_Definition - | Iir_Kind_Wildcard_Type_Definition - | Iir_Kind_Subtype_Definition - | Iir_Kind_Scalar_Nature_Definition - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Signal_Attribute_Declaration - | Iir_Kind_Unaffected_Waveform - | Iir_Kind_Waveform_Element - | Iir_Kind_Conditional_Waveform - | Iir_Kind_Binding_Indication - | Iir_Kind_Component_Configuration - | Iir_Kind_Block_Configuration - | Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kinds_Subprogram_Body - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Generate_Statement_Body - | Iir_Kind_Procedure_Call - | Iir_Kind_Aggregate_Info - | Iir_Kind_Entity_Class - | Iir_Kind_Signature - | Iir_Kind_Reference_Name - | Iir_Kind_Package_Header - | Iir_Kind_Block_Header - | Iir_Kinds_Association_Element - | Iir_Kind_Association_Element_Package - | Iir_Kind_Association_Element_Type - | Iir_Kind_Association_Element_Subprogram - | Iir_Kinds_Choice - | Iir_Kinds_Entity_Aspect - | Iir_Kind_If_Generate_Else_Clause - | Iir_Kind_Elsif - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Array_Element_Resolution - | Iir_Kind_Record_Resolution - | Iir_Kind_Record_Element_Resolution - | Iir_Kind_Element_Declaration - | Iir_Kind_Psl_Endpoint_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Package_Pathname - | Iir_Kind_Absolute_Pathname - | Iir_Kind_Relative_Pathname - | Iir_Kind_Pathname_Element - | Iir_Kind_Range_Expression - | Iir_Kind_Overload_List => - return Adecl; - end case; - end loop; - end Get_Object_Prefix; - - function Is_Object_Name (Name : Iir) return Boolean - is - Obj : constant Iir := Name_To_Object (Name); - begin - return Obj /= Null_Iir; - end Is_Object_Name; - - function Name_To_Object (Name : Iir) return Iir is - begin - -- LRM08 6.4 Objects - -- An object is a named entity that contains (has) a value of a type. - -- An object is obe of the following: - case Get_Kind (Name) is - -- An object declared by an object declaration (see 6.4.2) - when Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Constant_Declaration => - return Name; - - -- A loop of generate parameter. - when Iir_Kind_Iterator_Declaration => - return Name; - - -- A formal parameter of a subprogram - -- A formal port - -- A formal generic constant - -- A local port - -- A local generic constant - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => - return Name; - - -- An implicit signak GUARD defined by the guard expression of a - -- block statement - when Iir_Kind_Guard_Signal_Declaration => - return Name; - - -- In addition, the following are objects [ but are not named - -- entities]: - -- An implicit signal defined by any of the predefined attributes - -- 'DELAYED, 'STABLE, 'QUIET, and 'TRANSACTION - when Iir_Kinds_Signal_Attribute => - return Name; - - -- An element or a slice of another object - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - return Name; - - -- An object designated by a value of an access type - when Iir_Kind_Implicit_Dereference - | Iir_Kind_Dereference => - return Name; - - -- LRM08 6.6 Alias declarations - -- An object alias is an alias whose alias designatore denotes an - -- object. - when Iir_Kind_Object_Alias_Declaration => - return Name; - - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - -- LRM08 8 Names - -- Names can denote declared entities [...] - -- GHDL: in particular, names can denote objects. - return Name_To_Object (Get_Named_Entity (Name)); - - when Iir_Kinds_External_Name => - return Name; - - when others => - return Null_Iir; - end case; - end Name_To_Object; - - function Name_To_Value (Name : Iir) return Iir is - begin - case Get_Kind (Name) is - when Iir_Kind_Attribute_Value - | Iir_Kind_Function_Call - | Iir_Kinds_Expression_Attribute => - return Name; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - return Name_To_Value (Get_Named_Entity (Name)); - when others => - return Name_To_Object (Name); - end case; - end Name_To_Value; - - -- Return TRUE if EXPR is a signal name. - function Is_Signal_Name (Expr : Iir) return Boolean - is - Obj : Iir; - begin - Obj := Name_To_Object (Expr); - if Obj /= Null_Iir then - return Is_Signal_Object (Obj); - else - return False; - end if; - end Is_Signal_Name; - - function Is_Signal_Object (Name : Iir) return Boolean - is - Adecl: Iir; - begin - Adecl := Get_Object_Prefix (Name, True); - case Get_Kind (Adecl) is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kinds_Signal_Attribute => - return True; - when Iir_Kind_Object_Alias_Declaration => - -- Must have been handled by Get_Object_Prefix. - raise Internal_Error; - when others => - return False; - end case; - end Is_Signal_Object; - - function Get_Interface_Of_Formal (Formal : Iir) return Iir - is - El : Iir; - begin - El := Formal; - loop - case Get_Kind (El) is - when Iir_Kind_Simple_Name - | Iir_Kind_Operator_Symbol => - -- Operator is for subprogram interfaces. - return Get_Named_Entity (El); - when Iir_Kinds_Interface_Declaration => - return El; - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - -- FIXME: use get_base_name ? - El := Get_Prefix (El); - when others => - Error_Kind ("get_interface_of_formal", El); - end case; - end loop; - end Get_Interface_Of_Formal; - - function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir - is - Formal : constant Iir := Get_Formal (Assoc); - begin - if Formal /= Null_Iir then - return Get_Interface_Of_Formal (Formal); - else - return Inter; - end if; - end Get_Association_Interface; - - procedure Next_Association_Interface - (Assoc : in out Iir; Inter : in out Iir) - is - Formal : constant Iir := Get_Formal (Assoc); - begin - -- In canon, open association can be inserted after an association by - -- name. So do not assume there is no association by position after - -- association by name. - if Is_Valid (Formal) then - Inter := Get_Chain (Get_Interface_Of_Formal (Formal)); - else - Inter := Get_Chain (Inter); - end if; - Assoc := Get_Chain (Assoc); - end Next_Association_Interface; - - function Get_Association_Formal (Assoc : Iir; Inter : Iir) return Iir - is - Formal : constant Iir := Get_Formal (Assoc); - begin - if Formal /= Null_Iir then - -- Strip denoting name - case Get_Kind (Formal) is - when Iir_Kind_Simple_Name - | Iir_Kind_Operator_Symbol => - return Get_Named_Entity (Formal); - when Iir_Kinds_Interface_Declaration => - -- Shouldn't happen. - raise Internal_Error; - when Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Element => - return Formal; - when others => - Error_Kind ("get_association_formal", Formal); - end case; - else - return Inter; - end if; - end Get_Association_Formal; - - function Find_First_Association_For_Interface - (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir - is - Assoc_El : Iir; - Inter_El : Iir; - begin - Assoc_El := Assoc_Chain; - Inter_El := Inter_Chain; - while Is_Valid (Assoc_El) loop - if Get_Association_Interface (Assoc_El, Inter_El) = Inter then - return Assoc_El; - end if; - Next_Association_Interface (Assoc_El, Inter_El); - end loop; - return Null_Iir; - end Find_First_Association_For_Interface; - - function Is_Parameter (Inter : Iir) return Boolean is - begin - case Get_Kind (Get_Parent (Inter)) is - when Iir_Kinds_Subprogram_Declaration - | Iir_Kinds_Interface_Subprogram_Declaration => - return True; - when others => - -- Port - return False; - end case; - end Is_Parameter; - - function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir - is - El : Iir; - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if Get_Identifier (El) = Lit then - return El; - end if; - end loop; - return Null_Iir; - end Find_Name_In_Flist; - - function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir - is - El: Iir := Chain; - begin - while El /= Null_Iir loop - if Get_Identifier (El) = Lit then - return El; - end if; - El := Get_Chain (El); - end loop; - return Null_Iir; - end Find_Name_In_Chain; - - function Is_In_Chain (Chain : Iir; El : Iir) return Boolean - is - Chain_El : Iir; - begin - Chain_El := Chain; - while Chain_El /= Null_Iir loop - if Chain_El = El then - return True; - end if; - Chain_El := Get_Chain (Chain_El); - end loop; - return False; - end Is_In_Chain; - - procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is - begin - -- Do not add self-dependency - if Unit = Target then - return; - end if; - - pragma Assert (Kind_In (Unit, Iir_Kind_Design_Unit, - Iir_Kind_Entity_Aspect_Entity)); - - Add_Element (Get_Dependence_List (Target), Unit); - end Add_Dependence; - - function Get_Unit_From_Dependence (Dep : Iir) return Iir is - begin - case Get_Kind (Dep) is - when Iir_Kind_Design_Unit => - return Dep; - when Iir_Kind_Entity_Aspect_Entity => - return Get_Design_Unit (Get_Entity (Dep)); - when others => - Error_Kind ("get_unit_from_dependence", Dep); - end case; - end Get_Unit_From_Dependence; - - procedure Clear_Instantiation_Configuration_Vhdl87 - (Parent : Iir; In_Generate : Boolean; Full : Boolean) - is - El : Iir; - Prev : Iir; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - if In_Generate and not Full then - Prev := Get_Component_Configuration (El); - if Prev /= Null_Iir then - case Get_Kind (Prev) is - when Iir_Kind_Configuration_Specification => - -- Keep it. - null; - when Iir_Kind_Component_Configuration => - Set_Component_Configuration (El, Null_Iir); - when others => - Error_Kind - ("clear_instantiation_configuration_vhdl87", - Prev); - end case; - end if; - else - Set_Component_Configuration (El, Null_Iir); - end if; - when Iir_Kind_For_Generate_Statement => - Set_Generate_Block_Configuration (El, Null_Iir); - -- Clear inside a generate statement. - Clear_Instantiation_Configuration_Vhdl87 (El, True, Full); - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (El, Null_Iir); - when others => - null; - end case; - El := Get_Chain (El); - end loop; - end Clear_Instantiation_Configuration_Vhdl87; - - procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean) - is - El : Iir; - begin - if False and then Flags.Vhdl_Std = Vhdl_87 then - Clear_Instantiation_Configuration_Vhdl87 - (Parent, Get_Kind (Parent) = Iir_Kind_For_Generate_Statement, Full); - else - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - Set_Component_Configuration (El, Null_Iir); - when Iir_Kind_For_Generate_Statement => - declare - Bod : constant Iir := Get_Generate_Statement_Body (El); - begin - Set_Generate_Block_Configuration (Bod, Null_Iir); - end; - when Iir_Kind_If_Generate_Statement => - declare - Clause : Iir; - Bod : Iir; - begin - Clause := El; - while Clause /= Null_Iir loop - Bod := Get_Generate_Statement_Body (Clause); - Set_Generate_Block_Configuration (Bod, Null_Iir); - Clause := Get_Generate_Else_Clause (Clause); - end loop; - end; - when Iir_Kind_Block_Statement => - Set_Block_Block_Configuration (El, Null_Iir); - when others => - null; - end case; - El := Get_Chain (El); - end loop; - end if; - end Clear_Instantiation_Configuration; - - -- Get identifier of NODE as a string. - function Image_Identifier (Node : Iir) return String is - begin - return Name_Table.Image (Vhdl.Nodes.Get_Identifier (Node)); - end Image_Identifier; - - function Image_String_Lit (Str : Iir) return String is - begin - return Str_Table.String_String8 - (Get_String8_Id (Str), Get_String_Length (Str)); - end Image_String_Lit; - - function Copy_Enumeration_Literal (Lit : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Enumeration_Literal); - Set_Identifier (Res, Get_Identifier (Lit)); - Location_Copy (Res, Lit); - Set_Parent (Res, Get_Parent (Lit)); - Set_Type (Res, Get_Type (Lit)); - Set_Enum_Pos (Res, Get_Enum_Pos (Lit)); - Set_Expr_Staticness (Res, Locally); - return Res; - end Copy_Enumeration_Literal; - - procedure Create_Range_Constraint_For_Enumeration_Type - (Def : Iir_Enumeration_Type_Definition) - is - Range_Expr : Iir_Range_Expression; - Literal_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); - List_Len : constant Natural := Get_Nbr_Elements (Literal_List); - begin - -- Create a constraint. - Range_Expr := Create_Iir (Iir_Kind_Range_Expression); - Location_Copy (Range_Expr, Def); - Set_Type (Range_Expr, Def); - Set_Direction (Range_Expr, Iir_To); - if List_Len >= 1 then - Set_Left_Limit - (Range_Expr, Get_Nth_Element (Literal_List, 0)); - Set_Right_Limit - (Range_Expr, Get_Nth_Element (Literal_List, List_Len - 1)); - end if; - Set_Expr_Staticness (Range_Expr, Locally); - Set_Range_Constraint (Def, Range_Expr); - end Create_Range_Constraint_For_Enumeration_Type; - - function Is_Static_Construct (Expr : Iir) return Boolean is - begin - case Get_Kind (Expr) is - when Iir_Kind_Aggregate => - return Get_Aggregate_Expand_Flag (Expr); - when Iir_Kinds_Literal => - return True; - when Iir_Kind_Simple_Aggregate - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Character_Literal => - return True; - when Iir_Kind_Overflow_Literal => - -- Needs to generate an error. - return False; - when others => - return False; - end case; - end Is_Static_Construct; - - procedure Free_Name (Node : Iir) - is - N : Iir; - N1 : Iir; - begin - if Node = Null_Iir then - return; - end if; - N := Node; - case Get_Kind (N) is - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal - | Iir_Kind_String_Literal8 - | Iir_Kind_Subtype_Definition => - Free_Iir (N); - when Iir_Kind_Selected_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Selected_By_All_Name => - N1 := Get_Prefix (N); - Free_Iir (N); - Free_Name (N1); - when Iir_Kind_Library_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Design_Unit - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement => - return; - when others => - Error_Kind ("free_name", Node); - --Free_Iir (N); - end case; - end Free_Name; - - procedure Free_Recursive_List (List : Iir_List) - is - It : List_Iterator; - begin - It := List_Iterate (List); - while Is_Valid (It) loop - Free_Recursive (Get_Element (It)); - Next (It); - end loop; - end Free_Recursive_List; - - procedure Free_Recursive_Flist (List : Iir_Flist) - is - El : Iir; - begin - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Free_Recursive (El); - end loop; - end Free_Recursive_Flist; - - procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) - is - N : Iir; - begin - if Node = Null_Iir then - return; - end if; - N := Node; - case Get_Kind (N) is - when Iir_Kind_Library_Declaration => - return; - when Iir_Kind_Simple_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Character_Literal => - null; - when Iir_Kind_Enumeration_Literal => - return; - when Iir_Kind_Selected_Name => - Free_Recursive (Get_Prefix (N)); - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration => - Free_Recursive (Get_Type (N)); - Free_Recursive (Get_Default_Value (N)); - when Iir_Kind_Range_Expression => - Free_Recursive (Get_Left_Limit (N)); - Free_Recursive (Get_Right_Limit (N)); - when Iir_Kind_Subtype_Definition => - Free_Recursive (Get_Base_Type (N)); - when Iir_Kind_Integer_Literal => - null; - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Context_Declaration => - null; - when Iir_Kind_File_Type_Definition - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => - return; - when Iir_Kind_Architecture_Body => - Free_Recursive (Get_Entity_Name (N)); - when Iir_Kind_Overload_List => - Free_Recursive_List (Get_Overload_List (N)); - if not Free_List then - return; - end if; - when Iir_Kind_Array_Subtype_Definition => - Free_Recursive_Flist (Get_Index_List (N)); - Free_Recursive (Get_Base_Type (N)); - when Iir_Kind_Entity_Aspect_Entity => - Free_Recursive (Get_Entity (N)); - Free_Recursive (Get_Architecture (N)); - when others => - Error_Kind ("free_recursive", Node); - end case; - Free_Iir (N); - end Free_Recursive; - - function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) - return String - is - begin - return Iir_Predefined_Functions'Image (Func); - end Get_Predefined_Function_Name; - - function Get_Callees_List_Holder (Subprg : Iir) return Iir is - begin - case Get_Kind (Subprg) is - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Declaration => - return Get_Subprogram_Body (Subprg); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - return Subprg; - when others => - Error_Kind ("get_callees_list_holder", Subprg); - end case; - end Get_Callees_List_Holder; - - procedure Clear_Seen_Flag (Top : Iir) - is - Callees_List : Iir_Callees_List; - It : List_Iterator; - El: Iir; - begin - if Get_Seen_Flag (Top) then - Set_Seen_Flag (Top, False); - Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top)); - if Callees_List /= Null_Iir_List then - It := List_Iterate (Callees_List); - while Is_Valid (It) loop - El := Get_Element (It); - if Get_Seen_Flag (El) = False then - Clear_Seen_Flag (El); - end if; - Next (It); - end loop; - end if; - end if; - end Clear_Seen_Flag; - - function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is - begin - return Get_Type_Declarator (Def) = Null_Iir; - end Is_Anonymous_Type_Definition; - - function Is_Fully_Constrained_Type (Def : Iir) return Boolean is - begin - return Get_Kind (Def) not in Iir_Kinds_Composite_Type_Definition - or else Get_Constraint_State (Def) = Fully_Constrained; - end Is_Fully_Constrained_Type; - - function Strip_Denoting_Name (Name : Iir) return Iir is - begin - if Get_Kind (Name) in Iir_Kinds_Denoting_Name then - return Get_Named_Entity (Name); - else - return Name; - end if; - end Strip_Denoting_Name; - - function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Simple_Name); - Set_Location (Res, Loc); - Set_Identifier (Res, Get_Identifier (Ref)); - Set_Named_Entity (Res, Ref); - Set_Base_Name (Res, Res); - -- FIXME: set type and expr staticness ? - return Res; - end Build_Simple_Name; - - function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir is - begin - return Build_Simple_Name (Ref, Get_Location (Loc)); - end Build_Simple_Name; - - function Build_Reference_Name (Name : Iir) return Iir - is - Res : Iir; - begin - pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name); - - Res := Create_Iir (Iir_Kind_Reference_Name); - Location_Copy (Res, Name); - Set_Referenced_Name (Res, Name); - Set_Is_Forward_Ref (Res, True); - Set_Named_Entity (Res, Get_Named_Entity (Name)); - return Res; - end Build_Reference_Name; - - function Strip_Reference_Name (N : Iir) return Iir is - begin - if Get_Kind (N) = Iir_Kind_Reference_Name then - return Get_Named_Entity (N); - else - return N; - end if; - end Strip_Reference_Name; - - function Has_Resolution_Function (Subtyp : Iir) return Iir - is - Ind : constant Iir := Get_Resolution_Indication (Subtyp); - begin - if Ind /= Null_Iir - and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name - then - -- A resolution indication can be an array/record element resolution. - return Get_Named_Entity (Ind); - else - return Null_Iir; - end if; - end Has_Resolution_Function; - - function Is_Type_Name (Name : Iir) return Iir - is - Ent : Iir; - begin - if Get_Kind (Name) in Iir_Kinds_Denoting_Name then - Ent := Get_Named_Entity (Name); - case Get_Kind (Ent) is - when Iir_Kind_Type_Declaration => - return Get_Type_Definition (Ent); - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Base_Attribute => - return Get_Type (Ent); - when others => - return Null_Iir; - end case; - else - return Null_Iir; - end if; - end Is_Type_Name; - - function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is - begin - case Get_Kind (Ind) is - when Iir_Kinds_Denoting_Name => - return Get_Type (Ind); - when Iir_Kinds_Subtype_Definition => - return Ind; - when Iir_Kind_Subtype_Attribute => - return Get_Type (Ind); - when Iir_Kind_Error => - return Ind; - when others => - Error_Kind ("get_type_of_subtype_indication", Ind); - end case; - end Get_Type_Of_Subtype_Indication; - - function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir - is - Index : constant Iir := Get_Nth_Element (Indexes, Idx); - begin - if Index = Null_Iir then - return Null_Iir; - else - return Get_Index_Type (Index); - end if; - end Get_Index_Type; - - function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir is - begin - return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx); - end Get_Index_Type; - - function Get_Nbr_Dimensions (Array_Type : Iir) return Natural is - begin - return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Type)); - end Get_Nbr_Dimensions; - - function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean - is - Indexes : constant Iir_Flist := Get_Index_Subtype_List (Array_Type); - Index : Iir; - begin - for I in Flist_First .. Flist_Last (Indexes) loop - Index := Get_Index_Type (Indexes, I); - if Get_Type_Staticness (Index) /= Locally then - return False; - end if; - end loop; - return True; - end Are_Array_Indexes_Locally_Static; - - function Are_Bounds_Locally_Static (Def : Iir) return Boolean is - begin - if Get_Type_Staticness (Def) = Locally then - return True; - end if; - - case Iir_Kinds_Type_And_Subtype_Definition (Get_Kind (Def)) is - when Iir_Kind_Array_Subtype_Definition => - pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); - - -- Indexes. - if not Are_Array_Indexes_Locally_Static (Def) then - return False; - end if; - - -- Element. - return Are_Bounds_Locally_Static (Get_Element_Subtype (Def)); - when Iir_Kind_Array_Type_Definition => - return False; - when Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Record_Type_Definition => - pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); - - declare - El_List : constant Iir_Flist := - Get_Elements_Declaration_List (Def); - El : Iir; - begin - for I in Flist_First .. Flist_Last (El_List) loop - El := Get_Nth_Element (El_List, I); - if not Are_Bounds_Locally_Static (Get_Type (El)) then - return False; - end if; - end loop; - return True; - end; - when Iir_Kinds_Scalar_Type_And_Subtype_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition => - return True; - when Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Interface_Type_Definition => - Error_Kind ("are_bounds_locally_static", Def); - end case; - end Are_Bounds_Locally_Static; - - function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir - is - Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp); - begin - if Type_Mark_Name = Null_Iir then - -- No type_mark (for array subtype created by constrained array - -- definition. - return Null_Iir; - else - return Get_Type (Get_Named_Entity (Type_Mark_Name)); - end if; - end Get_Denoted_Type_Mark; - - function Get_Base_Element_Declaration (El : Iir) return Iir - is - Rec_Type : constant Iir := Get_Base_Type (Get_Parent (El)); - Els_List : constant Iir_Flist := - Get_Elements_Declaration_List (Rec_Type); - begin - return Get_Nth_Element - (Els_List, Natural (Get_Element_Position (El))); - end Get_Base_Element_Declaration; - - procedure Append_Owned_Element_Constraint (Rec_Type : Iir; El : Iir) is - begin - pragma Assert (Get_Parent (El) = Rec_Type); - Set_Chain (El, Get_Owned_Elements_Chain (Rec_Type)); - Set_Owned_Elements_Chain (Rec_Type, El); - end Append_Owned_Element_Constraint; - - - function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean - is - Bod : constant Iir := Get_Chain (Spec); - begin - -- FIXME: don't directly use Subprogram_Body as it is not yet correctly - -- set during instantiation. - return Get_Has_Body (Spec) - and then Get_Subprogram_Specification (Bod) /= Spec; - end Is_Second_Subprogram_Specification; - - function Is_Implicit_Subprogram (Spec : Iir) return Boolean is - begin - return Get_Kind (Spec) in Iir_Kinds_Subprogram_Declaration - and then Get_Implicit_Definition (Spec) in Iir_Predefined_Implicit; - end Is_Implicit_Subprogram; - - function Is_Function_Declaration (N : Iir) return Boolean is - begin - return Kind_In (N, Iir_Kind_Function_Declaration, - Iir_Kind_Interface_Function_Declaration); - end Is_Function_Declaration; - - function Is_Procedure_Declaration (N : Iir) return Boolean is - begin - return Kind_In (N, Iir_Kind_Procedure_Declaration, - Iir_Kind_Interface_Procedure_Declaration); - end Is_Procedure_Declaration; - - function Is_Same_Profile (L, R: Iir) return Boolean - is - L1, R1 : Iir; - L_Kind, R_Kind : Iir_Kind; - El_L, El_R : Iir; - begin - L_Kind := Get_Kind (L); - if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then - L1 := Get_Named_Entity (Get_Name (L)); - L_Kind := Get_Kind (L1); - else - L1 := L; - end if; - R_Kind := Get_Kind (R); - if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then - R1 := Get_Named_Entity (Get_Name (R)); - R_Kind := Get_Kind (R1); - else - R1 := R; - end if; - - -- Check L and R are both of the same 'kind'. - -- Also the return profile for functions. - if L_Kind = Iir_Kind_Function_Declaration - and then R_Kind = Iir_Kind_Function_Declaration - then - if Get_Base_Type (Get_Return_Type (L1)) /= - Get_Base_Type (Get_Return_Type (R1)) - then - return False; - end if; - elsif L_Kind = Iir_Kind_Procedure_Declaration - and then R_Kind = Iir_Kind_Procedure_Declaration - then - null; - elsif L_Kind = Iir_Kind_Enumeration_Literal - and then R_Kind = Iir_Kind_Enumeration_Literal - then - return Get_Type (L1) = Get_Type (R1); - elsif L_Kind = Iir_Kind_Enumeration_Literal - and then R_Kind = Iir_Kind_Function_Declaration - then - return Get_Interface_Declaration_Chain (R1) = Null_Iir - and then Get_Base_Type (Get_Return_Type (R1)) = Get_Type (L1); - elsif L_Kind = Iir_Kind_Function_Declaration - and then R_Kind = Iir_Kind_Enumeration_Literal - then - return Get_Interface_Declaration_Chain (L1) = Null_Iir - and then Get_Base_Type (Get_Return_Type (L1)) = Get_Type (R1); - else - -- Kind mismatch. - return False; - end if; - - -- Check parameters profile. - El_L := Get_Interface_Declaration_Chain (L1); - El_R := Get_Interface_Declaration_Chain (R1); - loop - exit when El_L = Null_Iir and El_R = Null_Iir; - if El_L = Null_Iir or El_R = Null_Iir then - return False; - end if; - if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R)) - then - return False; - end if; - El_L := Get_Chain (El_L); - El_R := Get_Chain (El_R); - end loop; - - return True; - end Is_Same_Profile; - - function Is_Operation_For_Type (Subprg : Iir; Atype : Iir) return Boolean - is - pragma Assert (Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration); - Base_Type : constant Iir := Get_Base_Type (Atype); - Inter : Iir; - begin - Inter := Get_Interface_Declaration_Chain (Subprg); - while Inter /= Null_Iir loop - if Get_Base_Type (Get_Type (Inter)) = Base_Type then - return True; - end if; - Inter := Get_Chain (Inter); - end loop; - if Get_Kind (Subprg) = Iir_Kind_Function_Declaration - and then Get_Base_Type (Get_Return_Type (Subprg)) = Base_Type - then - return True; - end if; - return False; - end Is_Operation_For_Type; - - -- From a block_specification, returns the block. - function Get_Block_From_Block_Specification (Block_Spec : Iir) - return Iir - is - Res : Iir; - begin - case Get_Kind (Block_Spec) is - when Iir_Kind_Design_Unit => - Res := Get_Library_Unit (Block_Spec); - if Get_Kind (Res) /= Iir_Kind_Architecture_Body then - raise Internal_Error; - end if; - return Res; - when Iir_Kind_Block_Statement - | Iir_Kind_Architecture_Body - | Iir_Kind_For_Generate_Statement - | Iir_Kind_If_Generate_Statement => - return Block_Spec; - when Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Slice_Name => - return Get_Named_Entity (Get_Prefix (Block_Spec)); - when Iir_Kind_Simple_Name => - return Get_Named_Entity (Block_Spec); - when Iir_Kind_Parenthesis_Name => - -- An alternative label. - return Get_Named_Entity (Block_Spec); - when others => - Error_Kind ("get_block_from_block_specification", Block_Spec); - return Null_Iir; - end case; - end Get_Block_From_Block_Specification; - - function Get_Entity (Decl : Iir) return Iir - is - Name : constant Iir := Get_Entity_Name (Decl); - Res : constant Iir := Get_Named_Entity (Name); - begin - if Res = Vhdl.Std_Package.Error_Mark then - return Null_Iir; - end if; - - pragma Assert (Res = Null_Iir - or else Get_Kind (Res) = Iir_Kind_Entity_Declaration); - return Res; - end Get_Entity; - - function Get_Configuration (Aspect : Iir) return Iir - is - Name : constant Iir := Get_Configuration_Name (Aspect); - Res : constant Iir := Get_Named_Entity (Name); - begin - pragma Assert (Get_Kind (Res) = Iir_Kind_Configuration_Declaration); - return Res; - end Get_Configuration; - - function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id - is - Name : constant Iir := Get_Entity_Name (Arch); - begin - case Get_Kind (Name) is - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => - return Get_Identifier (Name); - when others => - Error_Kind ("get_entity_identifier_of_architecture", Name); - end case; - end Get_Entity_Identifier_Of_Architecture; - - function Is_Component_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean is - begin - case Get_Kind (Get_Instantiated_Unit (Inst)) is - when Iir_Kinds_Denoting_Name => - return True; - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration => - return False; - when others => - Error_Kind ("is_component_instantiation", Inst); - end case; - end Is_Component_Instantiation; - - function Is_Entity_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean is - begin - case Get_Kind (Get_Instantiated_Unit (Inst)) is - when Iir_Kinds_Denoting_Name => - return False; - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Entity_Aspect_Configuration => - return True; - when others => - Error_Kind ("is_entity_instantiation", Inst); - end case; - end Is_Entity_Instantiation; - - function Get_Attribute_Name_Expression (Name : Iir) return Iir - is - Attr_Val : constant Iir := Get_Named_Entity (Name); - Attr_Spec : constant Iir := Get_Attribute_Specification (Attr_Val); - Attr_Expr : constant Iir := Get_Expression (Attr_Spec); - begin - return Attr_Expr; - end Get_Attribute_Name_Expression; - - function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is - begin - if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then - Error_Kind ("get_string_type_bound_type", Sub_Type); - end if; - return Get_Nth_Element (Get_Index_Subtype_List (Sub_Type), 0); - end Get_String_Type_Bound_Type; - - procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; - Low, High : out Iir) - is - begin - case Get_Direction (Arange) is - when Iir_To => - Low := Get_Left_Limit (Arange); - High := Get_Right_Limit (Arange); - when Iir_Downto => - High := Get_Left_Limit (Arange); - Low := Get_Right_Limit (Arange); - end case; - end Get_Low_High_Limit; - - function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is - begin - case Get_Direction (Arange) is - when Iir_To => - return Get_Left_Limit (Arange); - when Iir_Downto => - return Get_Right_Limit (Arange); - end case; - end Get_Low_Limit; - - function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is - begin - case Get_Direction (Arange) is - when Iir_To => - return Get_Right_Limit (Arange); - when Iir_Downto => - return Get_Left_Limit (Arange); - end case; - end Get_High_Limit; - - function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean - is - Base_Type : constant Iir := Get_Base_Type (A_Type); - begin - if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition - and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1 - then - return True; - else - return False; - end if; - end Is_One_Dimensional_Array_Type; - - function Is_Range_Attribute_Name (Expr : Iir) return Boolean - is - Attr : Iir; - Id : Name_Id; - begin - if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then - Attr := Get_Prefix (Expr); - else - Attr := Expr; - end if; - if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then - return False; - end if; - Id := Get_Identifier (Attr); - return Id = Name_Range or Id = Name_Reverse_Range; - end Is_Range_Attribute_Name; - - function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) - return Iir_Array_Subtype_Definition - is - Base_Type : constant Iir := Get_Base_Type (Arr_Type); - El_Type : constant Iir := Get_Element_Subtype (Base_Type); - Res : Iir_Array_Subtype_Definition; - List : Iir_Flist; - begin - Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); - Set_Location (Res, Loc); - Set_Base_Type (Res, Base_Type); - Set_Element_Subtype (Res, El_Type); - if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then - Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type)); - end if; - Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); - Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); - Set_Type_Staticness (Res, Get_Type_Staticness (El_Type)); - List := Create_Iir_Flist (Get_Nbr_Dimensions (Base_Type)); - Set_Index_Subtype_List (Res, List); - Set_Index_Constraint_List (Res, List); - return Res; - end Create_Array_Subtype; - - function Is_Subprogram_Method (Spec : Iir) return Boolean is - begin - case Get_Kind (Get_Parent (Spec)) is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Protected_Type_Body => - return True; - when others => - return False; - end case; - end Is_Subprogram_Method; - - function Get_Method_Type (Spec : Iir) return Iir - is - Parent : Iir; - begin - Parent := Get_Parent (Spec); - case Get_Kind (Parent) is - when Iir_Kind_Protected_Type_Declaration => - return Parent; - when Iir_Kind_Protected_Type_Body => - return Get_Protected_Type_Declaration (Parent); - when others => - return Null_Iir; - end case; - end Get_Method_Type; - - function Get_Actual_Or_Default (Assoc : Iir; Inter : Iir) return Iir is - begin - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - return Get_Actual (Assoc); - when Iir_Kind_Association_Element_Open => - return Get_Default_Value (Inter); - when others => - Error_Kind ("get_actual_or_default", Assoc); - end case; - end Get_Actual_Or_Default; - - function Create_Error (Orig : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Error); - if Orig /= Null_Iir then - Set_Error_Origin (Res, Orig); - Location_Copy (Res, Orig); - end if; - return Res; - end Create_Error; - - function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Error (Orig); - Set_Expr_Staticness (Res, None); - Set_Type (Res, Atype); - return Res; - end Create_Error_Expr; - - function Create_Error_Type (Orig : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Error (Orig); - --Set_Expr_Staticness (Res, Locally); - Set_Base_Type (Res, Res); - Set_Type_Declarator (Res, Null_Iir); - Set_Resolved_Flag (Res, True); - Set_Signal_Type_Flag (Res, True); - return Res; - end Create_Error_Type; - - function Create_Error_Name (Orig : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Error); - Set_Expr_Staticness (Res, None); - Set_Error_Origin (Res, Orig); - Location_Copy (Res, Orig); - return Res; - end Create_Error_Name; - - -- Extract the entity from ASPECT. - -- Note: if ASPECT is a component declaration, returns ASPECT. - function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir - is - Inst : Iir; - begin - case Get_Kind (Aspect) is - when Iir_Kinds_Denoting_Name => - -- A component declaration. - Inst := Get_Named_Entity (Aspect); - pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Declaration); - return Inst; - when Iir_Kind_Component_Declaration => - return Aspect; - when Iir_Kind_Entity_Aspect_Entity => - return Get_Entity (Aspect); - when Iir_Kind_Entity_Aspect_Configuration => - Inst := Get_Configuration (Aspect); - return Get_Entity (Inst); - when Iir_Kind_Entity_Aspect_Open => - return Null_Iir; - when others => - Error_Kind ("get_entity_from_entity_aspect", Aspect); - end case; - end Get_Entity_From_Entity_Aspect; - - function Is_Nested_Package (Pkg : Iir) return Boolean is - begin - return Get_Kind (Get_Parent (Pkg)) /= Iir_Kind_Design_Unit; - end Is_Nested_Package; - - -- LRM08 4.7 Package declarations - -- If the package header is empty, the package declared by a package - -- declaration is called a simple package. - function Is_Simple_Package (Pkg : Iir) return Boolean is - begin - return Get_Package_Header (Pkg) = Null_Iir; - end Is_Simple_Package; - - -- LRM08 4.7 Package declarations - -- If the package header contains a generic clause and no generic map - -- aspect, the package is called an uninstantiated package. - function Is_Uninstantiated_Package (Pkg : Iir) return Boolean - is - Header : constant Iir := Get_Package_Header (Pkg); - begin - return Header /= Null_Iir - and then Get_Generic_Map_Aspect_Chain (Header) = Null_Iir; - end Is_Uninstantiated_Package; - - -- LRM08 4.7 Package declarations - -- If the package header contains both a generic clause and a generic - -- map aspect, the package is declared a generic-mapped package. - function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean - is - Header : constant Iir := Get_Package_Header (Pkg); - begin - return Header /= Null_Iir - and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir; - end Is_Generic_Mapped_Package; - - function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean - is - K : constant Iir_Kind := Get_Kind (N); - begin - return K = K1 or K = K2; - end Kind_In; - - function Get_HDL_Node (N : PSL_Node) return Iir is - begin - return Iir (PSL.Nodes.Get_HDL_Node (N)); - end Get_HDL_Node; - - procedure Set_HDL_Node (N : PSL_Node; Expr : Iir) is - begin - PSL.Nodes.Set_HDL_Node (N, PSL.Nodes.HDL_Node (Expr)); - end Set_HDL_Node; -end Iirs_Utils; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads deleted file mode 100644 index acee1bc64..000000000 --- a/src/vhdl/iirs_utils.ads +++ /dev/null @@ -1,375 +0,0 @@ --- Common operations on nodes. --- 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 Vhdl.Nodes; use Vhdl.Nodes; - -package Iirs_Utils is - -- Transform the current token into an iir literal. - -- The current token must be either a character, a string or an identifier. - function Current_Text return Iir; - - -- Get identifier of NODE as a string. - function Image_Identifier (Node : Iir) return String; - function Image_String_Lit (Str : Iir) return String; - - -- Return True iff N is an error node. - function Is_Error (N : Iir) return Boolean; - pragma Inline (Is_Error); - - -- Return True iff N is an overflow_literal node. - function Is_Overflow_Literal (N : Iir) return Boolean; - pragma Inline (Is_Overflow_Literal); - - -- Find LIT in the list of identifiers or characters LIST. - -- Return the literal (whose name is LIT) or null_iir if not found. - function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir; - function Find_Name_In_Flist (List : Iir_Flist; Lit: Name_Id) return Iir; - - -- Return TRUE if EL in an element of chain CHAIN. - function Is_In_Chain (Chain : Iir; El : Iir) return Boolean; - - -- Convert a list L to an Flist, and free L. - function List_To_Flist (L : Iir_List) return Iir_Flist; - - -- Return a copy of the LEN first elements of L. L is destroyed. - function Truncate_Flist (L : Iir_Flist; Len : Natural) return Iir_Flist; - - -- Convert an operator node to a name. - function Get_Operator_Name (Op : Iir) return Name_Id; - - -- Get the longuest static prefix of EXPR. - -- See LRM §8.1 - function Get_Longuest_Static_Prefix (Expr: Iir) return Iir; - - -- Get the prefix of NAME, ie the declaration at the base of NAME. - -- Return NAME itself if NAME is not an object or a subelement of - -- an object. If WITH_ALIAS is true, continue with the alias name when an - -- alias is found, else return the alias. - -- FIXME: clarify when NAME is returned. - function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) - return Iir; - - - -- Return TRUE if NAME is a name that designate an object (ie a constant, - -- a variable, a signal or a file). - function Is_Object_Name (Name : Iir) return Boolean; - - -- Return an object node if NAME designates an object (ie either is an - -- object or a name for an object). - -- Otherwise, returns NULL_IIR. - -- For the definition of an object, see LRM08 6.4 Objects. - function Name_To_Object (Name : Iir) return Iir; - - -- Return the value designated by NAME. This is often an object, but can - -- also be an expression like a function call or an attribute. - function Name_To_Value (Name : Iir) return Iir; - - -- Return TRUE if EXPR is a signal name. - function Is_Signal_Name (Expr : Iir) return Boolean; - - -- Get the interface corresponding to the formal name FORMAL. This is - -- always an interface, even if the formal is a name. - function Get_Interface_Of_Formal (Formal : Iir) return Iir; - - -- Get the corresponding interface of an association while walking on - -- associations. ASSOC and INTER are the current association and - -- interface (initialized to the association chain and interface chain). - -- The function Get_Association_Interface return the interface associated - -- to ASSOC,and Next_Association_Interface updates ASSOC and INTER. - function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir; - procedure Next_Association_Interface - (Assoc : in out Iir; Inter : in out Iir); - - -- Return the formal of ASSOC as a named entity (either an interface - -- declaration or indexed/sliced/selected name of it). If there is no - -- formal in ASSOC, return the corresponding interface INTER. - function Get_Association_Formal (Assoc : Iir; Inter : Iir) return Iir; - - -- Return the first association in ASSOC_CHAIN for interface INTER. This - -- is the first in case of individual association. - -- Return NULL_IIR if not found (not present). - function Find_First_Association_For_Interface - (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir; - - -- Return True iff interface INTER is a (subprogram) parameter. - function Is_Parameter (Inter : Iir) return Boolean; - - -- Duplicate enumeration literal LIT. - function Copy_Enumeration_Literal (Lit : Iir) return Iir; - - -- True if EXPR can be built statically. This is the case of literals - -- (except overflow), and the case of some aggregates. - -- This is different from locally static expression, particularly for - -- agregate: the analyzer may choose to dynamically create a locally - -- static aggregate if it is sparse. - function Is_Static_Construct (Expr : Iir) return Boolean; - - -- Make TARGETS depends on UNIT. - -- UNIT must be either a design unit or a entity_aspect_entity. - procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); - - -- Get the design_unit from dependency DEP. DEP must be an element of - -- a dependencies list. - function Get_Unit_From_Dependence (Dep : Iir) return Iir; - - -- Clear configuration field of all component instantiation of - -- the concurrent statements of PARENT. - procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean); - - -- Free Node and its prefixes, if any. - procedure Free_Name (Node : Iir); - - -- Free NODE and its sub-nodes. - procedure Free_Recursive (Node : Iir; Free_List : Boolean := False); - - -- Free nodes in LIST. - procedure Free_Recursive_List (List : Iir_List); - - -- Name of FUNC. - function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) - return String; - - -- Create the range_constraint node for an enumeration type. - procedure Create_Range_Constraint_For_Enumeration_Type - (Def : Iir_Enumeration_Type_Definition); - - -- Return the node containing the Callees_List (ie the subprogram body if - -- SUBPRG is a subprogram spec, SUBPRG if SUBPRG is a process). - function Get_Callees_List_Holder (Subprg : Iir) return Iir; - - -- Clear flag of TOP and all of its callees. - procedure Clear_Seen_Flag (Top : Iir); - - -- Return TRUE iff DEF is an anonymous type (or subtype) definition. - -- Note: DEF is required to be a type (or subtype) definition. - -- Note: type (and not subtype) are never anonymous. - function Is_Anonymous_Type_Definition (Def : Iir) return Boolean; - pragma Inline (Is_Anonymous_Type_Definition); - - -- Return TRUE iff DEF is a fully constrained type (or subtype) definition. - function Is_Fully_Constrained_Type (Def : Iir) return Boolean; - - -- Return the type definition/subtype indication of NAME if NAME denotes - -- a type or subtype name. Otherwise, return Null_Iir; - function Is_Type_Name (Name : Iir) return Iir; - - -- Return TRUE iff SPEC is the subprogram specification of a subprogram - -- body which was previously declared. In that case, the only use of SPEC - -- is to match the body with its declaration. - function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean; - - -- Return True iif SPEC is the specification of an implicit subprogram. - -- False for explicit subprograms. - function Is_Implicit_Subprogram (Spec : Iir) return Boolean; - pragma Inline (Is_Implicit_Subprogram); - - -- Return True if N is a function_declaration or an - -- interface_function_declaration. - function Is_Function_Declaration (N : Iir) return Boolean; - pragma Inline (Is_Function_Declaration); - - -- Return True if N is a procedure_declaration or an - -- interface_procedure_declaration. - function Is_Procedure_Declaration (N : Iir) return Boolean; - pragma Inline (Is_Procedure_Declaration); - - -- If NAME is a simple or an expanded name, return the denoted declaration. - -- Otherwise, return NAME. - function Strip_Denoting_Name (Name : Iir) return Iir; - - -- Build a simple name node whose named entity is REF and location LOC. - function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir; - function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir; - - -- Create a name that referenced the same named entity as NAME. - -- - -- This is mainly used by canon, when there is a need to reference an - -- existing name. In some cases, it is not possible to use the name, - -- because it is already owned. - function Build_Reference_Name (Name : Iir) return Iir; - - -- If N is a reference_name, return the corresponding node, otherwise - -- return N. - function Strip_Reference_Name (N : Iir) return Iir; - - -- If SUBTYP has a resolution indication that is a function name, returns - -- the function declaration (not the name). - function Has_Resolution_Function (Subtyp : Iir) return Iir; - - -- Get the type of any node representing a subtype indication. This simply - -- skip over denoting names. - function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir; - - -- Get the type of an index_subtype_definition or of a discrete_range from - -- an index_constraint. - function Get_Index_Type (Index_Type : Iir) return Iir - renames Get_Type_Of_Subtype_Indication; - - -- Return the IDX-th index type for index subtype definition list or - -- index_constraint INDEXES. Return Null_Iir if IDX is out of dimension - -- bounds, so that this function can be used to iterator over indexes of - -- a type (or subtype). Note that IDX starts at 0. - function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir; - - -- Likewise but for array type or subtype ARRAY_TYPE. - function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir; - - -- Number of dimensions (1..n) for ARRAY_TYPE. - function Get_Nbr_Dimensions (Array_Type : Iir) return Natural; - - -- Return True iff the all indexes of ARRAY_TYPE are locally static. - function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean; - - -- Return true if array/record bounds are locally static. Only fully - -- constrained records or arrays are allowed. - -- It is possible to have non-locally static types with locally bounds (eg: - -- a constrained array of type). - function Are_Bounds_Locally_Static (Def : Iir) return Boolean; - - -- Return the type or subtype definition of the SUBTYP type mark. - function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir; - - -- From element declaration or element constraint EL, get the corresponding - -- element declaration in the base record type. - function Get_Base_Element_Declaration (El : Iir) return Iir; - - -- Append EL to the chain of owned elements of REC_TYPE. Used only when - -- a record_element_constraint is built. - procedure Append_Owned_Element_Constraint (Rec_Type : Iir; El : Iir); - - -- Return true iff L and R have the same profile. - -- L and R must be subprograms specification (or spec_body). - function Is_Same_Profile (L, R: Iir) return Boolean; - - -- Return true iff FUNC is an operation for ATYPE. - -- - -- LRM08 5.1 Types - -- The set of operations of a type includes the explicitely declared - -- subprograms that have a parameter or result of the type. The remaining - -- operations of a type are the base operations and the predefined - -- operations. - function Is_Operation_For_Type (Subprg : Iir; Atype : Iir) return Boolean; - - -- From a block_specification, returns the block. - -- Roughly speaking, this get prefix of indexed and sliced name. - function Get_Block_From_Block_Specification (Block_Spec : Iir) - return Iir; - - -- Wrapper around Get_Entity_Name: return the entity declaration of the - -- entity name of DECL, or Null_Iir in case of error. - function Get_Entity (Decl : Iir) return Iir; - - -- Wrapper around get_Configuration_Name: return the configuration - -- declaration of ASPECT. - function Get_Configuration (Aspect : Iir) return Iir; - - -- Return the identifier of the entity for architecture ARCH. - function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id; - - -- Return True is component instantiation statement INST instantiate a - -- component. - function Is_Component_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean; - - -- Return True is component instantiation statement INST instantiate a - -- design entity. - function Is_Entity_Instantiation - (Inst : Iir_Component_Instantiation_Statement) - return Boolean; - - -- Get the expression of the attribute specification corresponding to the - -- attribute name NAME. Meaningful only for static values. - function Get_Attribute_Name_Expression (Name : Iir) return Iir; - - -- Return the bound type of a string type, ie the type of the (first) - -- dimension of a one-dimensional array type. - function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir; - - -- Return left or right limit according to the direction. - procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; - Low, High : out Iir); - function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir; - function Get_High_Limit (Arange : Iir_Range_Expression) return Iir; - - -- Return TRUE iff type/subtype definition A_TYPE is an undim array. - function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean; - - -- Return TRUE iff unanalyzed EXPR is a range attribute. - function Is_Range_Attribute_Name (Expr : Iir) return Boolean; - - -- Create an array subtype from array_type or array_subtype ARR_TYPE. - -- All fields of the returned node are filled, except the index_list. - -- The type_staticness is set with the type staticness of the element - -- subtype and therefore must be updated. - -- The type_declarator field is set to null_iir. - function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) - return Iir_Array_Subtype_Definition; - - -- Return TRUE iff SPEC is declared inside a protected type or a protected - -- body. - function Is_Subprogram_Method (Spec : Iir) return Boolean; - - -- Return the protected type for method SPEC. - function Get_Method_Type (Spec : Iir) return Iir; - - -- For Association_Element_By_Expression: return the actual. - -- For Association_Element_Open: return the default value of the - -- interface INTER. - function Get_Actual_Or_Default (Assoc : Iir; Inter : Iir) return Iir; - - -- Create an error node for node ORIG. - function Create_Error (Orig : Iir) return Iir; - - -- Create an error node for node ORIG, and set its type to ATYPE. - -- Set its staticness to locally. - function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir; - - -- Create an error node for node ORIG, which is supposed to be a type. - function Create_Error_Type (Orig : Iir) return Iir; - - -- Create an error node for a name. - function Create_Error_Name (Orig : Iir) return Iir; - - -- Extract the entity from ASPECT. - -- Note: if ASPECT is a component declaration, returns ASPECT. - -- if ASPECT is open, return Null_Iir; - function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir; - - -- Definition from LRM08 4.8 Package bodies - -- True if PKG (a package declaration or a package body) is not a library - -- unit. Can be true only for vhdl08. - function Is_Nested_Package (Pkg : Iir) return Boolean; - - -- Definitions from LRM08 4.7 Package declarations. - -- PKG must denote a package declaration. - function Is_Simple_Package (Pkg : Iir) return Boolean; - function Is_Uninstantiated_Package (Pkg : Iir) return Boolean; - function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean; - - -- Return TRUE if the base name of NAME is a signal object. - function Is_Signal_Object (Name: Iir) return Boolean; - - -- Return True IFF kind of N is K1 or K2. - function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean; - pragma Inline (Kind_In); - - -- IIR wrapper around Get_HDL_Node/Set_HDL_Node. - function Get_HDL_Node (N : PSL_Node) return Iir; - procedure Set_HDL_Node (N : PSL_Node; Expr : Iir); -end Iirs_Utils; diff --git a/src/vhdl/iirs_walk.adb b/src/vhdl/iirs_walk.adb index 3bc4ecf07..c367af9e6 100644 --- a/src/vhdl/iirs_walk.adb +++ b/src/vhdl/iirs_walk.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; package body Iirs_Walk is diff --git a/src/vhdl/simulate/simul-annotations.adb b/src/vhdl/simulate/simul-annotations.adb index 22ca12a07..6fe7852f6 100644 --- a/src/vhdl/simulate/simul-annotations.adb +++ b/src/vhdl/simulate/simul-annotations.adb @@ -20,7 +20,7 @@ with Tables; with Ada.Text_IO; with Vhdl.Std_Package; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Types; use Types; package body Simul.Annotations is diff --git a/src/vhdl/simulate/simul-debugger-ams.adb b/src/vhdl/simulate/simul-debugger-ams.adb index ab4cfa36b..adbb1df69 100644 --- a/src/vhdl/simulate/simul-debugger-ams.adb +++ b/src/vhdl/simulate/simul-debugger-ams.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Ada.Text_IO; use Ada.Text_IO; with Vhdl.Disp_Vhdl; diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb index e96a8100e..f094073e2 100644 --- a/src/vhdl/simulate/simul-debugger.adb +++ b/src/vhdl/simulate/simul-debugger.adb @@ -35,7 +35,7 @@ with Vhdl.Std_Package; with Simul.Annotations; use Simul.Annotations; with Simul.Elaboration; use Simul.Elaboration; with Simul.Execution; use Simul.Execution; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Vhdl.Disp_Vhdl; with Iirs_Walk; use Iirs_Walk; diff --git a/src/vhdl/simulate/simul-elaboration.adb b/src/vhdl/simulate/simul-elaboration.adb index a961aeeae..da8c15664 100644 --- a/src/vhdl/simulate/simul-elaboration.adb +++ b/src/vhdl/simulate/simul-elaboration.adb @@ -21,7 +21,7 @@ with Str_Table; with Errorout; use Errorout; with Vhdl.Evaluation; with Simul.Execution; use Simul.Execution; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Libraries; with Name_Table; with Simul.File_Operation; diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb index d40a093cb..b820e6425 100644 --- a/src/vhdl/simulate/simul-execution.adb +++ b/src/vhdl/simulate/simul-execution.adb @@ -24,7 +24,7 @@ with Flags; use Flags; with Errorout; use Errorout; with Vhdl.Std_Package; with Vhdl.Evaluation; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Simul.Annotations; use Simul.Annotations; with Name_Table; with Simul.File_Operation; diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb index 141e1fd2d..ab9b083fc 100644 --- a/src/vhdl/simulate/simul-simulation-main.adb +++ b/src/vhdl/simulate/simul-simulation-main.adb @@ -19,7 +19,7 @@ with Ada.Unchecked_Conversion; with Ada.Text_IO; use Ada.Text_IO; with Types; use Types; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with PSL.Nodes; with PSL.NFAs; diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 9a0afe2e5..f29dfa76f 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -24,7 +24,7 @@ with Hash; with Interning; with Vhdl.Nodes; use Vhdl.Nodes; with Libraries; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; with Flags; with Vhdl.Configuration; diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index a8b61c4d4..164f7df3b 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Translation; use Translation; with Trans.Chap2; with Trans.Chap3; diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index f739edb53..540f775d6 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -19,7 +19,7 @@ with Vhdl.Configuration; with Errorout; use Errorout; with Vhdl.Std_Package; use Vhdl.Std_Package; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Libraries; with Flags; with Vhdl.Sem; diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb index df6b937e3..439fc7035 100644 --- a/src/vhdl/translate/trans-chap14.adb +++ b/src/vhdl/translate/trans-chap14.adb @@ -19,7 +19,7 @@ with Vhdl.Evaluation; use Vhdl.Evaluation; with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Trans_Decls; use Trans_Decls; with Trans.Chap3; with Trans.Chap6; diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 5b14d6ab5..0546a5cb7 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -21,7 +21,7 @@ with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; with Vhdl.Sem_Inst; with Vhdl.Nodes_Meta; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Trans.Chap3; with Trans.Chap4; with Trans.Chap5; diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index f9685f284..9388c8fdc 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -18,7 +18,7 @@ with Name_Table; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; with Trans.Chap2; with Trans.Chap4; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 01a198563..91861f0c6 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -18,7 +18,7 @@ with Errorout; use Errorout; with Files_Map; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Canon; with Translation; use Translation; diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index 0b700189f..b9c8e42d3 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Trans.Chap3; with Trans.Chap4; with Trans.Chap6; diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 383dd8ce8..ffb0581a0 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -18,7 +18,7 @@ with Files_Map; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; with Trans.Chap3; with Trans.Chap7; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index ebde37648..85b74416e 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -19,7 +19,7 @@ with Ada.Text_IO; with Name_Table; with Str_Table; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Iir_Chains; use Iir_Chains; with Vhdl.Std_Package; use Vhdl.Std_Package; with Errorout; use Errorout; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 4819a0e16..59bbca656 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -23,7 +23,7 @@ with Iir_Chains; with Vhdl.Canon; with Vhdl.Evaluation; use Vhdl.Evaluation; with Vhdl.Std_Package; use Vhdl.Std_Package; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Trans.Chap2; with Trans.Chap3; with Trans.Chap4; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index cc5e38834..f6f7cc465 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Vhdl.Std_Package; use Vhdl.Std_Package; with Flags; diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index b0997006d..49b5b30a2 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -19,7 +19,7 @@ with Name_Table; with Files_Map; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Configuration; with Libraries; with Trans.Chap7; diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb index 3ad9c3e25..2d4aef0d6 100644 --- a/src/vhdl/translate/trans_analyzes.adb +++ b/src/vhdl/translate/trans_analyzes.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Iirs_Walk; use Iirs_Walk; with Vhdl.Disp_Vhdl; with Ada.Text_IO; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index c1cb1e0a4..3f2ce1a7f 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -24,7 +24,7 @@ with Errorout; use Errorout; with Name_Table; -- use Name_Table; with Str_Table; with Files_Map; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Sem_Specs; with Libraries; diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index 2c27e61d7..379adaed6 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Types; use Types; with Flags; use Flags; with Name_Table; diff --git a/src/vhdl/vhdl-canon_psl.adb b/src/vhdl/vhdl-canon_psl.adb index 08cb84d05..a130b0a5e 100644 --- a/src/vhdl/vhdl-canon_psl.adb +++ b/src/vhdl/vhdl-canon_psl.adb @@ -19,7 +19,7 @@ with PSL.Nodes; use PSL.Nodes; with PSL.Errors; use PSL.Errors; with Vhdl.Canon; use Vhdl.Canon; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; package body Vhdl.Canon_PSL is -- Version of Canon.Canon_Extract_Sensitivity for PSL nodes. diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index 0c688a083..6b371d601 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -21,7 +21,7 @@ with Errorout; use Errorout; with Vhdl.Std_Package; with Name_Table; use Name_Table; with Flags; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Iirs_Walk; with Vhdl.Sem_Scopes; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; diff --git a/src/vhdl/vhdl-disp_vhdl.adb b/src/vhdl/vhdl-disp_vhdl.adb index acf7f0c5f..b6904c07f 100644 --- a/src/vhdl/vhdl-disp_vhdl.adb +++ b/src/vhdl/vhdl-disp_vhdl.adb @@ -24,7 +24,7 @@ with GNAT.OS_Lib; with Vhdl.Std_Package; with Flags; use Flags; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Name_Table; with Str_Table; with Std_Names; @@ -262,7 +262,7 @@ package body Vhdl.Disp_Vhdl is Put (".all"); when Iir_Kind_Simple_Name | Iir_Kind_Character_Literal => - Put (Iirs_Utils.Image_Identifier (Name)); + Put (Utils.Image_Identifier (Name)); when Iir_Kind_Operator_Symbol => Disp_Function_Name (Name); when Iir_Kind_Selected_Name => @@ -2114,7 +2114,7 @@ package body Vhdl.Disp_Vhdl is Put ("("); end if; Disp_Expression (Get_Left (Expr)); - Put (' ' & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & ' '); + Put (' ' & Name_Table.Image (Utils.Get_Operator_Name (Expr)) & ' '); Disp_Expression (Get_Right (Expr)); if Flag_Parenthesis then Put (")"); @@ -2128,7 +2128,7 @@ package body Vhdl.Disp_Vhdl is return; end if; - Put (Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr))); + Put (Name_Table.Image (Utils.Get_Operator_Name (Expr))); Put (' '); if Flag_Parenthesis then Put ('('); diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb index 11776b1b6..65d099a42 100644 --- a/src/vhdl/vhdl-evaluation.adb +++ b/src/vhdl/vhdl-evaluation.adb @@ -21,7 +21,7 @@ with Vhdl.Scanner; with Errorout; use Errorout; with Name_Table; use Name_Table; with Str_Table; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; with Flags; use Flags; with Std_Names; diff --git a/src/vhdl/vhdl-ieee-vital_timing.adb b/src/vhdl/vhdl-ieee-vital_timing.adb index 0cd175a05..c4263672a 100644 --- a/src/vhdl/vhdl-ieee-vital_timing.adb +++ b/src/vhdl/vhdl-ieee-vital_timing.adb @@ -26,7 +26,7 @@ with Vhdl.Sem_Scopes; with Vhdl.Sem_Specs; with Vhdl.Evaluation; with Vhdl.Sem; -with Iirs_Utils; +with Vhdl.Utils; package body Vhdl.Ieee.Vital_Timing is -- This package is based on IEEE 1076.4 1995. @@ -1312,7 +1312,7 @@ package body Vhdl.Ieee.Vital_Timing is -- 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 + if not Is_Vital_Level0 (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; diff --git a/src/vhdl/vhdl-ieee.adb b/src/vhdl/vhdl-ieee.adb index 8d1021efb..69d5196f0 100644 --- a/src/vhdl/vhdl-ieee.adb +++ b/src/vhdl/vhdl-ieee.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; package body Vhdl.Ieee is diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index ac1fa7b94..dfd98c400 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -18,7 +18,7 @@ with Iir_Chains; use Iir_Chains; with Vhdl.Tokens; use Vhdl.Tokens; with Vhdl.Scanner; use Vhdl.Scanner; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Std_Names; use Std_Names; with Flags; use Flags; diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 8cc7f934f..077d9c5f6 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -28,7 +28,7 @@ with Vhdl.Sem_Decls; use Vhdl.Sem_Decls; with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs; with Vhdl.Sem_Inst; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Flags; use Flags; with Str_Table; with Vhdl.Sem_Utils; diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index b56692a40..6a9226fe0 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -19,7 +19,7 @@ with Vhdl.Evaluation; use Vhdl.Evaluation; with Errorout; use Errorout; with Flags; use Flags; with Types; use Types; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Parse; with Std_Names; with Vhdl.Sem_Names; use Vhdl.Sem_Names; diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index 24d07d77f..507ed1a3f 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -22,7 +22,7 @@ with Vhdl.Tokens; with Flags; use Flags; with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Evaluation; use Vhdl.Evaluation; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Sem; use Vhdl.Sem; with Vhdl.Sem_Utils; use Vhdl.Sem_Utils; with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 91ff0b950..096cd8961 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -25,7 +25,7 @@ with Vhdl.Sem_Names; use Vhdl.Sem_Names; with Vhdl.Sem; with Name_Table; with Str_Table; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; with Iir_Chains; use Iir_Chains; with Vhdl.Sem_Types; @@ -1765,7 +1765,7 @@ package body Vhdl.Sem_Expr is Left := Get_Left (Expr); Right := Get_Right (Expr); end if; - Operator := Iirs_Utils.Get_Operator_Name (Expr); + Operator := Utils.Get_Operator_Name (Expr); if Get_Type (Expr) = Null_Iir then -- First pass. diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb index 151bfda8f..7a8c6e36f 100644 --- a/src/vhdl/vhdl-sem_inst.adb +++ b/src/vhdl/vhdl-sem_inst.adb @@ -19,7 +19,7 @@ with Vhdl.Nodes_Priv; with Vhdl.Nodes_Meta; with Types; use Types; with Files_Map; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Vhdl.Sem_Utils; diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index fe788202d..050beeee9 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -18,7 +18,7 @@ with Flags; with Name_Table; with Files_Map; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Libraries; use Libraries; with Vhdl.Scanner; @@ -220,7 +220,7 @@ package body Vhdl.Sem_Lib is -- Move the unit in the library: keep the design_unit of the library, -- but replace the library_unit by the one that has been parsed. Do -- not forget to relocate parents. - Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); + Vhdl.Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); Set_Parent (Get_Library_Unit (Res), Design_Unit); diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index 85986cb78..8cf89d02a 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Vhdl.Evaluation; use Vhdl.Evaluation; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Errorout; use Errorout; with Flags; use Flags; with Name_Table; diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index 5d782ed40..9dede6e06 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -26,7 +26,7 @@ with Vhdl.Sem_Stmts; use Vhdl.Sem_Stmts; with Vhdl.Sem_Scopes; with Vhdl.Sem_Names; with Std_Names; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb index 8e616bd4b..c1f3fe8fd 100644 --- a/src/vhdl/vhdl-sem_scopes.adb +++ b/src/vhdl/vhdl-sem_scopes.adb @@ -21,7 +21,7 @@ with Flags; use Flags; with Name_Table; -- use Name_Table; with Files_Map; use Files_Map; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; package body Vhdl.Sem_Scopes is -- An interpretation cell is the element of the simply linked list diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index 5d3224ed0..6bf56aed5 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -15,7 +15,7 @@ -- 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.Utils; use Vhdl.Utils; with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; with Vhdl.Sem_Names; use Vhdl.Sem_Names; with Vhdl.Evaluation; use Vhdl.Evaluation; diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index 9553dc7df..18c38f67d 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -29,7 +29,7 @@ with Vhdl.Sem_Types; with Vhdl.Sem_Psl; with Std_Names; with Vhdl.Evaluation; use Vhdl.Evaluation; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Stmts is diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index 1769bdbfc..3ec8586ce 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -28,7 +28,7 @@ with Vhdl.Sem_Decls; with Vhdl.Sem_Inst; with Name_Table; with Std_Names; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Xrefs; use Vhdl.Xrefs; diff --git a/src/vhdl/vhdl-sem_utils.adb b/src/vhdl/vhdl-sem_utils.adb index 11585bb90..0f3045bdf 100644 --- a/src/vhdl/vhdl-sem_utils.adb +++ b/src/vhdl/vhdl-sem_utils.adb @@ -19,7 +19,7 @@ with Ada.Unchecked_Conversion; with Types; use Types; with Flags; use Flags; with Errorout; use Errorout; -with Iirs_Utils; use Iirs_Utils; +with Vhdl.Utils; use Vhdl.Utils; with Iir_Chains; use Iir_Chains; with Vhdl.Ieee.Std_Logic_1164; with Std_Names; diff --git a/src/vhdl/vhdl-std_package.adb b/src/vhdl/vhdl-std_package.adb index 78a614afd..fb68dfd64 100644 --- a/src/vhdl/vhdl-std_package.adb +++ b/src/vhdl/vhdl-std_package.adb @@ -21,7 +21,7 @@ with Name_Table; with Str_Table; with Std_Names; use Std_Names; with Flags; use Flags; -with Iirs_Utils; +with Vhdl.Utils; with Vhdl.Sem_Utils; with Iir_Chains; @@ -66,7 +66,7 @@ package body Vhdl.Std_Package is is Res : Iir; begin - Res := Iirs_Utils.Build_Simple_Name (Ref, Std_Location); + Res := Utils.Build_Simple_Name (Ref, Std_Location); Set_Type (Res, Get_Type (Ref)); return Res; end Create_Std_Type_Mark; @@ -461,7 +461,7 @@ package body Vhdl.Std_Package is Create_Std_Type (Boolean_Type_Declaration, Boolean_Type_Definition, Name_Boolean); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (Boolean_Type_Definition); Add_Implicit_Operations (Boolean_Type_Declaration); end; @@ -498,7 +498,7 @@ package body Vhdl.Std_Package is -- type bit is Create_Std_Type (Bit_Type_Declaration, Bit_Type_Definition, Name_Bit); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (Bit_Type_Definition); Add_Implicit_Operations (Bit_Type_Declaration); end; @@ -562,7 +562,7 @@ package body Vhdl.Std_Package is (Character_Type_Declaration, Character_Type_Definition, Name_Character); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (Character_Type_Definition); Add_Implicit_Operations (Character_Type_Declaration); end; @@ -595,7 +595,7 @@ package body Vhdl.Std_Package is (Severity_Level_Type_Declaration, Severity_Level_Type_Definition, Name_Severity_Level); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (Severity_Level_Type_Definition); Add_Implicit_Operations (Severity_Level_Type_Declaration); end; @@ -1151,7 +1151,7 @@ package body Vhdl.Std_Package is (File_Open_Kind_Type_Declaration, File_Open_Kind_Type_Definition, Name_File_Open_Kind); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (File_Open_Kind_Type_Definition); Add_Implicit_Operations (File_Open_Kind_Type_Declaration); else @@ -1190,7 +1190,7 @@ package body Vhdl.Std_Package is Create_Std_Type (File_Open_Status_Type_Declaration, File_Open_Status_Type_Definition, Name_File_Open_Status); - Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type + Utils.Create_Range_Constraint_For_Enumeration_Type (File_Open_Status_Type_Definition); Add_Implicit_Operations (File_Open_Status_Type_Declaration); else @@ -1266,7 +1266,7 @@ package body Vhdl.Std_Package is Create_Wildcard_Type (Wildcard_Any_String_Type, "any string type"); Create_Wildcard_Type (Wildcard_Any_Access_Type, "any access type"); - Error_Type := Iirs_Utils.Create_Error_Type (Wildcard_Any_Type); + Error_Type := Utils.Create_Error_Type (Wildcard_Any_Type); Set_Error_Origin (Error_Type, Null_Iir); Create_Wildcard_Type (Error_Type, "unknown type"); end Create_Std_Standard_Package; diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb new file mode 100644 index 000000000..e93becc60 --- /dev/null +++ b/src/vhdl/vhdl-utils.adb @@ -0,0 +1,1688 @@ +-- Common operations on nodes. +-- 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 Vhdl.Scanner; use Vhdl.Scanner; +with Vhdl.Tokens; use Vhdl.Tokens; +with Errorout; use Errorout; +with Name_Table; +with Str_Table; +with Std_Names; use Std_Names; +with Vhdl.Std_Package; +with Flags; use Flags; +with PSL.Nodes; + +package body Vhdl.Utils is + -- Transform the current token into an iir literal. + -- The current token must be either a character or an identifier. + function Current_Text return Iir is + Res: Iir; + begin + case Current_Token is + when Tok_Identifier => + Res := Create_Iir (Iir_Kind_Simple_Name); + when Tok_Character => + Res := Create_Iir (Iir_Kind_Character_Literal); + when others => + raise Internal_Error; + end case; + Set_Identifier (Res, Current_Identifier); + Invalidate_Current_Identifier; + Invalidate_Current_Token; + Set_Location (Res, Get_Token_Location); + return Res; + end Current_Text; + + function Is_Error (N : Iir) return Boolean is + begin + return Get_Kind (N) = Iir_Kind_Error; + end Is_Error; + + function Is_Overflow_Literal (N : Iir) return Boolean is + begin + return Get_Kind (N) = Iir_Kind_Overflow_Literal; + end Is_Overflow_Literal; + + function List_To_Flist (L : Iir_List) return Iir_Flist + is + Len : constant Natural := Get_Nbr_Elements (L); + It : List_Iterator; + Temp_L : Iir_List; + Res : Iir_Flist; + begin + Res := Create_Iir_Flist (Len); + It := List_Iterate (L); + for I in 0 .. Len - 1 loop + pragma Assert (Is_Valid (It)); + Set_Nth_Element (Res, I, Get_Element (It)); + Next (It); + end loop; + pragma Assert (not Is_Valid (It)); + + Temp_L := L; + Destroy_Iir_List (Temp_L); + + return Res; + end List_To_Flist; + + function Truncate_Flist (L : Iir_Flist; Len : Natural) return Iir_Flist + is + Res : Iir_Flist; + Temp_L : Iir_Flist; + begin + Res := Create_Iir_Flist (Len); + for I in 0 .. Len - 1 loop + Set_Nth_Element (Res, I, Get_Nth_Element (L, I)); + end loop; + Temp_L := L; + Destroy_Iir_Flist (Temp_L); + return Res; + end Truncate_Flist; + + function Get_Operator_Name (Op : Iir) return Name_Id is + begin + case Get_Kind (Op) is + when Iir_Kind_And_Operator + | Iir_Kind_Reduction_And_Operator => + return Name_And; + when Iir_Kind_Or_Operator + | Iir_Kind_Reduction_Or_Operator => + return Name_Or; + when Iir_Kind_Nand_Operator + | Iir_Kind_Reduction_Nand_Operator => + return Name_Nand; + when Iir_Kind_Nor_Operator + | Iir_Kind_Reduction_Nor_Operator => + return Name_Nor; + when Iir_Kind_Xor_Operator + | Iir_Kind_Reduction_Xor_Operator => + return Name_Xor; + when Iir_Kind_Xnor_Operator + | Iir_Kind_Reduction_Xnor_Operator => + return Name_Xnor; + + when Iir_Kind_Equality_Operator => + return Name_Op_Equality; + when Iir_Kind_Inequality_Operator => + return Name_Op_Inequality; + when Iir_Kind_Less_Than_Operator => + return Name_Op_Less; + when Iir_Kind_Less_Than_Or_Equal_Operator => + return Name_Op_Less_Equal; + when Iir_Kind_Greater_Than_Operator => + return Name_Op_Greater; + when Iir_Kind_Greater_Than_Or_Equal_Operator => + return Name_Op_Greater_Equal; + + when Iir_Kind_Match_Equality_Operator => + return Name_Op_Match_Equality; + when Iir_Kind_Match_Inequality_Operator => + return Name_Op_Match_Inequality; + when Iir_Kind_Match_Less_Than_Operator => + return Name_Op_Match_Less; + when Iir_Kind_Match_Less_Than_Or_Equal_Operator => + return Name_Op_Match_Less_Equal; + when Iir_Kind_Match_Greater_Than_Operator => + return Name_Op_Match_Greater; + when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => + return Name_Op_Match_Greater_Equal; + + when Iir_Kind_Sll_Operator => + return Name_Sll; + when Iir_Kind_Sla_Operator => + return Name_Sla; + when Iir_Kind_Srl_Operator => + return Name_Srl; + when Iir_Kind_Sra_Operator => + return Name_Sra; + when Iir_Kind_Rol_Operator => + return Name_Rol; + when Iir_Kind_Ror_Operator => + return Name_Ror; + when Iir_Kind_Addition_Operator => + return Name_Op_Plus; + when Iir_Kind_Substraction_Operator => + return Name_Op_Minus; + when Iir_Kind_Concatenation_Operator => + return Name_Op_Concatenation; + when Iir_Kind_Multiplication_Operator => + return Name_Op_Mul; + when Iir_Kind_Division_Operator => + return Name_Op_Div; + when Iir_Kind_Modulus_Operator => + return Name_Mod; + when Iir_Kind_Remainder_Operator => + return Name_Rem; + when Iir_Kind_Exponentiation_Operator => + return Name_Op_Exp; + when Iir_Kind_Not_Operator => + return Name_Not; + when Iir_Kind_Negation_Operator => + return Name_Op_Minus; + when Iir_Kind_Identity_Operator => + return Name_Op_Plus; + when Iir_Kind_Absolute_Operator => + return Name_Abs; + when Iir_Kind_Condition_Operator + | Iir_Kind_Implicit_Condition_Operator => + return Name_Op_Condition; + when others => + raise Internal_Error; + end case; + end Get_Operator_Name; + + function Get_Longuest_Static_Prefix (Expr: Iir) return Iir is + Adecl: Iir; + begin + Adecl := Expr; + loop + case Get_Kind (Adecl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration => + return Adecl; + when Iir_Kind_Constant_Declaration + | Iir_Kind_Interface_Constant_Declaration => + return Adecl; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration => + return Adecl; + when Iir_Kind_Object_Alias_Declaration => + -- LRM 4.3.3.1 Object Aliases + -- 2. The name must be a static name [...] + return Adecl; + when Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element => + if Get_Name_Staticness (Adecl) >= Globally then + return Adecl; + else + Adecl := Get_Prefix (Adecl); + end if; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Adecl := Get_Named_Entity (Adecl); + when Iir_Kind_Type_Conversion => + return Null_Iir; + when others => + Error_Kind ("get_longuest_static_prefix", Adecl); + end case; + end loop; + end Get_Longuest_Static_Prefix; + + function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) + return Iir + is + Adecl : Iir; + begin + Adecl := Name; + loop + case Get_Kind (Adecl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Interface_Package_Declaration + | Iir_Kind_Interface_Function_Declaration + | Iir_Kind_Interface_Procedure_Declaration + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Variable_Name => + return Adecl; + when Iir_Kind_Object_Alias_Declaration => + if With_Alias then + Adecl := Get_Name (Adecl); + else + return Adecl; + end if; + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Selected_By_All_Name => + Adecl := Get_Base_Name (Adecl); + when Iir_Kinds_Literal + | Iir_Kind_Overflow_Literal + | Iir_Kind_Enumeration_Literal + | Iir_Kinds_Monadic_Operator + | Iir_Kinds_Dyadic_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Parenthesis_Expression + | Iir_Kinds_Attribute + | Iir_Kind_Attribute_Value + | Iir_Kind_Aggregate + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Unit_Declaration + | Iir_Kind_Psl_Expression + | Iir_Kinds_Concurrent_Statement + | Iir_Kinds_Sequential_Statement + | Iir_Kind_Simple_Simultaneous_Statement => + return Adecl; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Adecl := Get_Named_Entity (Adecl); + when Iir_Kind_Attribute_Name => + return Get_Named_Entity (Adecl); + when Iir_Kind_Error + | Iir_Kind_Unused + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Conditional_Expression + | Iir_Kind_Character_Literal + | Iir_Kind_Operator_Symbol + | Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Context_Reference + | Iir_Kind_Library_Declaration + | Iir_Kinds_Library_Unit + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kinds_Type_Declaration + | Iir_Kinds_Type_And_Subtype_Definition + | Iir_Kind_Wildcard_Type_Definition + | Iir_Kind_Subtype_Definition + | Iir_Kind_Scalar_Nature_Definition + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Signal_Attribute_Declaration + | Iir_Kind_Unaffected_Waveform + | Iir_Kind_Waveform_Element + | Iir_Kind_Conditional_Waveform + | Iir_Kind_Binding_Indication + | Iir_Kind_Component_Configuration + | Iir_Kind_Block_Configuration + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kinds_Subprogram_Body + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_Procedure_Call + | Iir_Kind_Aggregate_Info + | Iir_Kind_Entity_Class + | Iir_Kind_Signature + | Iir_Kind_Reference_Name + | Iir_Kind_Package_Header + | Iir_Kind_Block_Header + | Iir_Kinds_Association_Element + | Iir_Kind_Association_Element_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram + | Iir_Kinds_Choice + | Iir_Kinds_Entity_Aspect + | Iir_Kind_If_Generate_Else_Clause + | Iir_Kind_Elsif + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Array_Element_Resolution + | Iir_Kind_Record_Resolution + | Iir_Kind_Record_Element_Resolution + | Iir_Kind_Element_Declaration + | Iir_Kind_Psl_Endpoint_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Package_Pathname + | Iir_Kind_Absolute_Pathname + | Iir_Kind_Relative_Pathname + | Iir_Kind_Pathname_Element + | Iir_Kind_Range_Expression + | Iir_Kind_Overload_List => + return Adecl; + end case; + end loop; + end Get_Object_Prefix; + + function Is_Object_Name (Name : Iir) return Boolean + is + Obj : constant Iir := Name_To_Object (Name); + begin + return Obj /= Null_Iir; + end Is_Object_Name; + + function Name_To_Object (Name : Iir) return Iir is + begin + -- LRM08 6.4 Objects + -- An object is a named entity that contains (has) a value of a type. + -- An object is obe of the following: + case Get_Kind (Name) is + -- An object declared by an object declaration (see 6.4.2) + when Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Constant_Declaration => + return Name; + + -- A loop of generate parameter. + when Iir_Kind_Iterator_Declaration => + return Name; + + -- A formal parameter of a subprogram + -- A formal port + -- A formal generic constant + -- A local port + -- A local generic constant + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_File_Declaration => + return Name; + + -- An implicit signak GUARD defined by the guard expression of a + -- block statement + when Iir_Kind_Guard_Signal_Declaration => + return Name; + + -- In addition, the following are objects [ but are not named + -- entities]: + -- An implicit signal defined by any of the predefined attributes + -- 'DELAYED, 'STABLE, 'QUIET, and 'TRANSACTION + when Iir_Kinds_Signal_Attribute => + return Name; + + -- An element or a slice of another object + when Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element => + return Name; + + -- An object designated by a value of an access type + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + return Name; + + -- LRM08 6.6 Alias declarations + -- An object alias is an alias whose alias designatore denotes an + -- object. + when Iir_Kind_Object_Alias_Declaration => + return Name; + + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + -- LRM08 8 Names + -- Names can denote declared entities [...] + -- GHDL: in particular, names can denote objects. + return Name_To_Object (Get_Named_Entity (Name)); + + when Iir_Kinds_External_Name => + return Name; + + when others => + return Null_Iir; + end case; + end Name_To_Object; + + function Name_To_Value (Name : Iir) return Iir is + begin + case Get_Kind (Name) is + when Iir_Kind_Attribute_Value + | Iir_Kind_Function_Call + | Iir_Kinds_Expression_Attribute => + return Name; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + return Name_To_Value (Get_Named_Entity (Name)); + when others => + return Name_To_Object (Name); + end case; + end Name_To_Value; + + -- Return TRUE if EXPR is a signal name. + function Is_Signal_Name (Expr : Iir) return Boolean + is + Obj : Iir; + begin + Obj := Name_To_Object (Expr); + if Obj /= Null_Iir then + return Is_Signal_Object (Obj); + else + return False; + end if; + end Is_Signal_Name; + + function Is_Signal_Object (Name : Iir) return Boolean + is + Adecl: Iir; + begin + Adecl := Get_Object_Prefix (Name, True); + case Get_Kind (Adecl) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kinds_Signal_Attribute => + return True; + when Iir_Kind_Object_Alias_Declaration => + -- Must have been handled by Get_Object_Prefix. + raise Internal_Error; + when others => + return False; + end case; + end Is_Signal_Object; + + function Get_Interface_Of_Formal (Formal : Iir) return Iir + is + El : Iir; + begin + El := Formal; + loop + case Get_Kind (El) is + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => + -- Operator is for subprogram interfaces. + return Get_Named_Entity (El); + when Iir_Kinds_Interface_Declaration => + return El; + when Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element => + -- FIXME: use get_base_name ? + El := Get_Prefix (El); + when others => + Error_Kind ("get_interface_of_formal", El); + end case; + end loop; + end Get_Interface_Of_Formal; + + function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir + is + Formal : constant Iir := Get_Formal (Assoc); + begin + if Formal /= Null_Iir then + return Get_Interface_Of_Formal (Formal); + else + return Inter; + end if; + end Get_Association_Interface; + + procedure Next_Association_Interface + (Assoc : in out Iir; Inter : in out Iir) + is + Formal : constant Iir := Get_Formal (Assoc); + begin + -- In canon, open association can be inserted after an association by + -- name. So do not assume there is no association by position after + -- association by name. + if Is_Valid (Formal) then + Inter := Get_Chain (Get_Interface_Of_Formal (Formal)); + else + Inter := Get_Chain (Inter); + end if; + Assoc := Get_Chain (Assoc); + end Next_Association_Interface; + + function Get_Association_Formal (Assoc : Iir; Inter : Iir) return Iir + is + Formal : constant Iir := Get_Formal (Assoc); + begin + if Formal /= Null_Iir then + -- Strip denoting name + case Get_Kind (Formal) is + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => + return Get_Named_Entity (Formal); + when Iir_Kinds_Interface_Declaration => + -- Shouldn't happen. + raise Internal_Error; + when Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element => + return Formal; + when others => + Error_Kind ("get_association_formal", Formal); + end case; + else + return Inter; + end if; + end Get_Association_Formal; + + function Find_First_Association_For_Interface + (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir + is + Assoc_El : Iir; + Inter_El : Iir; + begin + Assoc_El := Assoc_Chain; + Inter_El := Inter_Chain; + while Is_Valid (Assoc_El) loop + if Get_Association_Interface (Assoc_El, Inter_El) = Inter then + return Assoc_El; + end if; + Next_Association_Interface (Assoc_El, Inter_El); + end loop; + return Null_Iir; + end Find_First_Association_For_Interface; + + function Is_Parameter (Inter : Iir) return Boolean is + begin + case Get_Kind (Get_Parent (Inter)) is + when Iir_Kinds_Subprogram_Declaration + | Iir_Kinds_Interface_Subprogram_Declaration => + return True; + when others => + -- Port + return False; + end case; + end Is_Parameter; + + function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir + is + El : Iir; + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if Get_Identifier (El) = Lit then + return El; + end if; + end loop; + return Null_Iir; + end Find_Name_In_Flist; + + function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir + is + El: Iir := Chain; + begin + while El /= Null_Iir loop + if Get_Identifier (El) = Lit then + return El; + end if; + El := Get_Chain (El); + end loop; + return Null_Iir; + end Find_Name_In_Chain; + + function Is_In_Chain (Chain : Iir; El : Iir) return Boolean + is + Chain_El : Iir; + begin + Chain_El := Chain; + while Chain_El /= Null_Iir loop + if Chain_El = El then + return True; + end if; + Chain_El := Get_Chain (Chain_El); + end loop; + return False; + end Is_In_Chain; + + procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is + begin + -- Do not add self-dependency + if Unit = Target then + return; + end if; + + pragma Assert (Kind_In (Unit, Iir_Kind_Design_Unit, + Iir_Kind_Entity_Aspect_Entity)); + + Add_Element (Get_Dependence_List (Target), Unit); + end Add_Dependence; + + function Get_Unit_From_Dependence (Dep : Iir) return Iir is + begin + case Get_Kind (Dep) is + when Iir_Kind_Design_Unit => + return Dep; + when Iir_Kind_Entity_Aspect_Entity => + return Get_Design_Unit (Get_Entity (Dep)); + when others => + Error_Kind ("get_unit_from_dependence", Dep); + end case; + end Get_Unit_From_Dependence; + + procedure Clear_Instantiation_Configuration_Vhdl87 + (Parent : Iir; In_Generate : Boolean; Full : Boolean) + is + El : Iir; + Prev : Iir; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + if In_Generate and not Full then + Prev := Get_Component_Configuration (El); + if Prev /= Null_Iir then + case Get_Kind (Prev) is + when Iir_Kind_Configuration_Specification => + -- Keep it. + null; + when Iir_Kind_Component_Configuration => + Set_Component_Configuration (El, Null_Iir); + when others => + Error_Kind + ("clear_instantiation_configuration_vhdl87", + Prev); + end case; + end if; + else + Set_Component_Configuration (El, Null_Iir); + end if; + when Iir_Kind_For_Generate_Statement => + Set_Generate_Block_Configuration (El, Null_Iir); + -- Clear inside a generate statement. + Clear_Instantiation_Configuration_Vhdl87 (El, True, Full); + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (El, Null_Iir); + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end Clear_Instantiation_Configuration_Vhdl87; + + procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean) + is + El : Iir; + begin + if False and then Flags.Vhdl_Std = Vhdl_87 then + Clear_Instantiation_Configuration_Vhdl87 + (Parent, Get_Kind (Parent) = Iir_Kind_For_Generate_Statement, Full); + else + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + Set_Component_Configuration (El, Null_Iir); + when Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (El); + begin + Set_Generate_Block_Configuration (Bod, Null_Iir); + end; + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + Bod : Iir; + begin + Clause := El; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Set_Generate_Block_Configuration (Bod, Null_Iir); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end; + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (El, Null_Iir); + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end if; + end Clear_Instantiation_Configuration; + + -- Get identifier of NODE as a string. + function Image_Identifier (Node : Iir) return String is + begin + return Name_Table.Image (Vhdl.Nodes.Get_Identifier (Node)); + end Image_Identifier; + + function Image_String_Lit (Str : Iir) return String is + begin + return Str_Table.String_String8 + (Get_String8_Id (Str), Get_String_Length (Str)); + end Image_String_Lit; + + function Copy_Enumeration_Literal (Lit : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Enumeration_Literal); + Set_Identifier (Res, Get_Identifier (Lit)); + Location_Copy (Res, Lit); + Set_Parent (Res, Get_Parent (Lit)); + Set_Type (Res, Get_Type (Lit)); + Set_Enum_Pos (Res, Get_Enum_Pos (Lit)); + Set_Expr_Staticness (Res, Locally); + return Res; + end Copy_Enumeration_Literal; + + procedure Create_Range_Constraint_For_Enumeration_Type + (Def : Iir_Enumeration_Type_Definition) + is + Range_Expr : Iir_Range_Expression; + Literal_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); + List_Len : constant Natural := Get_Nbr_Elements (Literal_List); + begin + -- Create a constraint. + Range_Expr := Create_Iir (Iir_Kind_Range_Expression); + Location_Copy (Range_Expr, Def); + Set_Type (Range_Expr, Def); + Set_Direction (Range_Expr, Iir_To); + if List_Len >= 1 then + Set_Left_Limit + (Range_Expr, Get_Nth_Element (Literal_List, 0)); + Set_Right_Limit + (Range_Expr, Get_Nth_Element (Literal_List, List_Len - 1)); + end if; + Set_Expr_Staticness (Range_Expr, Locally); + Set_Range_Constraint (Def, Range_Expr); + end Create_Range_Constraint_For_Enumeration_Type; + + function Is_Static_Construct (Expr : Iir) return Boolean is + begin + case Get_Kind (Expr) is + when Iir_Kind_Aggregate => + return Get_Aggregate_Expand_Flag (Expr); + when Iir_Kinds_Literal => + return True; + when Iir_Kind_Simple_Aggregate + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Character_Literal => + return True; + when Iir_Kind_Overflow_Literal => + -- Needs to generate an error. + return False; + when others => + return False; + end case; + end Is_Static_Construct; + + procedure Free_Name (Node : Iir) + is + N : Iir; + N1 : Iir; + begin + if Node = Null_Iir then + return; + end if; + N := Node; + case Get_Kind (N) is + when Iir_Kind_Simple_Name + | Iir_Kind_Character_Literal + | Iir_Kind_String_Literal8 + | Iir_Kind_Subtype_Definition => + Free_Iir (N); + when Iir_Kind_Selected_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Selected_By_All_Name => + N1 := Get_Prefix (N); + Free_Iir (N); + Free_Name (N1); + when Iir_Kind_Library_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Design_Unit + | Iir_Kinds_Concurrent_Statement + | Iir_Kinds_Sequential_Statement => + return; + when others => + Error_Kind ("free_name", Node); + --Free_Iir (N); + end case; + end Free_Name; + + procedure Free_Recursive_List (List : Iir_List) + is + It : List_Iterator; + begin + It := List_Iterate (List); + while Is_Valid (It) loop + Free_Recursive (Get_Element (It)); + Next (It); + end loop; + end Free_Recursive_List; + + procedure Free_Recursive_Flist (List : Iir_Flist) + is + El : Iir; + begin + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Free_Recursive (El); + end loop; + end Free_Recursive_Flist; + + procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) + is + N : Iir; + begin + if Node = Null_Iir then + return; + end if; + N := Node; + case Get_Kind (N) is + when Iir_Kind_Library_Declaration => + return; + when Iir_Kind_Simple_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Character_Literal => + null; + when Iir_Kind_Enumeration_Literal => + return; + when Iir_Kind_Selected_Name => + Free_Recursive (Get_Prefix (N)); + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration => + Free_Recursive (Get_Type (N)); + Free_Recursive (Get_Default_Value (N)); + when Iir_Kind_Range_Expression => + Free_Recursive (Get_Left_Limit (N)); + Free_Recursive (Get_Right_Limit (N)); + when Iir_Kind_Subtype_Definition => + Free_Recursive (Get_Base_Type (N)); + when Iir_Kind_Integer_Literal => + null; + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration => + null; + when Iir_Kind_File_Type_Definition + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition => + return; + when Iir_Kind_Architecture_Body => + Free_Recursive (Get_Entity_Name (N)); + when Iir_Kind_Overload_List => + Free_Recursive_List (Get_Overload_List (N)); + if not Free_List then + return; + end if; + when Iir_Kind_Array_Subtype_Definition => + Free_Recursive_Flist (Get_Index_List (N)); + Free_Recursive (Get_Base_Type (N)); + when Iir_Kind_Entity_Aspect_Entity => + Free_Recursive (Get_Entity (N)); + Free_Recursive (Get_Architecture (N)); + when others => + Error_Kind ("free_recursive", Node); + end case; + Free_Iir (N); + end Free_Recursive; + + function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) + return String + is + begin + return Iir_Predefined_Functions'Image (Func); + end Get_Predefined_Function_Name; + + function Get_Callees_List_Holder (Subprg : Iir) return Iir is + begin + case Get_Kind (Subprg) is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + return Get_Subprogram_Body (Subprg); + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return Subprg; + when others => + Error_Kind ("get_callees_list_holder", Subprg); + end case; + end Get_Callees_List_Holder; + + procedure Clear_Seen_Flag (Top : Iir) + is + Callees_List : Iir_Callees_List; + It : List_Iterator; + El: Iir; + begin + if Get_Seen_Flag (Top) then + Set_Seen_Flag (Top, False); + Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top)); + if Callees_List /= Null_Iir_List then + It := List_Iterate (Callees_List); + while Is_Valid (It) loop + El := Get_Element (It); + if Get_Seen_Flag (El) = False then + Clear_Seen_Flag (El); + end if; + Next (It); + end loop; + end if; + end if; + end Clear_Seen_Flag; + + function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is + begin + return Get_Type_Declarator (Def) = Null_Iir; + end Is_Anonymous_Type_Definition; + + function Is_Fully_Constrained_Type (Def : Iir) return Boolean is + begin + return Get_Kind (Def) not in Iir_Kinds_Composite_Type_Definition + or else Get_Constraint_State (Def) = Fully_Constrained; + end Is_Fully_Constrained_Type; + + function Strip_Denoting_Name (Name : Iir) return Iir is + begin + if Get_Kind (Name) in Iir_Kinds_Denoting_Name then + return Get_Named_Entity (Name); + else + return Name; + end if; + end Strip_Denoting_Name; + + function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Simple_Name); + Set_Location (Res, Loc); + Set_Identifier (Res, Get_Identifier (Ref)); + Set_Named_Entity (Res, Ref); + Set_Base_Name (Res, Res); + -- FIXME: set type and expr staticness ? + return Res; + end Build_Simple_Name; + + function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir is + begin + return Build_Simple_Name (Ref, Get_Location (Loc)); + end Build_Simple_Name; + + function Build_Reference_Name (Name : Iir) return Iir + is + Res : Iir; + begin + pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name); + + Res := Create_Iir (Iir_Kind_Reference_Name); + Location_Copy (Res, Name); + Set_Referenced_Name (Res, Name); + Set_Is_Forward_Ref (Res, True); + Set_Named_Entity (Res, Get_Named_Entity (Name)); + return Res; + end Build_Reference_Name; + + function Strip_Reference_Name (N : Iir) return Iir is + begin + if Get_Kind (N) = Iir_Kind_Reference_Name then + return Get_Named_Entity (N); + else + return N; + end if; + end Strip_Reference_Name; + + function Has_Resolution_Function (Subtyp : Iir) return Iir + is + Ind : constant Iir := Get_Resolution_Indication (Subtyp); + begin + if Ind /= Null_Iir + and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name + then + -- A resolution indication can be an array/record element resolution. + return Get_Named_Entity (Ind); + else + return Null_Iir; + end if; + end Has_Resolution_Function; + + function Is_Type_Name (Name : Iir) return Iir + is + Ent : Iir; + begin + if Get_Kind (Name) in Iir_Kinds_Denoting_Name then + Ent := Get_Named_Entity (Name); + case Get_Kind (Ent) is + when Iir_Kind_Type_Declaration => + return Get_Type_Definition (Ent); + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Base_Attribute => + return Get_Type (Ent); + when others => + return Null_Iir; + end case; + else + return Null_Iir; + end if; + end Is_Type_Name; + + function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is + begin + case Get_Kind (Ind) is + when Iir_Kinds_Denoting_Name => + return Get_Type (Ind); + when Iir_Kinds_Subtype_Definition => + return Ind; + when Iir_Kind_Subtype_Attribute => + return Get_Type (Ind); + when Iir_Kind_Error => + return Ind; + when others => + Error_Kind ("get_type_of_subtype_indication", Ind); + end case; + end Get_Type_Of_Subtype_Indication; + + function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir + is + Index : constant Iir := Get_Nth_Element (Indexes, Idx); + begin + if Index = Null_Iir then + return Null_Iir; + else + return Get_Index_Type (Index); + end if; + end Get_Index_Type; + + function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir is + begin + return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx); + end Get_Index_Type; + + function Get_Nbr_Dimensions (Array_Type : Iir) return Natural is + begin + return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Type)); + end Get_Nbr_Dimensions; + + function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean + is + Indexes : constant Iir_Flist := Get_Index_Subtype_List (Array_Type); + Index : Iir; + begin + for I in Flist_First .. Flist_Last (Indexes) loop + Index := Get_Index_Type (Indexes, I); + if Get_Type_Staticness (Index) /= Locally then + return False; + end if; + end loop; + return True; + end Are_Array_Indexes_Locally_Static; + + function Are_Bounds_Locally_Static (Def : Iir) return Boolean is + begin + if Get_Type_Staticness (Def) = Locally then + return True; + end if; + + case Iir_Kinds_Type_And_Subtype_Definition (Get_Kind (Def)) is + when Iir_Kind_Array_Subtype_Definition => + pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); + + -- Indexes. + if not Are_Array_Indexes_Locally_Static (Def) then + return False; + end if; + + -- Element. + return Are_Bounds_Locally_Static (Get_Element_Subtype (Def)); + when Iir_Kind_Array_Type_Definition => + return False; + when Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Record_Type_Definition => + pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); + + declare + El_List : constant Iir_Flist := + Get_Elements_Declaration_List (Def); + El : Iir; + begin + for I in Flist_First .. Flist_Last (El_List) loop + El := Get_Nth_Element (El_List, I); + if not Are_Bounds_Locally_Static (Get_Type (El)) then + return False; + end if; + end loop; + return True; + end; + when Iir_Kinds_Scalar_Type_And_Subtype_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Access_Subtype_Definition => + return True; + when Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Interface_Type_Definition => + Error_Kind ("are_bounds_locally_static", Def); + end case; + end Are_Bounds_Locally_Static; + + function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir + is + Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp); + begin + if Type_Mark_Name = Null_Iir then + -- No type_mark (for array subtype created by constrained array + -- definition. + return Null_Iir; + else + return Get_Type (Get_Named_Entity (Type_Mark_Name)); + end if; + end Get_Denoted_Type_Mark; + + function Get_Base_Element_Declaration (El : Iir) return Iir + is + Rec_Type : constant Iir := Get_Base_Type (Get_Parent (El)); + Els_List : constant Iir_Flist := + Get_Elements_Declaration_List (Rec_Type); + begin + return Get_Nth_Element + (Els_List, Natural (Get_Element_Position (El))); + end Get_Base_Element_Declaration; + + procedure Append_Owned_Element_Constraint (Rec_Type : Iir; El : Iir) is + begin + pragma Assert (Get_Parent (El) = Rec_Type); + Set_Chain (El, Get_Owned_Elements_Chain (Rec_Type)); + Set_Owned_Elements_Chain (Rec_Type, El); + end Append_Owned_Element_Constraint; + + + function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean + is + Bod : constant Iir := Get_Chain (Spec); + begin + -- FIXME: don't directly use Subprogram_Body as it is not yet correctly + -- set during instantiation. + return Get_Has_Body (Spec) + and then Get_Subprogram_Specification (Bod) /= Spec; + end Is_Second_Subprogram_Specification; + + function Is_Implicit_Subprogram (Spec : Iir) return Boolean is + begin + return Get_Kind (Spec) in Iir_Kinds_Subprogram_Declaration + and then Get_Implicit_Definition (Spec) in Iir_Predefined_Implicit; + end Is_Implicit_Subprogram; + + function Is_Function_Declaration (N : Iir) return Boolean is + begin + return Kind_In (N, Iir_Kind_Function_Declaration, + Iir_Kind_Interface_Function_Declaration); + end Is_Function_Declaration; + + function Is_Procedure_Declaration (N : Iir) return Boolean is + begin + return Kind_In (N, Iir_Kind_Procedure_Declaration, + Iir_Kind_Interface_Procedure_Declaration); + end Is_Procedure_Declaration; + + function Is_Same_Profile (L, R: Iir) return Boolean + is + L1, R1 : Iir; + L_Kind, R_Kind : Iir_Kind; + El_L, El_R : Iir; + begin + L_Kind := Get_Kind (L); + if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then + L1 := Get_Named_Entity (Get_Name (L)); + L_Kind := Get_Kind (L1); + else + L1 := L; + end if; + R_Kind := Get_Kind (R); + if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then + R1 := Get_Named_Entity (Get_Name (R)); + R_Kind := Get_Kind (R1); + else + R1 := R; + end if; + + -- Check L and R are both of the same 'kind'. + -- Also the return profile for functions. + if L_Kind = Iir_Kind_Function_Declaration + and then R_Kind = Iir_Kind_Function_Declaration + then + if Get_Base_Type (Get_Return_Type (L1)) /= + Get_Base_Type (Get_Return_Type (R1)) + then + return False; + end if; + elsif L_Kind = Iir_Kind_Procedure_Declaration + and then R_Kind = Iir_Kind_Procedure_Declaration + then + null; + elsif L_Kind = Iir_Kind_Enumeration_Literal + and then R_Kind = Iir_Kind_Enumeration_Literal + then + return Get_Type (L1) = Get_Type (R1); + elsif L_Kind = Iir_Kind_Enumeration_Literal + and then R_Kind = Iir_Kind_Function_Declaration + then + return Get_Interface_Declaration_Chain (R1) = Null_Iir + and then Get_Base_Type (Get_Return_Type (R1)) = Get_Type (L1); + elsif L_Kind = Iir_Kind_Function_Declaration + and then R_Kind = Iir_Kind_Enumeration_Literal + then + return Get_Interface_Declaration_Chain (L1) = Null_Iir + and then Get_Base_Type (Get_Return_Type (L1)) = Get_Type (R1); + else + -- Kind mismatch. + return False; + end if; + + -- Check parameters profile. + El_L := Get_Interface_Declaration_Chain (L1); + El_R := Get_Interface_Declaration_Chain (R1); + loop + exit when El_L = Null_Iir and El_R = Null_Iir; + if El_L = Null_Iir or El_R = Null_Iir then + return False; + end if; + if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R)) + then + return False; + end if; + El_L := Get_Chain (El_L); + El_R := Get_Chain (El_R); + end loop; + + return True; + end Is_Same_Profile; + + function Is_Operation_For_Type (Subprg : Iir; Atype : Iir) return Boolean + is + pragma Assert (Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration); + Base_Type : constant Iir := Get_Base_Type (Atype); + Inter : Iir; + begin + Inter := Get_Interface_Declaration_Chain (Subprg); + while Inter /= Null_Iir loop + if Get_Base_Type (Get_Type (Inter)) = Base_Type then + return True; + end if; + Inter := Get_Chain (Inter); + end loop; + if Get_Kind (Subprg) = Iir_Kind_Function_Declaration + and then Get_Base_Type (Get_Return_Type (Subprg)) = Base_Type + then + return True; + end if; + return False; + end Is_Operation_For_Type; + + -- From a block_specification, returns the block. + function Get_Block_From_Block_Specification (Block_Spec : Iir) + return Iir + is + Res : Iir; + begin + case Get_Kind (Block_Spec) is + when Iir_Kind_Design_Unit => + Res := Get_Library_Unit (Block_Spec); + if Get_Kind (Res) /= Iir_Kind_Architecture_Body then + raise Internal_Error; + end if; + return Res; + when Iir_Kind_Block_Statement + | Iir_Kind_Architecture_Body + | Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement => + return Block_Spec; + when Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Slice_Name => + return Get_Named_Entity (Get_Prefix (Block_Spec)); + when Iir_Kind_Simple_Name => + return Get_Named_Entity (Block_Spec); + when Iir_Kind_Parenthesis_Name => + -- An alternative label. + return Get_Named_Entity (Block_Spec); + when others => + Error_Kind ("get_block_from_block_specification", Block_Spec); + return Null_Iir; + end case; + end Get_Block_From_Block_Specification; + + function Get_Entity (Decl : Iir) return Iir + is + Name : constant Iir := Get_Entity_Name (Decl); + Res : constant Iir := Get_Named_Entity (Name); + begin + if Res = Vhdl.Std_Package.Error_Mark then + return Null_Iir; + end if; + + pragma Assert (Res = Null_Iir + or else Get_Kind (Res) = Iir_Kind_Entity_Declaration); + return Res; + end Get_Entity; + + function Get_Configuration (Aspect : Iir) return Iir + is + Name : constant Iir := Get_Configuration_Name (Aspect); + Res : constant Iir := Get_Named_Entity (Name); + begin + pragma Assert (Get_Kind (Res) = Iir_Kind_Configuration_Declaration); + return Res; + end Get_Configuration; + + function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id + is + Name : constant Iir := Get_Entity_Name (Arch); + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + return Get_Identifier (Name); + when others => + Error_Kind ("get_entity_identifier_of_architecture", Name); + end case; + end Get_Entity_Identifier_Of_Architecture; + + function Is_Component_Instantiation + (Inst : Iir_Component_Instantiation_Statement) + return Boolean is + begin + case Get_Kind (Get_Instantiated_Unit (Inst)) is + when Iir_Kinds_Denoting_Name => + return True; + when Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Entity_Aspect_Configuration => + return False; + when others => + Error_Kind ("is_component_instantiation", Inst); + end case; + end Is_Component_Instantiation; + + function Is_Entity_Instantiation + (Inst : Iir_Component_Instantiation_Statement) + return Boolean is + begin + case Get_Kind (Get_Instantiated_Unit (Inst)) is + when Iir_Kinds_Denoting_Name => + return False; + when Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Entity_Aspect_Configuration => + return True; + when others => + Error_Kind ("is_entity_instantiation", Inst); + end case; + end Is_Entity_Instantiation; + + function Get_Attribute_Name_Expression (Name : Iir) return Iir + is + Attr_Val : constant Iir := Get_Named_Entity (Name); + Attr_Spec : constant Iir := Get_Attribute_Specification (Attr_Val); + Attr_Expr : constant Iir := Get_Expression (Attr_Spec); + begin + return Attr_Expr; + end Get_Attribute_Name_Expression; + + function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is + begin + if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then + Error_Kind ("get_string_type_bound_type", Sub_Type); + end if; + return Get_Nth_Element (Get_Index_Subtype_List (Sub_Type), 0); + end Get_String_Type_Bound_Type; + + procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; + Low, High : out Iir) + is + begin + case Get_Direction (Arange) is + when Iir_To => + Low := Get_Left_Limit (Arange); + High := Get_Right_Limit (Arange); + when Iir_Downto => + High := Get_Left_Limit (Arange); + Low := Get_Right_Limit (Arange); + end case; + end Get_Low_High_Limit; + + function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is + begin + case Get_Direction (Arange) is + when Iir_To => + return Get_Left_Limit (Arange); + when Iir_Downto => + return Get_Right_Limit (Arange); + end case; + end Get_Low_Limit; + + function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is + begin + case Get_Direction (Arange) is + when Iir_To => + return Get_Right_Limit (Arange); + when Iir_Downto => + return Get_Left_Limit (Arange); + end case; + end Get_High_Limit; + + function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean + is + Base_Type : constant Iir := Get_Base_Type (A_Type); + begin + if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition + and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1 + then + return True; + else + return False; + end if; + end Is_One_Dimensional_Array_Type; + + function Is_Range_Attribute_Name (Expr : Iir) return Boolean + is + Attr : Iir; + Id : Name_Id; + begin + if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then + Attr := Get_Prefix (Expr); + else + Attr := Expr; + end if; + if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then + return False; + end if; + Id := Get_Identifier (Attr); + return Id = Name_Range or Id = Name_Reverse_Range; + end Is_Range_Attribute_Name; + + function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) + return Iir_Array_Subtype_Definition + is + Base_Type : constant Iir := Get_Base_Type (Arr_Type); + El_Type : constant Iir := Get_Element_Subtype (Base_Type); + Res : Iir_Array_Subtype_Definition; + List : Iir_Flist; + begin + Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Set_Location (Res, Loc); + Set_Base_Type (Res, Base_Type); + Set_Element_Subtype (Res, El_Type); + if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then + Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type)); + end if; + Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); + Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); + Set_Type_Staticness (Res, Get_Type_Staticness (El_Type)); + List := Create_Iir_Flist (Get_Nbr_Dimensions (Base_Type)); + Set_Index_Subtype_List (Res, List); + Set_Index_Constraint_List (Res, List); + return Res; + end Create_Array_Subtype; + + function Is_Subprogram_Method (Spec : Iir) return Boolean is + begin + case Get_Kind (Get_Parent (Spec)) is + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Protected_Type_Body => + return True; + when others => + return False; + end case; + end Is_Subprogram_Method; + + function Get_Method_Type (Spec : Iir) return Iir + is + Parent : Iir; + begin + Parent := Get_Parent (Spec); + case Get_Kind (Parent) is + when Iir_Kind_Protected_Type_Declaration => + return Parent; + when Iir_Kind_Protected_Type_Body => + return Get_Protected_Type_Declaration (Parent); + when others => + return Null_Iir; + end case; + end Get_Method_Type; + + function Get_Actual_Or_Default (Assoc : Iir; Inter : Iir) return Iir is + begin + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + return Get_Actual (Assoc); + when Iir_Kind_Association_Element_Open => + return Get_Default_Value (Inter); + when others => + Error_Kind ("get_actual_or_default", Assoc); + end case; + end Get_Actual_Or_Default; + + function Create_Error (Orig : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Error); + if Orig /= Null_Iir then + Set_Error_Origin (Res, Orig); + Location_Copy (Res, Orig); + end if; + return Res; + end Create_Error; + + function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Error (Orig); + Set_Expr_Staticness (Res, None); + Set_Type (Res, Atype); + return Res; + end Create_Error_Expr; + + function Create_Error_Type (Orig : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Error (Orig); + --Set_Expr_Staticness (Res, Locally); + Set_Base_Type (Res, Res); + Set_Type_Declarator (Res, Null_Iir); + Set_Resolved_Flag (Res, True); + Set_Signal_Type_Flag (Res, True); + return Res; + end Create_Error_Type; + + function Create_Error_Name (Orig : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Error); + Set_Expr_Staticness (Res, None); + Set_Error_Origin (Res, Orig); + Location_Copy (Res, Orig); + return Res; + end Create_Error_Name; + + -- Extract the entity from ASPECT. + -- Note: if ASPECT is a component declaration, returns ASPECT. + function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir + is + Inst : Iir; + begin + case Get_Kind (Aspect) is + when Iir_Kinds_Denoting_Name => + -- A component declaration. + Inst := Get_Named_Entity (Aspect); + pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Declaration); + return Inst; + when Iir_Kind_Component_Declaration => + return Aspect; + when Iir_Kind_Entity_Aspect_Entity => + return Get_Entity (Aspect); + when Iir_Kind_Entity_Aspect_Configuration => + Inst := Get_Configuration (Aspect); + return Get_Entity (Inst); + when Iir_Kind_Entity_Aspect_Open => + return Null_Iir; + when others => + Error_Kind ("get_entity_from_entity_aspect", Aspect); + end case; + end Get_Entity_From_Entity_Aspect; + + function Is_Nested_Package (Pkg : Iir) return Boolean is + begin + return Get_Kind (Get_Parent (Pkg)) /= Iir_Kind_Design_Unit; + end Is_Nested_Package; + + -- LRM08 4.7 Package declarations + -- If the package header is empty, the package declared by a package + -- declaration is called a simple package. + function Is_Simple_Package (Pkg : Iir) return Boolean is + begin + return Get_Package_Header (Pkg) = Null_Iir; + end Is_Simple_Package; + + -- LRM08 4.7 Package declarations + -- If the package header contains a generic clause and no generic map + -- aspect, the package is called an uninstantiated package. + function Is_Uninstantiated_Package (Pkg : Iir) return Boolean + is + Header : constant Iir := Get_Package_Header (Pkg); + begin + return Header /= Null_Iir + and then Get_Generic_Map_Aspect_Chain (Header) = Null_Iir; + end Is_Uninstantiated_Package; + + -- LRM08 4.7 Package declarations + -- If the package header contains both a generic clause and a generic + -- map aspect, the package is declared a generic-mapped package. + function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean + is + Header : constant Iir := Get_Package_Header (Pkg); + begin + return Header /= Null_Iir + and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir; + end Is_Generic_Mapped_Package; + + function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean + is + K : constant Iir_Kind := Get_Kind (N); + begin + return K = K1 or K = K2; + end Kind_In; + + function Get_HDL_Node (N : PSL_Node) return Iir is + begin + return Iir (PSL.Nodes.Get_HDL_Node (N)); + end Get_HDL_Node; + + procedure Set_HDL_Node (N : PSL_Node; Expr : Iir) is + begin + PSL.Nodes.Set_HDL_Node (N, PSL.Nodes.HDL_Node (Expr)); + end Set_HDL_Node; +end Vhdl.Utils; diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads new file mode 100644 index 000000000..478b54c62 --- /dev/null +++ b/src/vhdl/vhdl-utils.ads @@ -0,0 +1,375 @@ +-- Common operations on nodes. +-- 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 Vhdl.Nodes; use Vhdl.Nodes; + +package Vhdl.Utils is + -- Transform the current token into an iir literal. + -- The current token must be either a character, a string or an identifier. + function Current_Text return Iir; + + -- Get identifier of NODE as a string. + function Image_Identifier (Node : Iir) return String; + function Image_String_Lit (Str : Iir) return String; + + -- Return True iff N is an error node. + function Is_Error (N : Iir) return Boolean; + pragma Inline (Is_Error); + + -- Return True iff N is an overflow_literal node. + function Is_Overflow_Literal (N : Iir) return Boolean; + pragma Inline (Is_Overflow_Literal); + + -- Find LIT in the list of identifiers or characters LIST. + -- Return the literal (whose name is LIT) or null_iir if not found. + function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir; + function Find_Name_In_Flist (List : Iir_Flist; Lit: Name_Id) return Iir; + + -- Return TRUE if EL in an element of chain CHAIN. + function Is_In_Chain (Chain : Iir; El : Iir) return Boolean; + + -- Convert a list L to an Flist, and free L. + function List_To_Flist (L : Iir_List) return Iir_Flist; + + -- Return a copy of the LEN first elements of L. L is destroyed. + function Truncate_Flist (L : Iir_Flist; Len : Natural) return Iir_Flist; + + -- Convert an operator node to a name. + function Get_Operator_Name (Op : Iir) return Name_Id; + + -- Get the longuest static prefix of EXPR. + -- See LRM §8.1 + function Get_Longuest_Static_Prefix (Expr: Iir) return Iir; + + -- Get the prefix of NAME, ie the declaration at the base of NAME. + -- Return NAME itself if NAME is not an object or a subelement of + -- an object. If WITH_ALIAS is true, continue with the alias name when an + -- alias is found, else return the alias. + -- FIXME: clarify when NAME is returned. + function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) + return Iir; + + + -- Return TRUE if NAME is a name that designate an object (ie a constant, + -- a variable, a signal or a file). + function Is_Object_Name (Name : Iir) return Boolean; + + -- Return an object node if NAME designates an object (ie either is an + -- object or a name for an object). + -- Otherwise, returns NULL_IIR. + -- For the definition of an object, see LRM08 6.4 Objects. + function Name_To_Object (Name : Iir) return Iir; + + -- Return the value designated by NAME. This is often an object, but can + -- also be an expression like a function call or an attribute. + function Name_To_Value (Name : Iir) return Iir; + + -- Return TRUE if EXPR is a signal name. + function Is_Signal_Name (Expr : Iir) return Boolean; + + -- Get the interface corresponding to the formal name FORMAL. This is + -- always an interface, even if the formal is a name. + function Get_Interface_Of_Formal (Formal : Iir) return Iir; + + -- Get the corresponding interface of an association while walking on + -- associations. ASSOC and INTER are the current association and + -- interface (initialized to the association chain and interface chain). + -- The function Get_Association_Interface return the interface associated + -- to ASSOC,and Next_Association_Interface updates ASSOC and INTER. + function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir; + procedure Next_Association_Interface + (Assoc : in out Iir; Inter : in out Iir); + + -- Return the formal of ASSOC as a named entity (either an interface + -- declaration or indexed/sliced/selected name of it). If there is no + -- formal in ASSOC, return the corresponding interface INTER. + function Get_Association_Formal (Assoc : Iir; Inter : Iir) return Iir; + + -- Return the first association in ASSOC_CHAIN for interface INTER. This + -- is the first in case of individual association. + -- Return NULL_IIR if not found (not present). + function Find_First_Association_For_Interface + (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir; + + -- Return True iff interface INTER is a (subprogram) parameter. + function Is_Parameter (Inter : Iir) return Boolean; + + -- Duplicate enumeration literal LIT. + function Copy_Enumeration_Literal (Lit : Iir) return Iir; + + -- True if EXPR can be built statically. This is the case of literals + -- (except overflow), and the case of some aggregates. + -- This is different from locally static expression, particularly for + -- agregate: the analyzer may choose to dynamically create a locally + -- static aggregate if it is sparse. + function Is_Static_Construct (Expr : Iir) return Boolean; + + -- Make TARGETS depends on UNIT. + -- UNIT must be either a design unit or a entity_aspect_entity. + procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); + + -- Get the design_unit from dependency DEP. DEP must be an element of + -- a dependencies list. + function Get_Unit_From_Dependence (Dep : Iir) return Iir; + + -- Clear configuration field of all component instantiation of + -- the concurrent statements of PARENT. + procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean); + + -- Free Node and its prefixes, if any. + procedure Free_Name (Node : Iir); + + -- Free NODE and its sub-nodes. + procedure Free_Recursive (Node : Iir; Free_List : Boolean := False); + + -- Free nodes in LIST. + procedure Free_Recursive_List (List : Iir_List); + + -- Name of FUNC. + function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) + return String; + + -- Create the range_constraint node for an enumeration type. + procedure Create_Range_Constraint_For_Enumeration_Type + (Def : Iir_Enumeration_Type_Definition); + + -- Return the node containing the Callees_List (ie the subprogram body if + -- SUBPRG is a subprogram spec, SUBPRG if SUBPRG is a process). + function Get_Callees_List_Holder (Subprg : Iir) return Iir; + + -- Clear flag of TOP and all of its callees. + procedure Clear_Seen_Flag (Top : Iir); + + -- Return TRUE iff DEF is an anonymous type (or subtype) definition. + -- Note: DEF is required to be a type (or subtype) definition. + -- Note: type (and not subtype) are never anonymous. + function Is_Anonymous_Type_Definition (Def : Iir) return Boolean; + pragma Inline (Is_Anonymous_Type_Definition); + + -- Return TRUE iff DEF is a fully constrained type (or subtype) definition. + function Is_Fully_Constrained_Type (Def : Iir) return Boolean; + + -- Return the type definition/subtype indication of NAME if NAME denotes + -- a type or subtype name. Otherwise, return Null_Iir; + function Is_Type_Name (Name : Iir) return Iir; + + -- Return TRUE iff SPEC is the subprogram specification of a subprogram + -- body which was previously declared. In that case, the only use of SPEC + -- is to match the body with its declaration. + function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean; + + -- Return True iif SPEC is the specification of an implicit subprogram. + -- False for explicit subprograms. + function Is_Implicit_Subprogram (Spec : Iir) return Boolean; + pragma Inline (Is_Implicit_Subprogram); + + -- Return True if N is a function_declaration or an + -- interface_function_declaration. + function Is_Function_Declaration (N : Iir) return Boolean; + pragma Inline (Is_Function_Declaration); + + -- Return True if N is a procedure_declaration or an + -- interface_procedure_declaration. + function Is_Procedure_Declaration (N : Iir) return Boolean; + pragma Inline (Is_Procedure_Declaration); + + -- If NAME is a simple or an expanded name, return the denoted declaration. + -- Otherwise, return NAME. + function Strip_Denoting_Name (Name : Iir) return Iir; + + -- Build a simple name node whose named entity is REF and location LOC. + function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir; + function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir; + + -- Create a name that referenced the same named entity as NAME. + -- + -- This is mainly used by canon, when there is a need to reference an + -- existing name. In some cases, it is not possible to use the name, + -- because it is already owned. + function Build_Reference_Name (Name : Iir) return Iir; + + -- If N is a reference_name, return the corresponding node, otherwise + -- return N. + function Strip_Reference_Name (N : Iir) return Iir; + + -- If SUBTYP has a resolution indication that is a function name, returns + -- the function declaration (not the name). + function Has_Resolution_Function (Subtyp : Iir) return Iir; + + -- Get the type of any node representing a subtype indication. This simply + -- skip over denoting names. + function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir; + + -- Get the type of an index_subtype_definition or of a discrete_range from + -- an index_constraint. + function Get_Index_Type (Index_Type : Iir) return Iir + renames Get_Type_Of_Subtype_Indication; + + -- Return the IDX-th index type for index subtype definition list or + -- index_constraint INDEXES. Return Null_Iir if IDX is out of dimension + -- bounds, so that this function can be used to iterator over indexes of + -- a type (or subtype). Note that IDX starts at 0. + function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir; + + -- Likewise but for array type or subtype ARRAY_TYPE. + function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir; + + -- Number of dimensions (1..n) for ARRAY_TYPE. + function Get_Nbr_Dimensions (Array_Type : Iir) return Natural; + + -- Return True iff the all indexes of ARRAY_TYPE are locally static. + function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean; + + -- Return true if array/record bounds are locally static. Only fully + -- constrained records or arrays are allowed. + -- It is possible to have non-locally static types with locally bounds (eg: + -- a constrained array of type). + function Are_Bounds_Locally_Static (Def : Iir) return Boolean; + + -- Return the type or subtype definition of the SUBTYP type mark. + function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir; + + -- From element declaration or element constraint EL, get the corresponding + -- element declaration in the base record type. + function Get_Base_Element_Declaration (El : Iir) return Iir; + + -- Append EL to the chain of owned elements of REC_TYPE. Used only when + -- a record_element_constraint is built. + procedure Append_Owned_Element_Constraint (Rec_Type : Iir; El : Iir); + + -- Return true iff L and R have the same profile. + -- L and R must be subprograms specification (or spec_body). + function Is_Same_Profile (L, R: Iir) return Boolean; + + -- Return true iff FUNC is an operation for ATYPE. + -- + -- LRM08 5.1 Types + -- The set of operations of a type includes the explicitely declared + -- subprograms that have a parameter or result of the type. The remaining + -- operations of a type are the base operations and the predefined + -- operations. + function Is_Operation_For_Type (Subprg : Iir; Atype : Iir) return Boolean; + + -- From a block_specification, returns the block. + -- Roughly speaking, this get prefix of indexed and sliced name. + function Get_Block_From_Block_Specification (Block_Spec : Iir) + return Iir; + + -- Wrapper around Get_Entity_Name: return the entity declaration of the + -- entity name of DECL, or Null_Iir in case of error. + function Get_Entity (Decl : Iir) return Iir; + + -- Wrapper around get_Configuration_Name: return the configuration + -- declaration of ASPECT. + function Get_Configuration (Aspect : Iir) return Iir; + + -- Return the identifier of the entity for architecture ARCH. + function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id; + + -- Return True is component instantiation statement INST instantiate a + -- component. + function Is_Component_Instantiation + (Inst : Iir_Component_Instantiation_Statement) + return Boolean; + + -- Return True is component instantiation statement INST instantiate a + -- design entity. + function Is_Entity_Instantiation + (Inst : Iir_Component_Instantiation_Statement) + return Boolean; + + -- Get the expression of the attribute specification corresponding to the + -- attribute name NAME. Meaningful only for static values. + function Get_Attribute_Name_Expression (Name : Iir) return Iir; + + -- Return the bound type of a string type, ie the type of the (first) + -- dimension of a one-dimensional array type. + function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir; + + -- Return left or right limit according to the direction. + procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; + Low, High : out Iir); + function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir; + function Get_High_Limit (Arange : Iir_Range_Expression) return Iir; + + -- Return TRUE iff type/subtype definition A_TYPE is an undim array. + function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean; + + -- Return TRUE iff unanalyzed EXPR is a range attribute. + function Is_Range_Attribute_Name (Expr : Iir) return Boolean; + + -- Create an array subtype from array_type or array_subtype ARR_TYPE. + -- All fields of the returned node are filled, except the index_list. + -- The type_staticness is set with the type staticness of the element + -- subtype and therefore must be updated. + -- The type_declarator field is set to null_iir. + function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) + return Iir_Array_Subtype_Definition; + + -- Return TRUE iff SPEC is declared inside a protected type or a protected + -- body. + function Is_Subprogram_Method (Spec : Iir) return Boolean; + + -- Return the protected type for method SPEC. + function Get_Method_Type (Spec : Iir) return Iir; + + -- For Association_Element_By_Expression: return the actual. + -- For Association_Element_Open: return the default value of the + -- interface INTER. + function Get_Actual_Or_Default (Assoc : Iir; Inter : Iir) return Iir; + + -- Create an error node for node ORIG. + function Create_Error (Orig : Iir) return Iir; + + -- Create an error node for node ORIG, and set its type to ATYPE. + -- Set its staticness to locally. + function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir; + + -- Create an error node for node ORIG, which is supposed to be a type. + function Create_Error_Type (Orig : Iir) return Iir; + + -- Create an error node for a name. + function Create_Error_Name (Orig : Iir) return Iir; + + -- Extract the entity from ASPECT. + -- Note: if ASPECT is a component declaration, returns ASPECT. + -- if ASPECT is open, return Null_Iir; + function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir; + + -- Definition from LRM08 4.8 Package bodies + -- True if PKG (a package declaration or a package body) is not a library + -- unit. Can be true only for vhdl08. + function Is_Nested_Package (Pkg : Iir) return Boolean; + + -- Definitions from LRM08 4.7 Package declarations. + -- PKG must denote a package declaration. + function Is_Simple_Package (Pkg : Iir) return Boolean; + function Is_Uninstantiated_Package (Pkg : Iir) return Boolean; + function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean; + + -- Return TRUE if the base name of NAME is a signal object. + function Is_Signal_Object (Name: Iir) return Boolean; + + -- Return True IFF kind of N is K1 or K2. + function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean; + pragma Inline (Kind_In); + + -- IIR wrapper around Get_HDL_Node/Set_HDL_Node. + function Get_HDL_Node (N : PSL_Node) return Iir; + procedure Set_HDL_Node (N : PSL_Node; Expr : Iir); +end Vhdl.Utils; -- cgit v1.2.3