From 3fea917ef9a145d448ab2dd5d83d7ac7de280602 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 3 Jan 2015 11:59:43 +0100 Subject: Initial rework for vhdl 2008 generate statements. --- src/vhdl/canon.adb | 117 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 72 insertions(+), 45 deletions(-) (limited to 'src/vhdl/canon.adb') diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index dc3e1af..ad80719 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -21,7 +21,6 @@ with Types; use Types; with Name_Table; with Sem; with Iir_Chains; use Iir_Chains; -with Flags; use Flags; with PSL.Nodes; with PSL.Rewrites; with PSL.Build; @@ -38,6 +37,8 @@ package body Canon is Parent : Iir; Decl_Parent : Iir); + procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir); + -- Canon on expressions, mainly for function calls. procedure Canon_Expression (Expr: Iir); @@ -1446,6 +1447,13 @@ package body Canon is end loop; end Canon_Selected_Concurrent_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; + procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir) is -- Current element in the chain of concurrent statements. @@ -1651,20 +1659,31 @@ package body Canon is Canon_Concurrent_Stmts (Top, El); end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement => declare - Scheme : Iir; + Clause : Iir; + Cond : Iir; begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir); - elsif Canon_Flag_Expressions then - Canon_Expression (Scheme); - end if; - Canon_Declarations (Top, El, El); - Canon_Concurrent_Stmts (Top, El); + Clause := El; + while Clause /= Null_Iir loop + if Canon_Flag_Expressions then + Cond := Get_Condition (El); + if Cond /= Null_Iir then + Canon_Expression (Cond); + end if; + end if; + Canon_Generate_Statement_Body + (Top, Get_Generate_Statement_Body (Clause)); + Clause := Get_Generate_Else_Clause (Clause); + end loop; end; + when Iir_Kind_For_Generate_Statement => + Canon_Declaration + (Top, Get_Parameter_Specification (El), Null_Iir, Null_Iir); + Canon_Generate_Statement_Body + (Top, Get_Generate_Statement_Body (El)); + when Iir_Kind_Psl_Assert_Statement | Iir_Kind_Psl_Cover_Statement => declare @@ -2084,15 +2103,6 @@ package body Canon is end if; end if; end if; - when Iir_Kind_Generate_Statement => - if False - and then Vhdl_Std = Vhdl_87 - and then - Get_Kind (Conf) = Iir_Kind_Configuration_Specification - then - Canon_Component_Specification_All_Others - (Conf, El, Spec, List, Comp); - end if; when others => null; end case; @@ -2381,6 +2391,26 @@ package body Canon is 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. @@ -2423,7 +2453,7 @@ package body Canon is Set_Prev_Block_Configuration (El, Get_Generate_Block_Configuration (Sub_Blk)); Set_Generate_Block_Configuration (Sub_Blk, El); - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => Set_Generate_Block_Configuration (Sub_Blk, El); when others => Error_Kind ("canon_block_configuration(0)", Sub_Blk); @@ -2495,40 +2525,37 @@ package body Canon is 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 - Res : Iir_Block_Configuration; + Bod : constant Iir := Get_Generate_Statement_Body (El); + Blk_Config : constant Iir_Block_Configuration := + Get_Generate_Block_Configuration (Bod); begin - if Get_Block_Block_Configuration (El) = Null_Iir then - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); + if Blk_Config = Null_Iir then + Create_Default_Block_Configuration (Bod); end if; end; - when Iir_Kind_Generate_Statement => + 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; - Scheme : Iir; - Blk_Config : Iir_Block_Configuration; Blk_Spec : Iir; begin - Scheme := Get_Generation_Scheme (El); - Blk_Config := Get_Generate_Block_Configuration (El); if Blk_Config = Null_Iir then - -- No block configuration for the (implicit) internal - -- block. Create one. - Res := Create_Iir (Iir_Kind_Block_Configuration); - Location_Copy (Res, El); - Set_Parent (Res, Conf); - Set_Block_Specification (Res, El); - Append (Last_Item, Conf, Res); - elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then + 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 then - -- There are partial configurations. - -- Create a default block configuration. + if Get_Kind (Blk_Spec) /= Iir_Kind_For_Generate_Statement + 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); @@ -2536,7 +2563,7 @@ package body Canon is Location_Copy (Blk_Spec, Res); Set_Index_List (Blk_Spec, Iir_List_Others); Set_Base_Name (Blk_Spec, El); - Set_Prefix (Blk_Spec, Build_Simple_Name (El, Res)); + Set_Prefix (Blk_Spec, Build_Simple_Name (Bod, Res)); Set_Block_Specification (Res, Blk_Spec); Append (Last_Item, Conf, Res); end if; -- cgit