diff options
Diffstat (limited to 'src/vhdl/translate')
| -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 |
3 files changed, 342 insertions, 250 deletions
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 40d6fce..ae2b106 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 ed36999..e2a81c3 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 76db3cc..6fd7c25 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)); |