From c8ec958606e57b5149eada285bfa0b00bf68098a Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 5 May 2019 07:31:00 +0200 Subject: vhdl: move configuration package as a vhdl child. --- src/vhdl/configuration.adb | 974 ------------------------------------ src/vhdl/configuration.ads | 63 --- src/vhdl/translate/ortho_front.adb | 10 +- src/vhdl/translate/trans-chap12.adb | 6 +- src/vhdl/translate/trans-rtis.adb | 4 +- src/vhdl/vhdl-configuration.adb | 974 ++++++++++++++++++++++++++++++++++++ src/vhdl/vhdl-configuration.ads | 63 +++ 7 files changed, 1047 insertions(+), 1047 deletions(-) delete mode 100644 src/vhdl/configuration.adb delete mode 100644 src/vhdl/configuration.ads create mode 100644 src/vhdl/vhdl-configuration.adb create mode 100644 src/vhdl/vhdl-configuration.ads (limited to 'src/vhdl') diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb deleted file mode 100644 index d047da43d..000000000 --- a/src/vhdl/configuration.adb +++ /dev/null @@ -1,974 +0,0 @@ --- Configuration generation. --- 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 Libraries; -with Errorout; use Errorout; -with Std_Package; -with Name_Table; use Name_Table; -with Flags; -with Iirs_Utils; use Iirs_Utils; -with Iirs_Walk; -with Vhdl.Sem_Scopes; -with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; -with Vhdl.Canon; - -package body Configuration is - procedure Add_Design_Concurrent_Stmts (Parent : Iir); - procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration); - procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean); - - Current_File_Dependence : Iir_List := Null_Iir_List; - Current_Configuration : Iir_Configuration_Declaration := Null_Iir; - - -- UNIT is a design unit of a configuration declaration. - -- Fill the DESIGN_UNITS table with all design units required to build - -- UNIT. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir) - is - List : Iir_List; - It : List_Iterator; - El : Iir; - Lib_Unit : Iir; - File : Iir_Design_File; - Prev_File_Dependence : Iir_List; - begin - if Flag_Build_File_Dependence then - -- The current file depends on unit. - File := Get_Design_File (Unit); - if Current_File_Dependence /= Null_Iir_List then - -- (There is no dependency for default configuration). - Add_Element (Current_File_Dependence, File); - end if; - end if; - - -- If already in the table, then nothing to do. - if Get_Configuration_Mark_Flag (Unit) then - -- There might be some direct recursions: - -- * the default configuration might be implicitly referenced by - -- a direct entity instantiation - -- * a configuration may be referenced by itself for a recursive - -- instantiation - pragma Assert (Get_Configuration_Done_Flag (Unit) - or else (Get_Kind (Get_Library_Unit (Unit)) - = Iir_Kind_Configuration_Declaration)); - return; - end if; - Set_Configuration_Mark_Flag (Unit, True); - - -- May be enabled to debug dependency construction. - if False then - if From = Null_Iir then - Report_Msg (Msgid_Note, Elaboration, +Unit, - "%n added", (1 => +Unit)); - else - Report_Msg (Msgid_Note, Elaboration, +From, - "%n added by %n", (+Unit, +From)); - end if; - end if; - - Lib_Unit := Get_Library_Unit (Unit); - - if Flag_Build_File_Dependence then - -- Switch current_file_dependence to the design file of Unit. - Prev_File_Dependence := Current_File_Dependence; - - if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration - and then Get_Identifier (Lib_Unit) = Null_Identifier - then - -- Do not add dependence for default configuration. - Current_File_Dependence := Null_Iir_List; - else - File := Get_Design_File (Unit); - Current_File_Dependence := Get_File_Dependence_List (File); - -- Create a list if not yet created. - if Current_File_Dependence = Null_Iir_List then - Current_File_Dependence := Create_Iir_List; - Set_File_Dependence_List (File, Current_File_Dependence); - end if; - end if; - end if; - - if Flag_Load_All_Design_Units then - Load_Design_Unit (Unit, From); - end if; - - -- Add packages from depend list. - -- If Flag_Build_File_Dependences is set, add design units of the - -- dependence list are added, because of LRM 11.4 Analysis Order. - -- Note: a design unit may be referenced but unused. - -- (eg: component specification which does not apply). - List := Get_Dependence_List (Unit); - It := List_Iterate (List); - while Is_Valid (It) loop - El := Get_Element (It); - El := Libraries.Find_Design_Unit (El); - if El /= Null_Iir then - Lib_Unit := Get_Library_Unit (El); - if Flag_Build_File_Dependence then - Add_Design_Unit (El, Unit); - else - case Get_Kind (Lib_Unit) is - when Iir_Kinds_Package_Declaration - | Iir_Kind_Context_Declaration => - Add_Design_Unit (El, Unit); - when others => - null; - end case; - end if; - end if; - Next (It); - end loop; - - -- Lib_Unit may have changed. - Lib_Unit := Get_Library_Unit (Unit); - - case Get_Kind (Lib_Unit) is - when Iir_Kind_Package_Declaration => - -- Analyze the package declaration, so that Set_Package below - -- will set the full package (and not a stub). - Load_Design_Unit (Unit, From); - Lib_Unit := Get_Library_Unit (Unit); - when Iir_Kind_Package_Instantiation_Declaration => - -- The uninstantiated package is part of the dependency. - null; - when Iir_Kind_Configuration_Declaration => - -- Add entity and architecture. - -- find all sub-configuration - Load_Design_Unit (Unit, From); - Lib_Unit := Get_Library_Unit (Unit); - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); - declare - Blk : Iir_Block_Configuration; - Prev_Configuration : Iir_Configuration_Declaration; - Arch : Iir; - begin - Prev_Configuration := Current_Configuration; - Current_Configuration := Lib_Unit; - Blk := Get_Block_Configuration (Lib_Unit); - Add_Design_Block_Configuration (Blk); - Current_Configuration := Prev_Configuration; - Arch := Strip_Denoting_Name (Get_Block_Specification (Blk)); - Add_Design_Unit (Get_Design_Unit (Arch), Unit); - end; - when Iir_Kind_Architecture_Body => - -- Add entity - -- find all entity/architecture/configuration instantiation - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); - Add_Design_Concurrent_Stmts (Lib_Unit); - when Iir_Kind_Entity_Declaration => - null; - when Iir_Kind_Package_Body => - null; - when Iir_Kind_Context_Declaration => - null; - when others => - Error_Kind ("add_design_unit", Lib_Unit); - end case; - - -- Add it in the table, after the dependencies. - Design_Units.Append (Unit); - - Set_Configuration_Done_Flag (Unit, True); - - -- Restore now the file dependence. - -- Indeed, we may add a package body when we are in a package - -- declaration. However, the later does not depend on the former. - -- The file which depends on the package declaration also depends on - -- the package body. - if Flag_Build_File_Dependence then - Current_File_Dependence := Prev_File_Dependence; - end if; - - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then - -- Add body (if any). - declare - Bod : Iir_Design_Unit; - begin - Bod := Libraries.Find_Secondary_Unit (Unit, Null_Identifier); - if Get_Need_Body (Lib_Unit) then - if not Flags.Flag_Elaborate_With_Outdated then - -- LIB_UNIT requires a body. - if Bod = Null_Iir then - Error_Msg_Elab - (Lib_Unit, "body of %n was never analyzed", +Lib_Unit); - elsif Get_Date (Bod) < Get_Date (Unit) then - Error_Msg_Elab (Bod, "%n is outdated", +Bod); - Bod := Null_Iir; - end if; - end if; - else - if Bod /= Null_Iir - and then Get_Date (Bod) < Get_Date (Unit) - then - -- There is a body for LIB_UNIT (which doesn't - -- require it) but it is outdated. - Bod := Null_Iir; - end if; - end if; - if Bod /= Null_Iir then - Set_Package (Get_Library_Unit (Bod), Lib_Unit); - Add_Design_Unit (Bod, Unit); - end if; - end; - end if; - end Add_Design_Unit; - - procedure Add_Design_Concurrent_Stmts (Parent : Iir) - is - Stmt : Iir; - begin - Stmt := Get_Concurrent_Statement_Chain (Parent); - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_Component_Instantiation_Statement => - if Is_Entity_Instantiation (Stmt) then - -- Entity or configuration instantiation. - Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True); - end if; - when Iir_Kind_Block_Statement => - Add_Design_Concurrent_Stmts (Stmt); - when Iir_Kind_For_Generate_Statement => - Add_Design_Concurrent_Stmts - (Get_Generate_Statement_Body (Stmt)); - when Iir_Kind_If_Generate_Statement => - declare - Clause : Iir; - begin - Clause := Stmt; - while Clause /= Null_Iir loop - Add_Design_Concurrent_Stmts - (Get_Generate_Statement_Body (Clause)); - Clause := Get_Generate_Else_Clause (Clause); - end loop; - end; - when Iir_Kind_Case_Generate_Statement => - declare - Alt : Iir; - begin - Alt := Get_Case_Statement_Alternative_Chain (Stmt); - while Alt /= Null_Iir loop - if not Get_Same_Alternative_Flag (Alt) then - Add_Design_Concurrent_Stmts - (Get_Associated_Block (Alt)); - end if; - Alt := Get_Chain (Alt); - end loop; - end; - when Iir_Kinds_Simple_Concurrent_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Endpoint_Declaration - | Iir_Kind_Simple_Simultaneous_Statement => - null; - when others => - Error_Kind ("add_design_concurrent_stmts(2)", Stmt); - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Add_Design_Concurrent_Stmts; - - procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean) - is - use Libraries; - - Entity : Iir; - Arch_Name : Iir; - Arch : Iir; - Config : Iir; - Arch_Lib : Iir; - Id : Name_Id; - Entity_Lib : Iir; - begin - if Aspect = Null_Iir then - return; - end if; - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - -- Add the entity. - Entity_Lib := Get_Entity (Aspect); - if Entity_Lib = Null_Iir then - -- In case of error (using -c). - return; - end if; - Entity := Get_Design_Unit (Entity_Lib); - Add_Design_Unit (Entity, Aspect); - - -- Extract and add the architecture. - Arch_Name := Get_Architecture (Aspect); - if Arch_Name /= Null_Iir then - case Get_Kind (Arch_Name) is - when Iir_Kind_Simple_Name => - Id := Get_Identifier (Arch_Name); - Arch := Load_Secondary_Unit (Entity, Id, Aspect); - if Arch = Null_Iir then - Error_Msg_Elab ("cannot find architecture %i of %n", - (+Id, +Entity_Lib)); - return; - else - Set_Named_Entity (Arch_Name, Get_Library_Unit (Arch)); - end if; - when Iir_Kind_Reference_Name => - Arch := Get_Design_Unit (Get_Named_Entity (Arch_Name)); - when others => - Error_Kind ("add_design_aspect", Arch_Name); - end case; - else - Arch := Get_Latest_Architecture (Entity_Lib); - if Arch = Null_Iir then - Error_Msg_Elab (Aspect, "no architecture in library for %n", - +Entity_Lib); - return; - end if; - Arch := Get_Design_Unit (Arch); - end if; - Load_Design_Unit (Arch, Aspect); - - -- Add the default configuration if required. Must be done - -- before the architecture in case of recursive instantiation: - -- the configuration depends on the architecture. - if Add_Default then - Arch_Lib := Get_Library_Unit (Arch); - - -- The default configuration may already exist due to a - -- previous instantiation. Create it if it doesn't exist. - Config := Get_Default_Configuration_Declaration (Arch_Lib); - if Is_Null (Config) then - Config := Vhdl.Canon.Create_Default_Configuration_Declaration - (Arch_Lib); - Set_Default_Configuration_Declaration (Arch_Lib, Config); - end if; - - if Get_Configuration_Mark_Flag (Config) - and then not Get_Configuration_Done_Flag (Config) - then - -- Recursive instantiation. - return; - else - Add_Design_Unit (Config, Aspect); - end if; - end if; - - -- Otherwise, simply the architecture. - Add_Design_Unit (Arch, Aspect); - - when Iir_Kind_Entity_Aspect_Configuration => - Add_Design_Unit - (Get_Design_Unit (Get_Configuration (Aspect)), Aspect); - when Iir_Kind_Entity_Aspect_Open => - null; - when others => - Error_Kind ("add_design_aspect", Aspect); - end case; - end Add_Design_Aspect; - - -- Return TRUE is PORT must not be open, and emit an error message only if - -- LOC is not NULL_IIR. - function Check_Open_Port (Port : Iir; Loc : Iir) return Boolean is - begin - case Get_Mode (Port) is - when Iir_In_Mode => - -- LRM93 1.1.1.2 Ports - -- A port of mode IN may be unconnected or unassociated only if - -- its declaration includes a default expression. - if Get_Default_Value (Port) = Null_Iir then - if Loc /= Null_Iir then - Error_Msg_Elab_Relaxed - (Loc, Warnid_Port, - "IN %n must be connected (or have a default value)", - (1 => +Port)); - end if; - return True; - end if; - when Iir_Out_Mode - | Iir_Inout_Mode - | Iir_Buffer_Mode - | Iir_Linkage_Mode => - -- LRM93 1.1.1.2 Ports - -- A port of any mode other than IN may be unconnected or - -- unassociated as long as its type is not an unconstrained array - -- type. - if Get_Kind (Get_Type (Port)) in Iir_Kinds_Array_Type_Definition - and then (Get_Constraint_State (Get_Type (Port)) - /= Fully_Constrained) - then - if Loc /= Null_Iir then - Error_Msg_Elab - (Loc, "unconstrained %n must be connected", +Port); - end if; - return True; - end if; - when Iir_Unknown_Mode => - raise Internal_Error; - end case; - return False; - end Check_Open_Port; - - procedure Check_Binding_Indication (Conf : Iir) - is - Comp : constant Iir := Get_Named_Entity (Get_Component_Name (Conf)); - Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf); - Aspect : constant Iir := Get_Entity_Aspect (Bind); - Ent : constant Iir := Get_Entity_From_Entity_Aspect (Aspect); - Assoc_Chain : constant Iir := Get_Port_Map_Aspect_Chain (Bind); - Inter_Chain : constant Iir := Get_Port_Chain (Ent); - Assoc : Iir; - Inter : Iir; - Inst_Assoc_Chain : Iir; - Inst_Inter_Chain : Iir; - Err : Boolean; - Inst : Iir; - Inst_List : Iir_Flist; - Formal : Iir; - Assoc_1 : Iir; - Inter_1 : Iir; - Actual : Iir; - begin - Err := False; - -- Note: the assoc chain is already canonicalized. - - -- First pass: check for open associations in configuration. - Assoc := Assoc_Chain; - Inter := Inter_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc, Inter); - Err := Err or Check_Open_Port (Formal, Assoc); - if Is_Warning_Enabled (Warnid_Binding) - and then not Get_Artificial_Flag (Assoc) - then - Warning_Msg_Elab - (Warnid_Binding, Assoc, "%n of %n is not bound", - (+Formal, +Get_Parent (Formal)), Cont => True); - Warning_Msg_Elab - (Warnid_Binding, Current_Configuration, - "(in %n)", +Current_Configuration); - end if; - end if; - Next_Association_Interface (Assoc, Inter); - end loop; - if Err then - return; - end if; - - -- Second pass: check for port connected to open in instantiation. - Inst_List := Get_Instantiation_List (Conf); - for I in Flist_First .. Flist_Last (Inst_List) loop - Inst := Get_Nth_Element (Inst_List, I); - Inst := Get_Named_Entity (Inst); - Err := False; - - -- Mark component ports not associated. - Inst_Assoc_Chain := Get_Port_Map_Aspect_Chain (Inst); - Inst_Inter_Chain := Get_Port_Chain (Comp); - Assoc := Inst_Assoc_Chain; - Inter := Inst_Inter_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc, Inter); - Set_Open_Flag (Formal, True); - Err := True; - end if; - Next_Association_Interface (Assoc, Inter); - end loop; - - -- If there is any component port open, search them in the - -- configuration. - if Err then - Assoc := Assoc_Chain; - Inter := Inter_Chain; - while Assoc /= Null_Iir loop - Formal := Get_Association_Interface (Assoc, Inter); - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Actual := Null_Iir; - else - Actual := Get_Actual (Assoc); - Actual := Name_To_Object (Actual); - if Actual /= Null_Iir then - Actual := Get_Object_Prefix (Actual); - end if; - end if; - if Actual /= Null_Iir - and then Get_Open_Flag (Actual) - and then Check_Open_Port (Formal, Null_Iir) - then - -- For a better message, find the location. - Assoc_1 := Inst_Assoc_Chain; - Inter_1 := Inst_Inter_Chain; - while Assoc_1 /= Null_Iir loop - if Get_Kind (Assoc_1) = Iir_Kind_Association_Element_Open - and then - Actual = Get_Association_Interface (Assoc_1, Inter_1) - then - Err := Check_Open_Port (Formal, Assoc_1); - exit; - end if; - Next_Association_Interface (Assoc_1, Inter_1); - end loop; - end if; - Next_Association_Interface (Assoc, Inter); - end loop; - - -- Clear open flag. - Assoc := Inst_Assoc_Chain; - Inter := Inst_Inter_Chain; - while Assoc /= Null_Iir loop - if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then - Formal := Get_Association_Interface (Assoc, Inter); - Set_Open_Flag (Formal, False); - end if; - Next_Association_Interface (Assoc, Inter); - end loop; - end if; - end loop; - end Check_Binding_Indication; - - -- CONF is either a configuration specification or a component - -- configuration. - -- If ADD_DEFAULT is true, then the default configuration for the design - -- binding must be added if required. - procedure Add_Design_Binding_Indication (Conf : Iir; Add_Default : Boolean) - is - Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf); - Aspect : Iir; - Inst : Iir; - begin - if Bind = Null_Iir then - if Is_Warning_Enabled (Warnid_Binding) then - Inst := Get_Nth_Element (Get_Instantiation_List (Conf), 0); - Inst := Strip_Denoting_Name (Inst); - Warning_Msg_Elab - (Warnid_Binding, Conf, - "%n of %n is not bound", - (+Inst, +Get_Instantiated_Unit (Inst)), Cont => True); - Warning_Msg_Elab - (Warnid_Binding, Current_Configuration, - "(in %n)", +Current_Configuration); - end if; - return; - end if; - Aspect := Get_Entity_Aspect (Bind); - if Is_Valid (Aspect) - and then Get_Kind (Aspect) /= Iir_Kind_Entity_Aspect_Open - then - Check_Binding_Indication (Conf); - Add_Design_Aspect (Aspect, Add_Default); - end if; - end Add_Design_Binding_Indication; - - procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration) - is - Item : Iir; - Sub_Config : Iir; - begin - if Blk = Null_Iir then - return; - end if; - Item := Get_Configuration_Item_Chain (Blk); - while Item /= Null_Iir loop - case Get_Kind (Item) is - when Iir_Kind_Configuration_Specification => - Add_Design_Binding_Indication (Item, True); - when Iir_Kind_Component_Configuration => - Sub_Config := Get_Block_Configuration (Item); - Add_Design_Binding_Indication (Item, Sub_Config = Null_Iir); - Add_Design_Block_Configuration (Sub_Config); - when Iir_Kind_Block_Configuration => - Add_Design_Block_Configuration (Item); - when others => - Error_Kind ("add_design_block_configuration", Item); - end case; - Item := Get_Chain (Item); - end loop; - end Add_Design_Block_Configuration; - - -- elaboration of a design hierarchy: - -- creates a list of design unit. - -- - -- find top configuration (may be a default one), add it to the list. - -- For each element of the list: - -- add direct dependences (packages, entity, arch) if not in the list - -- for architectures and configuration: find instantiations and add - -- corresponding configurations. - -- - -- Return the configuration declaration for the design. - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) - return Iir - is - use Libraries; - - Unit : Iir_Design_Unit; - Lib_Unit : Iir; - Top : Iir; - begin - Unit := Find_Primary_Unit (Work_Library, Primary_Id); - if Unit = Null_Iir then - Error_Msg_Elab ("cannot find entity or configuration " - & Name_Table.Image (Primary_Id)); - return Null_Iir; - end if; - Lib_Unit := Get_Library_Unit (Unit); - case Get_Kind (Lib_Unit) is - when Iir_Kind_Entity_Declaration => - -- Use WORK as location (should use a command line location ?) - Load_Design_Unit (Unit, Work_Library); - Lib_Unit := Get_Library_Unit (Unit); - if Secondary_Id /= Null_Identifier then - Unit := Find_Secondary_Unit (Unit, Secondary_Id); - if Unit = Null_Iir then - Error_Msg_Elab ("cannot find architecture %i of %n", - (+Secondary_Id, +Lib_Unit)); - return Null_Iir; - end if; - else - declare - Arch_Unit : Iir_Architecture_Body; - begin - Arch_Unit := Get_Latest_Architecture (Lib_Unit); - if Arch_Unit = Null_Iir then - Error_Msg_Elab - ("%n has no architecture in library %i", - (+Lib_Unit, +Work_Library)); - return Null_Iir; - end if; - Unit := Get_Design_Unit (Arch_Unit); - end; - end if; - Load_Design_Unit (Unit, Lib_Unit); - if Nbr_Errors /= 0 then - return Null_Iir; - end if; - Lib_Unit := Get_Library_Unit (Unit); - pragma Assert - (Is_Null (Get_Default_Configuration_Declaration (Lib_Unit))); - - Top := Vhdl.Canon.Create_Default_Configuration_Declaration - (Lib_Unit); - Set_Default_Configuration_Declaration (Lib_Unit, Top); - pragma Assert (Is_Valid (Top)); - when Iir_Kind_Configuration_Declaration => - if Secondary_Id /= Null_Identifier then - Error_Msg_Elab - ("no secondary unit allowed after configuration %i", - +Primary_Id); - return Null_Iir; - end if; - Top := Unit; - when others => - Error_Msg_Elab ("%i is neither an entity nor a configuration", - +Primary_Id); - return Null_Iir; - end case; - - -- Exclude std.standard - Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); - Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); - - Add_Design_Unit (Top, Null_Iir); - return Top; - end Configure; - - function Configure (Primary : String; Secondary : String) return Iir - is - Primary_Id : Name_Id; - Secondary_Id : Name_Id; - begin - Primary_Id := Get_Identifier (Primary); - if Secondary /= "" then - Secondary_Id := Get_Identifier (Secondary); - else - Secondary_Id := Null_Identifier; - end if; - return Configure (Primary_Id, Secondary_Id); - end Configure; - - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) - is - Has_Error : Boolean := False; - - -- Return TRUE if GRT supports override of generic GEN. - function Allow_Generic_Override (Gen : Iir) return Boolean - is - Gen_Type : constant Iir := Get_Type (Gen); - begin - case Get_Kind (Gen_Type) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - return True; - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - -- Only one-dimensional arrays of enumeration are allowed. - -- If unconstrained, the index must be of integer type. - if Get_Kind (Get_Base_Type (Get_Element_Subtype (Gen_Type))) - /= Iir_Kind_Enumeration_Type_Definition - then - -- Not an array of enumeration type. - return False; - end if; - declare - Indexes : constant Iir_Flist := - Get_Index_Subtype_List (Gen_Type); - begin - if Get_Nbr_Elements (Indexes) /= 1 then - -- Not a one-dimensional array. - return False; - end if; - if Get_Constraint_State (Gen_Type) /= Fully_Constrained - and then (Get_Kind (Get_Index_Type (Indexes, 0)) - /= Iir_Kind_Integer_Subtype_Definition) - then - -- Index not constrained or not of integer subtype. - return False; - end if; - end; - return True; - when others => - return False; - end case; - end Allow_Generic_Override; - - procedure Error (Loc : Iir; Msg : String; Arg1 : Earg_Type) is - begin - if not Has_Error then - Error_Msg_Elab ("%n cannot be at the top of a design", +Entity); - Has_Error := True; - end if; - Error_Msg_Elab (Loc, Msg, Arg1); - end Error; - - El : Iir; - begin - -- Check generics. - El := Get_Generic_Chain (Entity); - while El /= Null_Iir loop - if Get_Default_Value (El) = Null_Iir then - if not Allow_Generic_Override (El) then - Error (El, "(%n has no default value)", +El); - end if; - end if; - El := Get_Chain (El); - end loop; - - -- Check port. - El := Get_Port_Chain (Entity); - while El /= Null_Iir loop - if not Is_Fully_Constrained_Type (Get_Type (El)) - and then Get_Default_Value (El) = Null_Iir - then - Error (El, "(%n is unconstrained and has no default value)", +El); - end if; - El := Get_Chain (El); - end loop; - end Check_Entity_Declaration_Top; - - package Top is - procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration); - - Nbr_Top_Entities : Natural; - First_Top_Entity : Iir; - - procedure Find_First_Top_Entity (Lib : Iir_Library_Declaration); - end Top; - - package body Top is - use Iirs_Walk; - - function Add_Entity_Cb (Design : Iir) return Walk_Status - is - Kind : constant Iir_Kind := Get_Kind (Get_Library_Unit (Design)); - begin - if Get_Date (Design) < Date_Analyzed then - return Walk_Continue; - end if; - - case Iir_Kinds_Library_Unit (Kind) is - when Iir_Kind_Architecture_Body - | Iir_Kind_Configuration_Declaration => - Load_Design_Unit (Design, Null_Iir); - when Iir_Kind_Entity_Declaration => - Load_Design_Unit (Design, Null_Iir); - Vhdl.Sem_Scopes.Add_Name (Get_Library_Unit (Design)); - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Context_Declaration => - null; - end case; - return Walk_Continue; - end Add_Entity_Cb; - - procedure Mark_Aspect (Aspect : Iir) - is - Unit : Iir; - begin - case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is - when Iir_Kind_Entity_Aspect_Entity => - Unit := Get_Entity (Aspect); - Set_Elab_Flag (Get_Parent (Unit), True); - when Iir_Kind_Entity_Aspect_Configuration - | Iir_Kind_Entity_Aspect_Open => - null; - end case; - end Mark_Aspect; - - function Mark_Instantiation_Cb (Stmt : Iir) return Walk_Status - is - Inst : Iir; - begin - if Get_Kind (Stmt) /= Iir_Kind_Component_Instantiation_Statement then - return Walk_Continue; - end if; - - Inst := Get_Instantiated_Unit (Stmt); - case Get_Kind (Inst) is - when Iir_Kinds_Denoting_Name => - -- TODO: look at default_binding_indication - -- or configuration_specification ? - declare - Config : constant Iir := - Get_Configuration_Specification (Stmt); - begin - if Is_Valid (Config) then - Mark_Aspect - (Get_Entity_Aspect (Get_Binding_Indication (Config))); - return Walk_Continue; - end if; - end; - declare - use Vhdl.Sem_Scopes; - Comp : constant Iir := Get_Named_Entity (Inst); - Interp : constant Name_Interpretation_Type := - Get_Interpretation (Get_Identifier (Comp)); - Decl : Iir; - begin - if Valid_Interpretation (Interp) then - Decl := Get_Declaration (Interp); - pragma Assert - (Get_Kind (Decl) = Iir_Kind_Entity_Declaration); - Set_Elab_Flag (Get_Design_Unit (Decl), True); - else - -- If there is no corresponding entity name for the - -- component name, assume it belongs to a different - -- library (or will be set by a configuration unit). - null; - end if; - end; - when Iir_Kinds_Entity_Aspect => - Mark_Aspect (Inst); - when others => - Error_Kind ("mark_instantiation_cb", Stmt); - end case; - - return Walk_Continue; - end Mark_Instantiation_Cb; - - function Mark_Units_Cb (Design : Iir) return Walk_Status - is - Unit : constant Iir := Get_Library_Unit (Design); - Status : Walk_Status; - begin - if Get_Date (Design) < Date_Analyzed then - return Walk_Continue; - end if; - - case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is - when Iir_Kind_Architecture_Body => - Status := Walk_Concurrent_Statements_Chain - (Get_Concurrent_Statement_Chain (Unit), - Mark_Instantiation_Cb'Access); - pragma Assert (Status = Walk_Continue); - when Iir_Kind_Configuration_Declaration => - -- TODO - raise Program_Error; - -- Mark_Units_Of_Block_Configuration - -- (Get_Block_Configuration (Unit)); - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Entity_Declaration - | Iir_Kind_Context_Declaration => - null; - end case; - return Walk_Continue; - end Mark_Units_Cb; - - procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration) - is - Status : Walk_Status; - begin - -- Name table is used to map names to entities. - Vhdl.Sem_Scopes.Push_Interpretations; - Vhdl.Sem_Scopes.Open_Declarative_Region; - - -- 1. Add all design entities in the name table. - Status := Walk_Design_Units (Lib, Add_Entity_Cb'Access); - pragma Assert (Status = Walk_Continue); - - -- 2. Walk architecture and configurations, and mark instantiated - -- entities. - Status := Walk_Design_Units (Lib, Mark_Units_Cb'Access); - pragma Assert (Status = Walk_Continue); - - Vhdl.Sem_Scopes.Close_Declarative_Region; - Vhdl.Sem_Scopes.Pop_Interpretations; - end Mark_Instantiated_Units; - - function Extract_Entity_Cb (Design : Iir) return Walk_Status - is - Unit : constant Iir := Get_Library_Unit (Design); - begin - if Get_Kind (Unit) = Iir_Kind_Entity_Declaration then - if Get_Elab_Flag (Design) then - Set_Elab_Flag (Design, False); - else - Nbr_Top_Entities := Nbr_Top_Entities + 1; - if Nbr_Top_Entities = 1 then - First_Top_Entity := Unit; - end if; - end if; - end if; - return Walk_Continue; - end Extract_Entity_Cb; - - procedure Find_First_Top_Entity (Lib : Iir_Library_Declaration) - is - Status : Walk_Status; - begin - Nbr_Top_Entities := 0; - First_Top_Entity := Null_Iir; - - Status := Walk_Design_Units (Lib, Extract_Entity_Cb'Access); - pragma Assert (Status = Walk_Continue); - end Find_First_Top_Entity; - - end Top; - - function Find_Top_Entity (From : Iir) return Iir is - begin - Top.Mark_Instantiated_Units (From); - Top.Find_First_Top_Entity (From); - - if Top.Nbr_Top_Entities = 1 then - return Top.First_Top_Entity; - else - return Null_Iir; - end if; - end Find_Top_Entity; - -end Configuration; diff --git a/src/vhdl/configuration.ads b/src/vhdl/configuration.ads deleted file mode 100644 index 6ec910f00..000000000 --- a/src/vhdl/configuration.ads +++ /dev/null @@ -1,63 +0,0 @@ --- Configuration generation. --- 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 Iirs; use Iirs; -with Tables; - -package Configuration is - package Design_Units is new Tables - (Table_Component_Type => Iir_Design_Unit, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 16); - - -- Get the top configuration to build a design hierarchy whose top is - -- PRIMARY + SECONDARY. - -- PRIMARY must designate a configuration declaration or an entity - -- declaration. In the last case, SECONDARY must be null_identifier or - -- designates an architecture declaration. - -- - -- creates a list of design unit. - -- and return the top configuration. - -- Note: this set the Elab_Flag on units. - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) - return Iir; - - -- Likewise but directly from strings. - function Configure (Primary : String; Secondary : String) return Iir; - - -- Add design unit UNIT (with its dependences) in the design_units table. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); - - -- If set, all design units (even package bodies) are loaded. - Flag_Load_All_Design_Units : Boolean := True; - - -- If set, compute the File_Dependence_List of design files. - Flag_Build_File_Dependence : Boolean := False; - - -- Check if ENTITY can be at the top of a hierarchy, ie: - -- ENTITY has no generics or all generics have a default expression - -- ENTITY has no ports or all ports type are constrained. - -- If not, emit a elab error message. - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration); - - -- Use heuritics to find the top entity in FROM (either a library or - -- a design file): mark all instantiated units and return the unmarked - -- one if there is only one. - function Find_Top_Entity (From : Iir) return Iir; -end Configuration; diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 3fc6f4e81..6db015494 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -27,7 +27,7 @@ with Libraries; with Iirs_Utils; use Iirs_Utils; with Std_Package; with Flags; -with Configuration; +with Vhdl.Configuration; with Translation; with Vhdl.Sem; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; @@ -324,7 +324,7 @@ package body Ortho_Front is -- Gather dependencies pragma Assert (Flags.Flag_Elaborate = False); - Configuration.Flag_Load_All_Design_Units := False; + Vhdl.Configuration.Flag_Load_All_Design_Units := False; -- Exclude std.standard Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); @@ -450,7 +450,7 @@ package body Ortho_Front is is use Interfaces.C_Streams; use System; - use Configuration; + use Vhdl.Configuration; use Name_Table; Nul : constant Character := Character'Val (0); @@ -550,7 +550,7 @@ package body Ortho_Front is Trans_Be.Sem_Foreign_Hook := Sem_Foreign_Hook'Access; Shlib_Interning.Init; - Config := Configuration.Configure + Config := Vhdl.Configuration.Configure (Elab_Entity.all, Elab_Architecture.all); if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). @@ -604,7 +604,7 @@ package body Ortho_Front is Flags.Flag_Elaborate := True; Flags.Flag_Only_Elab_Warnings := False; - Config := Configuration.Configure + Config := Vhdl.Configuration.Configure (Elab_Entity.all, Elab_Architecture.all); Translation.Elaborate (Config, True); diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index 1659d54fb..00e071010 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Configuration; +with Vhdl.Configuration; with Errorout; use Errorout; with Std_Package; use Std_Package; with Iirs_Utils; use Iirs_Utils; @@ -419,7 +419,7 @@ package body Trans.Chap12 is -- Write to file FILELIST all the files that are needed to link the design. procedure Gen_Stubs is - use Configuration; + use Vhdl.Configuration; -- Add all dependences of UNIT. -- UNIT is not used, but added during link. @@ -527,7 +527,7 @@ package body Trans.Chap12 is procedure Elaborate (Config : Iir_Design_Unit; Whole : Boolean) is - use Configuration; + use Vhdl.Configuration; Unit : Iir_Design_Unit; Lib_Unit : Iir; diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 7a1baf407..b0997006d 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -20,7 +20,7 @@ with Name_Table; with Files_Map; with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; -with Configuration; +with Vhdl.Configuration; with Libraries; with Trans.Chap7; with Trans; use Trans.Helpers; @@ -2926,7 +2926,7 @@ package body Trans.Rtis is procedure Generate_Top (Nbr_Pkgs : out Natural) is - use Configuration; + use Vhdl.Configuration; Unit : Iir_Design_Unit; Lib : Iir_Library_Declaration; diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb new file mode 100644 index 000000000..8d06a3a73 --- /dev/null +++ b/src/vhdl/vhdl-configuration.adb @@ -0,0 +1,974 @@ +-- Configuration generation. +-- 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 Libraries; +with Errorout; use Errorout; +with Std_Package; +with Name_Table; use Name_Table; +with Flags; +with Iirs_Utils; use Iirs_Utils; +with Iirs_Walk; +with Vhdl.Sem_Scopes; +with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; +with Vhdl.Canon; + +package body Vhdl.Configuration is + procedure Add_Design_Concurrent_Stmts (Parent : Iir); + procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration); + procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean); + + Current_File_Dependence : Iir_List := Null_Iir_List; + Current_Configuration : Iir_Configuration_Declaration := Null_Iir; + + -- UNIT is a design unit of a configuration declaration. + -- Fill the DESIGN_UNITS table with all design units required to build + -- UNIT. + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir) + is + List : Iir_List; + It : List_Iterator; + El : Iir; + Lib_Unit : Iir; + File : Iir_Design_File; + Prev_File_Dependence : Iir_List; + begin + if Flag_Build_File_Dependence then + -- The current file depends on unit. + File := Get_Design_File (Unit); + if Current_File_Dependence /= Null_Iir_List then + -- (There is no dependency for default configuration). + Add_Element (Current_File_Dependence, File); + end if; + end if; + + -- If already in the table, then nothing to do. + if Get_Configuration_Mark_Flag (Unit) then + -- There might be some direct recursions: + -- * the default configuration might be implicitly referenced by + -- a direct entity instantiation + -- * a configuration may be referenced by itself for a recursive + -- instantiation + pragma Assert (Get_Configuration_Done_Flag (Unit) + or else (Get_Kind (Get_Library_Unit (Unit)) + = Iir_Kind_Configuration_Declaration)); + return; + end if; + Set_Configuration_Mark_Flag (Unit, True); + + -- May be enabled to debug dependency construction. + if False then + if From = Null_Iir then + Report_Msg (Msgid_Note, Elaboration, +Unit, + "%n added", (1 => +Unit)); + else + Report_Msg (Msgid_Note, Elaboration, +From, + "%n added by %n", (+Unit, +From)); + end if; + end if; + + Lib_Unit := Get_Library_Unit (Unit); + + if Flag_Build_File_Dependence then + -- Switch current_file_dependence to the design file of Unit. + Prev_File_Dependence := Current_File_Dependence; + + if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration + and then Get_Identifier (Lib_Unit) = Null_Identifier + then + -- Do not add dependence for default configuration. + Current_File_Dependence := Null_Iir_List; + else + File := Get_Design_File (Unit); + Current_File_Dependence := Get_File_Dependence_List (File); + -- Create a list if not yet created. + if Current_File_Dependence = Null_Iir_List then + Current_File_Dependence := Create_Iir_List; + Set_File_Dependence_List (File, Current_File_Dependence); + end if; + end if; + end if; + + if Flag_Load_All_Design_Units then + Load_Design_Unit (Unit, From); + end if; + + -- Add packages from depend list. + -- If Flag_Build_File_Dependences is set, add design units of the + -- dependence list are added, because of LRM 11.4 Analysis Order. + -- Note: a design unit may be referenced but unused. + -- (eg: component specification which does not apply). + List := Get_Dependence_List (Unit); + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + El := Libraries.Find_Design_Unit (El); + if El /= Null_Iir then + Lib_Unit := Get_Library_Unit (El); + if Flag_Build_File_Dependence then + Add_Design_Unit (El, Unit); + else + case Get_Kind (Lib_Unit) is + when Iir_Kinds_Package_Declaration + | Iir_Kind_Context_Declaration => + Add_Design_Unit (El, Unit); + when others => + null; + end case; + end if; + end if; + Next (It); + end loop; + + -- Lib_Unit may have changed. + Lib_Unit := Get_Library_Unit (Unit); + + case Get_Kind (Lib_Unit) is + when Iir_Kind_Package_Declaration => + -- Analyze the package declaration, so that Set_Package below + -- will set the full package (and not a stub). + Load_Design_Unit (Unit, From); + Lib_Unit := Get_Library_Unit (Unit); + when Iir_Kind_Package_Instantiation_Declaration => + -- The uninstantiated package is part of the dependency. + null; + when Iir_Kind_Configuration_Declaration => + -- Add entity and architecture. + -- find all sub-configuration + Load_Design_Unit (Unit, From); + Lib_Unit := Get_Library_Unit (Unit); + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); + declare + Blk : Iir_Block_Configuration; + Prev_Configuration : Iir_Configuration_Declaration; + Arch : Iir; + begin + Prev_Configuration := Current_Configuration; + Current_Configuration := Lib_Unit; + Blk := Get_Block_Configuration (Lib_Unit); + Add_Design_Block_Configuration (Blk); + Current_Configuration := Prev_Configuration; + Arch := Strip_Denoting_Name (Get_Block_Specification (Blk)); + Add_Design_Unit (Get_Design_Unit (Arch), Unit); + end; + when Iir_Kind_Architecture_Body => + -- Add entity + -- find all entity/architecture/configuration instantiation + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); + Add_Design_Concurrent_Stmts (Lib_Unit); + when Iir_Kind_Entity_Declaration => + null; + when Iir_Kind_Package_Body => + null; + when Iir_Kind_Context_Declaration => + null; + when others => + Error_Kind ("add_design_unit", Lib_Unit); + end case; + + -- Add it in the table, after the dependencies. + Design_Units.Append (Unit); + + Set_Configuration_Done_Flag (Unit, True); + + -- Restore now the file dependence. + -- Indeed, we may add a package body when we are in a package + -- declaration. However, the later does not depend on the former. + -- The file which depends on the package declaration also depends on + -- the package body. + if Flag_Build_File_Dependence then + Current_File_Dependence := Prev_File_Dependence; + end if; + + if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then + -- Add body (if any). + declare + Bod : Iir_Design_Unit; + begin + Bod := Libraries.Find_Secondary_Unit (Unit, Null_Identifier); + if Get_Need_Body (Lib_Unit) then + if not Flags.Flag_Elaborate_With_Outdated then + -- LIB_UNIT requires a body. + if Bod = Null_Iir then + Error_Msg_Elab + (Lib_Unit, "body of %n was never analyzed", +Lib_Unit); + elsif Get_Date (Bod) < Get_Date (Unit) then + Error_Msg_Elab (Bod, "%n is outdated", +Bod); + Bod := Null_Iir; + end if; + end if; + else + if Bod /= Null_Iir + and then Get_Date (Bod) < Get_Date (Unit) + then + -- There is a body for LIB_UNIT (which doesn't + -- require it) but it is outdated. + Bod := Null_Iir; + end if; + end if; + if Bod /= Null_Iir then + Set_Package (Get_Library_Unit (Bod), Lib_Unit); + Add_Design_Unit (Bod, Unit); + end if; + end; + end if; + end Add_Design_Unit; + + procedure Add_Design_Concurrent_Stmts (Parent : Iir) + is + Stmt : Iir; + begin + Stmt := Get_Concurrent_Statement_Chain (Parent); + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_Component_Instantiation_Statement => + if Is_Entity_Instantiation (Stmt) then + -- Entity or configuration instantiation. + Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True); + end if; + when Iir_Kind_Block_Statement => + Add_Design_Concurrent_Stmts (Stmt); + when Iir_Kind_For_Generate_Statement => + Add_Design_Concurrent_Stmts + (Get_Generate_Statement_Body (Stmt)); + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Add_Design_Concurrent_Stmts + (Get_Generate_Statement_Body (Clause)); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end; + when Iir_Kind_Case_Generate_Statement => + declare + Alt : Iir; + begin + Alt := Get_Case_Statement_Alternative_Chain (Stmt); + while Alt /= Null_Iir loop + if not Get_Same_Alternative_Flag (Alt) then + Add_Design_Concurrent_Stmts + (Get_Associated_Block (Alt)); + end if; + Alt := Get_Chain (Alt); + end loop; + end; + when Iir_Kinds_Simple_Concurrent_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Endpoint_Declaration + | Iir_Kind_Simple_Simultaneous_Statement => + null; + when others => + Error_Kind ("add_design_concurrent_stmts(2)", Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Add_Design_Concurrent_Stmts; + + procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean) + is + use Libraries; + + Entity : Iir; + Arch_Name : Iir; + Arch : Iir; + Config : Iir; + Arch_Lib : Iir; + Id : Name_Id; + Entity_Lib : Iir; + begin + if Aspect = Null_Iir then + return; + end if; + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + -- Add the entity. + Entity_Lib := Get_Entity (Aspect); + if Entity_Lib = Null_Iir then + -- In case of error (using -c). + return; + end if; + Entity := Get_Design_Unit (Entity_Lib); + Add_Design_Unit (Entity, Aspect); + + -- Extract and add the architecture. + Arch_Name := Get_Architecture (Aspect); + if Arch_Name /= Null_Iir then + case Get_Kind (Arch_Name) is + when Iir_Kind_Simple_Name => + Id := Get_Identifier (Arch_Name); + Arch := Load_Secondary_Unit (Entity, Id, Aspect); + if Arch = Null_Iir then + Error_Msg_Elab ("cannot find architecture %i of %n", + (+Id, +Entity_Lib)); + return; + else + Set_Named_Entity (Arch_Name, Get_Library_Unit (Arch)); + end if; + when Iir_Kind_Reference_Name => + Arch := Get_Design_Unit (Get_Named_Entity (Arch_Name)); + when others => + Error_Kind ("add_design_aspect", Arch_Name); + end case; + else + Arch := Get_Latest_Architecture (Entity_Lib); + if Arch = Null_Iir then + Error_Msg_Elab (Aspect, "no architecture in library for %n", + +Entity_Lib); + return; + end if; + Arch := Get_Design_Unit (Arch); + end if; + Load_Design_Unit (Arch, Aspect); + + -- Add the default configuration if required. Must be done + -- before the architecture in case of recursive instantiation: + -- the configuration depends on the architecture. + if Add_Default then + Arch_Lib := Get_Library_Unit (Arch); + + -- The default configuration may already exist due to a + -- previous instantiation. Create it if it doesn't exist. + Config := Get_Default_Configuration_Declaration (Arch_Lib); + if Is_Null (Config) then + Config := Vhdl.Canon.Create_Default_Configuration_Declaration + (Arch_Lib); + Set_Default_Configuration_Declaration (Arch_Lib, Config); + end if; + + if Get_Configuration_Mark_Flag (Config) + and then not Get_Configuration_Done_Flag (Config) + then + -- Recursive instantiation. + return; + else + Add_Design_Unit (Config, Aspect); + end if; + end if; + + -- Otherwise, simply the architecture. + Add_Design_Unit (Arch, Aspect); + + when Iir_Kind_Entity_Aspect_Configuration => + Add_Design_Unit + (Get_Design_Unit (Get_Configuration (Aspect)), Aspect); + when Iir_Kind_Entity_Aspect_Open => + null; + when others => + Error_Kind ("add_design_aspect", Aspect); + end case; + end Add_Design_Aspect; + + -- Return TRUE is PORT must not be open, and emit an error message only if + -- LOC is not NULL_IIR. + function Check_Open_Port (Port : Iir; Loc : Iir) return Boolean is + begin + case Get_Mode (Port) is + when Iir_In_Mode => + -- LRM93 1.1.1.2 Ports + -- A port of mode IN may be unconnected or unassociated only if + -- its declaration includes a default expression. + if Get_Default_Value (Port) = Null_Iir then + if Loc /= Null_Iir then + Error_Msg_Elab_Relaxed + (Loc, Warnid_Port, + "IN %n must be connected (or have a default value)", + (1 => +Port)); + end if; + return True; + end if; + when Iir_Out_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode + | Iir_Linkage_Mode => + -- LRM93 1.1.1.2 Ports + -- A port of any mode other than IN may be unconnected or + -- unassociated as long as its type is not an unconstrained array + -- type. + if Get_Kind (Get_Type (Port)) in Iir_Kinds_Array_Type_Definition + and then (Get_Constraint_State (Get_Type (Port)) + /= Fully_Constrained) + then + if Loc /= Null_Iir then + Error_Msg_Elab + (Loc, "unconstrained %n must be connected", +Port); + end if; + return True; + end if; + when Iir_Unknown_Mode => + raise Internal_Error; + end case; + return False; + end Check_Open_Port; + + procedure Check_Binding_Indication (Conf : Iir) + is + Comp : constant Iir := Get_Named_Entity (Get_Component_Name (Conf)); + Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf); + Aspect : constant Iir := Get_Entity_Aspect (Bind); + Ent : constant Iir := Get_Entity_From_Entity_Aspect (Aspect); + Assoc_Chain : constant Iir := Get_Port_Map_Aspect_Chain (Bind); + Inter_Chain : constant Iir := Get_Port_Chain (Ent); + Assoc : Iir; + Inter : Iir; + Inst_Assoc_Chain : Iir; + Inst_Inter_Chain : Iir; + Err : Boolean; + Inst : Iir; + Inst_List : Iir_Flist; + Formal : Iir; + Assoc_1 : Iir; + Inter_1 : Iir; + Actual : Iir; + begin + Err := False; + -- Note: the assoc chain is already canonicalized. + + -- First pass: check for open associations in configuration. + Assoc := Assoc_Chain; + Inter := Inter_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Association_Interface (Assoc, Inter); + Err := Err or Check_Open_Port (Formal, Assoc); + if Is_Warning_Enabled (Warnid_Binding) + and then not Get_Artificial_Flag (Assoc) + then + Warning_Msg_Elab + (Warnid_Binding, Assoc, "%n of %n is not bound", + (+Formal, +Get_Parent (Formal)), Cont => True); + Warning_Msg_Elab + (Warnid_Binding, Current_Configuration, + "(in %n)", +Current_Configuration); + end if; + end if; + Next_Association_Interface (Assoc, Inter); + end loop; + if Err then + return; + end if; + + -- Second pass: check for port connected to open in instantiation. + Inst_List := Get_Instantiation_List (Conf); + for I in Flist_First .. Flist_Last (Inst_List) loop + Inst := Get_Nth_Element (Inst_List, I); + Inst := Get_Named_Entity (Inst); + Err := False; + + -- Mark component ports not associated. + Inst_Assoc_Chain := Get_Port_Map_Aspect_Chain (Inst); + Inst_Inter_Chain := Get_Port_Chain (Comp); + Assoc := Inst_Assoc_Chain; + Inter := Inst_Inter_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Association_Interface (Assoc, Inter); + Set_Open_Flag (Formal, True); + Err := True; + end if; + Next_Association_Interface (Assoc, Inter); + end loop; + + -- If there is any component port open, search them in the + -- configuration. + if Err then + Assoc := Assoc_Chain; + Inter := Inter_Chain; + while Assoc /= Null_Iir loop + Formal := Get_Association_Interface (Assoc, Inter); + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Actual := Null_Iir; + else + Actual := Get_Actual (Assoc); + Actual := Name_To_Object (Actual); + if Actual /= Null_Iir then + Actual := Get_Object_Prefix (Actual); + end if; + end if; + if Actual /= Null_Iir + and then Get_Open_Flag (Actual) + and then Check_Open_Port (Formal, Null_Iir) + then + -- For a better message, find the location. + Assoc_1 := Inst_Assoc_Chain; + Inter_1 := Inst_Inter_Chain; + while Assoc_1 /= Null_Iir loop + if Get_Kind (Assoc_1) = Iir_Kind_Association_Element_Open + and then + Actual = Get_Association_Interface (Assoc_1, Inter_1) + then + Err := Check_Open_Port (Formal, Assoc_1); + exit; + end if; + Next_Association_Interface (Assoc_1, Inter_1); + end loop; + end if; + Next_Association_Interface (Assoc, Inter); + end loop; + + -- Clear open flag. + Assoc := Inst_Assoc_Chain; + Inter := Inst_Inter_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Association_Interface (Assoc, Inter); + Set_Open_Flag (Formal, False); + end if; + Next_Association_Interface (Assoc, Inter); + end loop; + end if; + end loop; + end Check_Binding_Indication; + + -- CONF is either a configuration specification or a component + -- configuration. + -- If ADD_DEFAULT is true, then the default configuration for the design + -- binding must be added if required. + procedure Add_Design_Binding_Indication (Conf : Iir; Add_Default : Boolean) + is + Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf); + Aspect : Iir; + Inst : Iir; + begin + if Bind = Null_Iir then + if Is_Warning_Enabled (Warnid_Binding) then + Inst := Get_Nth_Element (Get_Instantiation_List (Conf), 0); + Inst := Strip_Denoting_Name (Inst); + Warning_Msg_Elab + (Warnid_Binding, Conf, + "%n of %n is not bound", + (+Inst, +Get_Instantiated_Unit (Inst)), Cont => True); + Warning_Msg_Elab + (Warnid_Binding, Current_Configuration, + "(in %n)", +Current_Configuration); + end if; + return; + end if; + Aspect := Get_Entity_Aspect (Bind); + if Is_Valid (Aspect) + and then Get_Kind (Aspect) /= Iir_Kind_Entity_Aspect_Open + then + Check_Binding_Indication (Conf); + Add_Design_Aspect (Aspect, Add_Default); + end if; + end Add_Design_Binding_Indication; + + procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration) + is + Item : Iir; + Sub_Config : Iir; + begin + if Blk = Null_Iir then + return; + end if; + Item := Get_Configuration_Item_Chain (Blk); + while Item /= Null_Iir loop + case Get_Kind (Item) is + when Iir_Kind_Configuration_Specification => + Add_Design_Binding_Indication (Item, True); + when Iir_Kind_Component_Configuration => + Sub_Config := Get_Block_Configuration (Item); + Add_Design_Binding_Indication (Item, Sub_Config = Null_Iir); + Add_Design_Block_Configuration (Sub_Config); + when Iir_Kind_Block_Configuration => + Add_Design_Block_Configuration (Item); + when others => + Error_Kind ("add_design_block_configuration", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Add_Design_Block_Configuration; + + -- elaboration of a design hierarchy: + -- creates a list of design unit. + -- + -- find top configuration (may be a default one), add it to the list. + -- For each element of the list: + -- add direct dependences (packages, entity, arch) if not in the list + -- for architectures and configuration: find instantiations and add + -- corresponding configurations. + -- + -- Return the configuration declaration for the design. + function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + return Iir + is + use Libraries; + + Unit : Iir_Design_Unit; + Lib_Unit : Iir; + Top : Iir; + begin + Unit := Find_Primary_Unit (Work_Library, Primary_Id); + if Unit = Null_Iir then + Error_Msg_Elab ("cannot find entity or configuration " + & Name_Table.Image (Primary_Id)); + return Null_Iir; + end if; + Lib_Unit := Get_Library_Unit (Unit); + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration => + -- Use WORK as location (should use a command line location ?) + Load_Design_Unit (Unit, Work_Library); + Lib_Unit := Get_Library_Unit (Unit); + if Secondary_Id /= Null_Identifier then + Unit := Find_Secondary_Unit (Unit, Secondary_Id); + if Unit = Null_Iir then + Error_Msg_Elab ("cannot find architecture %i of %n", + (+Secondary_Id, +Lib_Unit)); + return Null_Iir; + end if; + else + declare + Arch_Unit : Iir_Architecture_Body; + begin + Arch_Unit := Get_Latest_Architecture (Lib_Unit); + if Arch_Unit = Null_Iir then + Error_Msg_Elab + ("%n has no architecture in library %i", + (+Lib_Unit, +Work_Library)); + return Null_Iir; + end if; + Unit := Get_Design_Unit (Arch_Unit); + end; + end if; + Load_Design_Unit (Unit, Lib_Unit); + if Nbr_Errors /= 0 then + return Null_Iir; + end if; + Lib_Unit := Get_Library_Unit (Unit); + pragma Assert + (Is_Null (Get_Default_Configuration_Declaration (Lib_Unit))); + + Top := Vhdl.Canon.Create_Default_Configuration_Declaration + (Lib_Unit); + Set_Default_Configuration_Declaration (Lib_Unit, Top); + pragma Assert (Is_Valid (Top)); + when Iir_Kind_Configuration_Declaration => + if Secondary_Id /= Null_Identifier then + Error_Msg_Elab + ("no secondary unit allowed after configuration %i", + +Primary_Id); + return Null_Iir; + end if; + Top := Unit; + when others => + Error_Msg_Elab ("%i is neither an entity nor a configuration", + +Primary_Id); + return Null_Iir; + end case; + + -- Exclude std.standard + Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); + + Add_Design_Unit (Top, Null_Iir); + return Top; + end Configure; + + function Configure (Primary : String; Secondary : String) return Iir + is + Primary_Id : Name_Id; + Secondary_Id : Name_Id; + begin + Primary_Id := Get_Identifier (Primary); + if Secondary /= "" then + Secondary_Id := Get_Identifier (Secondary); + else + Secondary_Id := Null_Identifier; + end if; + return Configure (Primary_Id, Secondary_Id); + end Configure; + + procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) + is + Has_Error : Boolean := False; + + -- Return TRUE if GRT supports override of generic GEN. + function Allow_Generic_Override (Gen : Iir) return Boolean + is + Gen_Type : constant Iir := Get_Type (Gen); + begin + case Get_Kind (Gen_Type) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + return True; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + -- Only one-dimensional arrays of enumeration are allowed. + -- If unconstrained, the index must be of integer type. + if Get_Kind (Get_Base_Type (Get_Element_Subtype (Gen_Type))) + /= Iir_Kind_Enumeration_Type_Definition + then + -- Not an array of enumeration type. + return False; + end if; + declare + Indexes : constant Iir_Flist := + Get_Index_Subtype_List (Gen_Type); + begin + if Get_Nbr_Elements (Indexes) /= 1 then + -- Not a one-dimensional array. + return False; + end if; + if Get_Constraint_State (Gen_Type) /= Fully_Constrained + and then (Get_Kind (Get_Index_Type (Indexes, 0)) + /= Iir_Kind_Integer_Subtype_Definition) + then + -- Index not constrained or not of integer subtype. + return False; + end if; + end; + return True; + when others => + return False; + end case; + end Allow_Generic_Override; + + procedure Error (Loc : Iir; Msg : String; Arg1 : Earg_Type) is + begin + if not Has_Error then + Error_Msg_Elab ("%n cannot be at the top of a design", +Entity); + Has_Error := True; + end if; + Error_Msg_Elab (Loc, Msg, Arg1); + end Error; + + El : Iir; + begin + -- Check generics. + El := Get_Generic_Chain (Entity); + while El /= Null_Iir loop + if Get_Default_Value (El) = Null_Iir then + if not Allow_Generic_Override (El) then + Error (El, "(%n has no default value)", +El); + end if; + end if; + El := Get_Chain (El); + end loop; + + -- Check port. + El := Get_Port_Chain (Entity); + while El /= Null_Iir loop + if not Is_Fully_Constrained_Type (Get_Type (El)) + and then Get_Default_Value (El) = Null_Iir + then + Error (El, "(%n is unconstrained and has no default value)", +El); + end if; + El := Get_Chain (El); + end loop; + end Check_Entity_Declaration_Top; + + package Top is + procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration); + + Nbr_Top_Entities : Natural; + First_Top_Entity : Iir; + + procedure Find_First_Top_Entity (Lib : Iir_Library_Declaration); + end Top; + + package body Top is + use Iirs_Walk; + + function Add_Entity_Cb (Design : Iir) return Walk_Status + is + Kind : constant Iir_Kind := Get_Kind (Get_Library_Unit (Design)); + begin + if Get_Date (Design) < Date_Analyzed then + return Walk_Continue; + end if; + + case Iir_Kinds_Library_Unit (Kind) is + when Iir_Kind_Architecture_Body + | Iir_Kind_Configuration_Declaration => + Load_Design_Unit (Design, Null_Iir); + when Iir_Kind_Entity_Declaration => + Load_Design_Unit (Design, Null_Iir); + Vhdl.Sem_Scopes.Add_Name (Get_Library_Unit (Design)); + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Context_Declaration => + null; + end case; + return Walk_Continue; + end Add_Entity_Cb; + + procedure Mark_Aspect (Aspect : Iir) + is + Unit : Iir; + begin + case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is + when Iir_Kind_Entity_Aspect_Entity => + Unit := Get_Entity (Aspect); + Set_Elab_Flag (Get_Parent (Unit), True); + when Iir_Kind_Entity_Aspect_Configuration + | Iir_Kind_Entity_Aspect_Open => + null; + end case; + end Mark_Aspect; + + function Mark_Instantiation_Cb (Stmt : Iir) return Walk_Status + is + Inst : Iir; + begin + if Get_Kind (Stmt) /= Iir_Kind_Component_Instantiation_Statement then + return Walk_Continue; + end if; + + Inst := Get_Instantiated_Unit (Stmt); + case Get_Kind (Inst) is + when Iir_Kinds_Denoting_Name => + -- TODO: look at default_binding_indication + -- or configuration_specification ? + declare + Config : constant Iir := + Get_Configuration_Specification (Stmt); + begin + if Is_Valid (Config) then + Mark_Aspect + (Get_Entity_Aspect (Get_Binding_Indication (Config))); + return Walk_Continue; + end if; + end; + declare + use Vhdl.Sem_Scopes; + Comp : constant Iir := Get_Named_Entity (Inst); + Interp : constant Name_Interpretation_Type := + Get_Interpretation (Get_Identifier (Comp)); + Decl : Iir; + begin + if Valid_Interpretation (Interp) then + Decl := Get_Declaration (Interp); + pragma Assert + (Get_Kind (Decl) = Iir_Kind_Entity_Declaration); + Set_Elab_Flag (Get_Design_Unit (Decl), True); + else + -- If there is no corresponding entity name for the + -- component name, assume it belongs to a different + -- library (or will be set by a configuration unit). + null; + end if; + end; + when Iir_Kinds_Entity_Aspect => + Mark_Aspect (Inst); + when others => + Error_Kind ("mark_instantiation_cb", Stmt); + end case; + + return Walk_Continue; + end Mark_Instantiation_Cb; + + function Mark_Units_Cb (Design : Iir) return Walk_Status + is + Unit : constant Iir := Get_Library_Unit (Design); + Status : Walk_Status; + begin + if Get_Date (Design) < Date_Analyzed then + return Walk_Continue; + end if; + + case Iir_Kinds_Library_Unit (Get_Kind (Unit)) is + when Iir_Kind_Architecture_Body => + Status := Walk_Concurrent_Statements_Chain + (Get_Concurrent_Statement_Chain (Unit), + Mark_Instantiation_Cb'Access); + pragma Assert (Status = Walk_Continue); + when Iir_Kind_Configuration_Declaration => + -- TODO + raise Program_Error; + -- Mark_Units_Of_Block_Configuration + -- (Get_Block_Configuration (Unit)); + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Entity_Declaration + | Iir_Kind_Context_Declaration => + null; + end case; + return Walk_Continue; + end Mark_Units_Cb; + + procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration) + is + Status : Walk_Status; + begin + -- Name table is used to map names to entities. + Vhdl.Sem_Scopes.Push_Interpretations; + Vhdl.Sem_Scopes.Open_Declarative_Region; + + -- 1. Add all design entities in the name table. + Status := Walk_Design_Units (Lib, Add_Entity_Cb'Access); + pragma Assert (Status = Walk_Continue); + + -- 2. Walk architecture and configurations, and mark instantiated + -- entities. + Status := Walk_Design_Units (Lib, Mark_Units_Cb'Access); + pragma Assert (Status = Walk_Continue); + + Vhdl.Sem_Scopes.Close_Declarative_Region; + Vhdl.Sem_Scopes.Pop_Interpretations; + end Mark_Instantiated_Units; + + function Extract_Entity_Cb (Design : Iir) return Walk_Status + is + Unit : constant Iir := Get_Library_Unit (Design); + begin + if Get_Kind (Unit) = Iir_Kind_Entity_Declaration then + if Get_Elab_Flag (Design) then + Set_Elab_Flag (Design, False); + else + Nbr_Top_Entities := Nbr_Top_Entities + 1; + if Nbr_Top_Entities = 1 then + First_Top_Entity := Unit; + end if; + end if; + end if; + return Walk_Continue; + end Extract_Entity_Cb; + + procedure Find_First_Top_Entity (Lib : Iir_Library_Declaration) + is + Status : Walk_Status; + begin + Nbr_Top_Entities := 0; + First_Top_Entity := Null_Iir; + + Status := Walk_Design_Units (Lib, Extract_Entity_Cb'Access); + pragma Assert (Status = Walk_Continue); + end Find_First_Top_Entity; + + end Top; + + function Find_Top_Entity (From : Iir) return Iir is + begin + Top.Mark_Instantiated_Units (From); + Top.Find_First_Top_Entity (From); + + if Top.Nbr_Top_Entities = 1 then + return Top.First_Top_Entity; + else + return Null_Iir; + end if; + end Find_Top_Entity; + +end Vhdl.Configuration; diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads new file mode 100644 index 000000000..96d9851ed --- /dev/null +++ b/src/vhdl/vhdl-configuration.ads @@ -0,0 +1,63 @@ +-- Configuration generation. +-- 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 Iirs; use Iirs; +with Tables; + +package Vhdl.Configuration is + package Design_Units is new Tables + (Table_Component_Type => Iir_Design_Unit, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 16); + + -- Get the top configuration to build a design hierarchy whose top is + -- PRIMARY + SECONDARY. + -- PRIMARY must designate a configuration declaration or an entity + -- declaration. In the last case, SECONDARY must be null_identifier or + -- designates an architecture declaration. + -- + -- creates a list of design unit. + -- and return the top configuration. + -- Note: this set the Elab_Flag on units. + function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + return Iir; + + -- Likewise but directly from strings. + function Configure (Primary : String; Secondary : String) return Iir; + + -- Add design unit UNIT (with its dependences) in the design_units table. + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); + + -- If set, all design units (even package bodies) are loaded. + Flag_Load_All_Design_Units : Boolean := True; + + -- If set, compute the File_Dependence_List of design files. + Flag_Build_File_Dependence : Boolean := False; + + -- Check if ENTITY can be at the top of a hierarchy, ie: + -- ENTITY has no generics or all generics have a default expression + -- ENTITY has no ports or all ports type are constrained. + -- If not, emit a elab error message. + procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration); + + -- Use heuritics to find the top entity in FROM (either a library or + -- a design file): mark all instantiated units and return the unmarked + -- one if there is only one. + function Find_Top_Entity (From : Iir) return Iir; +end Vhdl.Configuration; -- cgit v1.2.3