diff options
author | Tristan Gingold <tgingold@free.fr> | 2015-01-03 11:59:43 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2015-01-03 11:59:43 +0100 |
commit | 3fea917ef9a145d448ab2dd5d83d7ac7de280602 (patch) | |
tree | a83cb707f28c353b6bedde63b500dc1562d8adf3 /src | |
parent | 4e27c73749284b46b899851f3b1ef00fe5187b47 (diff) | |
download | ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.gz ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.bz2 ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.zip |
Initial rework for vhdl 2008 generate statements.
Diffstat (limited to 'src')
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 3 | ||||
-rw-r--r-- | src/vhdl/canon.adb | 117 | ||||
-rw-r--r-- | src/vhdl/configuration.adb | 17 | ||||
-rw-r--r-- | src/vhdl/disp_vhdl.adb | 76 | ||||
-rw-r--r-- | src/vhdl/errorout.adb | 7 | ||||
-rw-r--r-- | src/vhdl/evaluation.adb | 21 | ||||
-rw-r--r-- | src/vhdl/iirs.adb | 123 | ||||
-rw-r--r-- | src/vhdl/iirs.ads | 120 | ||||
-rw-r--r-- | src/vhdl/iirs_utils.adb | 27 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.adb | 338 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.ads | 18 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 207 | ||||
-rw-r--r-- | src/vhdl/sem.adb | 203 | ||||
-rw-r--r-- | src/vhdl/sem_decls.adb | 8 | ||||
-rw-r--r-- | src/vhdl/sem_names.adb | 31 | ||||
-rw-r--r-- | src/vhdl/sem_scopes.adb | 2 | ||||
-rw-r--r-- | src/vhdl/sem_specs.adb | 11 | ||||
-rw-r--r-- | src/vhdl/sem_stmts.adb | 105 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap1.adb | 312 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 168 | ||||
-rw-r--r-- | src/vhdl/translate/trans-rtis.adb | 112 |
21 files changed, 1306 insertions, 720 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index f685e79e4..c852cc0ae 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -1682,7 +1682,8 @@ package body Ghdlprint is C := 'm'; when Iir_Kind_Component_Instantiation_Statement => C := 'I'; - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => C := 'G'; when others => C := '?'; diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index dc3e1af52..ad8071937 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; diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index 30d9eb116..07dce428f 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -215,9 +215,22 @@ package body Configuration is -- Entity or configuration instantiation. Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True); end if; - when Iir_Kind_Generate_Statement - | Iir_Kind_Block_Statement => + when Iir_Kind_Block_Statement => Add_Design_Concurrent_Stmts (Stmt); + when Iir_Kind_For_Generate_Statement => + Add_Design_Concurrent_Stmts + (Get_Generate_Statement_Body (Stmt)); + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Add_Design_Concurrent_Stmts + (Get_Generate_Statement_Body (Clause)); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end; when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Psl_Assert_Statement diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index b8ca9f400..6550d1e38 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -222,7 +222,8 @@ package body Disp_Vhdl is | Iir_Kind_Simple_Name => Disp_Identifier (Decl); when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => declare Ident : constant Name_Id := Get_Label (Decl); begin @@ -2797,32 +2798,58 @@ package body Disp_Vhdl is Disp_End (Block, "block"); end Disp_Block_Statement; - procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement) + procedure Disp_Generate_Statement_Body (Parent : Iir; Indent : Count) is - Indent : Count; - Scheme : Iir; + Bod : constant Iir := Get_Generate_Statement_Body (Parent); begin - Indent := Col; - Disp_Label (Stmt); - Scheme := Get_Generation_Scheme (Stmt); - case Get_Kind (Scheme) is - when Iir_Kind_Iterator_Declaration => - Put ("for "); - Disp_Parameter_Specification (Scheme); - when others => - Put ("if "); - Disp_Expression (Scheme); - end case; - Put_Line (" generate"); - Disp_Declaration_Chain (Stmt, Indent); - if Get_Has_Begin (Stmt) then + Disp_Declaration_Chain (Bod, Indent); + if Get_Has_Begin (Bod) then Set_Col (Indent); Put_Line ("begin"); end if; - Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation); + Disp_Concurrent_Statement_Chain (Bod, Indent + Indentation); + end Disp_Generate_Statement_Body; + + procedure Disp_For_Generate_Statement (Stmt : Iir) + is + Indent : constant Count := Col; + begin + Disp_Label (Stmt); + Put ("for "); + Disp_Parameter_Specification (Get_Parameter_Specification (Stmt)); + Put_Line (" generate"); + Disp_Generate_Statement_Body (Stmt, Indent); + Set_Col (Indent); + Disp_End (Stmt, "generate"); + end Disp_For_Generate_Statement; + + procedure Disp_If_Generate_Statement (Stmt : Iir) + is + Indent : constant Count := Col; + Clause : Iir; + Cond : Iir; + begin + Disp_Label (Stmt); + Put ("if "); + Disp_Expression (Get_Condition (Stmt)); + Clause := Stmt; + loop + Put_Line (" generate"); + Disp_Generate_Statement_Body (Clause, Indent); + Clause := Get_Generate_Else_Clause (Stmt); + exit when Clause = Null_Iir; + Cond := Get_Condition (Clause); + Set_Col (Indent); + if Cond = Null_Iir then + Put ("else"); + else + Put ("elsif "); + Disp_Expression (Cond); + end if; + end loop; Set_Col (Indent); Disp_End (Stmt, "generate"); - end Disp_Generate_Statement; + end Disp_If_Generate_Statement; procedure Disp_Psl_Default_Clock (Stmt : Iir) is begin @@ -2914,8 +2941,10 @@ package body Disp_Vhdl is Disp_Procedure_Call (Get_Procedure_Call (Stmt)); when Iir_Kind_Block_Statement => Disp_Block_Statement (Stmt); - when Iir_Kind_Generate_Statement => - Disp_Generate_Statement (Stmt); + when Iir_Kind_If_Generate_Statement => + Disp_If_Generate_Statement (Stmt); + when Iir_Kind_For_Generate_Statement => + Disp_For_Generate_Statement (Stmt); when Iir_Kind_Psl_Default_Clock => Disp_Psl_Default_Clock (Stmt); when Iir_Kind_Psl_Assert_Statement => @@ -3047,7 +3076,8 @@ package body Disp_Vhdl is Spec := Get_Block_Specification (Block); case Get_Kind (Spec) is when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Architecture_Body => Disp_Name_Of (Spec); when Iir_Kind_Indexed_Name => diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index c059c5273..0923c5981 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -662,7 +662,12 @@ package body Errorout is when Iir_Kind_Concurrent_Procedure_Call_Statement => return "concurrent procedure call"; - when Iir_Kind_Generate_Statement => + when Iir_Kind_For_Generate_Statement => + return "for generate statement"; + when Iir_Kind_If_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause => + return "if generate statement"; + when Iir_Kind_Generate_Statement_Body => return "generate statement"; when Iir_Kind_Simple_Simultaneous_Statement => diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index d6ddfc7e2..bf0e7d3c6 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -2895,19 +2895,14 @@ package body Evaluation is when Iir_Kind_Procedure_Body => Path_Add_Element (Get_Subprogram_Specification (El), Is_Instance); - when Iir_Kind_Generate_Statement => - declare - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Path_Instance := El; - else - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - end if; - end; + when Iir_Kind_For_Generate_Statement => + Path_Instance := El; + when Iir_Kind_If_Generate_Statement => + Path_Add_Element (Get_Parent (El), Is_Instance); + Path_Add_Name (El); + Path_Add (":"); + when Iir_Kind_Generate_Statement_Body => + Path_Add_Element (Get_Parent (El), Is_Instance); when Iir_Kinds_Sequential_Statement => Path_Add_Element (Get_Parent (El), Is_Instance); when others => diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index 6864213b6..933dac697 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -374,6 +374,10 @@ package body Iirs is | Iir_Kind_Concurrent_Assertion_Statement | Iir_Kind_Psl_Default_Clock | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_Signal_Assignment_Statement | Iir_Kind_Null_Statement | Iir_Kind_Assertion_Statement @@ -469,7 +473,6 @@ package body Iirs is | Iir_Kind_Psl_Assert_Statement | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement | Iir_Kind_Wait_Statement => @@ -899,6 +902,34 @@ package body Iirs is Set_Field4 (Target, Iir_List_To_Iir (List)); end Set_Simple_Aggregate_List; + function Get_String8_Id (Lit : Iir) return String8_Id is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String8_Id (Get_Kind (Lit))); + return Iir_To_String8_Id (Get_Field5 (Lit)); + end Get_String8_Id; + + procedure Set_String8_Id (Lit : Iir; Id : String8_Id) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String8_Id (Get_Kind (Lit))); + Set_Field5 (Lit, String8_Id_To_Iir (Id)); + end Set_String8_Id; + + function Get_String_Length (Lit : Iir) return Int32 is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Length (Get_Kind (Lit))); + return Iir_To_Int32 (Get_Field4 (Lit)); + end Get_String_Length; + + procedure Set_String_Length (Lit : Iir; Len : Int32) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Length (Get_Kind (Lit))); + Set_Field4 (Lit, Int32_To_Iir (Len)); + end Set_String_Length; + function Get_Bit_String_Base (Lit : Iir) return Base_Type is begin pragma Assert (Lit /= Null_Iir); @@ -3266,29 +3297,57 @@ package body Iirs is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); - return Get_Field7 (Target); + return Get_Field2 (Target); end Get_Generate_Block_Configuration; procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is begin pragma Assert (Target /= Null_Iir); pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); - Set_Field7 (Target, Conf); + Set_Field2 (Target, Conf); end Set_Generate_Block_Configuration; - function Get_Generation_Scheme (Target : Iir) return Iir is + function Get_Generate_Statement_Body (Target : Iir) return Iir is begin pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); - return Get_Field6 (Target); - end Get_Generation_Scheme; + pragma Assert (Has_Generate_Statement_Body (Get_Kind (Target))); + return Get_Field4 (Target); + end Get_Generate_Statement_Body; + + procedure Set_Generate_Statement_Body (Target : Iir; Bod : Iir) is + begin + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generate_Statement_Body (Get_Kind (Target))); + Set_Field4 (Target, Bod); + end Set_Generate_Statement_Body; + + function Get_Alternative_Label (Target : Iir) return Name_Id is + begin + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Alternative_Label (Get_Kind (Target))); + return Iir_To_Name_Id (Get_Field3 (Target)); + end Get_Alternative_Label; + + procedure Set_Alternative_Label (Target : Iir; Label : Name_Id) is + begin + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Alternative_Label (Get_Kind (Target))); + Set_Field3 (Target, Name_Id_To_Iir (Label)); + end Set_Alternative_Label; + + function Get_Generate_Else_Clause (Target : Iir) return Iir is + begin + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generate_Else_Clause (Get_Kind (Target))); + return Get_Field5 (Target); + end Get_Generate_Else_Clause; - procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is + procedure Set_Generate_Else_Clause (Target : Iir; Clause : Iir) is begin pragma Assert (Target /= Null_Iir); - pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); - Set_Field6 (Target, Scheme); - end Set_Generation_Scheme; + pragma Assert (Has_Generate_Else_Clause (Get_Kind (Target))); + Set_Field5 (Target, Clause); + end Set_Generate_Else_Clause; function Get_Condition (Target : Iir) return Iir is begin @@ -4253,34 +4312,6 @@ package body Iirs is Set_Field6 (Target, Location_Type_To_Iir (Loc)); end Set_End_Location; - function Get_String8_Id (Lit : Iir) return String8_Id is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String8_Id (Get_Kind (Lit))); - return Iir_To_String8_Id (Get_Field5 (Lit)); - end Get_String8_Id; - - procedure Set_String8_Id (Lit : Iir; Id : String8_Id) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String8_Id (Get_Kind (Lit))); - Set_Field5 (Lit, String8_Id_To_Iir (Id)); - end Set_String8_Id; - - function Get_String_Length (Lit : Iir) return Int32 is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Length (Get_Kind (Lit))); - return Iir_To_Int32 (Get_Field4 (Lit)); - end Get_String_Length; - - procedure Set_String_Length (Lit : Iir; Len : Int32) is - begin - pragma Assert (Lit /= Null_Iir); - pragma Assert (Has_String_Length (Get_Kind (Lit))); - Set_Field4 (Lit, Int32_To_Iir (Len)); - end Set_String_Length; - function Get_Use_Flag (Decl : Iir) return Boolean is begin pragma Assert (Decl /= Null_Iir); @@ -4351,6 +4382,20 @@ package body Iirs is Set_Flag10 (Decl, Flag); end Set_Has_Begin; + function Get_Has_End (Decl : Iir) return Boolean is + begin + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_End (Get_Kind (Decl))); + return Get_Flag11 (Decl); + end Get_Has_End; + + procedure Set_Has_End (Decl : Iir; Flag : Boolean) is + begin + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_End (Get_Kind (Decl))); + Set_Flag11 (Decl, Flag); + end Set_Has_End; + function Get_Has_Is (Decl : Iir) return Boolean is begin pragma Assert (Decl /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 0387f2783..9aff3cca4 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -501,19 +501,22 @@ package Iirs is -- -- Get/Set_Parent (Field0) -- + -- Only use_clause are allowed here. -- Get/Set_Declaration_Chain (Field1) -- -- Get/Set_Chain (Field2) -- -- Get/Set_Configuration_Item_Chain (Field3) -- - -- Note: for default block configurations of iterative generate statement, - -- the block specification is an indexed_name, whose index_list is others. - -- Get/Set_Block_Specification (Field5) - -- -- Single linked list of block configuration that apply to the same -- for scheme generate block. -- Get/Set_Prev_Block_Configuration (Field4) + -- + -- Note: for default block configurations of iterative generate statement, + -- the block specification is an indexed_name, whose index_list is others. + -- The name designates either a block statement or a generate statement + -- body. + -- Get/Set_Block_Specification (Field5) -- Iir_Kind_Binding_Indication (Medium) -- @@ -2511,36 +2514,89 @@ package Iirs is -- -- Get/Set_End_Has_Identifier (Flag9) - -- Iir_Kind_Generate_Statement (Medium) + -- Iir_Kind_Generate_Statement_Body (Short) + -- LRM08 11.8 Generate statements + -- + -- generate_statement_body ::= + -- [ block_declarative_part + -- BEGIN ] + -- { concurrent_statement } + -- [ END [ alternative_label ] ; ] -- -- Get/Set_Parent (Field0) -- -- Get/Set_Declaration_Chain (Field1) -- - -- Get/Set_Chain (Field2) + -- The block configuration for this statement body. + -- Get/Set_Generate_Block_Configuration (Field2) -- - -- Get/Set_Label (Field3) + -- Get/Set_Alternative_Label (Field3) -- Get/Set_Identifier (Alias Field3) -- -- Get/Set_Attribute_Value_Chain (Field4) -- -- Get/Set_Concurrent_Statement_Chain (Field5) -- - -- The generation scheme. - -- A (boolean) expression for a conditionnal elaboration (if). - -- A (iterator) declaration for an iterative elaboration (for). - -- Get/Set_Generation_Scheme (Field6) + -- Get/Set_End_Has_Identifier (Flag9) -- - -- The block configuration for this statement. - -- Get/Set_Generate_Block_Configuration (Field7) + -- Get/Set_Has_Begin (Flag10) + -- + -- Get/Set_Has_End (Flag11) + + -- Iir_Kind_For_Generate_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- The parameters specification is represented by an Iterator_Declaration. + -- Get/Set_Parameter_Specification (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Generate_Statement_Body (Field4) -- -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_End_Has_Reserved_Id (Flag8) -- -- Get/Set_End_Has_Identifier (Flag9) + + -- Iir_Kind_If_Generate_Else_Clause (Short) -- - -- Get/Set_Has_Begin (Flag10) + -- Get/Set_Parent (Field0) + -- + -- Null_Iir for the else clause. + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Generate_Statement_Body (Field4) + -- + -- Get/Set_Generate_Else_Clause (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_If_Generate_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Null_Iir for the else clause. + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Generate_Statement_Body (Field4) + -- + -- Get/Set_Generate_Else_Clause (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_End_Has_Reserved_Id (Flag8) + -- + -- Get/Set_End_Has_Identifier (Flag9) -- Iir_Kind_Simple_Simultaneous_Statement (Medium) -- @@ -2578,12 +2634,12 @@ package Iirs is -- Only for Iir_Kind_If_Statement: -- Get/Set_Label (Field3) -- - -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses. - -- Get/Set_Else_Clause (Field4) - -- -- Only for Iir_Kind_If_Statement: -- Get/Set_Identifier (Alias Field3) -- + -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses. + -- Get/Set_Else_Clause (Field4) + -- -- Get/Set_Sequential_Statement_Chain (Field5) -- -- Only for Iir_Kind_If_Statement: @@ -3540,11 +3596,15 @@ package Iirs is Iir_Kind_Psl_Cover_Statement, Iir_Kind_Concurrent_Procedure_Call_Statement, Iir_Kind_Block_Statement, - Iir_Kind_Generate_Statement, + Iir_Kind_If_Generate_Statement, + Iir_Kind_For_Generate_Statement, Iir_Kind_Component_Instantiation_Statement, Iir_Kind_Simple_Simultaneous_Statement, + Iir_Kind_Generate_Statement_Body, + Iir_Kind_If_Generate_Else_Clause, + -- Iir_Kind_Sequential_Statement Iir_Kind_Signal_Assignment_Statement, Iir_Kind_Null_Statement, @@ -4406,7 +4466,8 @@ package Iirs is --Iir_Kind_Psl_Cover_Statement --Iir_Kind_Concurrent_Procedure_Call_Statement --Iir_Kind_Block_Statement - --Iir_Kind_Generate_Statement + --Iir_Kind_If_Generate_Statement + --Iir_Kind_For_Generate_Statement Iir_Kind_Component_Instantiation_Statement; subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range @@ -5915,13 +5976,21 @@ package Iirs is -- Get/Set the block_configuration (there may be several -- block_configuration through the use of prev_configuration singly linked -- list) that apply to this generate statement. - -- Field: Field7 + -- Field: Field2 function Get_Generate_Block_Configuration (Target : Iir) return Iir; procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir); - -- Field: Field6 - function Get_Generation_Scheme (Target : Iir) return Iir; - procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir); + -- Field: Field4 + function Get_Generate_Statement_Body (Target : Iir) return Iir; + procedure Set_Generate_Statement_Body (Target : Iir; Bod : Iir); + + -- Field: Field3 (uc) + function Get_Alternative_Label (Target : Iir) return Name_Id; + procedure Set_Alternative_Label (Target : Iir; Label : Name_Id); + + -- Field: Field5 + function Get_Generate_Else_Clause (Target : Iir) return Iir; + procedure Set_Generate_Else_Clause (Target : Iir; Clause : Iir); -- Condition of a conditionam_waveform, if_statement, elsif, -- while_loop_statement, next_statement or exit_statement. @@ -6294,6 +6363,11 @@ package Iirs is function Get_Has_Begin (Decl : Iir) return Boolean; procedure Set_Has_Begin (Decl : Iir; Flag : Boolean); + -- Layout flag: true if 'end' is present (only for generate body). + -- Field: Flag11 + function Get_Has_End (Decl : Iir) return Boolean; + procedure Set_Has_End (Decl : Iir; Flag : Boolean); + -- Layout flag: true if 'is' is present. -- Field: Flag7 function Get_Has_Is (Decl : Iir) return Boolean; diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 99737c428..db100e438 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -349,7 +349,7 @@ package body Iirs_Utils is else Set_Component_Configuration (El, Null_Iir); end if; - when Iir_Kind_Generate_Statement => + when Iir_Kind_For_Generate_Statement => Set_Generate_Block_Configuration (El, Null_Iir); -- Clear inside a generate statement. Clear_Instantiation_Configuration_Vhdl87 (El, True, Full); @@ -368,15 +368,31 @@ package body Iirs_Utils is begin if False and then Flags.Vhdl_Std = Vhdl_87 then Clear_Instantiation_Configuration_Vhdl87 - (Parent, Get_Kind (Parent) = Iir_Kind_Generate_Statement, Full); + (Parent, Get_Kind (Parent) = Iir_Kind_For_Generate_Statement, Full); else El := Get_Concurrent_Statement_Chain (Parent); while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Component_Instantiation_Statement => Set_Component_Configuration (El, Null_Iir); - when Iir_Kind_Generate_Statement => - Set_Generate_Block_Configuration (El, Null_Iir); + when Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (El); + begin + Set_Generate_Block_Configuration (Bod, Null_Iir); + end; + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + Bod : Iir; + begin + Clause := El; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Set_Generate_Block_Configuration (Bod, Null_Iir); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end; when Iir_Kind_Block_Statement => Set_Block_Block_Configuration (El, Null_Iir); when others => @@ -809,7 +825,8 @@ package body Iirs_Utils is return Res; when Iir_Kind_Block_Statement | Iir_Kind_Architecture_Body - | Iir_Kind_Generate_Statement => + | Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement => return Block_Spec; when Iir_Kind_Indexed_Name | Iir_Kind_Selected_Name diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 62a893563..8de6dde87 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -48,6 +48,8 @@ package body Nodes_Meta is Field_Physical_Unit_Value => Type_Iir, Field_Fp_Value => Type_Iir_Fp64, Field_Simple_Aggregate_List => Type_Iir_List, + Field_String8_Id => Type_String8_Id, + Field_String_Length => Type_Int32, Field_Bit_String_Base => Type_Base_Type, Field_Has_Signed => Type_Boolean, Field_Has_Sign => Type_Boolean, @@ -217,7 +219,9 @@ package body Nodes_Meta is Field_Block_Header => Type_Iir, Field_Uninstantiated_Package_Name => Type_Iir, Field_Generate_Block_Configuration => Type_Iir, - Field_Generation_Scheme => Type_Iir, + Field_Generate_Statement_Body => Type_Iir, + Field_Alternative_Label => Type_Name_Id, + Field_Generate_Else_Clause => Type_Iir, Field_Condition => Type_Iir, Field_Else_Clause => Type_Iir, Field_Parameter_Specification => Type_Iir, @@ -286,13 +290,12 @@ package body Nodes_Meta is Field_Protected_Type_Body => Type_Iir, Field_Protected_Type_Declaration => Type_Iir, Field_End_Location => Type_Location_Type, - Field_String8_Id => Type_String8_Id, - Field_String_Length => Type_Int32, Field_Use_Flag => Type_Boolean, Field_End_Has_Reserved_Id => Type_Boolean, Field_End_Has_Identifier => Type_Boolean, Field_End_Has_Postponed => Type_Boolean, Field_Has_Begin => Type_Boolean, + Field_Has_End => Type_Boolean, Field_Has_Is => Type_Boolean, Field_Has_Pure => Type_Boolean, Field_Has_Body => Type_Boolean, @@ -374,6 +377,10 @@ package body Nodes_Meta is return "fp_value"; when Field_Simple_Aggregate_List => return "simple_aggregate_list"; + when Field_String8_Id => + return "string8_id"; + when Field_String_Length => + return "string_length"; when Field_Bit_String_Base => return "bit_string_base"; when Field_Has_Signed => @@ -712,8 +719,12 @@ package body Nodes_Meta is return "uninstantiated_package_name"; when Field_Generate_Block_Configuration => return "generate_block_configuration"; - when Field_Generation_Scheme => - return "generation_scheme"; + when Field_Generate_Statement_Body => + return "generate_statement_body"; + when Field_Alternative_Label => + return "alternative_label"; + when Field_Generate_Else_Clause => + return "generate_else_clause"; when Field_Condition => return "condition"; when Field_Else_Clause => @@ -850,10 +861,6 @@ package body Nodes_Meta is return "protected_type_declaration"; when Field_End_Location => return "end_location"; - when Field_String8_Id => - return "string8_id"; - when Field_String_Length => - return "string_length"; when Field_Use_Flag => return "use_flag"; when Field_End_Has_Reserved_Id => @@ -864,6 +871,8 @@ package body Nodes_Meta is return "end_has_postponed"; when Field_Has_Begin => return "has_begin"; + when Field_Has_End => + return "has_end"; when Field_Has_Is => return "has_is"; when Field_Has_Pure => @@ -1244,12 +1253,18 @@ package body Nodes_Meta is return "concurrent_procedure_call_statement"; when Iir_Kind_Block_Statement => return "block_statement"; - when Iir_Kind_Generate_Statement => - return "generate_statement"; + when Iir_Kind_If_Generate_Statement => + return "if_generate_statement"; + when Iir_Kind_For_Generate_Statement => + return "for_generate_statement"; when Iir_Kind_Component_Instantiation_Statement => return "component_instantiation_statement"; when Iir_Kind_Simple_Simultaneous_Statement => return "simple_simultaneous_statement"; + when Iir_Kind_Generate_Statement_Body => + return "generate_statement_body"; + when Iir_Kind_If_Generate_Else_Clause => + return "if_generate_else_clause"; when Iir_Kind_Signal_Assignment_Statement => return "signal_assignment_statement"; when Iir_Kind_Null_Statement => @@ -1434,6 +1449,10 @@ package body Nodes_Meta is return Attr_None; when Field_Simple_Aggregate_List => return Attr_None; + when Field_String8_Id => + return Attr_None; + when Field_String_Length => + return Attr_None; when Field_Bit_String_Base => return Attr_None; when Field_Has_Signed => @@ -1772,7 +1791,11 @@ package body Nodes_Meta is return Attr_None; when Field_Generate_Block_Configuration => return Attr_None; - when Field_Generation_Scheme => + when Field_Generate_Statement_Body => + return Attr_None; + when Field_Alternative_Label => + return Attr_None; + when Field_Generate_Else_Clause => return Attr_None; when Field_Condition => return Attr_None; @@ -1910,10 +1933,6 @@ package body Nodes_Meta is return Attr_None; when Field_End_Location => return Attr_None; - when Field_String8_Id => - return Attr_None; - when Field_String_Length => - return Attr_None; when Field_Use_Flag => return Attr_None; when Field_End_Has_Reserved_Id => @@ -1924,6 +1943,8 @@ package body Nodes_Meta is return Attr_None; when Field_Has_Begin => return Attr_None; + when Field_Has_End => + return Attr_None; when Field_Has_Is => return Attr_None; when Field_Has_Pure => @@ -3353,18 +3374,24 @@ package body Nodes_Meta is Field_Block_Header, Field_Guard_Decl, Field_Parent, - -- Iir_Kind_Generate_Statement + -- Iir_Kind_If_Generate_Statement Field_Label, - Field_Has_Begin, Field_Visible_Flag, Field_End_Has_Reserved_Id, Field_End_Has_Identifier, - Field_Declaration_Chain, + Field_Condition, Field_Chain, - Field_Attribute_Value_Chain, - Field_Concurrent_Statement_Chain, - Field_Generation_Scheme, - Field_Generate_Block_Configuration, + Field_Generate_Statement_Body, + Field_Generate_Else_Clause, + Field_Parent, + -- Iir_Kind_For_Generate_Statement + Field_Label, + Field_Visible_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Parameter_Specification, + Field_Chain, + Field_Generate_Statement_Body, Field_Parent, -- Iir_Kind_Component_Instantiation_Statement Field_Label, @@ -3385,6 +3412,22 @@ package body Nodes_Meta is Field_Simultaneous_Right, Field_Tolerance, Field_Parent, + -- Iir_Kind_Generate_Statement_Body + Field_Alternative_Label, + Field_Has_Begin, + Field_Has_End, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Generate_Block_Configuration, + Field_Attribute_Value_Chain, + Field_Concurrent_Statement_Chain, + Field_Parent, + -- Iir_Kind_If_Generate_Else_Clause + Field_Visible_Flag, + Field_Condition, + Field_Generate_Statement_Body, + Field_Generate_Else_Clause, + Field_Parent, -- Iir_Kind_Signal_Assignment_Statement Field_Label, Field_Delay_Mechanism, @@ -3972,69 +4015,72 @@ package body Nodes_Meta is Iir_Kind_Psl_Cover_Statement => 1204, Iir_Kind_Concurrent_Procedure_Call_Statement => 1210, Iir_Kind_Block_Statement => 1223, - Iir_Kind_Generate_Statement => 1235, - Iir_Kind_Component_Instantiation_Statement => 1245, - Iir_Kind_Simple_Simultaneous_Statement => 1252, - Iir_Kind_Signal_Assignment_Statement => 1261, - Iir_Kind_Null_Statement => 1265, - Iir_Kind_Assertion_Statement => 1272, - Iir_Kind_Report_Statement => 1278, - Iir_Kind_Wait_Statement => 1285, - Iir_Kind_Variable_Assignment_Statement => 1291, - Iir_Kind_Return_Statement => 1297, - Iir_Kind_For_Loop_Statement => 1305, - Iir_Kind_While_Loop_Statement => 1312, - Iir_Kind_Next_Statement => 1318, - Iir_Kind_Exit_Statement => 1324, - Iir_Kind_Case_Statement => 1331, - Iir_Kind_Procedure_Call_Statement => 1336, - Iir_Kind_If_Statement => 1344, - Iir_Kind_Elsif => 1349, - Iir_Kind_Character_Literal => 1356, - Iir_Kind_Simple_Name => 1363, - Iir_Kind_Selected_Name => 1371, - Iir_Kind_Operator_Symbol => 1376, - Iir_Kind_Selected_By_All_Name => 1381, - Iir_Kind_Parenthesis_Name => 1385, - Iir_Kind_Base_Attribute => 1387, - Iir_Kind_Left_Type_Attribute => 1392, - Iir_Kind_Right_Type_Attribute => 1397, - Iir_Kind_High_Type_Attribute => 1402, - Iir_Kind_Low_Type_Attribute => 1407, - Iir_Kind_Ascending_Type_Attribute => 1412, - Iir_Kind_Image_Attribute => 1418, - Iir_Kind_Value_Attribute => 1424, - Iir_Kind_Pos_Attribute => 1430, - Iir_Kind_Val_Attribute => 1436, - Iir_Kind_Succ_Attribute => 1442, - Iir_Kind_Pred_Attribute => 1448, - Iir_Kind_Leftof_Attribute => 1454, - Iir_Kind_Rightof_Attribute => 1460, - Iir_Kind_Delayed_Attribute => 1468, - Iir_Kind_Stable_Attribute => 1476, - Iir_Kind_Quiet_Attribute => 1484, - Iir_Kind_Transaction_Attribute => 1492, - Iir_Kind_Event_Attribute => 1496, - Iir_Kind_Active_Attribute => 1500, - Iir_Kind_Last_Event_Attribute => 1504, - Iir_Kind_Last_Active_Attribute => 1508, - Iir_Kind_Last_Value_Attribute => 1512, - Iir_Kind_Driving_Attribute => 1516, - Iir_Kind_Driving_Value_Attribute => 1520, - Iir_Kind_Behavior_Attribute => 1520, - Iir_Kind_Structure_Attribute => 1520, - Iir_Kind_Simple_Name_Attribute => 1527, - Iir_Kind_Instance_Name_Attribute => 1532, - Iir_Kind_Path_Name_Attribute => 1537, - Iir_Kind_Left_Array_Attribute => 1544, - Iir_Kind_Right_Array_Attribute => 1551, - Iir_Kind_High_Array_Attribute => 1558, - Iir_Kind_Low_Array_Attribute => 1565, - Iir_Kind_Length_Array_Attribute => 1572, - Iir_Kind_Ascending_Array_Attribute => 1579, - Iir_Kind_Range_Array_Attribute => 1586, - Iir_Kind_Reverse_Range_Array_Attribute => 1593, - Iir_Kind_Attribute_Name => 1601 + Iir_Kind_If_Generate_Statement => 1232, + Iir_Kind_For_Generate_Statement => 1240, + Iir_Kind_Component_Instantiation_Statement => 1250, + Iir_Kind_Simple_Simultaneous_Statement => 1257, + Iir_Kind_Generate_Statement_Body => 1266, + Iir_Kind_If_Generate_Else_Clause => 1271, + Iir_Kind_Signal_Assignment_Statement => 1280, + Iir_Kind_Null_Statement => 1284, + Iir_Kind_Assertion_Statement => 1291, + Iir_Kind_Report_Statement => 1297, + Iir_Kind_Wait_Statement => 1304, + Iir_Kind_Variable_Assignment_Statement => 1310, + Iir_Kind_Return_Statement => 1316, + Iir_Kind_For_Loop_Statement => 1324, + Iir_Kind_While_Loop_Statement => 1331, + Iir_Kind_Next_Statement => 1337, + Iir_Kind_Exit_Statement => 1343, + Iir_Kind_Case_Statement => 1350, + Iir_Kind_Procedure_Call_Statement => 1355, + Iir_Kind_If_Statement => 1363, + Iir_Kind_Elsif => 1368, + Iir_Kind_Character_Literal => 1375, + Iir_Kind_Simple_Name => 1382, + Iir_Kind_Selected_Name => 1390, + Iir_Kind_Operator_Symbol => 1395, + Iir_Kind_Selected_By_All_Name => 1400, + Iir_Kind_Parenthesis_Name => 1404, + Iir_Kind_Base_Attribute => 1406, + Iir_Kind_Left_Type_Attribute => 1411, + Iir_Kind_Right_Type_Attribute => 1416, + Iir_Kind_High_Type_Attribute => 1421, + Iir_Kind_Low_Type_Attribute => 1426, + Iir_Kind_Ascending_Type_Attribute => 1431, + Iir_Kind_Image_Attribute => 1437, + Iir_Kind_Value_Attribute => 1443, + Iir_Kind_Pos_Attribute => 1449, + Iir_Kind_Val_Attribute => 1455, + Iir_Kind_Succ_Attribute => 1461, + Iir_Kind_Pred_Attribute => 1467, + Iir_Kind_Leftof_Attribute => 1473, + Iir_Kind_Rightof_Attribute => 1479, + Iir_Kind_Delayed_Attribute => 1487, + Iir_Kind_Stable_Attribute => 1495, + Iir_Kind_Quiet_Attribute => 1503, + Iir_Kind_Transaction_Attribute => 1511, + Iir_Kind_Event_Attribute => 1515, + Iir_Kind_Active_Attribute => 1519, + Iir_Kind_Last_Event_Attribute => 1523, + Iir_Kind_Last_Active_Attribute => 1527, + Iir_Kind_Last_Value_Attribute => 1531, + Iir_Kind_Driving_Attribute => 1535, + Iir_Kind_Driving_Value_Attribute => 1539, + Iir_Kind_Behavior_Attribute => 1539, + Iir_Kind_Structure_Attribute => 1539, + Iir_Kind_Simple_Name_Attribute => 1546, + Iir_Kind_Instance_Name_Attribute => 1551, + Iir_Kind_Path_Name_Attribute => 1556, + Iir_Kind_Left_Array_Attribute => 1563, + Iir_Kind_Right_Array_Attribute => 1570, + Iir_Kind_High_Array_Attribute => 1577, + Iir_Kind_Low_Array_Attribute => 1584, + Iir_Kind_Length_Array_Attribute => 1591, + Iir_Kind_Ascending_Array_Attribute => 1598, + Iir_Kind_Range_Array_Attribute => 1605, + Iir_Kind_Reverse_Range_Array_Attribute => 1612, + Iir_Kind_Attribute_Name => 1620 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4158,6 +4204,8 @@ package body Nodes_Meta is return Get_End_Has_Postponed (N); when Field_Has_Begin => return Get_Has_Begin (N); + when Field_Has_End => + return Get_Has_End (N); when Field_Has_Is => return Get_Has_Is (N); when Field_Has_Pure => @@ -4260,6 +4308,8 @@ package body Nodes_Meta is Set_End_Has_Postponed (N, V); when Field_Has_Begin => Set_Has_Begin (N, V); + when Field_Has_End => + Set_Has_End (N, V); when Field_Has_Is => Set_Has_Is (N, V); when Field_Has_Pure => @@ -4576,8 +4626,10 @@ package body Nodes_Meta is return Get_Uninstantiated_Package_Name (N); when Field_Generate_Block_Configuration => return Get_Generate_Block_Configuration (N); - when Field_Generation_Scheme => - return Get_Generation_Scheme (N); + when Field_Generate_Statement_Body => + return Get_Generate_Statement_Body (N); + when Field_Generate_Else_Clause => + return Get_Generate_Else_Clause (N); when Field_Condition => return Get_Condition (N); when Field_Else_Clause => @@ -4932,8 +4984,10 @@ package body Nodes_Meta is Set_Uninstantiated_Package_Name (N, V); when Field_Generate_Block_Configuration => Set_Generate_Block_Configuration (N, V); - when Field_Generation_Scheme => - Set_Generation_Scheme (N, V); + when Field_Generate_Statement_Body => + Set_Generate_Statement_Body (N, V); + when Field_Generate_Else_Clause => + Set_Generate_Else_Clause (N, V); when Field_Condition => Set_Condition (N, V); when Field_Else_Clause => @@ -5558,6 +5612,8 @@ package body Nodes_Meta is return Get_Identifier (N); when Field_Label => return Get_Label (N); + when Field_Alternative_Label => + return Get_Alternative_Label (N); when Field_Simple_Name_Identifier => return Get_Simple_Name_Identifier (N); when others => @@ -5580,6 +5636,8 @@ package body Nodes_Meta is Set_Identifier (N, V); when Field_Label => Set_Label (N, V); + when Field_Alternative_Label => + Set_Alternative_Label (N, V); when Field_Simple_Name_Identifier => Set_Simple_Name_Identifier (N, V); when others => @@ -5949,6 +6007,16 @@ package body Nodes_Meta is return K = Iir_Kind_Simple_Aggregate; end Has_Simple_Aggregate_List; + function Has_String8_Id (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_String_Literal8; + end Has_String8_Id; + + function Has_String_Length (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_String_Literal8; + end Has_String_Length; + function Has_Bit_String_Base (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_String_Literal8; @@ -6232,7 +6300,7 @@ package body Nodes_Meta is | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => return True; when others => return False; @@ -6299,7 +6367,7 @@ package body Nodes_Meta is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => return True; when others => return False; @@ -6375,7 +6443,8 @@ package body Nodes_Meta is | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement | Iir_Kind_Signal_Assignment_Statement @@ -6922,7 +6991,7 @@ package body Nodes_Meta is | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => return True; when others => return False; @@ -7079,9 +7148,11 @@ package body Nodes_Meta is | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Generate_Statement_Body | Iir_Kind_Signal_Assignment_Statement | Iir_Kind_Null_Statement | Iir_Kind_Assertion_Statement @@ -7120,7 +7191,8 @@ package body Nodes_Meta is | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement | Iir_Kind_Signal_Assignment_Statement @@ -7193,9 +7265,11 @@ package body Nodes_Meta is | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_Signal_Assignment_Statement | Iir_Kind_Null_Statement | Iir_Kind_Assertion_Statement @@ -7973,18 +8047,43 @@ package body Nodes_Meta is function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Generate_Statement; + return K = Iir_Kind_Generate_Statement_Body; end Has_Generate_Block_Configuration; - function Has_Generation_Scheme (K : Iir_Kind) return Boolean is + function Has_Generate_Statement_Body (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Generate_Statement; - end Has_Generation_Scheme; + case K is + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause => + return True; + when others => + return False; + end case; + end Has_Generate_Statement_Body; + + function Has_Alternative_Label (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Generate_Statement_Body; + end Has_Alternative_Label; + + function Has_Generate_Else_Clause (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_If_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause => + return True; + when others => + return False; + end case; + end Has_Generate_Else_Clause; function Has_Condition (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Conditional_Waveform + | Iir_Kind_If_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_While_Loop_Statement | Iir_Kind_Next_Statement | Iir_Kind_Exit_Statement @@ -8009,7 +8108,13 @@ package body Nodes_Meta is function Has_Parameter_Specification (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_For_Loop_Statement; + case K is + when Iir_Kind_For_Generate_Statement + | Iir_Kind_For_Loop_Statement => + return True; + when others => + return False; + end case; end Has_Parameter_Specification; function Has_Parent (K : Iir_Kind) return Boolean is @@ -8080,9 +8185,12 @@ package body Nodes_Meta is | Iir_Kind_Psl_Cover_Statement | Iir_Kind_Concurrent_Procedure_Call_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_Signal_Assignment_Statement | Iir_Kind_Null_Statement | Iir_Kind_Assertion_Statement @@ -8978,16 +9086,6 @@ package body Nodes_Meta is return K = Iir_Kind_Design_Unit; end Has_End_Location; - function Has_String8_Id (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_String_Literal8; - end Has_String8_Id; - - function Has_String_Length (K : Iir_Kind) return Boolean is - begin - return K = Iir_Kind_String_Literal8; - end Has_String_Length; - function Has_Use_Flag (K : Iir_Kind) return Boolean is begin case K is @@ -9043,7 +9141,8 @@ package body Nodes_Meta is | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => return True; when others => return False; @@ -9069,7 +9168,9 @@ package body Nodes_Meta is | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body | Iir_Kind_For_Loop_Statement | Iir_Kind_While_Loop_Statement | Iir_Kind_Case_Statement @@ -9096,13 +9197,18 @@ package body Nodes_Meta is begin case K is when Iir_Kind_Entity_Declaration - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => return True; when others => return False; end case; end Has_Has_Begin; + function Has_Has_End (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Generate_Statement_Body; + end Has_Has_End; + function Has_Has_Is (K : Iir_Kind) return Boolean is begin case K is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index a04a31114..a0b0180a4 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -87,6 +87,8 @@ package Nodes_Meta is Field_Physical_Unit_Value, Field_Fp_Value, Field_Simple_Aggregate_List, + Field_String8_Id, + Field_String_Length, Field_Bit_String_Base, Field_Has_Signed, Field_Has_Sign, @@ -256,7 +258,9 @@ package Nodes_Meta is Field_Block_Header, Field_Uninstantiated_Package_Name, Field_Generate_Block_Configuration, - Field_Generation_Scheme, + Field_Generate_Statement_Body, + Field_Alternative_Label, + Field_Generate_Else_Clause, Field_Condition, Field_Else_Clause, Field_Parameter_Specification, @@ -325,13 +329,12 @@ package Nodes_Meta is Field_Protected_Type_Body, Field_Protected_Type_Declaration, Field_End_Location, - Field_String8_Id, - Field_String_Length, Field_Use_Flag, Field_End_Has_Reserved_Id, Field_End_Has_Identifier, Field_End_Has_Postponed, Field_Has_Begin, + Field_Has_End, Field_Has_Is, Field_Has_Pure, Field_Has_Body, @@ -550,6 +553,8 @@ package Nodes_Meta is function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean; function Has_Fp_Value (K : Iir_Kind) return Boolean; function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean; + function Has_String8_Id (K : Iir_Kind) return Boolean; + function Has_String_Length (K : Iir_Kind) return Boolean; function Has_Bit_String_Base (K : Iir_Kind) return Boolean; function Has_Has_Signed (K : Iir_Kind) return Boolean; function Has_Has_Sign (K : Iir_Kind) return Boolean; @@ -724,7 +729,9 @@ package Nodes_Meta is function Has_Block_Header (K : Iir_Kind) return Boolean; function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean; function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean; - function Has_Generation_Scheme (K : Iir_Kind) return Boolean; + function Has_Generate_Statement_Body (K : Iir_Kind) return Boolean; + function Has_Alternative_Label (K : Iir_Kind) return Boolean; + function Has_Generate_Else_Clause (K : Iir_Kind) return Boolean; function Has_Condition (K : Iir_Kind) return Boolean; function Has_Else_Clause (K : Iir_Kind) return Boolean; function Has_Parameter_Specification (K : Iir_Kind) return Boolean; @@ -796,13 +803,12 @@ package Nodes_Meta is function Has_Protected_Type_Body (K : Iir_Kind) return Boolean; function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean; function Has_End_Location (K : Iir_Kind) return Boolean; - function Has_String8_Id (K : Iir_Kind) return Boolean; - function Has_String_Length (K : Iir_Kind) return Boolean; function Has_Use_Flag (K : Iir_Kind) return Boolean; function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean; function Has_End_Has_Identifier (K : Iir_Kind) return Boolean; function Has_End_Has_Postponed (K : Iir_Kind) return Boolean; function Has_Has_Begin (K : Iir_Kind) return Boolean; + function Has_Has_End (K : Iir_Kind) return Boolean; function Has_Has_Is (K : Iir_Kind) return Boolean; function Has_Has_Pure (K : Iir_Kind) return Boolean; function Has_Has_Body (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 7d8e3a724..0ebe63226 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -153,6 +153,8 @@ package body Parse is Xrefs.Xref_End (Get_Token_Location, Decl); end if; end if; + + -- Skip identifier (the label). Scan; end Check_End_Name; @@ -899,6 +901,7 @@ package body Parse is raise Parse_Error; end case; + -- Skip identifier or string. Scan; return Parse_Name_Suffix (Res, Allow_Indexes); @@ -6079,47 +6082,30 @@ package body Parse is return Res; end Parse_Block_Statement; - -- precond : IF or FOR - -- postcond: ';' - -- - -- [ LRM93 9.7 ] - -- generate_statement ::= - -- GENERATE_label : generation_scheme GENERATE - -- [ { block_declarative_item } - -- BEGIN ] - -- { concurrent_statement } - -- END GENERATE [ GENERATE_label ] ; - -- - -- [ LRM93 9.7 ] - -- generation_scheme ::= - -- FOR GENERATE_parameter_specification - -- | IF condition - -- - -- FIXME: block_declarative item. - function Parse_Generate_Statement (Label : Name_Id; Loc : Location_Type) - return Iir_Generate_Statement + -- Precond : next token + -- Postcond: next token after 'end' + -- + -- [ LRM08 11.8 ] Generate statements + -- generate_statement_body ::= + -- [ block_declarative_part + -- BEGIN ] + -- { concurrent_statement } + -- [ END [ alternative_label ] ; ] + -- + -- This corresponds to the following part of LRM93 9.7: + -- [ { block_declarative_item } + -- BEGIN ] + -- { concurrent_statement } + -- Note there is no END. This part is followed by: + -- END GENERATE [ /generate/_label ] ; + function Parse_Generate_Statement_Body (Parent : Iir) return Iir is - Res : Iir_Generate_Statement; + Bod : Iir; begin - if Label = Null_Identifier then - Error_Msg_Parse ("a generate statement must have a label"); - end if; - Res := Create_Iir (Iir_Kind_Generate_Statement); - Set_Location (Res, Loc); - Set_Label (Res, Label); - case Current_Token is - when Tok_For => - Scan; - Set_Generation_Scheme (Res, Parse_Parameter_Specification (Res)); - when Tok_If => - Scan; - Set_Generation_Scheme (Res, Parse_Expression); - when others => - raise Internal_Error; - end case; - Expect (Tok_Generate); + Bod := Create_Iir (Iir_Kind_Generate_Statement_Body); + Set_Location (Bod); + Set_Parent (Bod, Parent); - Scan; -- Check for a block declarative item. case Current_Token is when @@ -6163,20 +6149,86 @@ package body Parse is Error_Msg_Parse ("declarations not allowed in a generate in vhdl87"); end if; - Parse_Declarative_Part (Res); + Parse_Declarative_Part (Bod); Expect (Tok_Begin); - Set_Has_Begin (Res, True); + Set_Has_Begin (Bod, True); + + -- Skip 'begin' Scan; when others => null; end case; - Parse_Concurrent_Statements (Res); + Parse_Concurrent_Statements (Bod); Expect (Tok_End); -- Skip 'end' - Scan_Expect (Tok_Generate); + Scan; + + if Vhdl_Std >= Vhdl_08 and then Current_Token /= Tok_Generate then + -- This is the 'end' of the generate_statement_body. + Check_End_Name (Null_Identifier, Bod); + Scan_Semi_Colon ("generate statement body"); + + Expect (Tok_End); + + -- Skip 'end' + Scan; + end if; + + return Bod; + end Parse_Generate_Statement_Body; + + -- precond : FOR + -- postcond: ';' + -- + -- [ LRM93 9.7 ] + -- generate_statement ::= + -- GENERATE_label : generation_scheme GENERATE + -- [ { block_declarative_item } + -- BEGIN ] + -- { concurrent_statement } + -- END GENERATE [ GENERATE_label ] ; + -- + -- [ LRM93 9.7 ] + -- generation_scheme ::= + -- FOR GENERATE_parameter_specification + -- | IF condition + -- + -- [ LRM08 11.8 ] + -- for_generate_statement ::= + -- /generate/_label : + -- FOR /generate/_parameter_specification GENERATE + -- generate_statement_body + -- END GENERATE [ /generate/_label ] ; + -- + -- FIXME: block_declarative item. + function Parse_For_Generate_Statement (Label : Name_Id; Loc : Location_Type) + return Iir + is + Res : Iir; + begin + if Label = Null_Identifier then + Error_Msg_Parse ("a generate statement must have a label"); + end if; + Res := Create_Iir (Iir_Kind_For_Generate_Statement); + Set_Location (Res, Loc); + Set_Label (Res, Label); + + -- Skip 'for' + Scan; + + Set_Parameter_Specification (Res, Parse_Parameter_Specification (Res)); + + -- Skip 'generate' + Expect (Tok_Generate); + Scan; + + Set_Generate_Statement_Body + (Res, Parse_Generate_Statement_Body (Res)); + + Expect (Tok_Generate); Set_End_Has_Reserved_Id (Res, True); -- Skip 'generate' @@ -6188,7 +6240,62 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); return Res; - end Parse_Generate_Statement; + end Parse_For_Generate_Statement; + + -- precond : IF + -- postcond: ';' + -- + -- [ LRM93 9.7 ] + -- generate_statement ::= + -- GENERATE_label : generation_scheme GENERATE + -- [ { block_declarative_item } + -- BEGIN ] + -- { concurrent_statement } + -- END GENERATE [ GENERATE_label ] ; + -- + -- [ LRM93 9.7 ] + -- generation_scheme ::= + -- FOR GENERATE_parameter_specification + -- | IF condition + -- + -- FIXME: block_declarative item. + function Parse_If_Generate_Statement (Label : Name_Id; Loc : Location_Type) + return Iir_Generate_Statement + is + Res : Iir_Generate_Statement; + begin + if Label = Null_Identifier then + Error_Msg_Parse ("a generate statement must have a label"); + end if; + Res := Create_Iir (Iir_Kind_If_Generate_Statement); + Set_Location (Res, Loc); + Set_Label (Res, Label); + + -- Skip 'if'. + Scan; + + Set_Condition (Res, Parse_Expression); + + -- Skip 'generate' + Expect (Tok_Generate); + Scan; + + Set_Generate_Statement_Body + (Res, Parse_Generate_Statement_Body (Res)); + + Expect (Tok_Generate); + Set_End_Has_Reserved_Id (Res, True); + + -- Skip 'generate' + Scan; + + -- LRM93 9.7 + -- If a label appears at the end of a generate statement, it must repeat + -- the generate label. + Check_End_Name (Res); + Expect (Tok_Semi_Colon); + return Res; + end Parse_If_Generate_Statement; -- precond : first token -- postcond: END @@ -6438,14 +6545,12 @@ package body Parse is when Tok_Block => Postponed_Not_Allowed; Stmt := Parse_Block_Statement (Label, Loc); - when Tok_If - | Tok_For => - if Postponed then - Error_Msg_Parse - ("'postponed' not allowed before a generate statement"); - Postponed := False; - end if; - Stmt := Parse_Generate_Statement (Label, Loc); + when Tok_If => + Postponed_Not_Allowed; + Stmt := Parse_If_Generate_Statement (Label, Loc); + when Tok_For => + Postponed_Not_Allowed; + Stmt := Parse_For_Generate_Statement (Label, Loc); when Tok_Eof => Error_Msg_Parse ("unexpected end of file, 'END;' expected"); return; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index a8cbbd4f3..2ecee9321 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -669,6 +669,107 @@ package body Sem is Close_Declarative_Region; end Sem_Configuration_Declaration; + -- Analyze the block specification of a block statement or of a generate + -- statement. Return the corresponding block statement, generate + -- statement body, or Null_Iir in case of error. + function Sem_Block_Specification_Of_Statement + (Block_Conf : Iir_Block_Configuration; Father : Iir) return Iir + is + Block_Spec : Iir; + Block_Name : Iir; + Block_Stmts : Iir; + Prev : Iir_Block_Configuration; + Block : Iir; + Res : Iir; + begin + Block_Spec := Get_Block_Specification (Block_Conf); + case Get_Kind (Block_Spec) is + when Iir_Kind_Simple_Name => + Block_Name := Block_Spec; + when Iir_Kind_Parenthesis_Name + | Iir_Kind_Slice_Name => + Block_Name := Get_Prefix (Block_Spec); + when others => + Error_Msg_Sem ("label expected", Block_Spec); + return Null_Iir; + end case; + + -- Analyze the label. + Block_Name := Sem_Denoting_Name (Block_Name); + Block := Get_Named_Entity (Block_Name); + case Get_Kind (Block) is + when Iir_Kind_Block_Statement => + if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then + Error_Msg_Sem ("label does not denote a generate statement", + Block_Spec); + end if; + Prev := Get_Block_Block_Configuration (Block); + if Prev /= Null_Iir then + Error_Msg_Sem + (Disp_Node (Block) & " was already configured at " + & Disp_Location (Prev), + Block_Conf); + return Null_Iir; + end if; + Set_Block_Block_Configuration (Block, Block_Conf); + Res := Block; + when Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement => + if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name + and then + Get_Kind (Block) /= Iir_Kind_For_Generate_Statement + then + -- LRM93 1.3 + -- If the block specification of a block configuration + -- contains a generate statement label, and if this + -- label contains an index specification, then it is + -- an error if the generate statement denoted by the + -- label does not have a generation scheme including + -- the reserved word for. + Error_Msg_Sem ("generate statement does not has a for", + Block_Spec); + return Null_Iir; + end if; + + Res := Get_Generate_Statement_Body (Block); + Set_Named_Entity (Block_Name, Res); + Set_Prev_Block_Configuration + (Block_Conf, Get_Generate_Block_Configuration (Res)); + Set_Generate_Block_Configuration (Res, Block_Conf); + when others => + Error_Msg_Sem ("block statement label expected", Block_Conf); + return Null_Iir; + end case; + + -- LRM93 1.3.1 / LRM08 3.4.2 Block configuration + -- [...], and the label must denote a block statement or generate + -- statement that is contained immediatly within the block denoted by + -- the block specification of the containing block configuration. + Block_Stmts := Get_Concurrent_Statement_Chain + (Get_Block_From_Block_Specification + (Get_Block_Specification (Father))); + if not Is_In_Chain (Block_Stmts, Block) then + Error_Msg_Sem ("label does not denotes an inner block statement", + Block_Conf); + return Null_Iir; + end if; + + case Get_Kind (Block_Spec) is + when Iir_Kind_Simple_Name => + Set_Block_Specification (Block_Conf, Block_Name); + when Iir_Kind_Parenthesis_Name => + Block_Spec := Sem_Index_Specification + (Block_Spec, Get_Type (Get_Parameter_Specification (Block))); + if Block_Spec /= Null_Iir then + Set_Prefix (Block_Spec, Block_Name); + Set_Block_Specification (Block_Conf, Block_Spec); + end if; + when others => + raise Internal_Error; + end case; + return Res; + end Sem_Block_Specification_Of_Statement; + -- LRM 1.3.1 Block Configuration. -- FATHER is the block_configuration, configuration_declaration, -- component_configuration containing the block_configuration BLOCK_CONF. @@ -784,7 +885,7 @@ package body Sem is end; when Iir_Kind_Block_Configuration => - -- LRM93 1.3.1 + -- LRM93 1.3.1 / LRM08 3.4.2 Block configuration -- If a block configuration appears immediately within another -- block configuration, then the block specification of the -- contained block configuration must be a block statement or @@ -792,102 +893,10 @@ package body Sem is -- statement or generate statement that is contained immediatly -- within the block denoted by the block specification of the -- containing block configuration. - declare - Block_Spec : Iir; - Block_Name : Iir; - Block_Stmts : Iir; - Block_Spec_Kind : Iir_Kind; - Prev : Iir_Block_Configuration; - begin - Block_Spec := Get_Block_Specification (Block_Conf); - -- Remember the kind of BLOCK_SPEC, since the node can be free - -- by find_declaration if it is a simple name. - Block_Spec_Kind := Get_Kind (Block_Spec); - case Block_Spec_Kind is - when Iir_Kind_Simple_Name => - Block_Name := Block_Spec; - when Iir_Kind_Parenthesis_Name => - Block_Name := Get_Prefix (Block_Spec); - when Iir_Kind_Slice_Name => - Block_Name := Get_Prefix (Block_Spec); - when others => - Error_Msg_Sem ("label expected", Block_Spec); - return; - end case; - Block_Name := Sem_Denoting_Name (Block_Name); - Block := Get_Named_Entity (Block_Name); - case Get_Kind (Block) is - when Iir_Kind_Block_Statement => - if Block_Spec_Kind /= Iir_Kind_Simple_Name then - Error_Msg_Sem - ("label does not denote a generate statement", - Block_Spec); - end if; - Prev := Get_Block_Block_Configuration (Block); - if Prev /= Null_Iir then - Error_Msg_Sem - (Disp_Node (Block) & " was already configured at " - & Disp_Location (Prev), - Block_Conf); - return; - end if; - Set_Block_Block_Configuration (Block, Block_Conf); - when Iir_Kind_Generate_Statement => - if Block_Spec_Kind /= Iir_Kind_Simple_Name - and then Get_Kind (Get_Generation_Scheme (Block)) - /= Iir_Kind_Iterator_Declaration - then - -- LRM93 1.3 - -- If the block specification of a block configuration - -- contains a generate statement label, and if this - -- label contains an index specification, then it is - -- an error if the generate statement denoted by the - -- label does not have a generation scheme including - -- the reserved word for. - Error_Msg_Sem ("generate statement does not has a for", - Block_Spec); - return; - end if; - Set_Prev_Block_Configuration - (Block_Conf, Get_Generate_Block_Configuration (Block)); - Set_Generate_Block_Configuration (Block, Block_Conf); - when others => - Error_Msg_Sem ("block statement label expected", - Block_Conf); - return; - end case; - Block_Stmts := Get_Concurrent_Statement_Chain - (Get_Block_From_Block_Specification - (Get_Block_Specification (Father))); - if not Is_In_Chain (Block_Stmts, Block) then - Error_Msg_Sem - ("label does not denotes an inner block statement", - Block_Conf); - return; - end if; - - if Block_Spec_Kind = Iir_Kind_Parenthesis_Name then - Block_Spec := Sem_Index_Specification - (Block_Spec, Get_Type (Get_Generation_Scheme (Block))); - if Block_Spec /= Null_Iir then - Set_Prefix (Block_Spec, Block_Name); - Set_Block_Specification (Block_Conf, Block_Spec); - Block_Spec_Kind := Get_Kind (Block_Spec); - end if; - end if; - - case Block_Spec_Kind is - when Iir_Kind_Simple_Name => - Set_Block_Specification (Block_Conf, Block_Name); - when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - null; - when Iir_Kind_Parenthesis_Name => - null; - when others => - raise Internal_Error; - end case; - end; + Block := Sem_Block_Specification_Of_Statement (Block_Conf, Father); + if Block = Null_Iir then + return; + end if; when others => Error_Kind ("sem_block_configuration", Father); diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index 64fd897e6..da7b1b2be 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -1702,7 +1702,7 @@ package body Sem_Decls is | Iir_Kind_Package_Declaration | Iir_Kind_Package_Body | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => if not Get_Shared_Flag (Decl) then Error_Msg_Sem ("non shared variable declaration not allowed here", @@ -2890,11 +2890,13 @@ package body Sem_Decls is -- May be used in architecture. null; when Iir_Kind_Architecture_Body - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Block_Statement => -- Might be used in a configuration. -- FIXME: create a second level of warning. null; + when Iir_Kind_Generate_Statement_Body => + -- Might be used in a configuration. + null; when Iir_Kind_Package_Body | Iir_Kind_Protected_Type_Body => -- Check only for declarations of the body. diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 472276956..933401725 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -324,7 +324,8 @@ package body Sem_Names is Iterator_Decl_Chain (Get_Port_Chain (Decl), Id); when Iir_Kind_Architecture_Body => null; - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => null; when Iir_Kind_Package_Declaration => null; @@ -358,10 +359,30 @@ package body Sem_Names is (Get_Sequential_Statement_Chain (Decl_Body), Id); when Iir_Kind_Architecture_Body | Iir_Kind_Entity_Declaration - | Iir_Kind_Generate_Statement | Iir_Kind_Block_Statement => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id); + when Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Block_Configuration (Decl); + begin + Iterator_Decl_Chain (Get_Declaration_Chain (Bod), Id); + Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Bod), Id); + end; + when Iir_Kind_If_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (Decl); + begin + if Get_Alternative_Label (Bod) = Null_Identifier then + Iterator_Decl_Chain + (Get_Declaration_Chain (Bod), Id); + Iterator_Decl_Chain + (Get_Concurrent_Statement_Chain (Bod), Id); + else + -- Error in LRM08 + raise Internal_Error; + end if; + end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); @@ -1294,7 +1315,8 @@ package body Sem_Names is | Iir_Kind_Package_Declaration | Iir_Kind_Package_Body | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kinds_Process_Statement | Iir_Kind_Protected_Type_Body => -- The procedure is impure. @@ -1850,7 +1872,8 @@ package body Sem_Names is | Iir_Kind_Entity_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Block_Statement | Iir_Kind_For_Loop_Statement => -- LRM93 §6.3 diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb index 490ce602e..f77e6e827 100644 --- a/src/vhdl/sem_scopes.adb +++ b/src/vhdl/sem_scopes.adb @@ -1160,7 +1160,7 @@ package body Sem_Scopes is when Iir_Kind_Architecture_Body => Add_Context_Clauses (Get_Design_Unit (Decl)); when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => -- FIXME: formal, iterator ? null; when others => diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index d2ace1580..47807a068 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -74,7 +74,8 @@ package body Sem_Specs is | Iir_Kind_Concurrent_Assertion_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_If_Statement | Iir_Kind_For_Loop_Statement | Iir_Kind_While_Loop_Statement @@ -530,7 +531,8 @@ package body Sem_Specs is end loop; end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => -- INT-1991/issue 27 -- Generate statements represent declarative region and -- have implicit declarative parts. @@ -619,7 +621,7 @@ package body Sem_Specs is case Get_Kind (Scope) is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope)); Sem_Named_Entity_Chain (Get_Concurrent_Statement_Chain (Scope)); when Iir_Kind_Block_Statement => @@ -1283,7 +1285,8 @@ package body Sem_Specs is (El, Spec, Primary_Entity_Aspect); Res := True; end if; - when Iir_Kind_Generate_Statement => + when Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement => if False and then Flags.Vhdl_Std = Vhdl_87 then Res := Res or Apply_Component_Specification (El, Check_Applied); diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index c220791bb..b64e9ac90 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -1511,46 +1511,68 @@ package body Sem_Stmts is Close_Declarative_Region; end Sem_Block_Statement; - procedure Sem_Generate_Statement (Stmt : Iir_Generate_Statement) + procedure Sem_Generate_Statement_Body (Parent : Iir) is - Scheme : Iir; + Bod : constant Iir := Get_Generate_Statement_Body (Parent); + begin + Sem_Block (Bod, True); -- Flags.Vhdl_Std /= Vhdl_87); + end Sem_Generate_Statement_Body; + + procedure Sem_For_Generate_Statement (Stmt : Iir) + is + Param : Iir; begin -- LRM93 10.1 Declarative region. -- 12. A generate statement. Open_Declarative_Region; - Scheme := Get_Generation_Scheme (Stmt); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Sem_Scopes.Add_Name (Scheme); - -- LRM93 §7.4.2 (Globally Static Primaries) - -- 4. a generate parameter; - Sem_Iterator (Scheme, Globally); - Set_Visible_Flag (Scheme, True); - -- LRM93 §9.7 - -- The discrete range in a generation scheme of the first form must - -- be a static discrete range; - if Get_Type (Scheme) /= Null_Iir - and then Get_Type_Staticness (Get_Type (Scheme)) < Globally - then - Error_Msg_Sem ("range must be a static discrete range", Stmt); - end if; + Param := Get_Parameter_Specification (Stmt); + Sem_Scopes.Add_Name (Param); + -- LRM93 7.4.2 (Globally Static Primaries) + -- 4. a generate parameter; + Sem_Iterator (Param, Globally); + Set_Visible_Flag (Param, True); + -- LRM93 9.7 + -- The discrete range in a generation scheme of the first form must + -- be a static discrete range; + if Get_Type (Param) /= Null_Iir + and then Get_Type_Staticness (Get_Type (Param)) < Globally + then + Error_Msg_Sem ("range must be a static discrete range", Stmt); + end if; + + -- In the same declarative region. + Sem_Generate_Statement_Body (Stmt); + + Close_Declarative_Region; + end Sem_For_Generate_Statement; + + procedure Sem_If_Generate_Statement (Stmt : Iir) + is + Condition : Iir; + begin + -- LRM93 10.1 Declarative region. + -- 12. A generate statement. + Open_Declarative_Region; + + Condition := Get_Condition (Stmt); + Condition := Sem_Condition (Condition); + -- LRM93 9.7 + -- the condition in a generation scheme of the second form must be + -- a static expression. + if Condition /= Null_Iir + and then Get_Expr_Staticness (Condition) < Globally + then + Error_Msg_Sem ("condition must be a static expression", Condition); else - Scheme := Sem_Condition (Scheme); - -- LRM93 §9.7 - -- the condition in a generation scheme of the second form must be - -- a static expression. - if Scheme /= Null_Iir - and then Get_Expr_Staticness (Scheme) < Globally - then - Error_Msg_Sem ("condition must be a static expression", Stmt); - else - Set_Generation_Scheme (Stmt, Scheme); - end if; + Set_Condition (Stmt, Condition); end if; - Sem_Block (Stmt, True); -- Flags.Vhdl_Std /= Vhdl_87); + -- In the same declarative region. + Sem_Generate_Statement_Body (Stmt); + Close_Declarative_Region; - end Sem_Generate_Statement; + end Sem_If_Generate_Statement; procedure Sem_Process_Statement (Proc: Iir) is begin @@ -1786,6 +1808,14 @@ package body Sem_Stmts is Is_Passive : constant Boolean := Get_Kind (Parent) = Iir_Kind_Entity_Declaration; El: Iir; + + procedure No_Generate_Statement is + begin + if Is_Passive then + Error_Msg_Sem ("generate statement forbidden in entity", El); + end if; + end No_Generate_Statement; + Prev_El : Iir; Prev_Concurrent_Statement : Iir; Prev_Psl_Default_Clock : Iir; @@ -1826,11 +1856,12 @@ package body Sem_Stmts is Error_Msg_Sem ("block forbidden in entity", El); end if; Sem_Block_Statement (El); - when Iir_Kind_Generate_Statement => - if Is_Passive then - Error_Msg_Sem ("generate statement forbidden in entity", El); - end if; - Sem_Generate_Statement (El); + when Iir_Kind_If_Generate_Statement => + No_Generate_Statement; + Sem_If_Generate_Statement (El); + when Iir_Kind_For_Generate_Statement => + No_Generate_Statement; + Sem_For_Generate_Statement (El); when Iir_Kind_Concurrent_Procedure_Call_Statement => declare Next_El : Iir; @@ -1898,7 +1929,9 @@ package body Sem_Stmts is -- implicit declarative part. if False and then Flags.Vhdl_Std = Vhdl_87 - and then Get_Kind (Stmt) = Iir_Kind_Generate_Statement + and then + (Get_Kind (Stmt) = Iir_Kind_For_Generate_Statement + or else Get_Kind (Stmt) = Iir_Kind_If_Generate_Statement) then Sem_Labels_Chain (Stmt); end if; diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 40d6fce45..ae2b10699 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -448,7 +448,7 @@ package body Trans.Chap1 is begin Push_Identifier_Prefix (Mark, Get_Identifier (Blk)); case Get_Kind (Blk) is - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, Blk_Info.Block_Origin_Field, @@ -531,17 +531,19 @@ package body Trans.Chap1 is Base_Block : Iir; Base_Info : Block_Info_Acc); - procedure Translate_Generate_Block_Configuration_Calls + procedure Translate_For_Generate_Block_Configuration_Calls (Block_Config : Iir_Block_Configuration; Parent_Info : Block_Info_Acc) is Spec : constant Iir := Get_Block_Specification (Block_Config); - Block : constant Iir := Get_Block_From_Block_Specification (Spec); - Info : constant Block_Info_Acc := Get_Info (Block); - Scheme : constant Iir := Get_Generation_Scheme (Block); + Bod : constant Iir := Get_Block_From_Block_Specification (Spec); + Block : constant Iir := Get_Parent (Bod); + Info : constant Block_Info_Acc := Get_Info (Bod); - Type_Info : Type_Info_Acc; - Iter_Type : Iir; + Iter : constant Iir := Get_Parameter_Specification (Block); + Iter_Type : constant Iir := Get_Type (Iter); + Type_Info : constant Type_Info_Acc := + Get_Info (Get_Base_Type (Iter_Type)); -- Generate a call for a iterative generate block whose index is -- INDEX. @@ -578,7 +580,7 @@ package body Trans.Chap1 is Info.Block_Configured_Field), New_Lit (Ghdl_Bool_True_Node)); Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var_Inst); - Translate_Block_Configuration_Calls (Block_Config, Block, Info); + Translate_Block_Configuration_Calls (Block_Config, Bod, Info); Clear_Scope (Info.Block_Scope); if Fails then @@ -620,135 +622,137 @@ package body Trans.Chap1 is Finish_Declare_Stmt; end Apply_To_All_Others_Blocks; begin - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Iter_Type := Get_Type (Scheme); - Type_Info := Get_Info (Get_Base_Type (Iter_Type)); - case Get_Kind (Spec) is - when Iir_Kind_Generate_Statement - | Iir_Kind_Simple_Name => - Apply_To_All_Others_Blocks (True); - when Iir_Kind_Indexed_Name => - declare - Index_List : constant Iir_List := Get_Index_List (Spec); - Rng : Mnode; - begin - if Index_List = Iir_List_Others then - Apply_To_All_Others_Blocks (False); - else - Open_Temp; - Rng := Stabilize (Chap3.Type_To_Range (Iter_Type)); - Gen_Subblock_Call - (Chap6.Translate_Index_To_Offset - (Rng, - Chap7.Translate_Expression - (Get_Nth_Element (Index_List, 0), Iter_Type), - Scheme, Iter_Type, Spec), - True); - Close_Temp; - end if; - end; - when Iir_Kind_Slice_Name => - declare - Rng : Mnode; - Slice : O_Dnode; - Left, Right : O_Dnode; - Index : O_Dnode; - High : O_Dnode; - If_Blk : O_If_Block; - Label : O_Snode; - begin + case Get_Kind (Spec) is + when Iir_Kind_For_Generate_Statement + | Iir_Kind_Simple_Name => + Apply_To_All_Others_Blocks (True); + when Iir_Kind_Indexed_Name => + declare + Index_List : constant Iir_List := Get_Index_List (Spec); + Rng : Mnode; + begin + if Index_List = Iir_List_Others then + Apply_To_All_Others_Blocks (False); + else Open_Temp; Rng := Stabilize (Chap3.Type_To_Range (Iter_Type)); - Slice := Create_Temp (Type_Info.T.Range_Type); - Chap7.Translate_Discrete_Range - (Dv2M (Slice, Type_Info, Mode_Value, - Type_Info.T.Range_Type, Type_Info.T.Range_Ptr_Type), - Get_Suffix (Spec)); - Left := Create_Temp_Init - (Ghdl_Index_Type, - Chap6.Translate_Index_To_Offset - (Rng, - New_Value (New_Selected_Element - (New_Obj (Slice), Type_Info.T.Range_Left)), - Spec, Iter_Type, Spec)); - Right := Create_Temp_Init - (Ghdl_Index_Type, - Chap6.Translate_Index_To_Offset + Gen_Subblock_Call + (Chap6.Translate_Index_To_Offset (Rng, - New_Value (New_Selected_Element - (New_Obj (Slice), - Type_Info.T.Range_Right)), - Spec, Iter_Type, Spec)); - Index := Create_Temp (Ghdl_Index_Type); - High := Create_Temp (Ghdl_Index_Type); - Start_If_Stmt - (If_Blk, - New_Compare_Op (ON_Eq, - M2E (Chap3.Range_To_Dir (Rng)), - New_Value - (New_Selected_Element - (New_Obj (Slice), - Type_Info.T.Range_Dir)), - Ghdl_Bool_Type)); - -- Same direction, so left to right. - New_Assign_Stmt (New_Obj (Index), - New_Value (New_Obj (Left))); - New_Assign_Stmt (New_Obj (High), - New_Value (New_Obj (Right))); - New_Else_Stmt (If_Blk); - -- Opposite direction, so right to left. - New_Assign_Stmt (New_Obj (Index), - New_Value (New_Obj (Right))); - New_Assign_Stmt (New_Obj (High), - New_Value (New_Obj (Left))); - Finish_If_Stmt (If_Blk); - - -- Loop. - Start_Loop_Stmt (Label); - Gen_Exit_When - (Label, New_Compare_Op (ON_Gt, - New_Value (New_Obj (Index)), - New_Value (New_Obj (High)), - Ghdl_Bool_Type)); - Open_Temp; - Gen_Subblock_Call (New_Value (New_Obj (Index)), True); - Close_Temp; - Inc_Var (Index); - Finish_Loop_Stmt (Label); + Chap7.Translate_Expression + (Get_Nth_Element (Index_List, 0), Iter_Type), + Iter, Iter_Type, Spec), + True); Close_Temp; - end; - when others => - Error_Kind - ("translate_generate_block_configuration_calls", Spec); - end case; - else - -- Conditional generate statement. - declare - Var : O_Dnode; - If_Blk : O_If_Block; - begin - -- Configure the block only if it was created. - Open_Temp; - Var := Create_Temp_Init - (Info.Block_Decls_Ptr_Type, - New_Value (New_Selected_Element - (Get_Instance_Ref (Parent_Info.Block_Scope), - Info.Block_Parent_Field))); - Start_If_Stmt - (If_Blk, - New_Compare_Op - (ON_Neq, - New_Obj_Value (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)), - Ghdl_Bool_Type)); - Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Translate_Block_Configuration_Calls (Block_Config, Block, Info); - Clear_Scope (Info.Block_Scope); - Finish_If_Stmt (If_Blk); - Close_Temp; - end; - end if; - end Translate_Generate_Block_Configuration_Calls; + end if; + end; + when Iir_Kind_Slice_Name => + declare + Rng : Mnode; + Slice : O_Dnode; + Left, Right : O_Dnode; + Index : O_Dnode; + High : O_Dnode; + If_Blk : O_If_Block; + Label : O_Snode; + begin + Open_Temp; + Rng := Stabilize (Chap3.Type_To_Range (Iter_Type)); + Slice := Create_Temp (Type_Info.T.Range_Type); + Chap7.Translate_Discrete_Range + (Dv2M (Slice, Type_Info, Mode_Value, + Type_Info.T.Range_Type, Type_Info.T.Range_Ptr_Type), + Get_Suffix (Spec)); + Left := Create_Temp_Init + (Ghdl_Index_Type, + Chap6.Translate_Index_To_Offset + (Rng, + New_Value (New_Selected_Element + (New_Obj (Slice), Type_Info.T.Range_Left)), + Spec, Iter_Type, Spec)); + Right := Create_Temp_Init + (Ghdl_Index_Type, + Chap6.Translate_Index_To_Offset + (Rng, + New_Value (New_Selected_Element + (New_Obj (Slice), + Type_Info.T.Range_Right)), + Spec, Iter_Type, Spec)); + Index := Create_Temp (Ghdl_Index_Type); + High := Create_Temp (Ghdl_Index_Type); + Start_If_Stmt + (If_Blk, + New_Compare_Op (ON_Eq, + M2E (Chap3.Range_To_Dir (Rng)), + New_Value + (New_Selected_Element + (New_Obj (Slice), + Type_Info.T.Range_Dir)), + Ghdl_Bool_Type)); + -- Same direction, so left to right. + New_Assign_Stmt (New_Obj (Index), + New_Value (New_Obj (Left))); + New_Assign_Stmt (New_Obj (High), + New_Value (New_Obj (Right))); + New_Else_Stmt (If_Blk); + -- Opposite direction, so right to left. + New_Assign_Stmt (New_Obj (Index), + New_Value (New_Obj (Right))); + New_Assign_Stmt (New_Obj (High), + New_Value (New_Obj (Left))); + Finish_If_Stmt (If_Blk); + + -- Loop. + Start_Loop_Stmt (Label); + Gen_Exit_When + (Label, New_Compare_Op (ON_Gt, + New_Value (New_Obj (Index)), + New_Value (New_Obj (High)), + Ghdl_Bool_Type)); + Open_Temp; + Gen_Subblock_Call (New_Value (New_Obj (Index)), True); + Close_Temp; + Inc_Var (Index); + Finish_Loop_Stmt (Label); + Close_Temp; + end; + when others => + Error_Kind + ("translate_for_generate_block_configuration_calls", Spec); + end case; + end Translate_For_Generate_Block_Configuration_Calls; + + procedure Translate_If_Generate_Block_Configuration_Calls + (Block_Config : Iir_Block_Configuration; + Parent_Info : Block_Info_Acc) + is + Spec : constant Iir := Get_Block_Specification (Block_Config); + Block : constant Iir := Get_Block_From_Block_Specification (Spec); + Info : constant Block_Info_Acc := Get_Info (Block); + Var : O_Dnode; + If_Blk : O_If_Block; + + begin + -- Configure the block only if it was created. + Open_Temp; + Var := Create_Temp_Init + (Info.Block_Decls_Ptr_Type, + New_Value (New_Selected_Element + (Get_Instance_Ref (Parent_Info.Block_Scope), + Info.Block_Parent_Field))); + Start_If_Stmt + (If_Blk, + New_Compare_Op + (ON_Neq, + New_Obj_Value (Var), + New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)), + Ghdl_Bool_Type)); + Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); + Translate_Block_Configuration_Calls (Block_Config, Block, Info); + Clear_Scope (Info.Block_Scope); + Finish_If_Stmt (If_Blk); + Close_Temp; + end Translate_If_Generate_Block_Configuration_Calls; procedure Translate_Block_Configuration_Calls (Block_Config : Iir_Block_Configuration; @@ -766,16 +770,40 @@ package body Trans.Chap1 is (El, Base_Block, Base_Info); when Iir_Kind_Block_Configuration => declare - Block : constant Iir := Strip_Denoting_Name - (Get_Block_Specification (El)); + Block : Iir; begin - if Get_Kind (Block) = Iir_Kind_Block_Statement then - Translate_Block_Configuration_Calls - (El, Base_Block, Get_Info (Block)); - else - Translate_Generate_Block_Configuration_Calls - (El, Base_Info); - end if; + Block := Get_Block_Specification (El); + case Get_Kind (Block) is + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + Block := Get_Named_Entity (Get_Prefix (Block)); + when Iir_Kinds_Denoting_Name => + Block := Get_Named_Entity (Block); + when others => + null; + end case; + + case Get_Kind (Block) is + when Iir_Kind_Block_Statement => + Translate_Block_Configuration_Calls + (El, Base_Block, Get_Info (Block)); + when Iir_Kind_Generate_Statement_Body => + case Get_Kind (Get_Parent (Block)) is + when Iir_Kind_If_Generate_Statement => + Translate_If_Generate_Block_Configuration_Calls + (El, Base_Info); + when Iir_Kind_For_Generate_Statement => + Translate_For_Generate_Block_Configuration_Calls + (El, Base_Info); + when others => + Error_Kind + ("translate_block_configuration_calls(3)", + Get_Parent (Block)); + end case; + when others => + Error_Kind + ("translate_block_configuration_calls(4)", Block); + end case; end; when others => Error_Kind ("translate_block_configuration_calls(2)", El); diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index ed3699908..e2a81c360 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -634,7 +634,7 @@ package body Trans.Chap9 is end Translate_Psl_Directive_Statement; -- Create the instance for block BLOCK. - -- BLOCK can be either an entity, an architecture or a block statement. + -- ORIGIN can be either an entity, an architecture or a block statement. procedure Translate_Block_Declarations (Block : Iir; Origin : Iir) is El : Iir; @@ -691,23 +691,21 @@ package body Trans.Chap9 is (Create_Identifier_Without_Prefix (El), Info.Block_Scope); end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_For_Generate_Statement => declare - Scheme : constant Iir := Get_Generation_Scheme (El); + Bod : constant Iir := Get_Generate_Statement_Body (El); + Param : constant Iir := Get_Parameter_Specification (El); Info : Block_Info_Acc; Mark : Id_Mark_Type; - Iter_Type : Iir; + Iter_Type : constant Iir := Get_Type (Param); It_Info : Ortho_Info_Acc; begin Push_Identifier_Prefix (Mark, Get_Identifier (El)); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Iter_Type := Get_Type (Scheme); - Chap3.Translate_Object_Subtype (Scheme, True); - end if; + Chap3.Translate_Object_Subtype (Param, True); - Info := Add_Info (El, Kind_Block); - Chap1.Start_Block_Decl (El); + Info := Add_Info (Bod, Kind_Block); + Chap1.Start_Block_Decl (Bod); Push_Instance_Factory (Info.Block_Scope'Access); -- Add a parent field in the current instance. @@ -715,43 +713,68 @@ package body Trans.Chap9 is (Get_Identifier ("ORIGIN"), Get_Info (Origin).Block_Decls_Ptr_Type); + -- Flag (if block was configured). + Info.Block_Configured_Field := + Add_Instance_Factory_Field + (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type); + -- Iterator. - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Info.Block_Configured_Field := - Add_Instance_Factory_Field - (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type); - It_Info := Add_Info (Scheme, Kind_Iterator); - It_Info.Iterator_Var := Create_Var - (Create_Var_Identifier (Scheme), - Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type - (Mode_Value)); - end if; + It_Info := Add_Info (Param, Kind_Iterator); + It_Info.Iterator_Var := Create_Var + (Create_Var_Identifier (Param), + Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type + (Mode_Value)); - Chap9.Translate_Block_Declarations (El, El); + Chap9.Translate_Block_Declarations (Bod, Bod); Pop_Instance_Factory (Info.Block_Scope'Access); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - -- Create array type of block_decls_type - Info.Block_Decls_Array_Type := New_Array_Type - (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type); - New_Type_Decl (Create_Identifier ("INSTARRTYPE"), - Info.Block_Decls_Array_Type); - -- Create access to the array type. - Info.Block_Decls_Array_Ptr_Type := New_Access_Type - (Info.Block_Decls_Array_Type); - New_Type_Decl (Create_Identifier ("INSTARRPTR"), - Info.Block_Decls_Array_Ptr_Type); - -- Add a field in parent record - Info.Block_Parent_Field := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Decls_Array_Ptr_Type); - else - -- Create an access field in the parent record. - Info.Block_Parent_Field := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Decls_Ptr_Type); - end if; + -- Create array type of block_decls_type + Info.Block_Decls_Array_Type := New_Array_Type + (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type); + New_Type_Decl (Create_Identifier ("INSTARRTYPE"), + Info.Block_Decls_Array_Type); + -- Create access to the array type. + Info.Block_Decls_Array_Ptr_Type := New_Access_Type + (Info.Block_Decls_Array_Type); + New_Type_Decl (Create_Identifier ("INSTARRPTR"), + Info.Block_Decls_Array_Ptr_Type); + + -- Add a field in the parent instance (Pop_Instance_Factory + -- has already been called). This is a pointer INSTARRPTR + -- to an array INSTARRTYPE of instace. The size of each + -- element is stored in the RTI. + Info.Block_Parent_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (El), + Info.Block_Decls_Array_Ptr_Type); + + Pop_Identifier_Prefix (Mark); + end; + when Iir_Kind_If_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (El); + Info : Block_Info_Acc; + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (El)); + + Info := Add_Info (Bod, Kind_Block); + Chap1.Start_Block_Decl (Bod); + Push_Instance_Factory (Info.Block_Scope'Access); + + -- Add a parent field in the current instance. + Info.Block_Origin_Field := Add_Instance_Factory_Field + (Get_Identifier ("ORIGIN"), + Get_Info (Origin).Block_Decls_Ptr_Type); + + Chap9.Translate_Block_Declarations (Bod, Bod); + + Pop_Instance_Factory (Info.Block_Scope'Access); + + -- Create an access field in the parent record. + Info.Block_Parent_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (El), + Info.Block_Decls_Ptr_Type); Pop_Identifier_Prefix (Mark); end; @@ -765,7 +788,7 @@ package body Trans.Chap9 is procedure Translate_Component_Instantiation_Subprogram (Stmt : Iir; Base : Block_Info_Acc) is - procedure Set_Component_Link (Ref_Scope : Var_Scope_Type; + procedure Set_Component_Link (Ref_Scope : Var_Scope_Type; Comp_Field : O_Fnode) is begin @@ -892,9 +915,11 @@ package body Trans.Chap9 is end if; Translate_Block_Subprograms (Stmt, Base_Block); end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement => declare - Info : constant Block_Info_Acc := Get_Info (Stmt); + Bod : constant Iir := Get_Generate_Statement_Body (Stmt); + Info : constant Block_Info_Acc := Get_Info (Bod); Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; begin Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access, @@ -904,7 +929,7 @@ package body Trans.Chap9 is Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, Info.Block_Origin_Field, Info.Block_Scope'Access); - Translate_Block_Subprograms (Stmt, Stmt); + Translate_Block_Subprograms (Bod, Bod); Clear_Scope (Base_Info.Block_Scope); Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); @@ -1493,11 +1518,12 @@ package body Trans.Chap9 is end; end Translate_Entity_Instantiation; - procedure Elab_Conditionnal_Generate_Statement + procedure Elab_If_Generate_Statement (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) is - Scheme : constant Iir := Get_Generation_Scheme (Stmt); - Info : constant Block_Info_Acc := Get_Info (Stmt); + Condition : constant Iir := Get_Condition (Stmt); + Bod : constant Iir := Get_Generate_Statement_Body (Stmt); + Info : constant Block_Info_Acc := Get_Info (Bod); Parent_Info : constant Block_Info_Acc := Get_Info (Parent); Var : O_Dnode; Blk : O_If_Block; @@ -1506,7 +1532,7 @@ package body Trans.Chap9 is Open_Temp; Var := Create_Temp (Info.Block_Decls_Ptr_Type); - Start_If_Stmt (Blk, Chap7.Translate_Expression (Scheme)); + Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition)); New_Assign_Stmt (New_Obj (Var), Gen_Alloc (Alloc_System, @@ -1536,20 +1562,21 @@ package body Trans.Chap9 is Get_Instance_Access (Base_Block)); -- Elaborate block Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Elab_Block_Declarations (Stmt, Stmt); + Elab_Block_Declarations (Bod, Bod); Clear_Scope (Info.Block_Scope); Finish_If_Stmt (Blk); Close_Temp; - end Elab_Conditionnal_Generate_Statement; + end Elab_If_Generate_Statement; - procedure Elab_Iterative_Generate_Statement + procedure Elab_For_Generate_Statement (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) is - Scheme : constant Iir := Get_Generation_Scheme (Stmt); - Iter_Type : constant Iir := Get_Type (Scheme); + Iter : constant Iir := Get_Parameter_Specification (Stmt); + Iter_Type : constant Iir := Get_Type (Iter); Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type); Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type); - Info : constant Block_Info_Acc := Get_Info (Stmt); + Bod : constant Iir := Get_Generate_Statement_Body (Stmt); + Info : constant Block_Info_Acc := Get_Info (Bod); Parent_Info : constant Block_Info_Acc := Get_Info (Parent); -- Base_Info : constant Block_Info_Acc := Get_Info (Base_Block); Var_Inst : O_Dnode; @@ -1644,7 +1671,7 @@ package body Trans.Chap9 is Finish_If_Stmt (If_Blk); New_Assign_Stmt - (Get_Var (Get_Info (Scheme).Iterator_Var), + (Get_Var (Get_Info (Iter).Iterator_Var), New_Dyadic_Op (ON_Add_Ov, New_Obj_Value (Val), @@ -1653,7 +1680,7 @@ package body Trans.Chap9 is end; -- Elaboration. - Elab_Block_Declarations (Stmt, Stmt); + Elab_Block_Declarations (Bod, Bod); -- Clear_Scope (Base_Info.Block_Scope); Clear_Scope (Info.Block_Scope); @@ -1661,7 +1688,7 @@ package body Trans.Chap9 is Inc_Var (Var_I); Finish_Loop_Stmt (Label); Close_Temp; - end Elab_Iterative_Generate_Statement; + end Elab_For_Generate_Statement; type Merge_Signals_Data is record Sig : Iir; @@ -1887,7 +1914,7 @@ package body Trans.Chap9 is Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header)); end if; end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => null; when others => Error_Kind ("elab_block_declarations", Block); @@ -1928,21 +1955,20 @@ package body Trans.Chap9 is Elab_Block_Declarations (Stmt, Base_Block); Pop_Identifier_Prefix (Mark); end; - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement => declare Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - - if Get_Kind (Get_Generation_Scheme (Stmt)) - = Iir_Kind_Iterator_Declaration - then - Elab_Iterative_Generate_Statement - (Stmt, Block, Base_Block); - else - Elab_Conditionnal_Generate_Statement - (Stmt, Block, Base_Block); - end if; + Elab_If_Generate_Statement (Stmt, Block, Base_Block); + Pop_Identifier_Prefix (Mark); + end; + when Iir_Kind_For_Generate_Statement => + declare + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + Elab_For_Generate_Statement (Stmt, Block, Base_Block); Pop_Identifier_Prefix (Mark); end; when others => diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 76db3ccd1..6fd7c25c2 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -725,6 +725,7 @@ package body Trans.Rtis is return; end if; if Cur_Block.Last_Nbr = Rti_Array'Last then + -- Append a new block. declare N : Rti_Array_List_Acc; begin @@ -2164,7 +2165,8 @@ package body Trans.Rtis is when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); Generate_Block (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); @@ -2207,28 +2209,27 @@ package body Trans.Rtis is Inst : O_Tnode; begin -- The type of a generator iterator is elaborated in the parent. - if Get_Kind (Blk) = Iir_Kind_Generate_Statement then + if Get_Kind (Blk) = Iir_Kind_For_Generate_Statement then declare - Scheme : constant Iir := Get_Generation_Scheme (Blk); - Iter_Type : Iir; - Type_Info : Type_Info_Acc; + Param : constant Iir := Get_Parameter_Specification (Blk); + Iter_Type : constant Iir := Get_Type (Param); + Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type); Mark : Id_Mark_Type; - Tmp : O_Dnode; + Iter_Rti : O_Dnode; begin - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Iter_Type := Get_Type (Scheme); - Type_Info := Get_Info (Iter_Type); - if Type_Info.Type_Rti = O_Dnode_Null then - Push_Identifier_Prefix (Mark, "ITERATOR"); - Tmp := Generate_Type_Definition (Iter_Type); - Add_Rti_Node (Tmp); - Pop_Identifier_Prefix (Mark); - end if; + if Type_Info.Type_Rti = O_Dnode_Null then + Push_Identifier_Prefix (Mark, "ITERATOR"); + Iter_Rti := Generate_Type_Definition (Iter_Type); + -- The RTIs for the parent are being defined, so append to the + -- parent. + Add_Rti_Node (Iter_Rti); + Pop_Identifier_Prefix (Mark); end if; end; end if; if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then + -- Also include filename for units. Rti_Type := Ghdl_Rtin_Block_File; else Rti_Type := Ghdl_Rtin_Block; @@ -2295,26 +2296,37 @@ package body Trans.Rtis is (Get_Concurrent_Statement_Chain (Blk), Rti); Field_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type); Inst := Get_Scope_Type (Info.Block_Scope); - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement => + Kind := Ghdl_Rtik_If_Generate; declare - Scheme : constant Iir := Get_Generation_Scheme (Blk); - Scheme_Rti : O_Dnode := O_Dnode_Null; + Bod : constant Iir := Get_Generate_Statement_Body (Blk); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); begin - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Generate_Object (Scheme, Scheme_Rti); - Add_Rti_Node (Scheme_Rti); - Kind := Ghdl_Rtik_For_Generate; - else - Kind := Ghdl_Rtik_If_Generate; - end if; + Generate_Declaration_Chain (Get_Declaration_Chain (Bod)); + Generate_Concurrent_Statement_Chain + (Get_Concurrent_Statement_Chain (Bod), Rti); + Field_Off := New_Offsetof + (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), + Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type); + end; + when Iir_Kind_For_Generate_Statement => + Kind := Ghdl_Rtik_For_Generate; + declare + Bod : constant Iir := Get_Generate_Statement_Body (Blk); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); + Param : constant Iir := Get_Parameter_Specification (Blk); + Param_Rti : O_Dnode := O_Dnode_Null; + begin + Generate_Object (Param, Param_Rti); + Add_Rti_Node (Param_Rti); + Generate_Declaration_Chain (Get_Declaration_Chain (Bod)); + Generate_Concurrent_Statement_Chain + (Get_Concurrent_Statement_Chain (Bod), Rti); + Inst := Get_Scope_Type (Bod_Info.Block_Scope); + Field_Off := New_Offsetof + (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), + Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type); end; - Generate_Declaration_Chain (Get_Declaration_Chain (Blk)); - Generate_Concurrent_Statement_Chain - (Get_Concurrent_Statement_Chain (Blk), Rti); - Inst := Get_Scope_Type (Info.Block_Scope); - Field_Off := New_Offsetof - (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), - Info.Block_Parent_Field, Ghdl_Ptr_Type); when others => Error_Kind ("rti.generate_block", Blk); end case; @@ -2346,6 +2358,8 @@ package body Trans.Rtis is if Inst = O_Tnode_Null then Res := Ghdl_Index_0; else + -- For for-generate: size of instance, which gives the stride in the + -- sub-blocks array. Res := New_Sizeof (Inst, Ghdl_Index_Type); end if; New_Record_Aggr_El (List, Res); @@ -2370,7 +2384,8 @@ package body Trans.Rtis is -- Put children in the parent list. case Get_Kind (Blk) is when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_If_Generate_Statement | Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Add_Rti_Node (Rti); @@ -2382,9 +2397,16 @@ package body Trans.Rtis is case Get_Kind (Blk) is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Block_Statement => Info.Block_Rti_Const := Rti; + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (Blk); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); + begin + Bod_Info.Block_Rti_Const := Rti; + end; when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Info.Process_Rti_Const := Rti; @@ -2571,8 +2593,16 @@ package body Trans.Rtis is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => Rti_Const := Node_Info.Block_Rti_Const; + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (Node); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); + begin + Rti_Const := Bod_Info.Block_Rti_Const; + end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => Rti_Const := Node_Info.Package_Rti_Const; @@ -2599,8 +2629,16 @@ package body Trans.Rtis is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_Generate_Statement_Body => Ref := Get_Instance_Ref (Node_Info.Block_Scope); + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => + declare + Bod : constant Iir := Get_Generate_Statement_Body (Node); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); + begin + Ref := Get_Instance_Ref (Bod_Info.Block_Scope); + end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => return New_Lit (New_Null_Access (Ghdl_Ptr_Type)); |