From 99443212bf78a5d36b693abab225a160a92d097a Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 7 Jan 2015 08:07:42 +0100 Subject: Handle vhdl08 if generate statements --- src/vhdl/translate/trans-chap9.adb | 426 ++++++++++++++++++++++--------------- 1 file changed, 249 insertions(+), 177 deletions(-) (limited to 'src/vhdl/translate/trans-chap9.adb') diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 192c8ee0c..b62b12f93 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -633,6 +633,149 @@ package body Trans.Chap9 is end case; end Translate_Psl_Directive_Statement; + procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Clause : Iir; + Bod : Iir; + Info : Block_Info_Acc; + Stmt_Info : Ortho_Info_Acc; + Mark : Id_Mark_Type; + Mark2 : Id_Mark_Type; + Num : Int32; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Stmt_Info := Add_Info (Stmt, Kind_Generate); + Stmt_Info.Generate_Parent_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Stmt), Ghdl_Ptr_Type); + Stmt_Info.Generate_Body_Id := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Get_Identifier (Stmt), "_ID"), + Ghdl_Index_Type); + + -- Translate generate statement body. + Num := 0; + Clause := Stmt; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Info := Add_Info (Bod, Kind_Block); + + Push_Identifier_Prefix (Mark2, Get_Alternative_Label (Bod)); + + 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); + + Info.Block_Id := Num; + + Chap9.Translate_Block_Declarations (Bod, Bod); + + Pop_Instance_Factory (Info.Block_Scope'Access); + + Pop_Identifier_Prefix (Mark2); + Clause := Get_Generate_Else_Clause (Clause); + Num := Num + 1; + end loop; + + Pop_Identifier_Prefix (Mark); + end Translate_If_Generate_Statement; + + procedure Translate_For_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Bod : constant Iir := Get_Generate_Statement_Body (Stmt); + Param : constant Iir := Get_Parameter_Specification (Stmt); + Iter_Type : constant Iir := Get_Type (Param); + Info : Block_Info_Acc; + Mark : Id_Mark_Type; + It_Info : Ortho_Info_Acc; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Chap3.Translate_Object_Subtype (Param, True); + + 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. This is + -- the first field (known by GRT). + Info.Block_Origin_Field := Add_Instance_Factory_Field + (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. + 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 (Bod, Bod); + + Pop_Instance_Factory (Info.Block_Scope'Access); + + -- 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 (Stmt), + Info.Block_Decls_Array_Ptr_Type); + + Pop_Identifier_Prefix (Mark); + end Translate_For_Generate_Statement; + + procedure Translate_Block_Statement (Stmt : Iir; Origin : Iir) + is + Hdr : constant Iir_Block_Header := Get_Block_Header (Stmt); + Guard : constant Iir := Get_Guard_Decl (Stmt); + Info : Block_Info_Acc; + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Info := Add_Info (Stmt, Kind_Block); + Chap1.Start_Block_Decl (Stmt); + Push_Instance_Factory (Info.Block_Scope'Access); + + -- Implicit guard signal. + if Guard /= Null_Iir then + Chap4.Translate_Declaration (Guard); + end if; + + -- generics, ports. + if Hdr /= Null_Iir then + Chap4.Translate_Generic_Chain (Hdr); + Chap4.Translate_Port_Chain (Hdr); + end if; + + Chap9.Translate_Block_Declarations (Stmt, Origin); + + Pop_Instance_Factory (Info.Block_Scope'Access); + Pop_Identifier_Prefix (Mark); + + -- Create a field in the parent record. + Add_Scope_Field (Create_Identifier_Without_Prefix (Stmt), + Info.Block_Scope); + end Translate_Block_Statement; + -- Create the instance for block BLOCK. -- ORIGIN can be either an entity, an architecture or a block statement. procedure Translate_Block_Declarations (Block : Iir; Origin : Iir) @@ -657,128 +800,11 @@ package body Trans.Chap9 is when Iir_Kind_Component_Instantiation_Statement => Translate_Component_Instantiation_Statement (El); when Iir_Kind_Block_Statement => - declare - Info : Block_Info_Acc; - Hdr : Iir_Block_Header; - Guard : Iir; - Mark : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - - Info := Add_Info (El, Kind_Block); - Chap1.Start_Block_Decl (El); - Push_Instance_Factory (Info.Block_Scope'Access); - - Guard := Get_Guard_Decl (El); - if Guard /= Null_Iir then - Chap4.Translate_Declaration (Guard); - end if; - - -- generics, ports. - Hdr := Get_Block_Header (El); - if Hdr /= Null_Iir then - Chap4.Translate_Generic_Chain (Hdr); - Chap4.Translate_Port_Chain (Hdr); - end if; - - Chap9.Translate_Block_Declarations (El, Origin); - - Pop_Instance_Factory (Info.Block_Scope'Access); - Pop_Identifier_Prefix (Mark); - - -- Create a field in the parent record. - Add_Scope_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Scope); - end; + Translate_Block_Statement (El, Origin); when Iir_Kind_For_Generate_Statement => - declare - 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 : constant Iir := Get_Type (Param); - It_Info : Ortho_Info_Acc; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - - Chap3.Translate_Object_Subtype (Param, True); - - 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. This is - -- the first field (known by GRT). - Info.Block_Origin_Field := Add_Instance_Factory_Field - (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. - 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 (Bod, Bod); - - Pop_Instance_Factory (Info.Block_Scope'Access); - - -- 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; + Translate_For_Generate_Statement (El, Origin); 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; + Translate_If_Generate_Statement (El, Origin); when others => Error_Kind ("translate_block_declarations", El); end case; @@ -863,6 +889,24 @@ package body Trans.Chap9 is Finish_Subprogram_Body; end Translate_Component_Instantiation_Subprogram; + procedure Translate_Generate_Statement_Body_Subprograms + (Bod : Iir; Base_Info : Block_Info_Acc) + is + Info : constant Block_Info_Acc := Get_Info (Bod); + Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + begin + Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access, + Info.Block_Decls_Ptr_Type, + Wki_Instance, + Prev_Subprg_Instance); + Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, + Info.Block_Origin_Field, + Info.Block_Scope'Access); + Translate_Block_Subprograms (Bod, Bod); + Clear_Scope (Base_Info.Block_Scope); + Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + end Translate_Generate_Statement_Body_Subprograms; + -- Translate concurrent statements into subprograms. procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir) is @@ -916,24 +960,25 @@ package body Trans.Chap9 is end if; Translate_Block_Subprograms (Stmt, Base_Block); end; - when Iir_Kind_For_Generate_Statement - | Iir_Kind_If_Generate_Statement => + when Iir_Kind_For_Generate_Statement => + Translate_Generate_Statement_Body_Subprograms + (Get_Generate_Statement_Body (Stmt), Base_Info); + when Iir_Kind_If_Generate_Statement => declare - Bod : constant Iir := Get_Generate_Statement_Body (Stmt); - Info : constant Block_Info_Acc := Get_Info (Bod); - Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Clause : Iir; + Bod : Iir; + Mark2 : Id_Mark_Type; begin - Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access, - Info.Block_Decls_Ptr_Type, - Wki_Instance, - Prev_Subprg_Instance); - Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, - Info.Block_Origin_Field, - Info.Block_Scope'Access); - Translate_Block_Subprograms (Bod, Bod); - Clear_Scope (Base_Info.Block_Scope); - Subprgs.Pop_Subprg_Instance - (Wki_Instance, Prev_Subprg_Instance); + Clause := Stmt; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Push_Identifier_Prefix + (Mark2, Get_Alternative_Label (Bod)); + Translate_Generate_Statement_Body_Subprograms + (Bod, Base_Info); + Pop_Identifier_Prefix (Mark2); + Clause := Get_Generate_Else_Clause (Clause); + end loop; end; when others => Error_Kind ("translate_block_subprograms", Stmt); @@ -1522,51 +1567,78 @@ package body Trans.Chap9 is procedure Elab_If_Generate_Statement (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) is - 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; - V : O_Lnode; - begin - Open_Temp; - Var := Create_Temp (Info.Block_Decls_Ptr_Type); - Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition)); - New_Assign_Stmt - (New_Obj (Var), - Gen_Alloc (Alloc_System, - New_Lit (Get_Scope_Size (Info.Block_Scope)), - Info.Block_Decls_Ptr_Type)); - New_Else_Stmt (Blk); - New_Assign_Stmt - (New_Obj (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type))); - Finish_If_Stmt (Blk); + -- Used to get Block_Parent_Field, set in the first generate statement + -- body. + Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt); - -- Add a link to child in parent. - V := Get_Instance_Ref (Parent_Info.Block_Scope); - V := New_Selected_Element (V, Info.Block_Parent_Field); - New_Assign_Stmt (V, New_Obj_Value (Var)); + -- Set the instance field in the parent. + procedure Set_Parent_Field (Val : O_Enode; Num : Nat32) + is + V : O_Lnode; + begin + V := Get_Instance_Ref (Parent_Info.Block_Scope); + V := New_Selected_Element (V, Stmt_Info.Generate_Parent_Field); + New_Assign_Stmt (V, Val); - Start_If_Stmt - (Blk, - New_Compare_Op - (ON_Neq, - New_Obj_Value (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)), - Ghdl_Bool_Type)); - -- Add a link to parent in child. - New_Assign_Stmt - (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field), - Get_Instance_Access (Base_Block)); - -- Elaborate block - Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Elab_Block_Declarations (Bod, Bod); - Clear_Scope (Info.Block_Scope); - Finish_If_Stmt (Blk); - Close_Temp; + V := Get_Instance_Ref (Parent_Info.Block_Scope); + V := New_Selected_Element (V, Stmt_Info.Generate_Body_Id); + New_Assign_Stmt (V, New_Lit (New_Index_Lit (Unsigned_64 (Num)))); + end Set_Parent_Field; + + procedure Elab_If_Clause (Clause : Iir) + is + Condition : constant Iir := Get_Condition (Clause); + Bod : constant Iir := Get_Generate_Statement_Body (Clause); + Info : constant Block_Info_Acc := Get_Info (Bod); + Var : O_Dnode; + Blk : O_If_Block; + N_Clause : Iir; + begin + Open_Temp; + + Var := Create_Temp (Info.Block_Decls_Ptr_Type); + if Condition /= Null_Iir then + Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition)); + end if; + New_Assign_Stmt + (New_Obj (Var), + Gen_Alloc (Alloc_System, + New_Lit (Get_Scope_Size (Info.Block_Scope)), + Info.Block_Decls_Ptr_Type)); + + -- Add a link to child in parent. This must be done before + -- elaboration, in case of use. + Set_Parent_Field + (New_Convert_Ov (New_Obj_Value (Var), Ghdl_Ptr_Type), + Info.Block_Id); + + -- Add a link to parent in child. + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field), + Get_Instance_Access (Base_Block)); + -- Elaborate block + Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); + Elab_Block_Declarations (Bod, Bod); + Clear_Scope (Info.Block_Scope); + + if Condition /= Null_Iir then + New_Else_Stmt (Blk); + N_Clause := Get_Generate_Else_Clause (Clause); + if N_Clause /= Null_Iir then + Elab_If_Clause (N_Clause); + else + Set_Parent_Field + (New_Lit (New_Null_Access (Ghdl_Ptr_Type)), + Info.Block_Id + 1); + end if; + Finish_If_Stmt (Blk); + end if; + Close_Temp; + end Elab_If_Clause; + begin + Elab_If_Clause (Stmt); end Elab_If_Generate_Statement; procedure Elab_For_Generate_Statement -- cgit v1.2.3