From ab0e8ee2d7a77ce7eb2a935be378bd94d1155901 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 19 Oct 2016 04:13:48 +0200 Subject: canon: do not set formal of association by position. --- src/vhdl/canon.adb | 121 +++++++++++++----------- src/vhdl/configuration.adb | 60 ++++++++---- src/vhdl/iirs_utils.adb | 85 +++++++++++++---- src/vhdl/iirs_utils.ads | 21 ++++- src/vhdl/sem.adb | 141 ++++++++++++++------------- src/vhdl/sem_assocs.adb | 21 ++--- src/vhdl/translate/trans-chap1.adb | 14 ++- src/vhdl/translate/trans-chap2.adb | 9 +- src/vhdl/translate/trans-chap4.adb | 27 ++++-- src/vhdl/translate/trans-chap4.ads | 4 +- src/vhdl/translate/trans-chap5.adb | 53 ++++++----- src/vhdl/translate/trans-chap5.ads | 9 +- src/vhdl/translate/trans-chap7.adb | 12 +-- src/vhdl/translate/trans-chap8.adb | 173 +++++++++++++++++----------------- src/vhdl/translate/trans-chap9.adb | 35 ++++--- src/vhdl/translate/trans_analyzes.adb | 10 +- 16 files changed, 450 insertions(+), 345 deletions(-) (limited to 'src/vhdl') diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 0e560cd5f..69d0ae9ec 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -31,6 +31,8 @@ with PSL.NFAs.Utils; with Canon_PSL; package body Canon is + Canon_Flag_Set_Assoc_Formals : constant Boolean := False; + -- Canonicalize the chain of declarations in Declaration_Chain of -- DECL_PARENT. PARENT must be the parent of the current statements chain, -- or NULL_IIR if DECL_PARENT has no corresponding current statments. @@ -316,6 +318,25 @@ package body Canon is end if; end Canon_Extract_Sensitivity_If_Not_Null; + procedure Canon_Extract_Sensitivity_Procedure_Call + (Sensitivity_List : Iir_List; Call : Iir) + is + Assoc : Iir; + Inter : Iir; + begin + Assoc := Get_Parameter_Association_Chain (Call); + Inter := Get_Interface_Declaration_Chain (Get_Implementation (Call)); + while Assoc /= Null_Iir loop + if (Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression) + and then (Get_Mode (Get_Association_Interface (Assoc, Inter)) + /= Iir_Out_Mode) + then + Canon_Extract_Sensitivity (Get_Actual (Assoc), Sensitivity_List); + end if; + Next_Association_Interface (Assoc, Inter); + end loop; + end Canon_Extract_Sensitivity_Procedure_Call; + procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity (Chain : Iir; List : Iir_List) is @@ -450,22 +471,8 @@ package body Canon is -- to each actual designator (other than OPEN) associated -- with each formal parameter of mode IN or INOUT, and -- construct the union of the resulting sets. - declare - Param : Iir; - begin - Param := Get_Parameter_Association_Chain - (Get_Procedure_Call (Stmt)); - while Param /= Null_Iir loop - if (Get_Kind (Param) - = Iir_Kind_Association_Element_By_Expression) - and then (Get_Mode (Get_Association_Interface (Param)) - /= Iir_Out_Mode) - then - Canon_Extract_Sensitivity (Get_Actual (Param), List); - end if; - Param := Get_Chain (Param); - end loop; - end; + Canon_Extract_Sensitivity_Procedure_Call + (List, Get_Procedure_Call (Stmt)); when others => Error_Kind ("canon_extract_sequential_statement_chain_sensitivity", @@ -842,6 +849,7 @@ package body Canon is N_Chain, Last : Iir; Inter : Iir; Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; + Formal : Iir; Assoc_Chain : Iir; Found : Boolean; @@ -865,10 +873,18 @@ package body Canon is Prev_Assoc_El := Null_Iir; while Assoc_El /= Null_Iir loop Next_Assoc_El := Get_Chain (Assoc_El); - if Get_Formal (Assoc_El) = Null_Iir then - Set_Formal (Assoc_El, Inter); + + Formal := Get_Formal (Assoc_El); + if Formal = Null_Iir then + Formal := Inter; + if Canon_Flag_Set_Assoc_Formals then + Set_Formal (Assoc_El, Inter); + end if; + else + Formal := Get_Interface_Of_Formal (Formal); end if; - if Get_Association_Interface (Assoc_El) = Inter then + + if Formal = Inter then -- Remove ASSOC_EL from ASSOC_CHAIN if Prev_Assoc_El /= Null_Iir then @@ -914,7 +930,11 @@ package body Canon is Set_Artificial_Flag (Assoc_El, True); Set_Whole_Association_Flag (Assoc_El, True); Location_Copy (Assoc_El, Loc); - Set_Formal (Assoc_El, Inter); + + if Canon_Flag_Set_Assoc_Formals then + Set_Formal (Assoc_El, Inter); + end if; + Sub_Chain_Append (N_Chain, Last, Assoc_El); << Done >> null; @@ -988,7 +1008,9 @@ package body Canon is Assoc := Create_Iir (Iir_Kind_Association_Element_Open); Set_Whole_Association_Flag (Assoc, True); Set_Artificial_Flag (Assoc, True); - Set_Formal (Assoc, El); + if Canon_Flag_Set_Assoc_Formals then + Set_Formal (Assoc, El); + end if; Location_Copy (Assoc, El); Sub_Chain_Append (Res, Last, Assoc); El := Get_Chain (El); @@ -1336,8 +1358,6 @@ package body Canon is Call : constant Iir_Procedure_Call := Get_Procedure_Call (El); Imp : constant Iir := Get_Implementation (Call); Assoc_Chain : Iir; - Assoc : Iir; - Inter : Iir; Sensitivity_List : Iir_List; Is_Sensitized : Boolean; begin @@ -1384,7 +1404,6 @@ package body Canon is Get_Parameter_Association_Chain (Call), Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); - Assoc := Assoc_Chain; -- LRM93 9.3 -- If there exists a name that denotes a signal in the actual part of @@ -1395,22 +1414,7 @@ package body Canon is -- the union of the sets constructed by applying th rule of Section 8.1 -- to each actual part associated with a formal parameter. Sensitivity_List := Create_Iir_List; - while Assoc /= Null_Iir loop - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - Inter := Get_Association_Interface (Assoc); - if Get_Mode (Inter) in Iir_In_Modes then - Canon_Extract_Sensitivity - (Get_Actual (Assoc), Sensitivity_List, False); - end if; - when Iir_Kind_Association_Element_Open - | Iir_Kind_Association_Element_By_Individual => - null; - when others => - raise Internal_Error; - end case; - Assoc := Get_Chain (Assoc); - end loop; + Canon_Extract_Sensitivity_Procedure_Call (Sensitivity_List, Call); if Is_Sensitized then Set_Sensitivity_List (Proc, Sensitivity_List); else @@ -2160,6 +2164,7 @@ package body Canon is end if; end Canon_Component_Configuration; + -- Create the 'final' binding indication in case of incremental binding. procedure Canon_Incremental_Binding (Conf_Spec : Iir_Configuration_Specification; Comp_Conf : Iir_Component_Configuration; @@ -2173,7 +2178,8 @@ package body Canon is First, Last : Iir; -- Copy an association and append new elements to FIRST/LAST. - procedure Copy_Association (Assoc : in out Iir; Inter : Iir) + procedure Copy_Association + (Assoc : in out Iir; Inter : in out Iir; Copy_Inter : Iir) is El : Iir; begin @@ -2203,49 +2209,54 @@ package body Canon is end case; Sub_Chain_Append (First, Last, El); - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; + exit when + Get_Association_Interface (Assoc, Inter) /= Copy_Inter; end loop; end Copy_Association; - procedure Advance (Assoc : in out Iir; Inter : Iir) is + procedure Advance + (Assoc : in out Iir; Inter : in out Iir; Skip_Inter : Iir) is begin loop - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; + exit when + Get_Association_Interface (Assoc, Inter) /= Skip_Inter; end loop; end Advance; Inter : Iir; F_El : Iir; + F_Inter : Iir; S_El : Iir; + S_Inter : Iir; begin if Sec_Chain = Null_Iir then -- Short-cut. return First_Chain; end if; F_El := First_Chain; + F_Inter := Inter_Chain; Sub_Chain_Init (First, Last); Inter := Inter_Chain; while Inter /= Null_Iir loop -- Consistency check. - pragma Assert (Get_Association_Interface (F_El) = Inter); + pragma Assert (Get_Association_Interface (F_El, F_Inter) = Inter); -- Find the associated in the second chain. - S_El := Sec_Chain; - while S_El /= Null_Iir loop - exit when Get_Association_Interface (S_El) = Inter; - S_El := Get_Chain (S_El); - end loop; + S_El := Find_First_Association_For_Interface + (Sec_Chain, Inter_Chain, Inter); + if S_El /= Null_Iir and then Get_Kind (S_El) /= Iir_Kind_Association_Element_Open then - Copy_Association (S_El, Inter); - Advance (F_El, Inter); + S_Inter := Inter; + Copy_Association (S_El, S_Inter, Inter); + Advance (F_El, F_Inter, Inter); else - Copy_Association (F_El, Inter); + Copy_Association (F_El, F_Inter, Inter); end if; Inter := Get_Chain (Inter); end loop; diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index 16554a2fa..78e51d034 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -406,25 +406,33 @@ package body Configuration is 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); - Conf_Chain : constant Iir := Get_Port_Map_Aspect_Chain (Bind); + 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; - Inst_Chain : Iir; + Inter : Iir; + Inst_Assoc_Chain : Iir; + Inst_Inter_Chain : Iir; Err : Boolean; Inst : Iir; Inst_List : Iir_List; 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 := Conf_Chain; + 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); + 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) @@ -437,7 +445,7 @@ package body Configuration is "(in %n)", +Current_Configuration); end if; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; if Err then return; @@ -452,23 +460,26 @@ package body Configuration is Err := False; -- Mark component ports not associated. - Inst_Chain := Get_Port_Map_Aspect_Chain (Inst); - Assoc := Inst_Chain; + 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); + Formal := Get_Association_Interface (Assoc, Inter); Set_Open_Flag (Formal, True); Err := True; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; -- If there is any component port open, search them in the -- configuration. if Err then - Assoc := Conf_Chain; + Assoc := Assoc_Chain; + Inter := Inter_Chain; while Assoc /= Null_Iir loop - Formal := Get_Association_Interface (Assoc); + Formal := Get_Association_Interface (Assoc, Inter); if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then Actual := Null_Iir; else @@ -483,28 +494,31 @@ package body Configuration is and then Check_Open_Port (Formal, Null_Iir) then -- For a better message, find the location. - Assoc_1 := Inst_Chain; + 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) + and then + Actual = Get_Association_Interface (Assoc_1, Inter_1) then Err := Check_Open_Port (Formal, Assoc_1); exit; end if; - Assoc_1 := Get_Chain (Assoc_1); + Next_Association_Interface (Assoc_1, Inter_1); end loop; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; -- Clear open flag. - Assoc := Inst_Chain; + 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); + Formal := Get_Association_Interface (Assoc, Inter); Set_Open_Flag (Formal, False); end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; end if; end loop; @@ -517,6 +531,7 @@ package body Configuration is 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 @@ -531,8 +546,13 @@ package body Configuration is end if; return; end if; - Check_Binding_Indication (Conf); - Add_Design_Aspect (Get_Entity_Aspect (Bind), Add_Default); + 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) diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index cf1ecee5b..ee10ed704 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -369,49 +369,96 @@ package body Iirs_Utils is end case; end Is_Signal_Object; - function Get_Association_Interface (Assoc : Iir) return Iir + function Get_Interface_Of_Formal (Formal : Iir) return Iir is - Formal : Iir; + El : Iir; begin - Formal := Get_Formal (Assoc); + El := Formal; loop - case Get_Kind (Formal) is + case Get_Kind (El) is when Iir_Kind_Simple_Name => - return Get_Named_Entity (Formal); + return Get_Named_Entity (El); when Iir_Kinds_Interface_Declaration => - return Formal; + return El; when Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element => - Formal := Get_Prefix (Formal); + -- FIXME: use get_base_name ? + El := Get_Prefix (El); when others => - Error_Kind ("get_association_interface", Formal); + Error_Kind ("get_interface_of_formal", El); end case; end loop; - end Get_Association_Interface; + end Get_Interface_Of_Formal; - function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir is + function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir + is + Formal : constant Iir := Get_Formal (Assoc); begin - if Get_Formal (Assoc) /= Null_Iir then - return Get_Association_Interface (Assoc); + 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 + (Assoc : in out Iir; Inter : in out Iir) + is + Formal : constant Iir := Get_Formal (Assoc); begin - if Get_Formal (Assoc) /= Null_Iir then - -- Association by name. Next one will also be associated by name - -- so no need to track interface. - Inter := Null_Iir; + -- 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 => + 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 Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is El: Iir; Ident: Name_Id; @@ -1230,13 +1277,13 @@ package body Iirs_Utils is end case; end Get_Method_Type; - function Get_Actual_Or_Default (Assoc : Iir) return Iir is + 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 (Get_Formal (Assoc)); + return Get_Default_Value (Inter); when others => Error_Kind ("get_actual_or_default", Assoc); end case; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index fb3f34b8c..0bb46e370 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -76,9 +76,9 @@ package Iirs_Utils is -- Return TRUE if EXPR is a signal name. function Is_Signal_Name (Expr : Iir) return Boolean; - -- Get the interface associated by the association ASSOC. This is always - -- an interface, even if the formal is a name. - function Get_Association_Interface (Assoc : Iir) return Iir; + -- 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 @@ -89,6 +89,17 @@ package Iirs_Utils is 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; + -- Duplicate enumeration literal LIT. function Copy_Enumeration_Literal (Lit : Iir) return Iir; @@ -275,8 +286,8 @@ package Iirs_Utils is -- For Association_Element_By_Expression: return the actual. -- For Association_Element_Open: return the default value of the - -- interface. - function Get_Actual_Or_Default (Assoc : Iir) return Iir; + -- 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; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 39e642722..6c364c39c 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -454,7 +454,7 @@ package body Sem is procedure Sem_Port_Association_Chain (Inter_Parent : Iir; Assoc_Parent : Iir) is - El : Iir; + Assoc : Iir; Actual : Iir; Prefix : Iir; Object : Iir; @@ -517,23 +517,14 @@ package body Sem is -- LRM93 1.1.1.2 -- The actual, if a port or signal, must be denoted by a static name. -- The actual, if an expression, must be a globally static expression. - El := Assoc_Chain; + Assoc := Assoc_Chain; Inter := Get_Port_Chain (Inter_Parent); - while El /= Null_Iir loop - Formal := Get_Formal (El); + while Assoc /= Null_Iir loop + Formal := Get_Association_Formal (Assoc, Inter); + Formal_Base := Get_Interface_Of_Formal (Formal); - if Formal = Null_Iir then - -- No formal: use association by position. - Formal := Inter; - Formal_Base := Inter; - Inter := Get_Chain (Inter); - else - Inter := Null_Iir; - Formal_Base := Get_Association_Interface (El); - end if; - - if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then - Actual := Get_Actual (El); + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then + Actual := Get_Actual (Assoc); -- There has been an error, exit from the loop. exit when Actual = Null_Iir; Object := Name_To_Object (Actual); @@ -549,12 +540,12 @@ package body Sem is | Iir_Kinds_Signal_Attribute => -- Port or signal. Set_Collapse_Signal_Flag - (El, Can_Collapse_Signals (El, Formal)); + (Assoc, Can_Collapse_Signals (Assoc, Formal)); if Get_Name_Staticness (Object) < Globally then Error_Msg_Sem (+Actual, "actual must be a static name"); end if; Check_Port_Association_Bounds_Restrictions - (Formal, Actual, El); + (Formal, Actual, Assoc); if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then declare @@ -562,25 +553,25 @@ package body Sem is pragma Unreferenced (P); begin P := Check_Port_Association_Mode_Restrictions - (Formal_Base, Prefix, El); + (Formal_Base, Prefix, Assoc); end; end if; when others => -- Expression. - Set_Collapse_Signal_Flag (El, False); + Set_Collapse_Signal_Flag (Assoc, False); -- If there is an IN conversion, re-integrate it into -- the actual. declare In_Conv : Iir; begin - In_Conv := Get_In_Conversion (El); + In_Conv := Get_In_Conversion (Assoc); if In_Conv /= Null_Iir then - Set_In_Conversion (El, Null_Iir); + Set_In_Conversion (Assoc, Null_Iir); Set_Expr_Staticness (In_Conv, Get_Expr_Staticness (Actual)); Actual := In_Conv; - Set_Actual (El, Actual); + Set_Actual (Assoc, Actual); end if; end; if Flags.Vhdl_Std >= Vhdl_93c then @@ -591,7 +582,7 @@ package body Sem is -- of mode in. if Get_Mode (Formal_Base) /= Iir_In_Mode then Error_Msg_Sem - (+El, "only 'in' ports may be associated with " + (+Assoc, "only 'in' ports may be associated with " & "expression"); end if; @@ -605,12 +596,12 @@ package body Sem is end if; else Error_Msg_Sem - (+El, + (+Assoc, "cannot associate ports with expression in vhdl87"); end if; end case; end if; - El := Get_Chain (El); + Next_Association_Interface (Assoc, Inter); end loop; end Sem_Port_Association_Chain; @@ -1110,6 +1101,56 @@ package body Sem is Sem_Scopes.Close_Scope_Extension; end Sem_Block_Configuration; + -- Check that incremental binding of the component configuration CONF only + -- rebinds non associated ports of each instantiations of CONFIGURED_BLOCK + -- which CONF applies to. + procedure Check_Incremental_Binding (Configured_Block : Iir; Conf : Iir) + is + Comp : constant Iir := Get_Named_Entity (Get_Component_Name (Conf)); + Inter_Chain : constant Iir := Get_Port_Chain (Comp); + Binding : constant Iir := Get_Binding_Indication (Conf); + Inst : Iir; + begin + -- Check each component instantiation of the block configured by CONF. + Inst := Get_Concurrent_Statement_Chain (Configured_Block); + while Inst /= Null_Iir loop + if Get_Kind (Inst) = Iir_Kind_Component_Instantiation_Statement + and then Get_Component_Configuration (Inst) = Conf + then + -- Check this instantiation. + declare + Primary_Binding : constant Iir := Get_Binding_Indication + (Get_Configuration_Specification (Inst)); + F_Chain : constant Iir := + Get_Port_Map_Aspect_Chain (Primary_Binding); + S_El : Iir; + S_Inter : Iir; + F_El : Iir; + Formal : Iir; + begin + S_El := Get_Port_Map_Aspect_Chain (Binding); + S_Inter := Inter_Chain; + while S_El /= Null_Iir loop + -- Find S_EL formal in F_CHAIN. + Formal := Get_Association_Interface (S_El, S_Inter); + F_El := Find_First_Association_For_Interface + (F_Chain, Inter_Chain, Formal); + if F_El /= Null_Iir + and then + Get_Kind (F_El) /= Iir_Kind_Association_Element_Open + then + Error_Msg_Sem + (+S_El, + "%n already associated in primary binding", +Formal); + end if; + Next_Association_Interface (S_El, S_Inter); + end loop; + end; + end if; + Inst := Get_Chain (Inst); + end loop; + end Check_Incremental_Binding; + -- LRM 1.3.2 procedure Sem_Component_Configuration (Conf : Iir_Component_Configuration; Father : Iir) @@ -1125,7 +1166,7 @@ package body Sem is -- 11. A component configuration. Open_Declarative_Region; - -- LRM93 §10.2 + -- LRM93 10.2 -- If a component configuration appears as a configuration item -- immediatly within a block configuration that configures a given -- block, and the scope of a given declaration includes the end of the @@ -1136,9 +1177,7 @@ package body Sem is -- for local ports and generics of the component. if Get_Kind (Father) = Iir_Kind_Block_Configuration then Configured_Block := Get_Block_Specification (Father); - if Get_Kind (Configured_Block) = Iir_Kind_Design_Unit then - raise Internal_Error; - end if; + pragma Assert (Get_Kind (Configured_Block) /= Iir_Kind_Design_Unit); Configured_Block := Get_Block_From_Block_Specification (Configured_Block); Sem_Scopes.Extend_Scope_Of_Block_Declarations (Configured_Block); @@ -1179,47 +1218,7 @@ package body Sem is -- of the incremental binding indication and it is a formal -- port that is associated with an actual other than OPEN in one -- of the primary binding indications. - declare - Inst : Iir; - Primary_Binding : Iir; - F_Chain : Iir; - F_El, S_El : Iir; - Formal : Iir; - begin - Inst := Get_Concurrent_Statement_Chain (Configured_Block); - while Inst /= Null_Iir loop - if Get_Kind (Inst) - = Iir_Kind_Component_Instantiation_Statement - and then Get_Component_Configuration (Inst) = Conf - then - -- Check here. - Primary_Binding := Get_Binding_Indication - (Get_Configuration_Specification (Inst)); - F_Chain := Get_Port_Map_Aspect_Chain (Primary_Binding); - S_El := Get_Port_Map_Aspect_Chain (Binding); - while S_El /= Null_Iir loop - -- Find S_EL formal in F_CHAIN. - Formal := Get_Association_Interface (S_El); - F_El := F_Chain; - while F_El /= Null_Iir loop - exit when Get_Association_Interface (F_El) = Formal; - F_El := Get_Chain (F_El); - end loop; - if F_El /= Null_Iir - and then Get_Kind (F_El) - /= Iir_Kind_Association_Element_Open - then - Error_Msg_Sem - (+S_El, - "%n already associated in primary binding", - +Formal); - end if; - S_El := Get_Chain (S_El); - end loop; - end if; - Inst := Get_Chain (Inst); - end loop; - end; + Check_Incremental_Binding (Configured_Block, Conf); end if; elsif Primary_Entity_Aspect = Null_Iir then -- LRM93 5.2.1 diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index e33775921..af573ae3b 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -192,7 +192,6 @@ package body Sem_Assocs is (Inter_Chain : Iir; Assoc_Chain : Iir) is Assoc : Iir; - Formal : Iir; Formal_Inter : Iir; Actual : Iir; Prefix : Iir; @@ -202,16 +201,7 @@ package body Sem_Assocs is Assoc := Assoc_Chain; Inter := Inter_Chain; while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); - if Formal = Null_Iir then - -- Association by position. - Formal_Inter := Inter; - Inter := Get_Chain (Inter); - else - -- Association by name. - Formal_Inter := Get_Association_Interface (Assoc); - Inter := Null_Iir; - end if; + Formal_Inter := Get_Association_Interface (Assoc, Inter); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => if Get_Default_Value (Formal_Inter) = Null_Iir then @@ -363,7 +353,7 @@ package body Sem_Assocs is when others => Error_Kind ("check_subprogram_associations", Assoc); end case; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; end Check_Subprogram_Associations; @@ -722,7 +712,8 @@ package body Sem_Assocs is Error_Msg_Sem (+Formal, "individual association of %n" & " conflicts with that at %l", - (+Get_Association_Interface (Iassoc), +Sub)); + (+Get_Interface_Of_Formal (Get_Formal (Iassoc)), + +Sub)); return; end case; end if; @@ -763,7 +754,7 @@ package body Sem_Assocs is if Prev /= Null_Iir then Error_Msg_Sem (+Assoc, "individual association of %n conflicts with that at %l", - (+Get_Association_Interface (Assoc), +Prev)); + (+Get_Interface_Of_Formal (Get_Formal (Assoc)), +Prev)); else Set_Associated_Expr (Res_Iass, Assoc); end if; @@ -950,7 +941,7 @@ package body Sem_Assocs is return; end if; - Formal := Get_Association_Interface (Assoc); + Formal := Get_Interface_Of_Formal (Get_Formal (Assoc)); Atype := Get_Type (Formal); Set_Whole_Association_Flag (Assoc, True); diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 4c5083ef6..a84442df4 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -392,6 +392,10 @@ package body Trans.Chap1 is end if; Entity_Aspect := Get_Entity_Aspect (Binding); + if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Open then + -- Unbound component. + return; + end if; Comp := Get_Named_Entity (Get_Component_Name (Cfg)); Comp_Info := Get_Info (Comp); @@ -530,13 +534,21 @@ package body Trans.Chap1 is procedure Translate_Component_Configuration_Call (Cfg : Iir; Base_Block : Iir; Block_Info : Block_Info_Acc) is + Binding : constant Iir := Get_Binding_Indication (Cfg); + Aspect : Iir; Cfg_Info : Config_Info_Acc; Base_Info : Block_Info_Acc; begin - if Get_Binding_Indication (Cfg) = Null_Iir then + if Is_Null (Binding) then -- Unbound component configuration, nothing to do. return; end if; + Aspect := Get_Entity_Aspect (Binding); + if Is_Null (Aspect) + or else Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Open + then + return; + end if; Cfg_Info := Get_Info (Cfg); Base_Info := Get_Info (Base_Block); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index f011020f1..d721a7816 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1001,8 +1001,8 @@ package body Trans.Chap2 is if Is_Generic_Mapped_Package (Spec) then Chap5.Elab_Generic_Map_Aspect - (Get_Package_Header (Spec), (Info.Package_Spec_Scope'Access, - Info.Package_Spec_Scope)); + (Get_Package_Header (Spec), Get_Package_Header (Spec), + (Info.Package_Spec_Scope'Access, Info.Package_Spec_Scope)); end if; Chap4.Elab_Declaration_Chain (Spec, Final); @@ -1404,8 +1404,9 @@ package body Trans.Chap2 is Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope, Pkg_Info.Package_Spec_Field, Pkg_Info.Package_Body_Scope'Access); - Chap5.Elab_Generic_Map_Aspect (Inst, (Pkg_Info.Package_Body_Scope'Access, - Pkg_Info.Package_Body_Scope)); + Chap5.Elab_Generic_Map_Aspect + (Get_Package_Header (Spec), Inst, + (Pkg_Info.Package_Body_Scope'Access, Pkg_Info.Package_Body_Scope)); Clear_Scope (Pkg_Info.Package_Spec_Scope); -- Call the elaborator of the generic. The generic must be diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index e59e7945c..14d04d486 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2550,12 +2550,13 @@ package body Trans.Chap4 is (Stmt : Iir; Block : Iir; Assoc : Iir; + Inter : Iir; Mode : Conv_Mode; Conv_Info : in out Assoc_Conv_Info; Base_Block : Iir; Entity : Iir) is - Formal : constant Iir := Get_Formal (Assoc); + Formal : constant Iir := Get_Association_Formal (Assoc, Inter); Actual : constant Iir := Get_Actual (Assoc); Mark2, Mark3 : Id_Mark_Type; @@ -2598,7 +2599,7 @@ package body Trans.Chap4 is end case; -- FIXME: individual assoc -> overload. Push_Identifier_Prefix - (Mark3, Get_Identifier (Get_Association_Interface (Assoc))); + (Mark3, Get_Identifier (Get_Association_Interface (Assoc, Inter))); -- Handle anonymous subtypes. Chap3.Translate_Anonymous_Type_Definition (Out_Type); @@ -2835,9 +2836,15 @@ package body Trans.Chap4 is (Stmt : Iir; Block : Iir; Base_Block : Iir; Entity : Iir) is Assoc : Iir; + Inter : Iir; Info : Assoc_Info_Acc; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); + if Is_Null (Entity) then + Inter := Get_Port_Chain (Stmt); + else + Inter := Get_Port_Chain (Entity); + end if; while Assoc /= Null_Iir loop if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then @@ -2845,7 +2852,7 @@ package body Trans.Chap4 is if Get_In_Conversion (Assoc) /= Null_Iir then Info := Add_Info (Assoc, Kind_Assoc); Translate_Association_Subprogram - (Stmt, Block, Assoc, Conv_Mode_In, Info.Assoc_In, + (Stmt, Block, Assoc, Inter, Conv_Mode_In, Info.Assoc_In, Base_Block, Entity); end if; if Get_Out_Conversion (Assoc) /= Null_Iir then @@ -2853,11 +2860,11 @@ package body Trans.Chap4 is Info := Add_Info (Assoc, Kind_Assoc); end if; Translate_Association_Subprogram - (Stmt, Block, Assoc, Conv_Mode_Out, Info.Assoc_Out, + (Stmt, Block, Assoc, Inter, Conv_Mode_Out, Info.Assoc_Out, Base_Block, Entity); end if; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; end Translate_Association_Subprograms; @@ -2983,22 +2990,24 @@ package body Trans.Chap4 is end Elab_Conversion; -- In conversion: from actual to formal. - procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode) + procedure Elab_In_Conversion (Assoc : Iir; Inter : Iir; Ndest : out Mnode) is Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin Elab_Conversion - (Get_Actual (Assoc), Get_Formal (Assoc), + (Get_Actual (Assoc), Get_Association_Formal (Assoc, Inter), Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest); end Elab_In_Conversion; -- Out conversion: from formal to actual. - procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode) + procedure Elab_Out_Conversion (Assoc : Iir; Inter : Iir; Ndest : out Mnode) is + -- Note: because it's an out conversion, the formal of ASSOC is set. + -- Still pass INTER for coherence with Elab_In_Conversion. Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin Elab_Conversion - (Get_Formal (Assoc), Get_Actual (Assoc), + (Get_Association_Formal (Assoc, Inter), Get_Actual (Assoc), Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest); end Elab_Out_Conversion; diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads index d91f0ee52..3505fac4e 100644 --- a/src/vhdl/translate/trans-chap4.ads +++ b/src/vhdl/translate/trans-chap4.ads @@ -51,8 +51,8 @@ package Trans.Chap4 is -- Elaborate In/Out_Conversion for ASSOC (signals only). -- NDEST is the data structure to be registered. - procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode); - procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode); + procedure Elab_In_Conversion (Assoc : Iir; Inter : Iir; Ndest : out Mnode); + procedure Elab_Out_Conversion (Assoc : Iir; Inter : Iir; Ndest : out Mnode); -- Create code to elaborate declarations. -- NEED_FINAL is set when at least one declaration needs to be diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index 7a6bb0cfb..18f54fd7e 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -368,15 +368,16 @@ package body Trans.Chap5 is Finish_Data_Record => Connect_Finish_Data_Composite); procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; + Inter : Iir; By_Copy : Boolean; Formal_Env : Map_Env; Actual_Env : Map_Env) is - Formal : constant Iir := Get_Formal (Assoc); + Formal : constant Iir := Get_Association_Formal (Assoc, Inter); Actual : constant Iir := Get_Actual (Assoc); Formal_Type : constant Iir := Get_Type (Formal); Actual_Type : constant Iir := Get_Type (Actual); - Inter : constant Iir := Get_Association_Interface (Assoc); + Port : constant Iir := Get_Interface_Of_Formal (Formal); Formal_Sig : Mnode; Formal_Val : Mnode; Actual_Sig : Mnode; @@ -412,7 +413,7 @@ package body Trans.Chap5 is -- association element that associates an actual -- with S. -- * [...] - case Get_Mode (Inter) is + case Get_Mode (Port) is when Iir_In_Mode => Mode := Connect_Effective; when Iir_Inout_Mode => @@ -473,7 +474,7 @@ package body Trans.Chap5 is Connect (Formal_Sig, Formal_Type, Data); else if Get_In_Conversion (Assoc) /= Null_Iir then - Chap4.Elab_In_Conversion (Assoc, Actual_Sig); + Chap4.Elab_In_Conversion (Assoc, Inter, Actual_Sig); Set_Map_Env (Formal_Env); Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); Data := (Actual_Sig => Actual_Sig, @@ -485,7 +486,7 @@ package body Trans.Chap5 is end if; if Get_Out_Conversion (Assoc) /= Null_Iir then -- flow: FORMAL to ACTUAL - Chap4.Elab_Out_Conversion (Assoc, Formal_Sig); + Chap4.Elab_Out_Conversion (Assoc, Inter, Formal_Sig); Set_Map_Env (Actual_Env); Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); Data := (Actual_Sig => Actual_Sig, @@ -517,7 +518,8 @@ package body Trans.Chap5 is Tinfo.T.Bounds_Ptr_Type); end Alloc_Bounds; - function Get_Unconstrained_Port_Bounds (Assoc : Iir) return Mnode + function Get_Unconstrained_Port_Bounds (Assoc : Iir; Inter : Iir) + return Mnode is Actual : constant Iir := Get_Actual (Assoc); Actual_Type : constant Iir := Get_Type (Actual); @@ -598,7 +600,7 @@ package body Trans.Chap5 is end if; pragma Assert (Can_Convert); - Res_Type := Get_Type (Get_Association_Interface (Assoc)); + Res_Type := Get_Type (Get_Association_Interface (Assoc, Inter)); Bounds := Get_Actual_Bounds (False); Res := Alloc_Bounds (Res_Type, Alloc_System); Chap7.Translate_Type_Conversion_Bounds @@ -616,7 +618,7 @@ package body Trans.Chap5 is case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_By_Expression => pragma Assert (Get_Whole_Association_Flag (Assoc)); - Bounds := Get_Unconstrained_Port_Bounds (Assoc); + Bounds := Get_Unconstrained_Port_Bounds (Assoc, Port); when Iir_Kind_Association_Element_Open => declare Actual_Type : constant Iir := @@ -648,19 +650,21 @@ package body Trans.Chap5 is end Elab_Unconstrained_Port_Bounds; procedure Elab_Port_Map_Aspect - (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) + (Header : Iir; Map : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is Actual_Env : Map_Env; Assoc : Iir; + Inter : Iir; begin Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); -- Ports. - Assoc := Get_Port_Map_Aspect_Chain (Mapping); + Assoc := Get_Port_Map_Aspect_Chain (Map); + Inter := Get_Port_Chain (Header); while Assoc /= Null_Iir loop declare - Formal : constant Iir := Strip_Denoting_Name (Get_Formal (Assoc)); - Formal_Base : constant Iir := Get_Association_Interface (Assoc); + Formal : constant Iir := Get_Association_Formal (Assoc, Inter); + Formal_Base : constant Iir := Get_Interface_Of_Formal (Formal); Fb_Type : constant Iir := Get_Type (Formal_Base); Fbt_Info : constant Type_Info_Acc := Get_Info (Fb_Type); begin @@ -697,14 +701,14 @@ package body Trans.Chap5 is if Get_Collapse_Signal_Flag (Assoc) then -- For collapsed association, copy signals. Elab_Port_Map_Aspect_Assoc - (Assoc, True, Formal_Env, Actual_Env); + (Assoc, Inter, True, Formal_Env, Actual_Env); else -- Create non-collapsed signals. Chap4.Elab_Signal_Declaration_Object (Formal, Block_Parent, False); -- And associate. Elab_Port_Map_Aspect_Assoc - (Assoc, False, Formal_Env, Actual_Env); + (Assoc, Inter, False, Formal_Env, Actual_Env); end if; else -- By sub-element. @@ -712,7 +716,7 @@ package body Trans.Chap5 is -- created. -- And associate. Elab_Port_Map_Aspect_Assoc - (Assoc, False, Formal_Env, Actual_Env); + (Assoc, Inter, False, Formal_Env, Actual_Env); end if; when Iir_Kind_Association_Element_Open | Iir_Kind_Association_Element_By_Individual => @@ -723,24 +727,27 @@ package body Trans.Chap5 is end case; Close_Temp; end; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; Set_Map_Env (Actual_Env); end Elab_Port_Map_Aspect; - procedure Elab_Generic_Map_Aspect (Mapping : Iir; Formal_Env : Map_Env) + procedure Elab_Generic_Map_Aspect + (Header : Iir; Map : Iir; Formal_Env : Map_Env) is Actual_Env : Map_Env; Assoc : Iir; Formal : Iir; + Inter : Iir; begin Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); -- Elab generics, and associate. - Assoc := Get_Generic_Map_Aspect_Chain (Mapping); + Assoc := Get_Generic_Map_Aspect_Chain (Map); + Inter := Get_Generic_Chain (Header); while Assoc /= Null_Iir loop + Formal := Get_Association_Formal (Assoc, Inter); Open_Temp; - Formal := Strip_Denoting_Name (Get_Formal (Assoc)); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => declare @@ -833,12 +840,12 @@ package body Trans.Chap5 is Error_Kind ("elab_generic_map_aspect(1)", Assoc); end case; Close_Temp; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; end Elab_Generic_Map_Aspect; procedure Elab_Map_Aspect - (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is + (Header : Iir; Maps : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is begin -- The use of FORMAL_ENV (and then later ACTUAL_ENV) is rather fragile -- as in some cases both the formal and the actual are referenced in the @@ -848,8 +855,8 @@ package body Trans.Chap5 is -- The generic map must be done before the elaboration of -- the ports, since a port subtype may depend on a generic. - Elab_Generic_Map_Aspect (Mapping, Formal_Env); + Elab_Generic_Map_Aspect (Header, Maps, Formal_Env); - Elab_Port_Map_Aspect (Mapping, Block_Parent, Formal_Env); + Elab_Port_Map_Aspect (Header, Maps, Block_Parent, Formal_Env); end Elab_Map_Aspect; end Trans.Chap5; diff --git a/src/vhdl/translate/trans-chap5.ads b/src/vhdl/translate/trans-chap5.ads index 6902d3b3b..6b545e051 100644 --- a/src/vhdl/translate/trans-chap5.ads +++ b/src/vhdl/translate/trans-chap5.ads @@ -45,7 +45,8 @@ package Trans.Chap5 is procedure Save_Map_Env (Env : out Map_Env; Scope_Ptr : Var_Scope_Acc); procedure Set_Map_Env (Env : Map_Env); - procedure Elab_Generic_Map_Aspect (Mapping : Iir; Formal_Env : Map_Env); + procedure Elab_Generic_Map_Aspect + (Header : Iir; Map : Iir; Formal_Env : Map_Env); -- There are 4 cases of generic/port map: -- 1) component instantiation @@ -54,8 +55,8 @@ package Trans.Chap5 is -- 3) block header -- 4) direct (entity + architecture or configuration) instantiation -- - -- MAPPING is the node containing the generic/port map aspects. - + -- HEADER is the node containing generics and ports declarations. + -- MAPS is the node containing the generic/port map aspects. procedure Elab_Map_Aspect - (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env); + (Header : Iir; Maps : Iir; Block_Parent : Iir; Formal_Env : Map_Env); end Trans.Chap5; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index c216e199d..f2f1cd906 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -718,29 +718,23 @@ package body Trans.Chap7 is is Imp : constant Iir := Get_Implementation (Call); - function Create_Assoc (Actual : Iir; Formal : Iir) return Iir + function Create_Assoc (Actual : Iir) return Iir is R : Iir; begin R := Create_Iir (Iir_Kind_Association_Element_By_Expression); Location_Copy (R, Actual); Set_Actual (R, Actual); - Set_Formal (R, Formal); return R; end Create_Assoc; - Inter : Iir; El_L : Iir; El_R : Iir; Res : O_Enode; begin - Inter := Get_Interface_Declaration_Chain (Imp); - - El_L := Create_Assoc (Left, Inter); - + El_L := Create_Assoc (Left); if Right /= Null_Iir then - Inter := Get_Chain (Inter); - El_R := Create_Assoc (Right, Inter); + El_R := Create_Assoc (Right); Set_Chain (El_L, El_R); end if; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 296f4de7f..f532afb39 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -1802,18 +1802,16 @@ package body Trans.Chap8 is procedure Translate_Write_Procedure_Call (Imp : Iir; Param_Chain : Iir) is - F_Assoc : Iir; - Value_Assoc : Iir; + Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); + F_Assoc : constant Iir := Param_Chain; + Value_Assoc : constant Iir := Get_Chain (Param_Chain); + Value_Inter : constant Iir := Get_Chain (Inter_Chain); + Formal_Type : constant Iir := Get_Type (Value_Inter); + Tinfo : constant Type_Info_Acc := Get_Info (Formal_Type); Value : O_Dnode; - Formal_Type : Iir; - Tinfo : Type_Info_Acc; Assocs : O_Assoc_List; Subprg_Info : Subprg_Info_Acc; begin - F_Assoc := Param_Chain; - Value_Assoc := Get_Chain (Param_Chain); - Formal_Type := Get_Type (Get_Formal (Value_Assoc)); - Tinfo := Get_Info (Formal_Type); case Tinfo.Type_Mode is when Type_Mode_Scalar => Open_Temp; @@ -1862,18 +1860,16 @@ package body Trans.Chap8 is procedure Translate_Read_Procedure_Call (Imp : Iir; Param_Chain : Iir) is - F_Assoc : Iir; - Value_Assoc : Iir; + Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); + F_Assoc : constant Iir := Param_Chain; + Value_Assoc : constant Iir := Get_Chain (Param_Chain); + Value_Inter : constant Iir := Get_Chain (Inter_Chain); + Formal_Type : constant Iir := Get_Type (Value_Inter); + Tinfo : constant Type_Info_Acc := Get_Info (Formal_Type); Value : Mnode; - Formal_Type : Iir; - Tinfo : Type_Info_Acc; Assocs : O_Assoc_List; Subprg_Info : Subprg_Info_Acc; begin - F_Assoc := Param_Chain; - Value_Assoc := Get_Chain (Param_Chain); - Formal_Type := Get_Type (Get_Formal (Value_Assoc)); - Tinfo := Get_Info (Formal_Type); case Tinfo.Type_Mode is when Type_Mode_Scalar => Open_Temp; @@ -1940,89 +1936,84 @@ package body Trans.Chap8 is Imp : constant Iir := Get_Implementation (Call); Kind : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); - Param_Chain : constant Iir := Get_Parameter_Association_Chain (Call); + Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Call); + Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); begin case Kind is when Iir_Predefined_Write => - -- Check wether text or not. declare - File_Param : Iir; + File_Assoc : constant Iir := Assoc_Chain; + File_Param : constant Iir := Get_Actual (File_Assoc); + Value_Assoc : constant Iir := Get_Chain (File_Assoc); + Value_Param : constant Iir := Get_Actual (Value_Assoc); Assocs : O_Assoc_List; begin - File_Param := Param_Chain; - -- FIXME: do the test. - if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param))) - then + -- Check whether text or not. + if Get_Text_File_Flag (Get_Type (File_Param)) then -- If text: Start_Association (Assocs, Ghdl_Text_Write); -- compute file parameter (get an index) New_Association - (Assocs, - Chap7.Translate_Expression (Get_Actual (File_Param))); + (Assocs, Chap7.Translate_Expression (File_Param)); -- compute string parameter (get a fat array pointer) New_Association (Assocs, Chap7.Translate_Expression - (Get_Actual (Get_Chain (Param_Chain)), - String_Type_Definition)); + (Value_Param, String_Type_Definition)); -- call a predefined procedure New_Procedure_Call (Assocs); else - Translate_Write_Procedure_Call (Imp, Param_Chain); + Translate_Write_Procedure_Call (Imp, Assoc_Chain); end if; end; when Iir_Predefined_Read_Length => -- FIXME: works only for text read length. declare - File_Param : Iir; - N_Param : Iir; + File_Assoc : constant Iir := Assoc_Chain; + File_Param : constant Iir := Get_Actual (File_Assoc); + N_Assoc : Iir; Assocs : O_Assoc_List; Str : O_Enode; Res : Mnode; begin - File_Param := Param_Chain; - if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param))) - then - N_Param := Get_Chain (File_Param); + if Get_Text_File_Flag (Get_Type (File_Param)) then + N_Assoc := Get_Chain (File_Assoc); Str := Chap7.Translate_Expression - (Get_Actual (N_Param), String_Type_Definition); - N_Param := Get_Chain (N_Param); + (Get_Actual (N_Assoc), String_Type_Definition); + N_Assoc := Get_Chain (N_Assoc); Res := - Chap6.Translate_Name (Get_Actual (N_Param), Mode_Value); + Chap6.Translate_Name (Get_Actual (N_Assoc), Mode_Value); Start_Association (Assocs, Ghdl_Text_Read_Length); -- compute file parameter (get an index) New_Association - (Assocs, - Chap7.Translate_Expression (Get_Actual (File_Param))); + (Assocs, Chap7.Translate_Expression (File_Param)); -- compute string parameter (get a fat array pointer) New_Association (Assocs, Str); -- call a predefined procedure - New_Assign_Stmt - (M2Lv (Res), New_Function_Call (Assocs)); + New_Assign_Stmt (M2Lv (Res), New_Function_Call (Assocs)); else - Translate_Read_Procedure_Call (Imp, Param_Chain); + Translate_Read_Procedure_Call (Imp, Assoc_Chain); end if; end; when Iir_Predefined_Read => - Translate_Read_Procedure_Call (Imp, Param_Chain); + Translate_Read_Procedure_Call (Imp, Assoc_Chain); when Iir_Predefined_Deallocate => - Chap3.Translate_Object_Deallocation (Get_Actual (Param_Chain)); + Chap3.Translate_Object_Deallocation (Get_Actual (Assoc_Chain)); when Iir_Predefined_File_Open => declare - N_Param : Iir; - File_Param : Iir; - Name_Param : Iir; - Kind_Param : Iir; + File_Param : constant Iir := Get_Actual (Assoc_Chain); + Name_Inter : constant Iir := Get_Chain (Inter_Chain); + Name_Assoc : constant Iir := Get_Chain (Assoc_Chain); + Name_Param : constant Iir := Get_Actual (Name_Assoc); + Kind_Inter : constant Iir := Get_Chain (Name_Inter); + Kind_Assoc : constant Iir := Get_Chain (Name_Assoc); + Kind_Param : constant Iir := + Get_Actual_Or_Default (Kind_Assoc, Kind_Inter); Constr : O_Assoc_List; begin - File_Param := Get_Actual (Param_Chain); - N_Param := Get_Chain (Param_Chain); - Name_Param := Get_Actual (N_Param); - N_Param := Get_Chain (N_Param); - Kind_Param := Get_Actual_Or_Default (N_Param); if Get_Text_File_Flag (Get_Type (File_Param)) then Start_Association (Constr, Ghdl_Text_File_Open); else @@ -2045,21 +2036,21 @@ package body Trans.Chap8 is Std_File_Open_Status_Otype : constant O_Tnode := Get_Ortho_Type (File_Open_Status_Type_Definition, Mode_Value); - N_Param : Iir; - Status_Param : constant Iir := Get_Actual (Param_Chain); - File_Param : Iir; - Name_Param : Iir; - Kind_Param : Iir; + Status_Param : constant Iir := Get_Actual (Assoc_Chain); + File_Inter : constant Iir := Get_Chain (Inter_Chain); + File_Assoc : constant Iir := Get_Chain (Assoc_Chain); + File_Param : constant Iir := Get_Actual (File_Assoc); + Name_Inter : constant Iir := Get_Chain (File_Inter); + Name_Assoc : constant Iir := Get_Chain (File_Assoc); + Name_Param : constant Iir := Get_Actual (Name_Assoc); + Kind_Inter : constant Iir := Get_Chain (Name_Inter); + Kind_Assoc : constant Iir := Get_Chain (Name_Assoc); + Kind_Param : constant Iir := + Get_Actual_Or_Default (Kind_Assoc, Kind_Inter); Constr : O_Assoc_List; Status : Mnode; begin Status := Chap6.Translate_Name (Status_Param, Mode_Value); - N_Param := Get_Chain (Param_Chain); - File_Param := Get_Actual (N_Param); - N_Param := Get_Chain (N_Param); - Name_Param := Get_Actual (N_Param); - N_Param := Get_Chain (N_Param); - Kind_Param := Get_Actual_Or_Default (N_Param); if Get_Text_File_Flag (Get_Type (File_Param)) then Start_Association (Constr, Ghdl_Text_File_Open_Status); else @@ -2073,16 +2064,16 @@ package body Trans.Chap8 is New_Association (Constr, Chap7.Translate_Expression (Name_Param, - String_Type_Definition)); + String_Type_Definition)); New_Assign_Stmt (M2Lv (Status), New_Convert_Ov (New_Function_Call (Constr), - Std_File_Open_Status_Otype)); + Std_File_Open_Status_Otype)); end; when Iir_Predefined_File_Close => declare - File_Param : constant Iir := Get_Actual (Param_Chain); + File_Param : constant Iir := Get_Actual (Assoc_Chain); Constr : O_Assoc_List; begin if Get_Text_File_Flag (Get_Type (File_Param)) then @@ -2097,7 +2088,7 @@ package body Trans.Chap8 is when Iir_Predefined_Flush => declare - File_Param : constant Iir := Get_Actual (Param_Chain); + File_Param : constant Iir := Get_Actual (Assoc_Chain); Constr : O_Assoc_List; begin Start_Association (Constr, Ghdl_File_Flush); @@ -2128,7 +2119,7 @@ package body Trans.Chap8 is Imp : constant Iir := Get_Implementation (Call); Info : constant Call_Info_Acc := Get_Info (Call); - Assoc : Iir; + Assoc, Inter : Iir; Num : Natural; begin Push_Instance_Factory (Info.Call_State_Scope'Access); @@ -2141,13 +2132,13 @@ package body Trans.Chap8 is Ghdl_Ptr_Type, O_Storage_Local); Assoc := Get_Parameter_Association_Chain (Call); + Inter := Get_Interface_Declaration_Chain (Imp); Num := 0; while Assoc /= Null_Iir loop declare - Formal : constant Iir := Strip_Denoting_Name (Get_Formal (Assoc)); + Formal : constant Iir := Get_Association_Formal (Assoc, Inter); Ftype : constant Iir := Get_Type (Formal); Ftype_Info : constant Type_Info_Acc := Get_Info (Ftype); - Inter : constant Iir := Get_Association_Interface (Assoc); Call_Assoc_Info : Call_Assoc_Info_Acc; Actual : Iir; Act_Type : Iir; @@ -2271,6 +2262,8 @@ package body Trans.Chap8 is return True; end Need_Value_Field; begin + Inter := Get_Association_Interface (Assoc, Inter); + Call_Assoc_Info := null; Has_Bounds_Field := False; Has_Fat_Pointer_Field := False; @@ -2412,7 +2405,7 @@ package body Trans.Chap8 is Num := Num + 1; end if; end; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; Pop_Instance_Factory (Info.Call_State_Scope'Access); @@ -2515,6 +2508,7 @@ package body Trans.Chap8 is (Call : Iir; Assoc_Chain : Iir; Obj : Iir) return O_Enode is Imp : constant Iir := Get_Implementation (Call); + Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); Is_Procedure : constant Boolean := Get_Kind (Imp) = Iir_Kind_Procedure_Declaration; @@ -2552,6 +2546,7 @@ package body Trans.Chap8 is Params_Var : Var_Type; Res : Mnode; El : Iir; + Inter : Iir; Pos : Natural; Constr : O_Assoc_List; Last_Individual : Natural; @@ -2614,6 +2609,7 @@ package body Trans.Chap8 is -- Non-composite in-out parameters address are saved in order to -- be able to assignate the result. El := Assoc_Chain; + Inter := Inter_Chain; Pos := 0; while El /= Null_Iir loop Params (Pos) := Mnode_Null; @@ -2622,15 +2618,15 @@ package body Trans.Chap8 is Inout_Params (Pos) := Mnode_Null; declare - Assoc_Info : Call_Assoc_Info_Acc; - Base_Formal : constant Iir := Get_Association_Interface (El); - Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El)); + Formal : constant Iir := Get_Association_Formal (El, Inter); Formal_Type : constant Iir := Get_Type (Formal); Ftype_Info : constant Type_Info_Acc := Get_Info (Formal_Type); + Base_Formal : constant Iir := Get_Interface_Of_Formal (Formal); Formal_Info : constant Interface_Info_Acc := Get_Info (Base_Formal); Formal_Object_Kind : constant Object_Kind_Type := Get_Interface_Kind (Base_Formal); + Assoc_Info : Call_Assoc_Info_Acc; Act : Iir; Actual_Type : Iir; In_Conv : Iir; @@ -2668,7 +2664,7 @@ package body Trans.Chap8 is case Get_Kind (El) is when Iir_Kind_Association_Element_Open => - Act := Get_Default_Value (Formal); + Act := Get_Default_Value (Base_Formal); In_Conv := Null_Iir; when Iir_Kind_Association_Element_By_Expression => Act := Get_Actual (El); @@ -2976,7 +2972,7 @@ package body Trans.Chap8 is << Continue >> null; end; - El := Get_Chain (El); + Next_Association_Interface (El, Inter); Pos := Pos + 1; end loop; @@ -3011,8 +3007,9 @@ package body Trans.Chap8 is begin Open_Temp; El := Assoc_Chain; + Inter := Inter_Chain; while El /= Null_Iir loop - Base_Formal := Get_Association_Interface (El); + Base_Formal := Get_Association_Interface (El, Inter); case Get_Kind (El) is when Iir_Kind_Association_Element_By_Individual => if Get_Kind (Base_Formal) @@ -3051,7 +3048,7 @@ package body Trans.Chap8 is when others => null; end case; - El := Get_Chain (El); + Next_Association_Interface (El, Inter); end loop; Close_Temp; end; @@ -3082,11 +3079,13 @@ package body Trans.Chap8 is -- Parameters. El := Assoc_Chain; + Inter := Inter_Chain; Pos := 0; while El /= Null_Iir loop declare - Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El)); - Base_Formal : constant Iir := Get_Association_Interface (El); + Formal : constant Iir := Get_Association_Formal (El, Inter); + Base_Formal : constant Iir := + Get_Association_Interface (El, Inter); Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal); begin if Formal_Info.Interface_Field (Mode_Value) = O_Fnode_Null then @@ -3110,7 +3109,7 @@ package body Trans.Chap8 is end if; end; - El := Get_Chain (El); + Next_Association_Interface (El, Inter); Pos := Pos + 1; end loop; @@ -3144,13 +3143,15 @@ package body Trans.Chap8 is -- Copy-out non-composite parameters. El := Assoc_Chain; + Inter := Inter_Chain; Pos := 0; while El /= Null_Iir loop if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then Last_Individual := Pos; declare Assoc_Info : constant Call_Assoc_Info_Acc := Get_Info (El); - Base_Formal : constant Iir := Get_Association_Interface (El); + Base_Formal : constant Iir := + Get_Association_Interface (El, Inter); Formal_Type : Iir; Ftype_Info : Type_Info_Acc; begin @@ -3178,8 +3179,8 @@ package body Trans.Chap8 is elsif Params (Pos) /= Mnode_Null then declare Assoc_Info : constant Call_Assoc_Info_Acc := Get_Info (El); - Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El)); - Base_Formal : constant Iir := Get_Association_Interface (El); + Formal : constant Iir := Get_Association_Formal (El, Inter); + Base_Formal : constant Iir := Get_Interface_Of_Formal (Formal); Formal_Type : constant Iir := Get_Type (Formal); Ftype_Info : constant Type_Info_Acc := Get_Info (Formal_Type); Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal); @@ -3238,7 +3239,7 @@ package body Trans.Chap8 is Chap7.Translate_Assign (Param, Val, Out_Expr, Actual_Type, El); end; end if; - El := Get_Chain (El); + Next_Association_Interface (El, Inter); Pos := Pos + 1; end loop; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index b8cc5741a..5f4ef84bf 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -159,12 +159,11 @@ package body Trans.Chap9 is procedure Translate_Component_Instantiation_Statement (Inst : Iir) is - Comp : constant Iir := Get_Instantiated_Unit (Inst); - Info : Block_Info_Acc; - Comp_Info : Comp_Info_Acc; + Info : Block_Info_Acc; + Ports : Iir; Mark, Mark2 : Id_Mark_Type; - Assoc, Conv, In_Type : Iir; + Assoc, Inter, Conv, In_Type : Iir; Has_Conv_Record : Boolean := False; begin Info := Add_Info (Inst, Kind_Block); @@ -172,15 +171,22 @@ package body Trans.Chap9 is if Is_Component_Instantiation (Inst) then -- Via a component declaration. - Comp_Info := Get_Info (Get_Named_Entity (Comp)); - Info.Block_Link_Field := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (Inst), - Get_Scope_Type (Comp_Info.Comp_Scope)); + declare + Comp : constant Iir := + Get_Named_Entity (Get_Instantiated_Unit (Inst)); + Comp_Info : constant Comp_Info_Acc := Get_Info (Comp); + begin + Info.Block_Link_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Inst), + Get_Scope_Type (Comp_Info.Comp_Scope)); + Ports := Comp; + end; else -- Direct instantiation. Info.Block_Link_Field := Add_Instance_Factory_Field (Create_Identifier_Without_Prefix (Inst), Rtis.Ghdl_Component_Link_Type); + Ports := Get_Entity_From_Entity_Aspect (Get_Instantiated_Unit (Inst)); end if; -- When conversions are used, the subtype of the actual (or of the @@ -189,6 +195,7 @@ package body Trans.Chap9 is -- We need to translate it and create variables in the instance -- because it will be referenced by the conversion subprogram. Assoc := Get_Port_Map_Aspect_Chain (Inst); + Inter := Get_Port_Chain (Ports); while Assoc /= Null_Iir loop if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then @@ -207,12 +214,12 @@ package body Trans.Chap9 is -- formal. Push_Identifier_Prefix (Mark2, - Get_Identifier (Get_Association_Interface (Assoc))); + Get_Identifier (Get_Association_Interface (Assoc, Inter))); Chap3.Translate_Type_Definition (In_Type, True); Pop_Identifier_Prefix (Mark2); end if; end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; if Has_Conv_Record then Pop_Instance_Factory (Info.Block_Scope'Access); @@ -946,8 +953,8 @@ package body Trans.Chap9 is -- instantiation statement. Set_Component_Link (Comp_Info.Comp_Scope, Comp_Info.Comp_Link); - Chap5.Elab_Map_Aspect (Stmt, Comp, (Comp_Info.Comp_Scope'Access, - Comp_Info.Comp_Scope)); + Chap5.Elab_Map_Aspect (Comp, Stmt, Comp, (Comp_Info.Comp_Scope'Access, + Comp_Info.Comp_Scope)); Clear_Scope (Comp_Info.Comp_Scope); end if; @@ -1723,7 +1730,7 @@ package body Trans.Chap9 is begin Entity_Map.Scope_Ptr := Entity_Info.Block_Scope'Access; Set_Scope_Via_Param_Ptr (Entity_Map.Scope, Var_Sub); - Chap5.Elab_Map_Aspect (Mapping, Entity, Entity_Map); + Chap5.Elab_Map_Aspect (Entity, Mapping, Entity, Entity_Map); Clear_Scope (Entity_Map.Scope); end; @@ -2453,7 +2460,7 @@ package body Trans.Chap9 is Block_Info := Get_Info (Block); Block_Env := (Block_Info.Block_Scope'Access, Block_Info.Block_Scope); - Chap5.Elab_Map_Aspect (Header, Block, Block_Env); + Chap5.Elab_Map_Aspect (Header, Header, Block, Block_Env); Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header)); end if; end; diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb index 8fce7c2bc..427989935 100644 --- a/src/vhdl/translate/trans_analyzes.adb +++ b/src/vhdl/translate/trans_analyzes.adb @@ -97,13 +97,7 @@ package body Trans_Analyzes is Inter := Get_Interface_Declaration_Chain (Get_Implementation (Call)); while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); - if Formal = Null_Iir then - Formal := Inter; - Inter := Get_Chain (Inter); - else - Formal := Get_Association_Interface (Assoc); - end if; + Formal := Get_Association_Interface (Assoc, Inter); if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression and then @@ -112,7 +106,7 @@ package body Trans_Analyzes is then Status := Extract_Driver_Target (Get_Actual (Assoc)); end if; - Assoc := Get_Chain (Assoc); + Next_Association_Interface (Assoc, Inter); end loop; end; when others => -- cgit v1.2.3