diff options
| author | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
| commit | 9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch) | |
| tree | 575346e529b99e26382b4a06f6ff2caa0b391ab2 /canon.adb | |
| parent | 184a123f91e07c927292d67462561dc84f3a920d (diff) | |
| download | ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2 ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip | |
Move sources to src/ subdirectory.
Diffstat (limited to 'canon.adb')
| -rw-r--r-- | canon.adb | 2735 |
1 files changed, 0 insertions, 2735 deletions
diff --git a/canon.adb b/canon.adb deleted file mode 100644 index cd2dae0fd..000000000 --- a/canon.adb +++ /dev/null @@ -1,2735 +0,0 @@ --- 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 Name_Table; -with Sem; -with Iir_Chains; use Iir_Chains; -with Flags; use Flags; -with PSL.Nodes; -with PSL.Rewrites; -with PSL.Build; - -package body Canon is - -- Canonicalize a list of declarations. LIST can be null. - -- PARENT must be the parent of the current statements chain for LIST, - -- or NULL_IIR if LIST has no corresponding current statments. - procedure Canon_Declarations (Top : Iir_Design_Unit; - Decl_Parent : Iir; - Parent : Iir); - procedure Canon_Declaration (Top : Iir_Design_Unit; - Decl : Iir; - Parent : Iir; - Decl_Parent : Iir); - - -- Canon on expressions, mainly for function calls. - procedure Canon_Expression (Expr: 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); - - 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_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 => - 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_Kind_Event_Attribute - | Iir_Kind_Active_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_Last_Value_Attribute => - null; - - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Stable_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_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_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_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_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); - declare - We: Iir_Waveform_Element; - begin - We := Get_Waveform_Chain (Stmt); - while We /= Null_Iir loop - Canon_Extract_Sensitivity (Get_We_Value (We), List); - We := Get_Chain (We); - 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. - 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; - 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 := Get_Suffix (Expr); - if Get_Kind (Suffix) not in Iir_Kinds_Discrete_Type_Definition - 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 Get_Kind (Get_Implementation (Expr)) = - Iir_Kind_Implicit_Function_Declaration - 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_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; - - procedure Canon_Waveform_Chain - (Chain : Iir_Waveform_Element; Sensitivity_List: Iir_List) - is - We: Iir_Waveform_Element; - begin - We := Chain; - while We /= Null_Iir loop - if Sensitivity_List /= Null_Iir_List then - Canon_Extract_Sensitivity - (Get_We_Value (We), Sensitivity_List, False); - end if; - if Canon_Flag_Expressions then - Canon_Expression (Get_We_Value (We)); - if Get_Time (We) /= Null_Iir then - Canon_Expression (Get_Time (We)); - end if; - end if; - We := Get_Chain (We); - end loop; - end Canon_Waveform_Chain; - - -- 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; - Assoc_Chain : Iir; - - Found : Boolean; - begin - -- 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); - if Get_Formal (Assoc_El) = Null_Iir then - Set_Formal (Assoc_El, Inter); - end if; - if Get_Association_Interface (Assoc_El) = 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 => - 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); - Set_Formal (Assoc_El, Inter); - 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 - 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); - Set_Formal (Assoc, El); - 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_Default_Map_Association_List --- (Formal_List, Actual_List : Iir_List; Loc : Location_Type) --- return Iir_Association_List --- is --- Res : Iir_Association_List; --- Formal, Actual : Iir; --- Assoc : Iir; --- Nbr_Assoc : Natural; --- begin --- -- formal is the entity port/generic. --- if Formal_List = Null_Iir_List then --- if Actual_List /= Null_Iir_List then --- raise Internal_Error; --- end if; --- return Null_Iir_List; --- end if; - --- Res := Create_Iir (Iir_Kind_Association_List); --- Set_Location (Res, Loc); --- Nbr_Assoc := 0; --- for I in Natural loop --- Formal := Get_Nth_Element (Formal_List, I); --- exit when Formal = Null_Iir; --- Actual := Find_Name_In_List (Actual_List, Get_Identifier (Formal)); --- if Actual /= Null_Iir then --- Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression); --- Set_Whole_Association_Flag (Assoc, True); --- Set_Actual (Assoc, Actual); --- Nbr_Assoc := Nbr_Assoc + 1; --- else --- Assoc := Create_Iir (Iir_Kind_Association_Element_Open); --- end if; --- Set_Location (Assoc, Loc); --- Set_Formal (Assoc, Formal); --- Set_Associated_Formal (Assoc, Formal); --- Append_Element (Res, Assoc); --- end loop; --- if Nbr_Assoc /= Get_Nbr_Elements (Actual_List) then --- -- There is non-associated actuals. --- raise Internal_Error; --- end if; --- return Res; --- end Canon_Default_Map_Association_List; - - -- Inner loop if any; used to canonicalize exit/next statement. - Cur_Loop : Iir; - - procedure Canon_Sequential_Stmts (First : Iir) - is - Stmt: Iir; - Expr: Iir; - Prev_Loop : Iir; - begin - Stmt := First; - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_If_Statement => - declare - Cond: Iir; - Clause: Iir := Stmt; - begin - while Clause /= Null_Iir loop - Cond := Get_Condition (Clause); - if Cond /= Null_Iir then - Canon_Expression (Cond); - end if; - Canon_Sequential_Stmts - (Get_Sequential_Statement_Chain (Clause)); - Clause := Get_Else_Clause (Clause); - end loop; - end; - - when Iir_Kind_Signal_Assignment_Statement => - Canon_Expression (Get_Target (Stmt)); - Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List); - - when Iir_Kind_Variable_Assignment_Statement => - Canon_Expression (Get_Target (Stmt)); - Canon_Expression (Get_Expression (Stmt)); - - when Iir_Kind_Wait_Statement => - declare - Expr: Iir; - List: Iir_List; - begin - Expr := Get_Timeout_Clause (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Expr := Get_Condition_Clause (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - 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; - begin - Choice := Get_Case_Statement_Alternative_Chain (Stmt); - while Choice /= Null_Iir loop - -- FIXME: canon choice expr. - Canon_Sequential_Stmts (Get_Associated_Chain (Choice)); - 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; - Expr := Get_Report_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Expr := Get_Severity_Expression (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - - when Iir_Kind_For_Loop_Statement => - -- FIXME: decl. - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - if Canon_Flag_Expressions then - Canon_Discrete_Range - (Get_Type (Get_Parameter_Specification (Stmt))); - end if; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; - - when Iir_Kind_While_Loop_Statement => - Expr := Get_Condition (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Prev_Loop := Cur_Loop; - Cur_Loop := Stmt; - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); - Cur_Loop := Prev_Loop; - - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - declare - Loop_Label : Iir; - begin - Expr := Get_Condition (Stmt); - if Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - 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; - Stmt := Get_Chain (Stmt); - end loop; - 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_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 Canon_Flag_Expressions then - Canon_Expression (Get_Target (Stmt)); - end if; - - 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)); - 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_Signal_Assignment_Statement); - Location_Copy (Dis_Stmt, Stmt); - Set_Parent (Dis_Stmt, If_Stmt); - Set_Target (Dis_Stmt, Target); - 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 (El : Iir) - return Iir_Sensitized_Process_Statement - is - Proc : Iir_Sensitized_Process_Statement; - Call_Stmt : Iir_Procedure_Call_Statement; - Wait_Stmt : Iir_Wait_Statement; - 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 - -- Optimization: the process is a sensitized process only if the - -- procedure is known not to have wait statement. - Is_Sensitized := Get_Wait_State (Imp) = False; - - -- 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, El); - Set_Parent (Proc, Get_Parent (El)); - Set_Process_Origin (Proc, El); - - -- 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 (El)); - - -- 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 (El)); - - Set_Attribute_Value_Chain (Proc, Get_Attribute_Value_Chain (El)); - - Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); - Set_Sequential_Statement_Chain (Proc, Call_Stmt); - Location_Copy (Call_Stmt, El); - Set_Parent (Call_Stmt, Proc); - Set_Procedure_Call (Call_Stmt, Call); - 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); - Assoc := Assoc_Chain; - - -- 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; - 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; - if Is_Sensitized then - Set_Sensitivity_List (Proc, Sensitivity_List); - else - Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); - Location_Copy (Wait_Stmt, El); - Set_Parent (Wait_Stmt, Proc); - Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); - 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) - return Iir - is - Stmt : Iir; - begin - if Waveform_Chain = Null_Iir 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_Signal_Assignment_Statement); - Set_Target (Stmt, Get_Target (Orig_Stmt)); - Canon_Waveform_Chain (Waveform_Chain, Get_Sensitivity_List (Proc)); - 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)); - end if; - Location_Copy (Stmt, Orig_Stmt); - return Stmt; - end Canon_Wave_Transform; - - -- Create signal_transform for a conditional concurrent signal assignment. - procedure Canon_Conditional_Concurrent_Signal_Assigment - (Conc_Stmt : Iir; Proc : Iir; Parent : 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); - Wf := Canon_Wave_Transform - (Conc_Stmt, Get_Waveform_Chain (Cond_Wf), Proc); - Set_Parent (Wf, Parent); - if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then - Res1 := Wf; - else - if Expr /= Null_Iir then - if Canon_Flag_Expressions then - Canon_Expression (Expr); - end if; - Canon_Extract_Sensitivity - (Expr, Get_Sensitivity_List (Proc), False); - end if; - if Stmt = Null_Iir then - Res1 := Create_Iir (Iir_Kind_If_Statement); - Set_Parent (Res1, Parent); - else - Res1 := Create_Iir (Iir_Kind_Elsif); - end if; - Location_Copy (Res1, Cond_Wf); - Set_Condition (Res1, Expr); - Set_Sequential_Statement_Chain (Res1, Wf); - end if; - if Stmt = Null_Iir then - Stmt := Res1; - else - Set_Else_Clause (Last_Res, Res1); - end if; - Last_Res := Res1; - Cond_Wf := Get_Chain (Cond_Wf); - end loop; - Set_Sequential_Statement_Chain (Parent, Stmt); - end Canon_Conditional_Concurrent_Signal_Assigment; - - procedure Canon_Selected_Concurrent_Signal_Assignment - (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) - is - Selected_Waveform : Iir; - Case_Stmt: Iir_Case_Statement; - Expr : Iir; - Stmt : Iir; - Assoc : Iir; - begin - 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); - Expr := Get_Expression (Conc_Stmt); - if Canon_Flag_Expressions then - Canon_Expression (Expr); - end if; - Set_Expression (Case_Stmt, Expr); - Canon_Extract_Sensitivity - (Expr, Get_Sensitivity_List (Proc), False); - - Selected_Waveform := Get_Selected_Waveform_Chain (Conc_Stmt); - Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform); - while Selected_Waveform /= Null_Iir loop - Assoc := Get_Associated_Chain (Selected_Waveform); - if Assoc /= Null_Iir then - Stmt := Canon_Wave_Transform (Conc_Stmt, Assoc, Proc); - Set_Parent (Stmt, Case_Stmt); - Set_Associated_Chain (Selected_Waveform, Stmt); - end if; - Selected_Waveform := Get_Chain (Selected_Waveform); - end loop; - end Canon_Selected_Concurrent_Signal_Assignment; - - 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; - Stmt: Iir; - Sub_Chain : Iir; - Expr: Iir; - Proc_Num : Natural := 0; - Sensitivity_List : Iir_List; - 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 => - 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_Conditional_Signal_Assignment => - Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); - - Canon_Conditional_Concurrent_Signal_Assigment - (El, Proc, Sub_Chain); - - Replace_Stmt (Proc); - Free_Iir (El); - El := Proc; - - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); - - Canon_Selected_Concurrent_Signal_Assignment - (El, Proc, Sub_Chain); - - Replace_Stmt (Proc); - Free_Iir (El); - El := Proc; - - when Iir_Kind_Concurrent_Assertion_Statement => - -- Create a new entry. - Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); - Location_Copy (Proc, El); - Set_Parent (Proc, Get_Parent (El)); - Set_Process_Origin (Proc, El); - - -- 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 (El)); - - -- 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 (El)); - - Stmt := Create_Iir (Iir_Kind_Assertion_Statement); - Set_Sequential_Statement_Chain (Proc, Stmt); - Set_Parent (Stmt, Proc); - Location_Copy (Stmt, El); - Sensitivity_List := Create_Iir_List; - Set_Sensitivity_List (Proc, Sensitivity_List); - - -- Expand the expression, fill the sensitivity list, - Canon_Extract_Sensitivity - (Get_Assertion_Condition (El), Sensitivity_List, False); - if Canon_Flag_Expressions then - Canon_Expression (Get_Assertion_Condition (El)); - end if; - Set_Assertion_Condition - (Stmt, Get_Assertion_Condition (El)); - - Expr := Get_Report_Expression (El); - if Canon_Flag_Expressions and Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Set_Report_Expression (Stmt, Expr); - - Expr := Get_Severity_Expression (El); - if Canon_Flag_Expressions and Expr /= Null_Iir then - Canon_Expression (Expr); - end if; - Set_Severity_Expression (Stmt, Expr); - - Replace_Stmt (Proc); - El := Proc; - - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Proc := Canon_Concurrent_Procedure_Call (El); - Replace_Stmt (Proc); - El := Proc; - - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Canon_Declarations (Top, El, Null_Iir); - if Canon_Flag_Sequentials_Stmts then - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El)); - 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_Generate_Statement => - declare - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir); - elsif Canon_Flag_Expressions then - Canon_Expression (Scheme); - end if; - Canon_Declarations (Top, El, El); - Canon_Concurrent_Stmts (Top, El); - end; - - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_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); - - -- FIXME: report/severity. - end; - - when Iir_Kind_Psl_Default_Clock => - null; - when Iir_Kind_Psl_Declaration => - declare - use PSL.Nodes; - Decl : PSL_Node; - Prop : PSL_Node; - Fa : PSL_NFA; - begin - Decl := Get_Psl_Declaration (El); - 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_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; - 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); - if Instances = Iir_List_All or Instances = Iir_List_Others then - -- designator_all and designator_others must have been replaced - -- by a list during canon. - raise Internal_Error; - else - Bind := Get_Default_Binding_Indication - (Get_Named_Entity (Get_First_Element (Instances))); - end if; - if Bind = Null_Iir then - -- Component is not bound. - return; - end if; - Set_Binding_Indication (Cfg, Bind); - 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); - Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); - if Map_Chain = Null_Iir then - if Is_Config then - Map_Chain := Get_Default_Generic_Map_Aspect_Chain (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); - - Map_Chain := Get_Port_Map_Aspect_Chain (Bind); - if Map_Chain = Null_Iir then - if Is_Config then - Map_Chain := Get_Default_Port_Map_Aspect_Chain (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 Get_Kind (Cfg) = Iir_Kind_Component_Configuration 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); - if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then - raise Internal_Error; - end if; - Set_Architecture - (Entity_Aspect, Get_Block_Specification (Block)); - end if; - Canon_Block_Configuration (Top, Block); - end if; - end if; - end if; - end if; - end Canon_Component_Configuration; - - 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 : Iir) - is - El : Iir; - begin - loop - El := Create_Iir (Get_Kind (Assoc)); - Location_Copy (El, Assoc); - Set_Formal (El, Get_Formal (Assoc)); - 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, Get_Actual (Assoc)); - Set_In_Conversion (El, Get_In_Conversion (Assoc)); - Set_Out_Conversion (El, 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)); - Set_Individual_Association_Chain - (El, Get_Individual_Association_Chain (Assoc)); - when others => - Error_Kind ("copy_association", Assoc); - end case; - - Sub_Chain_Append (First, Last, El); - Assoc := Get_Chain (Assoc); - exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; - end loop; - end Copy_Association; - - procedure Advance (Assoc : in out Iir; Inter : Iir) - is - begin - loop - Assoc := Get_Chain (Assoc); - exit when Assoc = Null_Iir; - exit when Get_Association_Interface (Assoc) /= Inter; - end loop; - end Advance; - - Inter : Iir; - F_El : Iir; - S_El : Iir; - begin - if Sec_Chain = Null_Iir then - -- Short-cut. - return First_Chain; - end if; - F_El := First_Chain; - Sub_Chain_Init (First, Last); - Inter := Inter_Chain; - while Inter /= Null_Iir loop - -- Consistency check. - pragma Assert (Get_Association_Interface (F_El) = 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; - 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); - else - Copy_Association (F_El, Inter); - end if; - Inter := Get_Chain (Inter); - end loop; - return First; - end Merge_Association_Chain; - - Res : Iir_Component_Configuration; - Cs_Binding : Iir_Binding_Indication; - Cc_Binding : Iir_Binding_Indication; - 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, Get_Component_Name (Conf_Spec)); - --- -- Keep in the designator list only the non-incrementally --- -- bound instances. --- Inst_List := Get_Instantiation_List (Comp_Conf); --- Designator_List := Create_Iir_List; --- for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop --- Inst := Get_Nth_Element (Inst_List, I); --- if Get_Component_Configuration (Inst) = Comp_Conf then --- Set_Component_Configuration (Inst, Res); --- Append_Element (Designator_List, Inst); --- end if; --- end loop; --- Set_Instantiation_List (Res, Designator_List); --- Set_Binding_Indication --- (Res, Get_Binding_Indication (Comp_Conf)); --- Append (Last_Item, Conf, Comp_Conf); - - Cs_Binding := Get_Binding_Indication (Conf_Spec); - Cc_Binding := Get_Binding_Indication (Comp_Conf); - 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 := Get_Default_Generic_Map_Aspect_Chain (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 := Get_Default_Port_Map_Aspect_Chain (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, 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; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Component_Instantiation_Statement => - if 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. - Append_Element (List, Build_Simple_Name (El, El)); - 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; - if Spec = Iir_List_All then - -- Several component configuration for an instance. - -- Must have been caught by sem. - raise Internal_Error; - elsif Spec = Iir_List_Others then - null; - else - raise Internal_Error; - end if; - end if; - end if; - when Iir_Kind_Generate_Statement => - if False - and then Vhdl_Std = Vhdl_87 - and then - Get_Kind (Conf) = Iir_Kind_Configuration_Specification - then - Canon_Component_Specification_All_Others - (Conf, El, Spec, List, Comp); - end if; - when others => - null; - end case; - 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 - if Get_Kind (Comp_Conf) /= Iir_Kind_Configuration_Specification - or else Get_Kind (Conf) /= Iir_Kind_Component_Configuration - then - raise Internal_Error; - end if; - 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 = Iir_List_All or Spec = Iir_List_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; - 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 - return; - end if; - Dis_Type := Get_Type (Get_Type_Mark (Dis)); - N_List := Create_Iir_List; - Set_Signal_List (Dis, N_List); - 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_Signal_Kind (El) /= Iir_No_Signal_Kind - 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 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_Nth_Element (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; - - procedure Canon_Declaration (Top : Iir_Design_Unit; - Decl : Iir; - Parent : Iir; - Decl_Parent : Iir) - is - 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 - Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl)); - 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_Implicit_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration => - null; - - when Iir_Kind_Configuration_Specification => - Canon_Component_Specification (Decl, Parent); - Canon_Component_Configuration (Top, Decl); --- declare --- List : Iir_List; --- Binding : Iir_Binding_Indication; --- Component : Iir_Component_Declaration; --- Aspect : Iir; --- Entity : Iir; --- begin --- Binding := Get_Binding_Indication (Decl); --- Component := Get_Component_Name (Decl); --- Aspect := Get_Entity_Aspect (Binding); --- case Get_Kind (Aspect) is --- when Iir_Kind_Entity_Aspect_Entity => --- Entity := Get_Entity (Aspect); --- when others => --- Error_Kind ("configuration_specification", Aspect); --- end case; --- Entity := Get_Library_Unit (Entity); --- List := Get_Generic_Map_Aspect_List (Binding); --- if List = Null_Iir_List then --- Set_Generic_Map_Aspect_List --- (Binding, --- Canon_Default_Map_Association_List --- (Get_Generic_List (Entity), Get_Generic_List (Component), --- Get_Location (Decl))); --- end if; --- List := Get_Port_Map_Aspect_List (Binding); --- if List = Null_Iir_List then --- Set_Port_Map_Aspect_List --- (Binding, --- Canon_Default_Map_Association_List --- (Get_Port_List (Entity), Get_Port_List (Component), --- Get_Location (Decl))); --- end if; --- end; - - when Iir_Kinds_Signal_Attribute => - null; - - when Iir_Kind_Nature_Declaration => - null; - when Iir_Kind_Terminal_Declaration => - null; - when Iir_Kinds_Quantity_Declaration => - null; - when others => - Error_Kind ("canon_declaration", Decl); - end case; - end Canon_Declaration; - - procedure Canon_Declarations (Top : Iir_Design_Unit; - Decl_Parent : Iir; - Parent : Iir) - is - Decl : Iir; - begin - if Parent /= Null_Iir then - Clear_Instantiation_Configuration (Parent, True); - end if; - Decl := Get_Declaration_Chain (Decl_Parent); - while Decl /= Null_Iir loop - Canon_Declaration (Top, Decl, Parent, Decl_Parent); - Decl := Get_Chain (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; - 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 canoncalized 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_Generate_Statement => - 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, 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, 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, Inst_Name); - end if; - end loop; - Set_Instantiation_List (Res, Designator_List); - Set_Binding_Indication - (Res, Get_Binding_Indication (Comp_Conf)); - Append (Last_Item, Conf, Res); - end if; - end; - when Iir_Kind_Block_Statement => - declare - Res : Iir_Block_Configuration; - begin - if Get_Block_Block_Configuration (El) = Null_Iir then - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); - end if; - end; - when Iir_Kind_Generate_Statement => - declare - Res : Iir_Block_Configuration; - Scheme : Iir; - Blk_Config : Iir_Block_Configuration; - Blk_Spec : Iir; - begin - Scheme := Get_Generation_Scheme (El); - Blk_Config := Get_Generate_Block_Configuration (El); - if Blk_Config = Null_Iir then - -- No block configuration for the (implicit) internal - -- block. Create one. - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); - elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Blk_Spec := Strip_Denoting_Name - (Get_Block_Specification (Blk_Config)); - if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement then - -- There are partial configurations. - -- Create a default block configuration. - 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 (El, Res)); - Set_Block_Specification (Res, Blk_Spec); - Append (Last_Item, Conf, Res); - end if; - end if; - end; - - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_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_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 => - null; - when Iir_Kind_Library_Clause => - 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); - Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); - when Iir_Kind_Package_Instantiation_Declaration => - declare - Pkg : constant Iir := - Get_Named_Entity (Get_Uninstantiated_Package_Name (El)); - Hdr : constant Iir := Get_Package_Header (Pkg); - begin - Set_Generic_Map_Aspect_Chain - (El, - Canon_Association_Chain_And_Actuals - (Get_Generic_Chain (Hdr), - Get_Generic_Map_Aspect_Chain (El), El)); - end; - 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, Arch); - Set_Block_Configuration (Config, Blk_Cfg); - - Canon_Block_Configuration (Res, Blk_Cfg); - - return Res; - end Create_Default_Configuration_Declaration; - -end Canon; |