aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl/vhdl-canon.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-05-05 06:57:01 +0200
committerTristan Gingold <tgingold@free.fr>2019-05-05 06:57:01 +0200
commitd1f0fedf7882cf1b15ea6450da5bbd878d007a98 (patch)
tree39c7312a2f1bbe3e5f357a22dd1df4fa228b3535 /src/vhdl/vhdl-canon.adb
parent19a9154fb3fadd0a33a6826e525091a9a75687e4 (diff)
downloadghdl-d1f0fedf7882cf1b15ea6450da5bbd878d007a98.tar.gz
ghdl-d1f0fedf7882cf1b15ea6450da5bbd878d007a98.tar.bz2
ghdl-d1f0fedf7882cf1b15ea6450da5bbd878d007a98.zip
vhdl: move canon to a vhdl child package.
Diffstat (limited to 'src/vhdl/vhdl-canon.adb')
-rw-r--r--src/vhdl/vhdl-canon.adb3290
1 files changed, 3290 insertions, 0 deletions
diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
new file mode 100644
index 000000000..2675e7cba
--- /dev/null
+++ b/src/vhdl/vhdl-canon.adb
@@ -0,0 +1,3290 @@
+-- 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 Vhdl.Canon_PSL;
+
+package body Vhdl.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; Clear : Boolean) 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;
+ 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);
+ declare
+ Flist : constant Iir_Flist := Get_Index_List (Expr);
+ El : Iir;
+ begin
+ for I in Flist_First .. Flist_Last (Flist) loop
+ El := Get_Nth_Element (Flist, I);
+ Canon_Extract_Sensitivity (El, Sensitivity_List, False);
+ end loop;
+ end;
+ 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_Kind_Dereference
+ | Iir_Kind_Implicit_Dereference =>
+ Canon_Extract_Sensitivity
+ (Get_Prefix (Expr), Sensitivity_List, False);
+
+ when Iir_Kind_External_Variable_Name
+ | Iir_Kind_External_Constant_Name =>
+ 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
+ | Iir_Kind_External_Signal_Name =>
+ -- 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);
+ It : List_Iterator;
+ begin
+ It := List_Iterate (List);
+ while Is_Valid (It) loop
+ Add_Element (Sensitivity_List, Get_Element (It));
+ Next (It);
+ end loop;
+ end;
+
+ when Iir_Kind_Object_Alias_Declaration =>
+ if not Is_Target and then Is_Signal_Object (Expr) then
+ Add_Element (Sensitivity_List, Expr);
+ end if;
+
+ 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_If_Not_Null
+ (Get_Severity_Expression (Stmt), List);
+ Canon_Extract_Sensitivity_If_Not_Null
+ (Get_Report_Expression (Stmt), List);
+ when Iir_Kind_Report_Statement =>
+ -- LRM08 11.3
+ -- See assertion_statement case.
+ Canon_Extract_Sensitivity_If_Not_Null
+ (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_If_Not_Null
+ (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;
+ Orig_Callee : Iir;
+ It : List_Iterator;
+ 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;
+ It := List_Iterate (Callees_List);
+ while Is_Valid (It) loop
+ Callee := Get_Element (It);
+
+ -- For subprograms of instantiated packages, refer to the
+ -- uninstantiated subprogram.
+ -- FIXME: not for macro-expanded packages
+ Orig_Callee := Sem_Inst.Get_Origin (Callee);
+ if Orig_Callee /= Null_Iir then
+ Callee := Orig_Callee;
+ end if;
+
+ 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 Invalid_Signal =>
+ -- Cannot be here. The error must have been detected.
+ raise Internal_Error;
+
+ when Unknown =>
+ -- Must be a subprogram declared in a different design unit.
+ -- Only a package can apply to this case.
+ -- Will be checked at elaboration.
+ pragma Assert (not Flags.Flag_Elaborate);
+ declare
+ Parent : Iir;
+ begin
+ Parent := Get_Parent (Callee);
+ pragma Assert
+ (Get_Kind (Parent) = Iir_Kind_Package_Declaration);
+ Parent := Get_Parent (Parent);
+ pragma Assert
+ (Get_Kind (Parent) = Iir_Kind_Design_Unit);
+ end;
+ end case;
+ end if;
+ Next (It);
+ 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
+ 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));
+ declare
+ Flist : constant Iir_Flist := Get_Index_List (Expr);
+ El : Iir;
+ begin
+ for I in Flist_First .. Flist_Last (Flist) loop
+ El := Get_Nth_Element (Flist, I);
+ Canon_Expression (El);
+ end loop;
+ end;
+
+ 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
+ | Iir_Kind_Psl_Endpoint_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
+ if Get_Kind (Waveform) = Iir_Kind_Unaffected_Waveform then
+ pragma Assert (Get_Chain (Waveform) = Null_Iir);
+ return;
+ end if;
+
+ 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), False);
+ 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; Clear : Boolean) 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;
+
+ if Clear then
+ Set_Condition (Cond_Wf, Null_Iir);
+ Set_Waveform_Chain (Cond_Wf, Null_Iir);
+ end if;
+
+ 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, True);
+ 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
+ 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
+ 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
+ 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_Flist;
+ 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_Flists_All_Others);
+ Bind := Get_Default_Binding_Indication
+ (Get_Named_Entity (Get_Nth_Element (Instances, 0)));
+ 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
+ -- Merge associations from FIRST_CHAIN and SEC_CHAIN.
+ 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. In
+ -- case of individual associations, all associations for the
+ -- interface are copied.
+ 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;
+ Set_Formal (El, Formal);
+ else
+ Formal := Inter;
+ end if;
+ 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_Actual_Conversion
+ (El,
+ Sem_Inst.Copy_Tree (Get_Actual_Conversion (Assoc)));
+ Set_Formal_Conversion
+ (El,
+ Sem_Inst.Copy_Tree (Get_Formal_Conversion (Assoc)));
+ Set_Collapse_Signal_Flag
+ (Assoc,
+ Sem.Can_Collapse_Signals (Assoc, Formal));
+ 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 association 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
+ -- Exists and not open: use it.
+ S_Inter := Inter;
+ Copy_Association (S_El, S_Inter, Inter);
+ Advance (F_El, F_Inter, Inter);
+ else
+ -- Does not exist: use the one from first chain.
+ 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_Flist;
+ 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;
+ Conf_Instance_List := Get_Instantiation_List (Comp_Conf);
+ N_Nbr := 0;
+ for I in Flist_First .. Flist_Last (Conf_Instance_List) 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
+ Set_Nth_Element (Conf_Instance_List, N_Nbr, Instance_Name);
+ N_Nbr := N_Nbr + 1;
+ end if;
+ end loop;
+ Set_Instantiation_List (Comp_Conf,
+ Truncate_Flist (Conf_Instance_List, N_Nbr));
+ Set_Instantiation_List (Res, List_To_Flist (Instance_List));
+
+ -- 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_Flist; 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_Flist_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_Flist_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_Flist)
+ is
+ El : Iir;
+ Comp_Conf : Iir;
+ begin
+ -- Already has a designator list.
+ for I in Flist_First .. Flist_Last (Spec) loop
+ El := Get_Nth_Element (Spec, I);
+ 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_Flist := Get_Instantiation_List (Conf);
+ List : Iir_List;
+ begin
+ if Spec in Iir_Flists_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_To_Flist (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_Flist;
+ Force : Boolean;
+ El : Iir;
+ N_List : Iir_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_Flist_All then
+ Force := True;
+ elsif Signal_List = Iir_Flist_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_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;
+ Set_Signal_List (Dis, List_To_Flist (N_List));
+ 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_Flist := Get_Index_Subtype_List (Def);
+ Index : Iir;
+ begin
+ for I in Flist_First .. Flist_Last (Indexes) loop
+ Index := Get_Index_Type (Indexes, I);
+ 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_Instance_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_Flist;
+ 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, List_To_Flist (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 Flist_First .. Flist_Last (Inst_List) 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, List_To_Flist (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_Flist_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 Vhdl.Canon;