-- Canonicalization pass -- Copyright (C) 2002, 2003, 2004, 2005, 2008 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 Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Types; use Types; with Flags; use Flags; with Name_Table; with Sem; with Sem_Inst; with Sem_Specs; with Iir_Chains; use Iir_Chains; with PSL.Nodes; with PSL.Rewrites; with PSL.Build; with PSL.NFAs; 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. procedure Canon_Declarations (Top : Iir_Design_Unit; Decl_Parent : Iir; Parent : Iir); function Canon_Declaration (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir; Decl_Parent : Iir) return Iir; procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir); -- Canonicalize an association list. -- If ASSOCIATION_LIST is not null, then it is re-ordored and returned. -- If ASSOCIATION_LIST is null then: -- if INTERFACE_LIST is null then returns null. -- if INTERFACE_LIST is not null, a default list is created. function Canon_Association_Chain (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) return Iir; -- Like Canon_Association_Chain but recurse on actuals. function Canon_Association_Chain_And_Actuals (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) return Iir; -- Like Canon_Subprogram_Call, but recurse on actuals. procedure Canon_Subprogram_Call_And_Actuals (Call : Iir); -- Canonicalize block configuration CONF. -- TOP is used to added dependences to the design unit which CONF -- belongs to. procedure Canon_Block_Configuration (Top : Iir_Design_Unit; Conf : Iir_Block_Configuration); procedure Canon_Subtype_Indication (Def : Iir); procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir); function Canon_Conditional_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) return Iir; procedure Canon_Conditional_Signal_Assignment_Expression (Stmt : Iir); procedure Canon_Extract_Sensitivity_Aggregate (Aggr : Iir; Sensitivity_List : Iir_List; Is_Target : Boolean; Aggr_Type : Iir; Dim : Natural) is Assoc : Iir; begin Assoc := Get_Association_Choices_Chain (Aggr); if Get_Nbr_Elements (Get_Index_Subtype_List (Aggr_Type)) = Dim then while Assoc /= Null_Iir loop Canon_Extract_Sensitivity (Get_Associated_Expr (Assoc), Sensitivity_List, Is_Target); Assoc := Get_Chain (Assoc); end loop; else while Assoc /= Null_Iir loop Canon_Extract_Sensitivity_Aggregate (Get_Associated_Expr (Assoc), Sensitivity_List, Is_Target, Aggr_Type, Dim + 1); Assoc := Get_Chain (Assoc); end loop; end if; end Canon_Extract_Sensitivity_Aggregate; procedure Canon_Extract_Sensitivity (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is El : Iir; List: Iir_List; begin if Get_Expr_Staticness (Expr) /= None then return; end if; case Get_Kind (Expr) is when Iir_Kind_Slice_Name => if not Is_Target and then Get_Name_Staticness (Expr) >= Globally then if Is_Signal_Object (Expr) then Add_Element (Sensitivity_List, Expr); end if; else declare Suff : Iir; begin Canon_Extract_Sensitivity (Get_Prefix (Expr), Sensitivity_List, Is_Target); Suff := Get_Suffix (Expr); if Get_Kind (Suff) not in Iir_Kinds_Scalar_Type_And_Subtype_Definition then Canon_Extract_Sensitivity (Suff, Sensitivity_List, False); end if; end; end if; when Iir_Kind_Selected_Element => if not Is_Target and then Get_Name_Staticness (Expr) >= Globally then if Is_Signal_Object (Expr) then Add_Element (Sensitivity_List, Expr); end if; else Canon_Extract_Sensitivity (Get_Prefix (Expr), Sensitivity_List, Is_Target); end if; when Iir_Kind_Indexed_Name => if not Is_Target and then Get_Name_Staticness (Expr) >= Globally then if Is_Signal_Object (Expr) then Add_Element (Sensitivity_List, Expr); end if; else Canon_Extract_Sensitivity (Get_Prefix (Expr), Sensitivity_List, Is_Target); List := Get_Index_List (Expr); for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Canon_Extract_Sensitivity (El, Sensitivity_List, False); end loop; end if; when Iir_Kind_Function_Call => El := Get_Parameter_Association_Chain (Expr); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Association_Element_By_Expression => Canon_Extract_Sensitivity (Get_Actual (El), Sensitivity_List, False); when Iir_Kind_Association_Element_Open => null; when others => Error_Kind ("canon_extract_sensitivity(call)", El); end case; El := Get_Chain (El); end loop; when Iir_Kind_Qualified_Expression | Iir_Kind_Type_Conversion | Iir_Kind_Allocator_By_Expression | Iir_Kind_Parenthesis_Expression => Canon_Extract_Sensitivity (Get_Expression (Expr), Sensitivity_List, False); when Iir_Kind_Allocator_By_Subtype => null; when Iir_Kinds_Monadic_Operator => Canon_Extract_Sensitivity (Get_Operand (Expr), Sensitivity_List, False); when Iir_Kinds_Dyadic_Operator => Canon_Extract_Sensitivity (Get_Left (Expr), Sensitivity_List, False); Canon_Extract_Sensitivity (Get_Right (Expr), Sensitivity_List, False); when Iir_Kind_Range_Expression => Canon_Extract_Sensitivity (Get_Left_Limit (Expr), Sensitivity_List, False); Canon_Extract_Sensitivity (Get_Right_Limit (Expr), Sensitivity_List, False); when Iir_Kinds_Type_Attribute => null; when Iir_Kinds_Signal_Value_Attribute => -- LRM 8.1 -- An attribute name: [...]; otherwise, apply this rule to the -- prefix of the attribute name. Canon_Extract_Sensitivity (Get_Prefix (Expr), Sensitivity_List, False); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kinds_Signal_Attribute => -- LRM 8.1 -- A simple name that denotes a signal, add the longuest static -- prefix of the name to the sensitivity set; -- -- An attribute name: if the designator denotes a signal -- attribute, add the longuest static prefix of the name of the -- implicit signal denoted by the attribute name to the -- sensitivity set; [...] if not Is_Target then Add_Element (Sensitivity_List, Expr); end if; when Iir_Kind_Psl_Endpoint_Declaration => declare List : constant Iir_List := Get_PSL_Clock_Sensitivity (Expr); El : Iir; begin for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Add_Element (Sensitivity_List, El); end loop; end; when Iir_Kind_Object_Alias_Declaration => Canon_Extract_Sensitivity (Get_Name (Expr), Sensitivity_List, Is_Target); when Iir_Kind_Constant_Declaration | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_File_Declaration => null; when Iir_Kinds_Array_Attribute => -- was Iir_Kind_Left_Array_Attribute -- ditto Right, Low, High, Length -- add Ascending, Range and Reverse_Range... null; --Canon_Extract_Sensitivity -- (Get_Prefix (Expr), Sensitivity_List, Is_Target); when Iir_Kind_Value_Attribute | Iir_Kind_Image_Attribute | Iir_Kinds_Scalar_Type_Attribute => Canon_Extract_Sensitivity (Get_Parameter (Expr), Sensitivity_List, Is_Target); when Iir_Kind_Aggregate => declare Aggr_Type : Iir; begin Aggr_Type := Get_Base_Type (Get_Type (Expr)); case Get_Kind (Aggr_Type) is when Iir_Kind_Array_Type_Definition => Canon_Extract_Sensitivity_Aggregate (Expr, Sensitivity_List, Is_Target, Aggr_Type, 1); when Iir_Kind_Record_Type_Definition => El := Get_Association_Choices_Chain (Expr); while El /= Null_Iir loop Canon_Extract_Sensitivity (Get_Associated_Expr (El), Sensitivity_List, Is_Target); El := Get_Chain (El); end loop; when others => Error_Kind ("canon_extract_sensitivity(aggr)", Aggr_Type); end case; end; when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => Canon_Extract_Sensitivity (Get_Named_Entity (Expr), Sensitivity_List, Is_Target); when others => Error_Kind ("canon_extract_sensitivity", Expr); end case; end Canon_Extract_Sensitivity; procedure Canon_Extract_Sensitivity_If_Not_Null (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is begin if Expr /= Null_Iir then Canon_Extract_Sensitivity (Expr, Sensitivity_List, Is_Target); 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_Sensitivity_Waveform (Chain : Iir; List : Iir_List) is We: Iir_Waveform_Element; begin We := Chain; while We /= Null_Iir loop Canon_Extract_Sensitivity (Get_We_Value (We), List); Canon_Extract_Sensitivity_If_Not_Null (Get_Time (We), List); We := Get_Chain (We); end loop; end Canon_Extract_Sensitivity_Waveform; procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity (Chain : Iir; List : Iir_List) is Stmt : Iir; begin Stmt := Chain; while Stmt /= Null_Iir loop case Get_Kind (Stmt) is when Iir_Kind_Assertion_Statement => -- LRM08 11.3 -- * For each assertion, report, next, exit or return -- statement, apply the rule of 10.2 to each expression -- in the statement, and construct the union of the -- resulting sets. Canon_Extract_Sensitivity (Get_Assertion_Condition (Stmt), List); Canon_Extract_Sensitivity (Get_Severity_Expression (Stmt), List); Canon_Extract_Sensitivity (Get_Report_Expression (Stmt), List); when Iir_Kind_Report_Statement => -- LRM08 11.3 -- See assertion_statement case. Canon_Extract_Sensitivity (Get_Severity_Expression (Stmt), List); Canon_Extract_Sensitivity (Get_Report_Expression (Stmt), List); when Iir_Kind_Next_Statement | Iir_Kind_Exit_Statement => -- LRM08 11.3 -- See assertion_statement case. Canon_Extract_Sensitivity (Get_Condition (Stmt), List); when Iir_Kind_Return_Statement => -- LRM08 11.3 -- See assertion_statement case. Canon_Extract_Sensitivity_If_Not_Null (Get_Expression (Stmt), List); when Iir_Kind_Variable_Assignment_Statement => -- LRM08 11.3 -- * For each assignment statement, apply the rule of 10.2 to -- each expression occuring in the assignment, including any -- expressions occuring in the index names or slice names in -- the target, and construct the union of the resulting sets. Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); Canon_Extract_Sensitivity (Get_Expression (Stmt), List, False); when Iir_Kind_Simple_Signal_Assignment_Statement => -- LRM08 11.3 -- See variable assignment statement case. Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); Canon_Extract_Sensitivity_If_Not_Null (Get_Reject_Time_Expression (Stmt), List); Canon_Extract_Sensitivity_Waveform (Get_Waveform_Chain (Stmt), List); when Iir_Kind_Conditional_Signal_Assignment_Statement => Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); Canon_Extract_Sensitivity_If_Not_Null (Get_Reject_Time_Expression (Stmt), List); declare Cwe : Iir; begin Cwe := Get_Conditional_Waveform_Chain (Stmt); while Cwe /= Null_Iir loop Canon_Extract_Sensitivity_If_Not_Null (Get_Condition (Cwe), List); Canon_Extract_Sensitivity_Waveform (Get_Waveform_Chain (Cwe), List); Cwe := Get_Chain (Cwe); end loop; end; when Iir_Kind_If_Statement => -- LRM08 11.3 -- * For each if statement, apply the rule of 10.2 to the -- condition and apply this rule recursively to each -- sequence of statements within the if statement, and -- construct the union of the resuling sets. declare El1 : Iir := Stmt; Cond : Iir; begin loop Cond := Get_Condition (El1); if Cond /= Null_Iir then Canon_Extract_Sensitivity (Cond, List); end if; Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (El1), List); El1 := Get_Else_Clause (El1); exit when El1 = Null_Iir; end loop; end; when Iir_Kind_Case_Statement => -- LRM08 11.3 -- * For each case statement, apply the rule of 10.2 to the -- expression and apply this rule recursively to each -- sequence of statements within the case statement, and -- construct the union of the resulting sets. Canon_Extract_Sensitivity (Get_Expression (Stmt), List); declare Choice: Iir; begin Choice := Get_Case_Statement_Alternative_Chain (Stmt); while Choice /= Null_Iir loop Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Associated_Chain (Choice), List); Choice := Get_Chain (Choice); end loop; end; when Iir_Kind_While_Loop_Statement => -- LRM08 11.3 -- * For each loop statement, apply the rule of 10.2 to each -- expression in the iteration scheme, if present, and apply -- this rule recursively to the sequence of statements within -- the loop statement, and construct the union of the -- resulting sets. Canon_Extract_Sensitivity_If_Not_Null (Get_Condition (Stmt), List); Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (Stmt), List); when Iir_Kind_For_Loop_Statement => -- LRM08 11.3 -- See loop statement case. declare It : constant Iir := Get_Parameter_Specification (Stmt); It_Type : constant Iir := Get_Type (It); Rng : constant Iir := Get_Range_Constraint (It_Type); begin if Get_Kind (Rng) = Iir_Kind_Range_Expression then Canon_Extract_Sensitivity (Rng, List); end if; end; Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (Stmt), List); when Iir_Kind_Null_Statement => -- LRM08 11.3 -- ? null; when Iir_Kind_Procedure_Call_Statement => -- LRM08 11.3 -- * For each procedure call statement, apply the rule of 10.2 -- 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. Canon_Extract_Sensitivity_Procedure_Call (List, Get_Procedure_Call (Stmt)); when others => Error_Kind ("canon_extract_sequential_statement_chain_sensitivity", Stmt); end case; Stmt := Get_Chain (Stmt); end loop; end Canon_Extract_Sequential_Statement_Chain_Sensitivity; procedure Canon_Extract_Sensitivity_From_Callees (Callees_List : Iir_List; Sensitivity_List : Iir_List) is Callee : Iir; Bod : Iir; begin -- LRM08 11.3 -- Moreover, for each subprogram for which the process is a parent -- (see 4.3), the sensitivity list includes members of the set -- constructed by apply the preceding rule to the statements of the -- subprogram, but excluding the members that denote formal signal -- parameters or members of formal signal parameters of the subprogram -- or any of its parents. if Callees_List = Null_Iir_List then return; end if; for I in Natural loop Callee := Get_Nth_Element (Callees_List, I); exit when Callee = Null_Iir; if not Get_Seen_Flag (Callee) then Set_Seen_Flag (Callee, True); case Get_All_Sensitized_State (Callee) is when Read_Signal => Bod := Get_Subprogram_Body (Callee); -- Extract sensitivity from signals read in the body. -- FIXME: what about signals read during in declarations ? Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (Bod), Sensitivity_List); -- Extract sensitivity from subprograms called. Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Bod), Sensitivity_List); when No_Signal => null; when Unknown | Invalid_Signal => raise Internal_Error; end case; end if; end loop; end Canon_Extract_Sensitivity_From_Callees; function Canon_Extract_Process_Sensitivity (Proc : Iir_Sensitized_Process_Statement) return Iir_List is Res : Iir_List; begin Res := Create_Iir_List; -- Signals read by statements. -- FIXME: justify why signals read in declarations don't care. Canon_Extract_Sequential_Statement_Chain_Sensitivity (Get_Sequential_Statement_Chain (Proc), Res); -- Signals read indirectly by subprograms called. Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Proc), Res); Set_Seen_Flag (Proc, True); Clear_Seen_Flag (Proc); return Res; end Canon_Extract_Process_Sensitivity; -- function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir) -- return Iir_Aggregate -- is -- Res : Iir_Aggregate; -- Choice : Iir; -- begin -- Res := Create_Iir (Iir_Kind_Aggregate); -- Location_Copy (Res, El); -- Choice := Create_Iir (Iir_Kind_Association_Choice_By_None); -- Set_Associated (Choice, El); -- Append_Element (Get_Association_Choices_List (Res), Choice); -- -- will call sem_aggregate -- return Sem_Expr.Sem_Expression (Res, Array_Type); -- end Make_Aggregate; -- procedure Canon_Concatenation_Operator (Expr : Iir) -- is -- Array_Type : Iir_Array_Type_Definition; -- El_Type : Iir; -- Left, Right : Iir; -- Func_List : Iir_Implicit_Functions_List; -- Func : Iir_Implicit_Function_Declaration; -- begin -- Array_Type := Get_Type (Expr); -- El_Type := Get_Base_Type (Get_Element_Subtype (Array_Type)); -- Left := Get_Left (Expr); -- if Get_Type (Left) = El_Type then -- Set_Left (Expr, Make_Aggregate (Array_Type, Left)); -- end if; -- Right := Get_Right (Expr); -- if Get_Type (Right) = El_Type then -- Set_Right (Expr, Make_Aggregate (Array_Type, Right)); -- end if; -- -- FIXME: must convert the implementation. -- -- Use implicit declaration list from the array_type ? -- Func_List := Get_Implicit_Functions_List -- (Get_Type_Declarator (Array_Type)); -- for I in Natural loop -- Func := Get_Nth_Element (Func_List, I); -- if Get_Implicit_Definition (Func) -- = Iir_Predefined_Array_Array_Concat -- then -- Set_Implementation (Expr, Func); -- exit; -- end if; -- end loop; -- end Canon_Concatenation_Operator; procedure Canon_Aggregate_Expression (Expr: Iir) is Assoc : Iir; begin Assoc := Get_Association_Choices_Chain (Expr); while Assoc /= Null_Iir loop case Get_Kind (Assoc) is when Iir_Kind_Choice_By_Others | Iir_Kind_Choice_By_None | Iir_Kind_Choice_By_Name => null; when Iir_Kind_Choice_By_Expression => Canon_Expression (Get_Choice_Expression (Assoc)); when Iir_Kind_Choice_By_Range => declare Choice : constant Iir := Get_Choice_Range (Assoc); begin if Get_Kind (Choice) = Iir_Kind_Range_Expression then Canon_Expression (Choice); end if; end; when others => Error_Kind ("canon_aggregate_expression", Assoc); end case; Canon_Expression (Get_Associated_Expr (Assoc)); Assoc := Get_Chain (Assoc); end loop; end Canon_Aggregate_Expression; -- canon on expressions, mainly for function calls. procedure Canon_Expression (Expr: Iir) is El : Iir; List: Iir_List; begin if Expr = Null_Iir then return; end if; case Get_Kind (Expr) is when Iir_Kind_Range_Expression => Canon_Expression (Get_Left_Limit (Expr)); Canon_Expression (Get_Right_Limit (Expr)); when Iir_Kind_Slice_Name => declare Suffix : Iir; begin Suffix := Strip_Denoting_Name (Get_Suffix (Expr)); if Get_Kind (Suffix) /= Iir_Kind_Subtype_Declaration then Canon_Expression (Suffix); end if; Canon_Expression (Get_Prefix (Expr)); end; when Iir_Kind_Indexed_Name => Canon_Expression (Get_Prefix (Expr)); List := Get_Index_List (Expr); for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Canon_Expression (El); end loop; when Iir_Kind_Selected_Element => Canon_Expression (Get_Prefix (Expr)); when Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference => Canon_Expression (Get_Prefix (Expr)); when Iir_Kinds_Denoting_Name => Canon_Expression (Get_Named_Entity (Expr)); when Iir_Kinds_Monadic_Operator => Canon_Expression (Get_Operand (Expr)); when Iir_Kinds_Dyadic_Operator => Canon_Expression (Get_Left (Expr)); Canon_Expression (Get_Right (Expr)); if Get_Kind (Expr) = Iir_Kind_Concatenation_Operator and then Canon_Concatenation and then Is_Implicit_Subprogram (Get_Implementation (Expr)) then --Canon_Concatenation_Operator (Expr); raise Internal_Error; end if; when Iir_Kind_Function_Call => Canon_Subprogram_Call_And_Actuals (Expr); -- FIXME: -- should canon concatenation. when Iir_Kind_Parenthesis_Expression => Canon_Expression (Get_Expression (Expr)); when Iir_Kind_Type_Conversion | Iir_Kind_Qualified_Expression => Canon_Expression (Get_Expression (Expr)); when Iir_Kind_Aggregate => Canon_Aggregate_Expression (Expr); when Iir_Kind_Allocator_By_Expression => Canon_Expression (Get_Expression (Expr)); when Iir_Kind_Allocator_By_Subtype => declare Ind : constant Iir := Get_Subtype_Indication (Expr); begin if Get_Kind (Ind) = Iir_Kind_Array_Subtype_Definition then Canon_Subtype_Indication (Ind); end if; end; when Iir_Kinds_Literal | Iir_Kind_Simple_Aggregate | Iir_Kind_Unit_Declaration => null; when Iir_Kinds_Array_Attribute => -- No need to canon parameter, since it is a locally static -- expression. declare Prefix : constant Iir := Get_Prefix (Expr); begin if Get_Kind (Prefix) in Iir_Kinds_Denoting_Name and then (Get_Kind (Get_Named_Entity (Prefix)) in Iir_Kinds_Type_Declaration) then -- No canon for types. null; else Canon_Expression (Prefix); end if; end; when Iir_Kinds_Type_Attribute => null; when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Transaction_Attribute => -- FIXME: add the default parameter ? Canon_Expression (Get_Prefix (Expr)); when Iir_Kind_Event_Attribute | Iir_Kind_Last_Value_Attribute | Iir_Kind_Active_Attribute | Iir_Kind_Last_Event_Attribute | Iir_Kind_Last_Active_Attribute | Iir_Kind_Driving_Attribute | Iir_Kind_Driving_Value_Attribute => Canon_Expression (Get_Prefix (Expr)); when Iir_Kinds_Scalar_Type_Attribute | Iir_Kind_Image_Attribute | Iir_Kind_Value_Attribute => Canon_Expression (Get_Parameter (Expr)); when Iir_Kind_Simple_Name_Attribute | Iir_Kind_Path_Name_Attribute | Iir_Kind_Instance_Name_Attribute => null; when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration => null; when Iir_Kind_Enumeration_Literal | Iir_Kind_Overflow_Literal => null; when Iir_Kind_Element_Declaration => null; when Iir_Kind_Attribute_Value | Iir_Kind_Attribute_Name => null; when others => Error_Kind ("canon_expression", Expr); null; end case; end Canon_Expression; procedure Canon_Expression_If_Valid (Expr : Iir) is begin if Is_Valid (Expr) then Canon_Expression (Expr); end if; end Canon_Expression_If_Valid; procedure Canon_PSL_Expression (Expr : PSL_Node) is use PSL.Nodes; begin case Get_Kind (Expr) is when N_HDL_Expr => Canon_Expression (Get_HDL_Node (Expr)); when N_True | N_EOS => null; when N_Not_Bool => Canon_PSL_Expression (Get_Boolean (Expr)); when N_And_Bool | N_Or_Bool => Canon_PSL_Expression (Get_Left (Expr)); Canon_PSL_Expression (Get_Right (Expr)); when others => Error_Kind ("canon_psl_expression", Expr); end case; end Canon_PSL_Expression; procedure Canon_Discrete_Range (Rng : Iir) is begin case Get_Kind (Rng) is when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition => Canon_Expression (Get_Range_Constraint (Rng)); when Iir_Kind_Enumeration_Type_Definition => null; when others => Error_Kind ("canon_discrete_range", Rng); end case; end Canon_Discrete_Range; -- Extract sensitivity of WAVEFORM. procedure Extract_Waveform_Sensitivity (Waveform : Iir; Sensitivity_List: Iir_List) is We : Iir_Waveform_Element; begin We := Waveform; while We /= Null_Iir loop Canon_Extract_Sensitivity (Get_We_Value (We), Sensitivity_List, False); We := Get_Chain (We); end loop; end Extract_Waveform_Sensitivity; -- Canon expression of WAVEFORM. procedure Canon_Waveform_Expression (Waveform : Iir) is We : Iir_Waveform_Element; begin We := Waveform; while We /= Null_Iir loop Canon_Expression (Get_We_Value (We)); if Get_Time (We) /= Null_Iir then Canon_Expression (Get_Time (We)); end if; We := Get_Chain (We); end loop; end Canon_Waveform_Expression; -- Names associations by position, -- reorder associations by name, -- create omitted association, function Canon_Association_Chain (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) return Iir is -- The canon list of association. N_Chain, Last : Iir; Inter : Iir; Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; Formal : Iir; Assoc_Chain : Iir; Found : Boolean; begin if not Canon_Flag_Associations then return Association_Chain; end if; -- No argument, so return now. if Interface_Chain = Null_Iir then pragma Assert (Association_Chain = Null_Iir); return Null_Iir; end if; Sub_Chain_Init (N_Chain, Last); Assoc_Chain := Association_Chain; -- Reorder the list of association in the interface order. -- Add missing associations. Inter := Interface_Chain; while Inter /= Null_Iir loop -- Search associations with INTERFACE. Found := False; Assoc_El := Assoc_Chain; Prev_Assoc_El := Null_Iir; while Assoc_El /= Null_Iir loop Next_Assoc_El := Get_Chain (Assoc_El); 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 Formal = Inter then -- Remove ASSOC_EL from ASSOC_CHAIN if Prev_Assoc_El /= Null_Iir then Set_Chain (Prev_Assoc_El, Next_Assoc_El); else Assoc_Chain := Next_Assoc_El; end if; -- Append ASSOC_EL in N_CHAIN. Set_Chain (Assoc_El, Null_Iir); Sub_Chain_Append (N_Chain, Last, Assoc_El); case Get_Kind (Assoc_El) is when Iir_Kind_Association_Element_Open => goto Done; when Iir_Kind_Association_Element_By_Expression => if Get_Whole_Association_Flag (Assoc_El) then goto Done; end if; when Iir_Kind_Association_Element_By_Individual => Found := True; when Iir_Kind_Association_Element_Package | Iir_Kind_Association_Element_Type | Iir_Kind_Association_Element_Subprogram => goto Done; when others => Error_Kind ("canon_association_chain", Assoc_El); end case; elsif Found then -- No more associations. goto Done; else Prev_Assoc_El := Assoc_El; end if; Assoc_El := Next_Assoc_El; end loop; if Found then goto Done; end if; -- No association, use default expr. Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open); Set_Artificial_Flag (Assoc_El, True); Set_Whole_Association_Flag (Assoc_El, True); Location_Copy (Assoc_El, Loc); if Canon_Flag_Set_Assoc_Formals then Set_Formal (Assoc_El, Inter); end if; Sub_Chain_Append (N_Chain, Last, Assoc_El); << Done >> null; Inter := Get_Chain (Inter); end loop; pragma Assert (Assoc_Chain = Null_Iir); return N_Chain; end Canon_Association_Chain; procedure Canon_Association_Chain_Actuals (Association_Chain : Iir) is Assoc_El : Iir; begin -- Canon actuals. Assoc_El := Association_Chain; while Assoc_El /= Null_Iir loop if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_By_Expression then Canon_Expression (Get_Actual (Assoc_El)); end if; Assoc_El := Get_Chain (Assoc_El); end loop; end Canon_Association_Chain_Actuals; function Canon_Association_Chain_And_Actuals (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) return Iir is Res : Iir; begin Res := Canon_Association_Chain (Interface_Chain, Association_Chain, Loc); if Canon_Flag_Expressions then Canon_Association_Chain_Actuals (Res); end if; return Res; end Canon_Association_Chain_And_Actuals; procedure Canon_Subprogram_Call (Call : Iir) is Imp : constant Iir := Get_Implementation (Call); Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); Assoc_Chain : Iir; begin Assoc_Chain := Get_Parameter_Association_Chain (Call); Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); end Canon_Subprogram_Call; procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is begin Canon_Subprogram_Call (Call); if Canon_Flag_Expressions then Canon_Association_Chain_Actuals (Get_Parameter_Association_Chain (Call)); end if; end Canon_Subprogram_Call_And_Actuals; -- Create a default association list for INTERFACE_LIST. -- The default is a list of interfaces associated with open. function Canon_Default_Association_Chain (Interface_Chain : Iir) return Iir is Res : Iir; Last : Iir; Assoc, El : Iir; begin if not Canon_Flag_Associations then return Null_Iir; end if; El := Interface_Chain; Sub_Chain_Init (Res, Last); while El /= Null_Iir loop Assoc := Create_Iir (Iir_Kind_Association_Element_Open); Set_Whole_Association_Flag (Assoc, True); Set_Artificial_Flag (Assoc, True); 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); end loop; return Res; end Canon_Default_Association_Chain; function Canon_Conditional_Variable_Assignment_Statement (Stmt : Iir) return Iir is Target : constant Iir := Get_Target (Stmt); Cond_Expr : Iir; Expr : Iir; Asgn : Iir; Res : Iir; El, N_El : Iir; begin Cond_Expr := Get_Conditional_Expression (Stmt); Res := Create_Iir (Iir_Kind_If_Statement); Set_Label (Res, Get_Label (Stmt)); Set_Suspend_Flag (Res, False); El := Res; loop -- Fill if/elsif statement. Set_Parent (El, Get_Parent (Stmt)); Location_Copy (El, Cond_Expr); Set_Condition (El, Get_Condition (Cond_Expr)); -- Create simple variable assignment. Asgn := Create_Iir (Iir_Kind_Variable_Assignment_Statement); Location_Copy (Asgn, Cond_Expr); Set_Parent (Asgn, Res); Set_Target (Asgn, Target); Expr := Get_Expression (Cond_Expr); if Canon_Flag_Expressions then Canon_Expression (Expr); end if; Set_Expression (Asgn, Expr); Set_Sequential_Statement_Chain (El, Asgn); -- Next condition. Cond_Expr := Get_Chain (Cond_Expr); exit when Cond_Expr = Null_Iir; N_El := Create_Iir (Iir_Kind_Elsif); Set_Else_Clause (El, N_El); El := N_El; end loop; return Res; end Canon_Conditional_Variable_Assignment_Statement; function Canon_Conditional_Signal_Assignment_Statement (Stmt : Iir) return Iir is begin return Canon_Conditional_Signal_Assignment (Stmt, Null_Iir, Get_Parent (Stmt)); end Canon_Conditional_Signal_Assignment_Statement; -- Inner loop if any; used to canonicalize exit/next statement. Cur_Loop : Iir; function Canon_Sequential_Stmts (First : Iir) return Iir is Stmt: Iir; N_Stmt : Iir; Res, Last : Iir; begin Sub_Chain_Init (Res, Last); Stmt := First; while Stmt /= Null_Iir loop -- Keep the same statement by default. N_Stmt := Stmt; case Get_Kind (Stmt) is when Iir_Kind_If_Statement => declare Cond: Iir; Clause: Iir; Stmts : Iir; begin Clause := Stmt; while Clause /= Null_Iir loop Cond := Get_Condition (Clause); Canon_Expression_If_Valid (Cond); Stmts := Get_Sequential_Statement_Chain (Clause); Stmts := Canon_Sequential_Stmts (Stmts); Set_Sequential_Statement_Chain (Clause, Stmts); Clause := Get_Else_Clause (Clause); end loop; end; when Iir_Kind_Simple_Signal_Assignment_Statement => Canon_Expression (Get_Target (Stmt)); Canon_Waveform_Expression (Get_Waveform_Chain (Stmt)); when Iir_Kind_Conditional_Signal_Assignment_Statement => Canon_Conditional_Signal_Assignment_Expression (Stmt); N_Stmt := Canon_Conditional_Signal_Assignment_Statement (Stmt); when Iir_Kind_Variable_Assignment_Statement => Canon_Expression (Get_Target (Stmt)); Canon_Expression (Get_Expression (Stmt)); when Iir_Kind_Conditional_Variable_Assignment_Statement => N_Stmt := Canon_Conditional_Variable_Assignment_Statement (Stmt); when Iir_Kind_Wait_Statement => declare List : Iir_List; Expr : Iir; begin Canon_Expression_If_Valid (Get_Timeout_Clause (Stmt)); Expr := Get_Condition_Clause (Stmt); Canon_Expression_If_Valid (Expr); List := Get_Sensitivity_List (Stmt); if List = Null_Iir_List and then Expr /= Null_Iir then List := Create_Iir_List; Canon_Extract_Sensitivity (Expr, List, False); Set_Sensitivity_List (Stmt, List); end if; end; when Iir_Kind_Case_Statement => Canon_Expression (Get_Expression (Stmt)); declare Choice: Iir; Stmts : Iir; begin Choice := Get_Case_Statement_Alternative_Chain (Stmt); while Choice /= Null_Iir loop -- FIXME: canon choice expr. Stmts := Get_Associated_Chain (Choice); Stmts := Canon_Sequential_Stmts (Stmts); Set_Associated_Chain (Choice, Stmts); Choice := Get_Chain (Choice); end loop; end; when Iir_Kind_Assertion_Statement | Iir_Kind_Report_Statement => if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then Canon_Expression (Get_Assertion_Condition (Stmt)); end if; Canon_Expression_If_Valid (Get_Report_Expression (Stmt)); Canon_Expression_If_Valid (Get_Severity_Expression (Stmt)); when Iir_Kind_For_Loop_Statement => declare Prev_Loop : constant Iir := Cur_Loop; Stmts : Iir; begin -- FIXME: decl. Cur_Loop := Stmt; if Canon_Flag_Expressions then Canon_Discrete_Range (Get_Type (Get_Parameter_Specification (Stmt))); end if; Stmts := Get_Sequential_Statement_Chain (Stmt); Stmts := Canon_Sequential_Stmts (Stmts); Set_Sequential_Statement_Chain (Stmt, Stmts); Cur_Loop := Prev_Loop; end; when Iir_Kind_While_Loop_Statement => declare Stmts : Iir; Prev_Loop : Iir; begin Canon_Expression_If_Valid (Get_Condition (Stmt)); Prev_Loop := Cur_Loop; Cur_Loop := Stmt; Stmts := Get_Sequential_Statement_Chain (Stmt); Stmts := Canon_Sequential_Stmts (Stmts); Set_Sequential_Statement_Chain (Stmt, Stmts); Cur_Loop := Prev_Loop; end; when Iir_Kind_Next_Statement | Iir_Kind_Exit_Statement => declare Loop_Label : Iir; begin Canon_Expression_If_Valid (Get_Condition (Stmt)); Loop_Label := Get_Loop_Label (Stmt); if Loop_Label = Null_Iir then Set_Loop_Label (Stmt, Build_Simple_Name (Cur_Loop, Stmt)); end if; end; when Iir_Kind_Procedure_Call_Statement => Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt)); when Iir_Kind_Null_Statement => null; when Iir_Kind_Return_Statement => Canon_Expression (Get_Expression (Stmt)); when others => Error_Kind ("canon_sequential_stmts", Stmt); end case; Sub_Chain_Append (Res, Last, N_Stmt); Stmt := Get_Chain (Stmt); end loop; return Res; end Canon_Sequential_Stmts; -- Create a statement transform from concurrent_signal_assignment -- statement STMT (either selected or conditional). -- waveform transformation is not done. -- PROC is the process created. -- PARENT is the place where signal assignment must be placed. This may -- be PROC, or an 'if' statement if the assignment is guarded. -- See LRM93 9.5 procedure Canon_Concurrent_Signal_Assignment (Stmt: Iir; Proc: out Iir_Sensitized_Process_Statement; Chain : out Iir) is If_Stmt: Iir; Sensitivity_List : Iir_List; begin Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); Location_Copy (Proc, Stmt); Set_Parent (Proc, Get_Parent (Stmt)); Sensitivity_List := Create_Iir_List; Set_Sensitivity_List (Proc, Sensitivity_List); Set_Is_Ref (Proc, True); Set_Process_Origin (Proc, Stmt); -- LRM93 9.5 -- 1. If a label appears on the concurrent signal assignment, then the -- same label appears on the process statement. Set_Label (Proc, Get_Label (Stmt)); -- LRM93 9.5 -- 2. The equivalent process statement is a postponed process if and -- only if the current signal assignment statement includes the -- reserved word POSTPONED. Set_Postponed_Flag (Proc, Get_Postponed_Flag (Proc)); Canon_Extract_Sensitivity (Get_Target (Stmt), Sensitivity_List, True); if Get_Guard (Stmt) /= Null_Iir then -- LRM93 9.1 -- If the option guarded appears in the concurrent signal assignment -- statement, then the concurrent signal assignment is called a -- guarded assignment. -- If the concurrent signal assignement statement is a guarded -- assignment and the target of the concurrent signal assignment is -- a guarded target, then the statement transform is as follow: -- if GUARD then -- signal_transform -- else -- disconnect_statements -- end if; -- Otherwise, if the concurrent signal assignment statement is a -- guarded assignement, but the target if the concurrent signal -- assignment is not a guarded target, the then statement transform -- is as follows: -- if GUARD then signal_transform end if; If_Stmt := Create_Iir (Iir_Kind_If_Statement); Set_Parent (If_Stmt, Proc); Set_Sequential_Statement_Chain (Proc, If_Stmt); Location_Copy (If_Stmt, Stmt); Canon_Extract_Sensitivity (Get_Guard (Stmt), Sensitivity_List, False); Set_Condition (If_Stmt, Get_Guard (Stmt)); Set_Is_Ref (If_Stmt, True); Chain := If_Stmt; declare Target : Iir; Else_Clause : Iir_Elsif; Dis_Stmt : Iir_Signal_Assignment_Statement; begin Target := Get_Target (Stmt); if Get_Guarded_Target_State (Stmt) = True then -- The target is a guarded target. -- create the disconnection statement. Else_Clause := Create_Iir (Iir_Kind_Elsif); Location_Copy (Else_Clause, Stmt); Set_Else_Clause (If_Stmt, Else_Clause); Dis_Stmt := Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); Location_Copy (Dis_Stmt, Stmt); Set_Parent (Dis_Stmt, If_Stmt); Set_Target (Dis_Stmt, Target); Set_Is_Ref (Dis_Stmt, True); Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt); -- XX Set_Waveform_Chain (Dis_Stmt, Null_Iir); end if; end; else -- LRM93 9.1 -- Finally, if the concurrent signal assignment statement is not a -- guarded assignment, and the traget of the concurrent signal -- assignment is not a guarded target, then the statement transform -- is as follows: -- signal_transform Chain := Proc; end if; end Canon_Concurrent_Signal_Assignment; function Canon_Concurrent_Procedure_Call (Conc_Stmt : Iir) return Iir_Sensitized_Process_Statement is Call : constant Iir_Procedure_Call := Get_Procedure_Call (Conc_Stmt); Imp : constant Iir := Get_Implementation (Call); Proc : Iir_Sensitized_Process_Statement; Call_Stmt : Iir_Procedure_Call_Statement; Wait_Stmt : Iir_Wait_Statement; Sensitivity_List : Iir_List; Is_Sensitized : Boolean; begin -- Optimization: the process is a sensitized process only if the -- procedure is known not to have wait statement. This is possible only -- when generating code at once for the whole design, otherwise this -- may create discrepencies in translate structures due to states. Is_Sensitized := (Get_Wait_State (Imp) = False) and Flags.Flag_Whole_Analyze; -- LRM93 9.3 -- The equivalent process statement has also no sensitivity list, an -- empty declarative part, and a statement part that consists of a -- procedure call statement followed by a wait statement. if Is_Sensitized then Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); else Proc := Create_Iir (Iir_Kind_Process_Statement); end if; Location_Copy (Proc, Conc_Stmt); Set_Parent (Proc, Get_Parent (Conc_Stmt)); Set_Process_Origin (Proc, Conc_Stmt); Set_Procedure_Call (Conc_Stmt, Null_Iir); -- LRM93 9.3 -- The equivalent process statement has a label if and only if the -- concurrent procedure call statement has a label; if the equivalent -- process statement has a label, it is the same as that of the -- concurrent procedure call statement. Set_Label (Proc, Get_Label (Conc_Stmt)); -- LRM93 9.3 -- The equivalent process statement is a postponed process if and only -- if the concurrent procedure call statement includes the reserved -- word POSTPONED. Set_Postponed_Flag (Proc, Get_Postponed_Flag (Conc_Stmt)); Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); Set_Sequential_Statement_Chain (Proc, Call_Stmt); Location_Copy (Call_Stmt, Conc_Stmt); Set_Parent (Call_Stmt, Proc); Set_Procedure_Call (Call_Stmt, Call); -- LRM93 9.3 -- If there exists a name that denotes a signal in the actual part of -- any association element in the concurrent procedure call statement, -- and that actual is associated with a formal parameter of mode IN or -- INOUT, then the equivalent process statement includes a final wait -- statement with a sensitivity clause that is constructed by taking -- 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; Canon_Extract_Sensitivity_Procedure_Call (Sensitivity_List, Call); if Is_Sensitized then Set_Sensitivity_List (Proc, Sensitivity_List); Set_Is_Ref (Proc, True); else Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); Location_Copy (Wait_Stmt, Conc_Stmt); Set_Parent (Wait_Stmt, Proc); Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); Set_Is_Ref (Wait_Stmt, True); Set_Chain (Call_Stmt, Wait_Stmt); end if; return Proc; end Canon_Concurrent_Procedure_Call; -- Return a statement from a waveform. function Canon_Wave_Transform (Orig_Stmt : Iir; Waveform_Chain : Iir_Waveform_Element; Proc : Iir; Is_First : Boolean) return Iir is Stmt : Iir; Sensitivity_List : Iir_List; begin if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then -- LRM 9.5.1 Conditionnal Signal Assignment -- If the waveform is of the form: -- UNAFFECTED -- then the wave transform in the corresponding process statement -- is of the form: -- NULL; -- In this example, the final NULL causes the driver to be unchanged, -- rather than disconnected. -- (This is the null statement not a null waveform element). Stmt := Create_Iir (Iir_Kind_Null_Statement); else -- LRM 9.5.1 Conditionnal Signal Assignment -- If the waveform is of the form: -- waveform_element1, waveform_element1, ..., waveform_elementN -- then the wave transform in the corresponding process statement is -- of the form: -- target <= [ delay_mechanism ] waveform_element1, -- waveform_element2, ..., waveform_elementN; Stmt := Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); Set_Target (Stmt, Get_Target (Orig_Stmt)); if not Is_First then Set_Is_Ref (Stmt, True); end if; if Proc /= Null_Iir then Sensitivity_List := Get_Sensitivity_List (Proc); Extract_Waveform_Sensitivity (Waveform_Chain, Sensitivity_List); end if; Set_Waveform_Chain (Stmt, Waveform_Chain); Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt)); Set_Reject_Time_Expression (Stmt, Get_Reject_Time_Expression (Orig_Stmt)); Set_Reject_Time_Expression (Orig_Stmt, Null_Iir); end if; Location_Copy (Stmt, Orig_Stmt); return Stmt; end Canon_Wave_Transform; -- Create signal_transform for a concurrent simple signal assignment. procedure Canon_Concurrent_Simple_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) is Stmt : Iir; begin Stmt := Canon_Wave_Transform (Conc_Stmt, Get_Waveform_Chain (Conc_Stmt), Proc, True); Set_Waveform_Chain (Conc_Stmt, Null_Iir); Set_Target (Conc_Stmt, Null_Iir); Set_Parent (Stmt, Parent); Set_Sequential_Statement_Chain (Parent, Stmt); end Canon_Concurrent_Simple_Signal_Assignment; procedure Canon_Conditional_Signal_Assignment_Expression (Stmt : Iir) is Cond_Wf : Iir_Conditional_Waveform; begin Cond_Wf := Get_Conditional_Waveform_Chain (Stmt); while Cond_Wf /= Null_Iir loop Canon_Expression_If_Valid (Get_Condition (Cond_Wf)); Canon_Waveform_Expression (Get_Waveform_Chain (Cond_Wf)); Cond_Wf := Get_Chain (Cond_Wf); end loop; end Canon_Conditional_Signal_Assignment_Expression; -- Create signal_transform for a concurrent conditional signal assignment. function Canon_Conditional_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) return Iir is Expr : Iir; Stmt : Iir; Res1 : Iir; Last_Res : Iir; Wf : Iir; Cond_Wf : Iir_Conditional_Waveform; Cond_Wf_Chain : Iir_Conditional_Waveform; begin Cond_Wf_Chain := Get_Conditional_Waveform_Chain (Conc_Stmt); Stmt := Null_Iir; Cond_Wf := Cond_Wf_Chain; Last_Res := Null_Iir; while Cond_Wf /= Null_Iir loop Expr := Get_Condition (Cond_Wf); -- Canon waveform. Wf := Get_Waveform_Chain (Cond_Wf); Wf := Canon_Wave_Transform (Conc_Stmt, Wf, Proc, False); -- Cond_Wf = Cond_Wf_Chain); if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then -- A conditional assignment that is in fact a simple one. Usual -- case for concurrent signal assignment in vhdl 93. pragma Assert (Get_Chain (Cond_Wf) = Null_Iir); Set_Parent (Wf, Parent); Res1 := Wf; Stmt := Res1; else -- A real conditional signal assignment. -- Canon condition (if any). if Expr /= Null_Iir then if Proc /= Null_Iir then Canon_Extract_Sensitivity (Expr, Get_Sensitivity_List (Proc), False); end if; end if; if Stmt = Null_Iir then Res1 := Create_Iir (Iir_Kind_If_Statement); Set_Parent (Res1, Parent); Stmt := Res1; else Res1 := Create_Iir (Iir_Kind_Elsif); Set_Else_Clause (Last_Res, Res1); end if; Location_Copy (Res1, Cond_Wf); Set_Condition (Res1, Expr); Set_Sequential_Statement_Chain (Res1, Wf); Set_Parent (Wf, Stmt); Last_Res := Res1; end if; Set_Condition (Cond_Wf, Null_Iir); Set_Waveform_Chain (Cond_Wf, Null_Iir); Cond_Wf := Get_Chain (Cond_Wf); end loop; return Stmt; end Canon_Conditional_Signal_Assignment; -- Create signal_transform for a concurrent conditional signal assignment. procedure Canon_Concurrent_Conditional_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) is Stmt : Iir; begin Stmt := Canon_Conditional_Signal_Assignment (Conc_Stmt, Proc, Parent); Set_Sequential_Statement_Chain (Parent, Stmt); end Canon_Concurrent_Conditional_Signal_Assignment; procedure Canon_Selected_Signal_Assignment_Expression (Stmt : Iir) is Selected_Waveform : Iir; Waveform : Iir; begin Canon_Expression (Get_Expression (Stmt)); Selected_Waveform := Get_Selected_Waveform_Chain (Stmt); while Selected_Waveform /= Null_Iir loop Waveform := Get_Associated_Chain (Selected_Waveform); if Waveform /= Null_Iir then Canon_Waveform_Expression (Waveform); end if; Selected_Waveform := Get_Chain (Selected_Waveform); end loop; end Canon_Selected_Signal_Assignment_Expression; procedure Canon_Concurrent_Selected_Signal_Assignment (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) is Sensitivity_List : constant Iir_List := Get_Sensitivity_List (Proc); Expr : constant Iir := Get_Expression (Conc_Stmt); Selected_Waveform_Chain : constant Iir := Get_Selected_Waveform_Chain (Conc_Stmt); Target : constant Iir := Get_Target (Conc_Stmt); Reject_Time : constant Iir := Get_Reject_Time_Expression (Conc_Stmt); Selected_Waveform : Iir; Case_Stmt: Iir_Case_Statement; Stmt : Iir; Waveform : Iir; begin Canon_Extract_Sensitivity (Expr, Sensitivity_List, False); if Vhdl_Std < Vhdl_08 then Case_Stmt := Create_Iir (Iir_Kind_Case_Statement); Set_Parent (Case_Stmt, Parent); Set_Sequential_Statement_Chain (Parent, Case_Stmt); Location_Copy (Case_Stmt, Conc_Stmt); Set_Expression (Case_Stmt, Expr); Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform_Chain); Selected_Waveform := Selected_Waveform_Chain; while Selected_Waveform /= Null_Iir loop Set_Parent (Selected_Waveform, Case_Stmt); Waveform := Get_Associated_Chain (Selected_Waveform); if Waveform /= Null_Iir then Stmt := Canon_Wave_Transform (Conc_Stmt, Waveform, Proc, Selected_Waveform = Selected_Waveform_Chain); Set_Parent (Stmt, Case_Stmt); Set_Associated_Chain (Selected_Waveform, Stmt); end if; Selected_Waveform := Get_Chain (Selected_Waveform); end loop; else Stmt := Create_Iir (Iir_Kind_Selected_Waveform_Assignment_Statement); Set_Parent (Stmt, Parent); Set_Sequential_Statement_Chain (Parent, Stmt); Location_Copy (Stmt, Conc_Stmt); Set_Expression (Stmt, Expr); Set_Target (Stmt, Target); Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Conc_Stmt)); Set_Reject_Time_Expression (Stmt, Reject_Time); Set_Selected_Waveform_Chain (Stmt, Selected_Waveform_Chain); Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); Selected_Waveform := Selected_Waveform_Chain; while Selected_Waveform /= Null_Iir loop Waveform := Get_Associated_Chain (Selected_Waveform); Set_Parent (Selected_Waveform, Stmt); if Waveform /= Null_Iir then Extract_Waveform_Sensitivity (Waveform, Sensitivity_List); end if; Selected_Waveform := Get_Chain (Selected_Waveform); end loop; end if; -- Transfer ownership. Set_Expression (Conc_Stmt, Null_Iir); Set_Target (Conc_Stmt, Null_Iir); Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); Set_Reject_Time_Expression (Conc_Stmt, Null_Iir); end Canon_Concurrent_Selected_Signal_Assignment; procedure Canon_Generate_Statement_Body (Top : Iir_Design_Unit; Bod : Iir) is begin Canon_Declarations (Top, Bod, Bod); Canon_Concurrent_Stmts (Top, Bod); end Canon_Generate_Statement_Body; -- Return TRUE iff NFA has an edge with an EOS. -- If so, we need to create a finalizer. function Psl_Need_Finalizer (Nfa : PSL_NFA) return Boolean is use PSL.NFAs; S : NFA_State; E : NFA_Edge; begin S := Get_Final_State (Nfa); E := Get_First_Dest_Edge (S); while E /= No_Edge loop if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then return True; end if; E := Get_Next_Dest_Edge (E); end loop; return False; end Psl_Need_Finalizer; -- Size the NFA and extract clock sensitivity. procedure Canon_Psl_Clocked_NFA (Stmt : Iir) is use PSL.Nodes; Fa : constant PSL_NFA := Get_PSL_NFA (Stmt); Num : Natural; List : Iir_List; begin PSL.NFAs.Labelize_States (Fa, Num); Set_PSL_Nbr_States (Stmt, Int32 (Num)); Set_PSL_EOS_Flag (Stmt, Psl_Need_Finalizer (Fa)); List := Create_Iir_List; Canon_PSL.Canon_Extract_Sensitivity (Get_PSL_Clock (Stmt), List); Set_PSL_Clock_Sensitivity (Stmt, List); end Canon_Psl_Clocked_NFA; procedure Canon_Psl_Directive (Stmt : Iir) is begin Canon_Psl_Clocked_NFA (Stmt); if Canon_Flag_Expressions then Canon_PSL_Expression (Get_PSL_Clock (Stmt)); Canon_Expression (Get_Severity_Expression (Stmt)); Canon_Expression (Get_Report_Expression (Stmt)); end if; end Canon_Psl_Directive; procedure Canon_If_Case_Generate_Statement_Body (Bod : Iir; Alt_Num : in out Natural; Top : Iir_Design_Unit) is begin if Canon_Flag_Add_Labels and then Get_Alternative_Label (Bod) = Null_Identifier then declare Str : String := Natural'Image (Alt_Num); begin -- Note: the label starts with a capitalized -- letter, to avoid any clash with user's -- identifiers. Str (1) := 'B'; Set_Alternative_Label (Bod, Name_Table.Get_Identifier (Str)); end; end if; Canon_Generate_Statement_Body (Top, Bod); Alt_Num := Alt_Num + 1; end Canon_If_Case_Generate_Statement_Body; function Canon_Concurrent_Assertion_Statement (Stmt : Iir) return Iir is Proc : Iir; Asrt : Iir; Expr : Iir; Sensitivity_List : Iir_List; begin -- Create a new entry. Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); Location_Copy (Proc, Stmt); Set_Parent (Proc, Get_Parent (Stmt)); Set_Process_Origin (Proc, Stmt); -- LRM93 9.4 -- The equivalent process statement has a label if and only if the -- current assertion statement has a label; if the equivalent process -- statement has a label; it is the same as that of the concurrent -- assertion statement. Set_Label (Proc, Get_Label (Stmt)); -- LRM93 9.4 -- The equivalent process statement is a postponed process if and only -- if the current assertion statement includes the reserved word -- POSTPONED. Set_Postponed_Flag (Proc, Get_Postponed_Flag (Stmt)); Asrt := Create_Iir (Iir_Kind_Assertion_Statement); Set_Sequential_Statement_Chain (Proc, Asrt); Set_Parent (Asrt, Proc); Location_Copy (Asrt, Stmt); Sensitivity_List := Create_Iir_List; Set_Sensitivity_List (Proc, Sensitivity_List); Set_Is_Ref (Proc, True); -- Expand the expression, fill the sensitivity list, Expr := Get_Assertion_Condition (Stmt); Canon_Extract_Sensitivity (Expr, Sensitivity_List, False); Set_Assertion_Condition (Asrt, Expr); Set_Assertion_Condition (Stmt, Null_Iir); Expr := Get_Report_Expression (Stmt); Set_Report_Expression (Asrt, Expr); Set_Report_Expression (Stmt, Null_Iir); Expr := Get_Severity_Expression (Stmt); Set_Severity_Expression (Asrt, Expr); Set_Severity_Expression (Stmt, Null_Iir); return Proc; end Canon_Concurrent_Assertion_Statement; procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir) is -- Current element in the chain of concurrent statements. El: Iir; -- Previous element or NULL_IIR if EL is the first element. -- This is used to make Replace_Stmt efficient. Prev_El : Iir; -- Replace in the chain EL by N_STMT. procedure Replace_Stmt (N_Stmt : Iir) is begin if Prev_El = Null_Iir then Set_Concurrent_Statement_Chain (Parent, N_Stmt); else Set_Chain (Prev_El, N_Stmt); end if; Set_Chain (N_Stmt, Get_Chain (El)); end Replace_Stmt; Proc: Iir; Sub_Chain : Iir; Expr: Iir; Proc_Num : Natural := 0; begin Prev_El := Null_Iir; El := Get_Concurrent_Statement_Chain (Parent); while El /= Null_Iir loop -- Add a label if required. if Canon_Flag_Add_Labels then case Get_Kind (El) is when Iir_Kind_Psl_Declaration | Iir_Kind_Psl_Endpoint_Declaration => null; when others => if Get_Label (El) = Null_Identifier then declare Str : String := Natural'Image (Proc_Num); begin -- Note: the label starts with a capitalized letter, -- to avoid any clash with user's identifiers. Str (1) := 'P'; Set_Label (El, Name_Table.Get_Identifier (Str)); end; Proc_Num := Proc_Num + 1; end if; end case; end if; case Get_Kind (El) is when Iir_Kind_Concurrent_Simple_Signal_Assignment => if Canon_Flag_Expressions then Canon_Expression (Get_Target (El)); Canon_Waveform_Expression (Get_Waveform_Chain (El)); end if; if Canon_Flag_Concurrent_Stmts then Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); Canon_Concurrent_Simple_Signal_Assignment (El, Proc, Sub_Chain); Replace_Stmt (Proc); El := Proc; end if; when Iir_Kind_Concurrent_Conditional_Signal_Assignment => if Canon_Flag_Expressions then Canon_Expression (Get_Target (El)); Canon_Conditional_Signal_Assignment_Expression (El); end if; if Canon_Flag_Concurrent_Stmts then Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); Canon_Concurrent_Conditional_Signal_Assignment (El, Proc, Sub_Chain); Replace_Stmt (Proc); El := Proc; end if; when Iir_Kind_Concurrent_Selected_Signal_Assignment => if Canon_Flag_Expressions then Canon_Expression (Get_Target (El)); Canon_Selected_Signal_Assignment_Expression (El); end if; if Canon_Flag_Concurrent_Stmts then Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); Canon_Concurrent_Selected_Signal_Assignment (El, Proc, Sub_Chain); Replace_Stmt (Proc); El := Proc; end if; when Iir_Kind_Concurrent_Assertion_Statement => if Canon_Flag_Expressions then Canon_Expression (Get_Assertion_Condition (El)); Canon_Expression_If_Valid (Get_Report_Expression (El)); Canon_Expression_If_Valid (Get_Severity_Expression (El)); end if; if Canon_Flag_Concurrent_Stmts then Proc := Canon_Concurrent_Assertion_Statement (El); Replace_Stmt (Proc); El := Proc; end if; when Iir_Kind_Concurrent_Procedure_Call_Statement => declare Call : constant Iir_Procedure_Call := Get_Procedure_Call (El); Imp : constant Iir := Get_Implementation (Call); Assoc_Chain : Iir; begin Assoc_Chain := Canon_Association_Chain_And_Actuals (Get_Interface_Declaration_Chain (Imp), Get_Parameter_Association_Chain (Call), Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); end; if Canon_Flag_Concurrent_Stmts then Proc := Canon_Concurrent_Procedure_Call (El); Replace_Stmt (Proc); El := Proc; end if; when Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement => Canon_Declarations (Top, El, Null_Iir); if Canon_Flag_Sequentials_Stmts then declare Stmts : Iir; begin Stmts := Get_Sequential_Statement_Chain (El); Stmts := Canon_Sequential_Stmts (Stmts); Set_Sequential_Statement_Chain (El, Stmts); end; end if; if Canon_Flag_All_Sensitivity and then Canon_Flag_Sequentials_Stmts and then Get_Kind (El) = Iir_Kind_Sensitized_Process_Statement and then Get_Sensitivity_List (El) = Iir_List_All then Set_Sensitivity_List (El, Canon_Extract_Process_Sensitivity (El)); end if; when Iir_Kind_Component_Instantiation_Statement => declare Inst : Iir; Assoc_Chain : Iir; begin Inst := Get_Instantiated_Unit (El); Inst := Get_Entity_From_Entity_Aspect (Inst); Assoc_Chain := Canon_Association_Chain_And_Actuals (Get_Generic_Chain (Inst), Get_Generic_Map_Aspect_Chain (El), El); Set_Generic_Map_Aspect_Chain (El, Assoc_Chain); Assoc_Chain := Canon_Association_Chain_And_Actuals (Get_Port_Chain (Inst), Get_Port_Map_Aspect_Chain (El), El); Set_Port_Map_Aspect_Chain (El, Assoc_Chain); end; when Iir_Kind_Block_Statement => declare Header : Iir_Block_Header; Chain : Iir; Guard : Iir_Guard_Signal_Declaration; begin Guard := Get_Guard_Decl (El); if Guard /= Null_Iir then Expr := Get_Guard_Expression (Guard); Set_Guard_Sensitivity_List (Guard, Create_Iir_List); Canon_Extract_Sensitivity (Expr, Get_Guard_Sensitivity_List (Guard), False); if Canon_Flag_Expressions then Canon_Expression (Expr); end if; end if; Header := Get_Block_Header (El); if Header /= Null_Iir then -- Generics. Chain := Get_Generic_Map_Aspect_Chain (Header); if Chain /= Null_Iir then Chain := Canon_Association_Chain_And_Actuals (Get_Generic_Chain (Header), Chain, Chain); else Chain := Canon_Default_Association_Chain (Get_Generic_Chain (Header)); end if; Set_Generic_Map_Aspect_Chain (Header, Chain); -- Ports. Chain := Get_Port_Map_Aspect_Chain (Header); if Chain /= Null_Iir then Chain := Canon_Association_Chain_And_Actuals (Get_Port_Chain (Header), Chain, Chain); else Chain := Canon_Default_Association_Chain (Get_Port_Chain (Header)); end if; Set_Port_Map_Aspect_Chain (Header, Chain); end if; Canon_Declarations (Top, El, El); Canon_Concurrent_Stmts (Top, El); end; when Iir_Kind_If_Generate_Statement => declare Clause : Iir; Alt_Num : Natural; begin Clause := El; Alt_Num := 1; while Clause /= Null_Iir loop if Canon_Flag_Expressions then Canon_Expression_If_Valid (Get_Condition (El)); end if; Canon_If_Case_Generate_Statement_Body (Get_Generate_Statement_Body (Clause), Alt_Num, Top); Clause := Get_Generate_Else_Clause (Clause); end loop; end; when Iir_Kind_Case_Generate_Statement => declare Alt : Iir; Alt_Num : Natural; begin Alt_Num := 1; if Canon_Flag_Expressions then Canon_Expression (Get_Expression (El)); end if; Alt := Get_Case_Statement_Alternative_Chain (El); while Alt /= Null_Iir loop if not Get_Same_Alternative_Flag (Alt) then Canon_If_Case_Generate_Statement_Body (Get_Associated_Block (Alt), Alt_Num, Top); end if; Alt := Get_Chain (Alt); end loop; end; when Iir_Kind_For_Generate_Statement => declare Decl : constant Iir := Get_Parameter_Specification (El); New_Decl : Iir; begin New_Decl := Canon_Declaration (Top, Decl, Null_Iir, Null_Iir); pragma Assert (New_Decl = Decl); Canon_Generate_Statement_Body (Top, Get_Generate_Statement_Body (El)); end; when Iir_Kind_Psl_Assert_Statement => declare use PSL.Nodes; Prop : PSL_Node; Fa : PSL_NFA; begin Prop := Get_Psl_Property (El); Prop := PSL.Rewrites.Rewrite_Property (Prop); Set_Psl_Property (El, Prop); -- Generate the NFA. Fa := PSL.Build.Build_FA (Prop); Set_PSL_NFA (El, Fa); Canon_Psl_Directive (El); end; when Iir_Kind_Psl_Cover_Statement => declare use PSL.Nodes; Seq : PSL_Node; Fa : PSL_NFA; begin Seq := Get_Psl_Sequence (El); Seq := PSL.Rewrites.Rewrite_SERE (Seq); Set_Psl_Sequence (El, Seq); -- Generate the NFA. Fa := PSL.Build.Build_SERE_FA (Seq); Set_PSL_NFA (El, Fa); Canon_Psl_Directive (El); end; when Iir_Kind_Psl_Default_Clock => null; when Iir_Kind_Psl_Declaration => declare use PSL.Nodes; Decl : constant PSL_Node := Get_Psl_Declaration (El); Prop : PSL_Node; Fa : PSL_NFA; begin case Get_Kind (Decl) is when N_Property_Declaration => Prop := Get_Property (Decl); Prop := PSL.Rewrites.Rewrite_Property (Prop); Set_Property (Decl, Prop); if Get_Parameter_List (Decl) = Null_Node then -- Generate the NFA. Fa := PSL.Build.Build_FA (Prop); Set_PSL_NFA (El, Fa); end if; when N_Sequence_Declaration | N_Endpoint_Declaration => Prop := Get_Sequence (Decl); Prop := PSL.Rewrites.Rewrite_SERE (Prop); Set_Sequence (Decl, Prop); when others => Error_Kind ("canon psl_declaration", Decl); end case; end; when Iir_Kind_Psl_Endpoint_Declaration => declare use PSL.Nodes; Decl : constant PSL_Node := Get_Psl_Declaration (El); Seq : PSL_Node; Fa : PSL_NFA; begin pragma Assert (Get_Parameter_List (Decl) = Null_Node); Seq := Get_Sequence (Decl); Seq := PSL.Rewrites.Rewrite_SERE (Seq); Set_Sequence (Decl, Seq); -- Generate the NFA. Fa := PSL.Build.Build_SERE_FA (Seq); Set_PSL_NFA (El, Fa); Canon_Psl_Clocked_NFA (El); end; when Iir_Kind_Simple_Simultaneous_Statement => if Canon_Flag_Expressions then Canon_Expression (Get_Simultaneous_Left (El)); Canon_Expression (Get_Simultaneous_Right (El)); end if; when others => Error_Kind ("canon_concurrent_stmts", El); end case; Prev_El := El; El := Get_Chain (El); end loop; end Canon_Concurrent_Stmts; -- procedure Canon_Binding_Indication -- (Component: Iir; Binding : Iir_Binding_Indication) -- is -- List : Iir_Association_List; -- begin -- if Binding = Null_Iir then -- return; -- end if; -- List := Get_Generic_Map_Aspect_List (Binding); -- List := Canon_Association_List (Get_Generic_List (Component), List); -- Set_Generic_Map_Aspect_List (Binding, List); -- List := Get_Port_Map_Aspect_List (Binding); -- List := Canon_Association_List (Get_Port_List (Component), List); -- Set_Port_Map_Aspect_List (Binding, List); -- end Canon_Binding_Indication; procedure Add_Binding_Indication_Dependence (Top : Iir_Design_Unit; Binding : Iir) is Aspect : Iir; begin if Binding = Null_Iir then return; end if; Aspect := Get_Entity_Aspect (Binding); if Aspect = Null_Iir then return; end if; case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => if Get_Architecture (Aspect) /= Null_Iir then Add_Dependence (Top, Aspect); else Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect))); end if; when Iir_Kind_Entity_Aspect_Configuration => Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect))); when Iir_Kind_Entity_Aspect_Open => null; when others => Error_Kind ("add_binding_indication_dependence", Aspect); end case; end Add_Binding_Indication_Dependence; -- Canon the component_configuration or configuration_specification CFG. procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir) is -- True iff CFG is a component_configuration. -- False iff CFG is a configuration_specification. Is_Config : constant Boolean := Get_Kind (Cfg) = Iir_Kind_Component_Configuration; Bind : Iir; Comp : Iir; Instances : Iir_List; Entity_Aspect : Iir; Block : Iir_Block_Configuration; Map_Chain : Iir; Entity : Iir; begin Bind := Get_Binding_Indication (Cfg); if Bind = Null_Iir then -- Add a default binding indication -- Extract a component instantiation Instances := Get_Instantiation_List (Cfg); -- Designator_all and designator_others must have been replaced -- by a list during canon. pragma Assert (Instances not in Iir_Lists_All_Others); Bind := Get_Default_Binding_Indication (Get_Named_Entity (Get_First_Element (Instances))); if Bind = Null_Iir then -- Component is not bound. return; end if; Set_Binding_Indication (Cfg, Bind); Set_Is_Ref (Cfg, True); Add_Binding_Indication_Dependence (Top, Bind); return; else Entity_Aspect := Get_Entity_Aspect (Bind); if Entity_Aspect = Null_Iir then Entity_Aspect := Get_Default_Entity_Aspect (Bind); Set_Entity_Aspect (Bind, Entity_Aspect); end if; if Entity_Aspect /= Null_Iir then Add_Binding_Indication_Dependence (Top, Bind); Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); Comp := Get_Named_Entity (Get_Component_Name (Cfg)); -- Canon generic map Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); if Map_Chain = Null_Iir then if Is_Config and then Is_Valid (Entity) then Map_Chain := Sem_Specs.Create_Default_Map_Aspect (Comp, Entity, Sem_Specs.Map_Generic, Bind); end if; else Map_Chain := Canon_Association_Chain (Get_Generic_Chain (Entity), Map_Chain, Map_Chain); end if; Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); -- Canon port map Map_Chain := Get_Port_Map_Aspect_Chain (Bind); if Map_Chain = Null_Iir then if Is_Config and then Is_Valid (Entity) then Map_Chain := Sem_Specs.Create_Default_Map_Aspect (Comp, Entity, Sem_Specs.Map_Port, Bind); end if; else Map_Chain := Canon_Association_Chain (Get_Port_Chain (Entity), Map_Chain, Map_Chain); end if; Set_Port_Map_Aspect_Chain (Bind, Map_Chain); if Is_Config then Block := Get_Block_Configuration (Cfg); if Block /= Null_Iir then -- If there is no architecture_identifier in the binding, -- set it from the block_configuration. if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity and then Get_Architecture (Entity_Aspect) = Null_Iir then Entity := Get_Entity (Entity_Aspect); pragma Assert (Get_Kind (Entity) = Iir_Kind_Entity_Declaration); Set_Architecture (Entity_Aspect, Build_Reference_Name (Get_Block_Specification (Block))); end if; Canon_Block_Configuration (Top, Block); end if; end if; end if; 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; Parent : Iir) is function Merge_Association_Chain (Inter_Chain : Iir; First_Chain : Iir; Sec_Chain : Iir) return Iir is -- Result (chain). First, Last : Iir; -- Copy an association and append new elements to FIRST/LAST. procedure Copy_Association (Assoc : in out Iir; Inter : in out Iir; Copy_Inter : Iir) is El : Iir; Formal : Iir; begin loop El := Create_Iir (Get_Kind (Assoc)); Location_Copy (El, Assoc); -- Copy formal. -- Special case: formal comes from a default binding -- indication. In that case Is_Forward_Ref is set, which makes -- it non-copiable by Sem_Inst. Formal := Get_Formal (Assoc); if Is_Valid (Formal) then if Get_Kind (Formal) = Iir_Kind_Simple_Name and then Get_Is_Forward_Ref (Formal) then Formal := Build_Simple_Name (Get_Named_Entity (Formal), Formal); else Formal := Sem_Inst.Copy_Tree (Formal); end if; end if; Set_Formal (El, Formal); Set_Whole_Association_Flag (El, Get_Whole_Association_Flag (Assoc)); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => null; when Iir_Kind_Association_Element_By_Expression => Set_Actual (El, Sem_Inst.Copy_Tree (Get_Actual (Assoc))); Set_In_Conversion (El, Sem_Inst.Copy_Tree (Get_In_Conversion (Assoc))); Set_Out_Conversion (El, Sem_Inst.Copy_Tree (Get_Out_Conversion (Assoc))); Set_Collapse_Signal_Flag (Assoc, Sem.Can_Collapse_Signals (Assoc, Get_Formal (Assoc))); when Iir_Kind_Association_Element_By_Individual => Set_Actual_Type (El, Get_Actual_Type (Assoc)); when others => Error_Kind ("copy_association", Assoc); end case; Sub_Chain_Append (First, Last, El); Next_Association_Interface (Assoc, Inter); exit when Assoc = Null_Iir; exit when Get_Association_Interface (Assoc, Inter) /= Copy_Inter; end loop; end Copy_Association; procedure Advance (Assoc : in out Iir; Inter : in out Iir; Skip_Inter : Iir) is begin loop Next_Association_Interface (Assoc, Inter); exit when Assoc = Null_Iir; 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 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, F_Inter) = Inter); -- Find the associated in the second chain. 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 S_Inter := Inter; Copy_Association (S_El, S_Inter, Inter); Advance (F_El, F_Inter, Inter); else Copy_Association (F_El, F_Inter, Inter); end if; Inter := Get_Chain (Inter); end loop; return First; end Merge_Association_Chain; Comp_Name : constant Iir := Get_Component_Name (Conf_Spec); Comp : constant Iir := Get_Named_Entity (Comp_Name); Cs_Binding : constant Iir := Get_Binding_Indication (Conf_Spec); Cc_Binding : constant Iir := Get_Binding_Indication (Comp_Conf); Res : Iir_Component_Configuration; Cs_Chain : Iir; Res_Binding : Iir_Binding_Indication; Entity : Iir; Instance_List : Iir_List; Conf_Instance_List : Iir_List; Instance : Iir; Instance_Name : Iir; N_Nbr : Natural; begin -- Create the new component configuration Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, Comp_Conf); Set_Parent (Res, Parent); Set_Component_Name (Res, Build_Reference_Name (Comp_Name)); Res_Binding := Create_Iir (Iir_Kind_Binding_Indication); Location_Copy (Res_Binding, Res); Set_Binding_Indication (Res, Res_Binding); Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding)); -- Merge generic map aspect. Cs_Chain := Get_Generic_Map_Aspect_Chain (Cs_Binding); if Cs_Chain = Null_Iir then Cs_Chain := Sem_Specs.Create_Default_Map_Aspect (Comp, Entity, Sem_Specs.Map_Generic, Cs_Binding); end if; Set_Generic_Map_Aspect_Chain (Res_Binding, Merge_Association_Chain (Get_Generic_Chain (Entity), Cs_Chain, Get_Generic_Map_Aspect_Chain (Cc_Binding))); -- Merge port map aspect. Cs_Chain := Get_Port_Map_Aspect_Chain (Cs_Binding); if Cs_Chain = Null_Iir then Cs_Chain := Sem_Specs.Create_Default_Map_Aspect (Comp, Entity, Sem_Specs.Map_Port, Cs_Binding); end if; Set_Port_Map_Aspect_Chain (Res_Binding, Merge_Association_Chain (Get_Port_Chain (Entity), Cs_Chain, Get_Port_Map_Aspect_Chain (Cc_Binding))); -- Set entity aspect. Set_Entity_Aspect (Res_Binding, Sem_Inst.Copy_Tree (Get_Entity_Aspect (Cs_Binding))); -- Create list of instances: -- * keep common instances -- replace component_configuration of them -- remove them in the instance list of COMP_CONF Instance_List := Create_Iir_List; Set_Instantiation_List (Res, Instance_List); Conf_Instance_List := Get_Instantiation_List (Comp_Conf); N_Nbr := 0; for I in 0 .. Get_Nbr_Elements (Conf_Instance_List) - 1 loop Instance_Name := Get_Nth_Element (Conf_Instance_List, I); Instance := Get_Named_Entity (Instance_Name); if Get_Component_Configuration (Instance) = Conf_Spec then -- The incremental binding applies to this instance. Set_Component_Configuration (Instance, Res); Append_Element (Instance_List, Instance_Name); else Replace_Nth_Element (Conf_Instance_List, N_Nbr, Instance_Name); N_Nbr := N_Nbr + 1; end if; end loop; Set_Nbr_Elements (Conf_Instance_List, N_Nbr); -- Insert RES. Set_Chain (Res, Get_Chain (Comp_Conf)); Set_Chain (Comp_Conf, Res); end Canon_Incremental_Binding; procedure Canon_Component_Specification_All_Others (Conf : Iir; Parent : Iir; Spec : Iir_List; List : Iir_List; Comp : Iir) is El : Iir; Comp_Conf : Iir; Inst : Iir; begin El := Get_Concurrent_Statement_Chain (Parent); while El /= Null_Iir loop -- Handle only component instantiation of COMP. if Get_Kind (El) = Iir_Kind_Component_Instantiation_Statement and then Is_Component_Instantiation (El) and then Get_Named_Entity (Get_Instantiated_Unit (El)) = Comp then Comp_Conf := Get_Component_Configuration (El); if Comp_Conf = Null_Iir then -- The component is not yet configured. Inst := Build_Simple_Name (El, El); Set_Is_Forward_Ref (Inst, True); Append_Element (List, Inst); Set_Component_Configuration (El, Conf); else -- The component is already configured. -- Handle incremental configuration. if Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification and then Spec = Iir_List_All then -- FIXME: handle incremental configuration. raise Internal_Error; end if; -- Several component configuration for an instance. -- Must have been caught by sem. pragma Assert (Spec = Iir_List_Others); end if; end if; El := Get_Chain (El); end loop; end Canon_Component_Specification_All_Others; procedure Canon_Component_Specification_List (Conf : Iir; Parent : Iir; Spec : Iir_List) is El : Iir; Comp_Conf : Iir; begin -- Already has a designator list. for I in Natural loop El := Get_Nth_Element (Spec, I); exit when El = Null_Iir; El := Get_Named_Entity (El); Comp_Conf := Get_Component_Configuration (El); if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then pragma Assert (Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification); pragma Assert (Get_Kind (Conf) = Iir_Kind_Component_Configuration); Canon_Incremental_Binding (Comp_Conf, Conf, Parent); else Set_Component_Configuration (El, Conf); end if; end loop; end Canon_Component_Specification_List; -- PARENT is the parent for the chain of concurrent statements. procedure Canon_Component_Specification (Conf : Iir; Parent : Iir) is Spec : constant Iir_List := Get_Instantiation_List (Conf); List : Iir_Designator_List; begin if Spec in Iir_Lists_All_Others then List := Create_Iir_List; Canon_Component_Specification_All_Others (Conf, Parent, Spec, List, Get_Named_Entity (Get_Component_Name (Conf))); Set_Instantiation_List (Conf, List); else -- Has Already a designator list. Canon_Component_Specification_List (Conf, Parent, Spec); end if; end Canon_Component_Specification; -- Replace ALL/OTHERS with the explicit list of signals. procedure Canon_Disconnection_Specification (Dis : Iir_Disconnection_Specification; Decl_Parent : Iir) is Signal_List : Iir_List; Force : Boolean; El : Iir; N_List : Iir_Designator_List; Dis_Type : Iir; begin if Canon_Flag_Expressions then Canon_Expression (Get_Expression (Dis)); end if; if Canon_Flag_Specification_Lists then Signal_List := Get_Signal_List (Dis); if Signal_List = Iir_List_All then Force := True; elsif Signal_List = Iir_List_Others then Force := False; else -- User list: nothing to do. return; end if; Dis_Type := Get_Type (Get_Type_Mark (Dis)); N_List := Create_Iir_List; Set_Signal_List (Dis, N_List); Set_Is_Ref (Dis, True); El := Get_Declaration_Chain (Decl_Parent); while El /= Null_Iir loop if Get_Kind (El) = Iir_Kind_Signal_Declaration and then Get_Type (El) = Dis_Type and then Get_Guarded_Signal_Flag (El) then if not Get_Has_Disconnect_Flag (El) then Set_Has_Disconnect_Flag (El, True); Append_Element (N_List, El); else if Force then raise Internal_Error; end if; end if; end if; El := Get_Chain (El); end loop; end if; end Canon_Disconnection_Specification; procedure Canon_Subtype_Indication (Def : Iir) is begin case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare Indexes : constant Iir_List := Get_Index_Subtype_List (Def); Index : Iir; begin for I in Natural loop Index := Get_Index_Type (Indexes, I); exit when Index = Null_Iir; Canon_Subtype_Indication_If_Anonymous (Index); end loop; end; when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition => declare Rng : constant Iir := Get_Range_Constraint (Def); begin if Get_Kind (Rng) = Iir_Kind_Range_Expression then Canon_Expression (Rng); end if; end; when Iir_Kind_Record_Subtype_Definition | Iir_Kind_Record_Type_Definition => null; when Iir_Kind_Access_Subtype_Definition => null; when others => Error_Kind ("canon_subtype_indication", Def); end case; end Canon_Subtype_Indication; procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir) is begin if Is_Anonymous_Type_Definition (Def) then Canon_Subtype_Indication (Def); end if; end Canon_Subtype_Indication_If_Anonymous; -- Return the new package declaration (if any). function Canon_Package_Instantiation_Declaration (Decl : Iir) return Iir is Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Decl); Bod : Iir; begin -- Canon map aspect. Set_Generic_Map_Aspect_Chain (Decl, Canon_Association_Chain_And_Actuals (Get_Generic_Chain (Decl), Get_Generic_Map_Aspect_Chain (Decl), Decl)); -- Generate the body now. -- Note: according to the LRM, if the instantiation occurs within a -- package, the body of the instance should be appended to the package -- body. -- FIXME: generate only if generating code for this unit. if Get_Macro_Expanded_Flag (Pkg) and then Get_Need_Body (Pkg) then Bod := Sem_Inst.Instantiate_Package_Body (Decl); Set_Parent (Bod, Get_Parent (Decl)); Set_Package_Body (Decl, Bod); end if; return Decl; end Canon_Package_Instantiation_Declaration; function Canon_Declaration (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir; Decl_Parent : Iir) return Iir is Stmts : Iir; begin case Get_Kind (Decl) is when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => Canon_Declarations (Top, Decl, Null_Iir); if Canon_Flag_Sequentials_Stmts then Stmts := Get_Sequential_Statement_Chain (Decl); Stmts := Canon_Sequential_Stmts (Stmts); Set_Sequential_Statement_Chain (Decl, Stmts); end if; when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => null; when Iir_Kind_Type_Declaration => declare Def : Iir; begin Def := Get_Type_Definition (Decl); if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then Canon_Declarations (Decl, Def, Null_Iir); end if; end; when Iir_Kind_Anonymous_Type_Declaration | Iir_Kind_Subtype_Declaration => null; when Iir_Kind_Protected_Type_Body => Canon_Declarations (Top, Decl, Null_Iir); when Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Constant_Declaration => if Canon_Flag_Expressions then Canon_Subtype_Indication_If_Anonymous (Get_Type (Decl)); Canon_Expression (Get_Default_Value (Decl)); end if; when Iir_Kind_Iterator_Declaration => null; when Iir_Kind_Object_Alias_Declaration => null; when Iir_Kind_Non_Object_Alias_Declaration => null; when Iir_Kind_File_Declaration => -- FIXME null; when Iir_Kind_Attribute_Declaration => null; when Iir_Kind_Attribute_Specification => if Canon_Flag_Expressions then Canon_Expression (Get_Expression (Decl)); end if; when Iir_Kind_Disconnection_Specification => Canon_Disconnection_Specification (Decl, Decl_Parent); when Iir_Kind_Group_Template_Declaration => null; when Iir_Kind_Group_Declaration => null; when Iir_Kind_Use_Clause => null; when Iir_Kind_Component_Declaration => null; when Iir_Kind_Configuration_Specification => if Canon_Flag_Configurations then Canon_Component_Specification (Decl, Parent); Canon_Component_Configuration (Top, Decl); end if; when Iir_Kind_Package_Declaration => Canon_Declarations (Top, Decl, Parent); when Iir_Kind_Package_Body => Canon_Declarations (Top, Decl, Parent); when Iir_Kind_Package_Instantiation_Declaration => return Canon_Package_Instantiation_Declaration (Decl); when Iir_Kind_Signal_Attribute_Declaration => null; when Iir_Kind_Nature_Declaration => null; when Iir_Kind_Terminal_Declaration => null; when Iir_Kinds_Quantity_Declaration => null; when Iir_Kind_Psl_Default_Clock => null; when others => Error_Kind ("canon_declaration", Decl); end case; return Decl; end Canon_Declaration; procedure Canon_Declarations (Top : Iir_Design_Unit; Decl_Parent : Iir; Parent : Iir) is Decl : Iir; Prev_Decl : Iir; New_Decl : Iir; begin if Parent /= Null_Iir then Clear_Instantiation_Configuration (Parent, True); end if; Decl := Get_Declaration_Chain (Decl_Parent); Prev_Decl := Null_Iir; while Decl /= Null_Iir loop New_Decl := Canon_Declaration (Top, Decl, Parent, Decl_Parent); if New_Decl /= Decl then -- Replace declaration if Prev_Decl = Null_Iir then Set_Declaration_Chain (Decl_Parent, New_Decl); else Set_Chain (Prev_Decl, New_Decl); end if; end if; Prev_Decl := New_Decl; Decl := Get_Chain (New_Decl); end loop; end Canon_Declarations; procedure Canon_Block_Configuration (Top : Iir_Design_Unit; Conf : Iir_Block_Configuration) is use Iir_Chains.Configuration_Item_Chain_Handling; Spec : constant Iir := Get_Block_Specification (Conf); Blk : constant Iir := Get_Block_From_Block_Specification (Spec); Stmts : constant Iir := Get_Concurrent_Statement_Chain (Blk); El : Iir; Sub_Blk : Iir; Last_Item : Iir; procedure Create_Default_Block_Configuration (Targ : Iir) is Res : Iir; Spec : Iir; begin Res := Create_Iir (Iir_Kind_Block_Configuration); Location_Copy (Res, Targ); Set_Parent (Res, Conf); if True then -- For debugging. Display as user block configuration. Spec := Build_Simple_Name (Targ, Targ); else -- To reduce size, it is possible to refer directly to the block -- itself, without using a name. Spec := El; end if; Set_Block_Specification (Res, Spec); Append (Last_Item, Conf, Res); end Create_Default_Block_Configuration; begin -- Note: the only allowed declarations are use clauses, which are not -- canonicalized. -- FIXME: handle indexed/sliced name? Clear_Instantiation_Configuration (Blk, False); Build_Init (Last_Item, Conf); -- 1) Configure instantiations with configuration specifications. -- TODO: merge. El := Get_Declaration_Chain (Blk); while El /= Null_Iir loop if Get_Kind (El) = Iir_Kind_Configuration_Specification then -- Already canonicalized during canon of block declarations. -- But need to set configuration on instantiations. Canon_Component_Specification (El, Blk); end if; El := Get_Chain (El); end loop; -- 2) Configure instantations with component configurations, -- and map block configurations with block/generate statements. El := Get_Configuration_Item_Chain (Conf); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Configuration_Specification => raise Internal_Error; when Iir_Kind_Component_Configuration => Canon_Component_Specification (El, Blk); when Iir_Kind_Block_Configuration => Sub_Blk := Strip_Denoting_Name (Get_Block_Specification (El)); case Get_Kind (Sub_Blk) is when Iir_Kind_Block_Statement => Set_Block_Block_Configuration (Sub_Blk, El); when Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name => Sub_Blk := Strip_Denoting_Name (Get_Prefix (Sub_Blk)); Set_Prev_Block_Configuration (El, Get_Generate_Block_Configuration (Sub_Blk)); Set_Generate_Block_Configuration (Sub_Blk, El); when Iir_Kind_Parenthesis_Name => Sub_Blk := Get_Named_Entity (Sub_Blk); Set_Prev_Block_Configuration (El, Get_Generate_Block_Configuration (Sub_Blk)); Set_Generate_Block_Configuration (Sub_Blk, El); when Iir_Kind_Generate_Statement_Body => Set_Generate_Block_Configuration (Sub_Blk, El); when others => Error_Kind ("canon_block_configuration(0)", Sub_Blk); end case; when others => Error_Kind ("canon_block_configuration(1)", El); end case; El := Get_Chain (El); end loop; -- 3) Add default component configuration for unspecified component -- instantiation statements, -- Add default block configuration for unconfigured block statements. El := Stmts; while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Component_Instantiation_Statement => declare Comp_Conf : Iir; Res : Iir_Component_Configuration; Designator_List : Iir_List; Inst_List : Iir_List; Inst : Iir; Inst_Name : Iir; begin Comp_Conf := Get_Component_Configuration (El); if Comp_Conf = Null_Iir then if Is_Component_Instantiation (El) then -- Create a component configuration. -- FIXME: should merge all these default configuration -- of the same component. Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, El); Set_Parent (Res, Conf); Set_Component_Name (Res, Build_Reference_Name (Get_Instantiated_Unit (El))); Designator_List := Create_Iir_List; Append_Element (Designator_List, Build_Simple_Name (El, El)); Set_Instantiation_List (Res, Designator_List); Append (Last_Item, Conf, Res); end if; elsif Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification then -- Create component configuration Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, Comp_Conf); Set_Parent (Res, Conf); Set_Component_Name (Res, Build_Reference_Name (Get_Component_Name (Comp_Conf))); -- Keep in the designator list only the non-incrementally -- bound instances, and only the instances in the current -- statements parts (vhdl-87 generate issue). Inst_List := Get_Instantiation_List (Comp_Conf); Designator_List := Create_Iir_List; for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop Inst_Name := Get_Nth_Element (Inst_List, I); Inst := Get_Named_Entity (Inst_Name); if Get_Component_Configuration (Inst) = Comp_Conf and then Get_Parent (Inst) = Blk then Set_Component_Configuration (Inst, Res); Append_Element (Designator_List, Build_Reference_Name (Inst_Name)); end if; end loop; Set_Instantiation_List (Res, Designator_List); Set_Binding_Indication (Res, Get_Binding_Indication (Comp_Conf)); Set_Is_Ref (Res, True); Append (Last_Item, Conf, Res); end if; end; when Iir_Kind_Block_Statement => if Get_Block_Block_Configuration (El) = Null_Iir then Create_Default_Block_Configuration (El); end if; when Iir_Kind_If_Generate_Statement => declare Clause : Iir; Bod : Iir; Blk_Config : Iir_Block_Configuration; begin Clause := El; while Clause /= Null_Iir loop Bod := Get_Generate_Statement_Body (Clause); Blk_Config := Get_Generate_Block_Configuration (Bod); if Blk_Config = Null_Iir then Create_Default_Block_Configuration (Bod); end if; Clause := Get_Generate_Else_Clause (Clause); end loop; end; when Iir_Kind_Case_Generate_Statement => declare Alt : Iir; Bod : Iir; Blk_Config : Iir_Block_Configuration; begin Alt := Get_Case_Statement_Alternative_Chain (El); while Alt /= Null_Iir loop if not Get_Same_Alternative_Flag (Alt) then Bod := Get_Associated_Block (Alt); Blk_Config := Get_Generate_Block_Configuration (Bod); if Blk_Config = Null_Iir then Create_Default_Block_Configuration (Bod); end if; end if; Alt := Get_Chain (Alt); end loop; end; when Iir_Kind_For_Generate_Statement => declare Bod : constant Iir := Get_Generate_Statement_Body (El); Blk_Config : constant Iir_Block_Configuration := Get_Generate_Block_Configuration (Bod); Res : Iir_Block_Configuration; Blk_Spec : Iir; begin if Blk_Config = Null_Iir then Create_Default_Block_Configuration (Bod); else Blk_Spec := Strip_Denoting_Name (Get_Block_Specification (Blk_Config)); if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement_Body then -- There are generate specification with range or -- expression. Create a default block configuration -- for the (possible) non-covered values. Res := Create_Iir (Iir_Kind_Block_Configuration); Location_Copy (Res, El); Set_Parent (Res, Conf); Blk_Spec := Create_Iir (Iir_Kind_Indexed_Name); Location_Copy (Blk_Spec, Res); Set_Index_List (Blk_Spec, Iir_List_Others); Set_Base_Name (Blk_Spec, El); Set_Prefix (Blk_Spec, Build_Simple_Name (Bod, Res)); Set_Block_Specification (Res, Blk_Spec); Append (Last_Item, Conf, Res); end if; end if; 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 ("canon_block_configuration(3)", El); end case; El := Get_Chain (El); end loop; -- 4) Canon component configuration and block configuration (recursion). El := Get_Configuration_Item_Chain (Conf); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Block_Configuration => Canon_Block_Configuration (Top, El); when Iir_Kind_Component_Configuration => Canon_Component_Configuration (Top, El); when others => Error_Kind ("canon_block_configuration", El); end case; El := Get_Chain (El); end loop; end Canon_Block_Configuration; procedure Canon_Interface_List (Chain : Iir) is Inter : Iir; begin if Canon_Flag_Expressions then Inter := Chain; while Inter /= Null_Iir loop Canon_Subtype_Indication_If_Anonymous (Get_Type (Inter)); Canon_Expression (Get_Default_Value (Inter)); Inter := Get_Chain (Inter); end loop; end if; end Canon_Interface_List; procedure Canonicalize (Unit: Iir_Design_Unit) is El: Iir; begin if False then -- Canon context clauses. -- This code is not executed since context clauses are already -- canonicalized. El := Get_Context_Items (Unit); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Use_Clause | Iir_Kind_Library_Clause | Iir_Kind_Context_Reference => null; when others => Error_Kind ("canonicalize1", El); end case; El := Get_Chain (El); end loop; end if; El := Get_Library_Unit (Unit); case Get_Kind (El) is when Iir_Kind_Entity_Declaration => Canon_Interface_List (Get_Generic_Chain (El)); Canon_Interface_List (Get_Port_Chain (El)); Canon_Declarations (Unit, El, El); Canon_Concurrent_Stmts (Unit, El); when Iir_Kind_Architecture_Body => Canon_Declarations (Unit, El, El); Canon_Concurrent_Stmts (Unit, El); when Iir_Kind_Package_Declaration => Canon_Declarations (Unit, El, Null_Iir); when Iir_Kind_Package_Body => Canon_Declarations (Unit, El, Null_Iir); when Iir_Kind_Configuration_Declaration => Canon_Declarations (Unit, El, Null_Iir); if Canon_Flag_Configurations then Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); end if; when Iir_Kind_Package_Instantiation_Declaration => El := Canon_Package_Instantiation_Declaration (El); Set_Library_Unit (Unit, El); when Iir_Kind_Context_Declaration => null; when others => Error_Kind ("canonicalize2", El); end case; end Canonicalize; -- -- Create a default component configuration for component instantiation -- -- statement INST. -- function Create_Default_Component_Configuration -- (Inst : Iir_Component_Instantiation_Statement; -- Parent : Iir; -- Config_Unit : Iir_Design_Unit) -- return Iir_Component_Configuration -- is -- Res : Iir_Component_Configuration; -- Designator : Iir; -- Comp : Iir_Component_Declaration; -- Bind : Iir; -- Aspect : Iir; -- begin -- Bind := Get_Default_Binding_Indication (Inst); -- if Bind = Null_Iir then -- -- Component is not bound. -- return Null_Iir; -- end if; -- Res := Create_Iir (Iir_Kind_Component_Configuration); -- Location_Copy (Res, Inst); -- Set_Parent (Res, Parent); -- Comp := Get_Instantiated_Unit (Inst); -- Set_Component_Name (Res, Comp); -- -- Create the instantiation list with only one element: INST. -- Designator := Create_Iir (Iir_Kind_Designator_List); -- Append_Element (Designator, Inst); -- Set_Instantiation_List (Res, Designator); -- Set_Binding_Indication (Res, Bind); -- Aspect := Get_Entity_Aspect (Bind); -- case Get_Kind (Aspect) is -- when Iir_Kind_Entity_Aspect_Entity => -- Add_Dependence (Config_Unit, Get_Entity (Aspect)); -- if Get_Architecture (Aspect) /= Null_Iir then -- raise Internal_Error; -- end if; -- when others => -- Error_Kind ("Create_Default_Component_Configuration", Aspect); -- end case; -- return Res; -- end Create_Default_Component_Configuration; -- Create a default configuration declaration for architecture ARCH. function Create_Default_Configuration_Declaration (Arch : Iir_Architecture_Body) return Iir_Design_Unit is Loc : constant Location_Type := Get_Location (Arch); Config : Iir_Configuration_Declaration; Res : Iir_Design_Unit; Blk_Cfg : Iir_Block_Configuration; begin Res := Create_Iir (Iir_Kind_Design_Unit); Set_Location (Res, Loc); Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch))); Set_Date_State (Res, Date_Analyze); Set_Date (Res, Date_Uptodate); Config := Create_Iir (Iir_Kind_Configuration_Declaration); Set_Location (Config, Loc); Set_Library_Unit (Res, Config); Set_Design_Unit (Config, Res); Set_Entity_Name (Config, Get_Entity_Name (Arch)); Set_Dependence_List (Res, Create_Iir_List); Add_Dependence (Res, Get_Design_Unit (Get_Entity (Config))); Add_Dependence (Res, Get_Design_Unit (Arch)); Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration); Set_Location (Blk_Cfg, Loc); Set_Parent (Blk_Cfg, Config); Set_Block_Specification (Blk_Cfg, Build_Simple_Name (Arch, Blk_Cfg)); Set_Block_Configuration (Config, Blk_Cfg); Canon_Block_Configuration (Res, Blk_Cfg); return Res; end Create_Default_Configuration_Declaration; end Canon;