From e305214943ba24c32b4c4883447d14da0bbf9d02 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 5 Jul 2016 03:58:37 +0200 Subject: vhdl08: add support of case-generate statement --- src/vhdl/translate/trans-chap9.adb | 417 +++++++++++++++++++++++++++++-------- 1 file changed, 326 insertions(+), 91 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 9500bbd88..9b453bf4c 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -662,55 +662,94 @@ package body Trans.Chap9 is end case; end Translate_Psl_Directive_Statement; - procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir) + procedure Translate_If_Case_Generate_Statement_Body + (Bod : Iir; Num : Int32; 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)); + 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); + end Translate_If_Case_Generate_Statement_Body; + + procedure Translate_If_Case_Generate_Statement (Stmt : Iir) + is + Stmt_Info : Ortho_Info_Acc; + begin 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); + end Translate_If_Case_Generate_Statement; + + procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Clause : Iir; + Bod : Iir; + Mark : Id_Mark_Type; + Num : Int32; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Translate_If_Case_Generate_Statement (Stmt); -- 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); + Translate_If_Case_Generate_Statement_Body (Bod, Num, Origin); + Clause := Get_Generate_Else_Clause (Clause); + Num := Num + 1; + end loop; - Info.Block_Id := Num; + Pop_Identifier_Prefix (Mark); + end Translate_If_Generate_Statement; - Chap9.Translate_Block_Declarations (Bod, Bod); + procedure Translate_Case_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Alt : Iir; + Bod : Iir; + Mark : Id_Mark_Type; + Num : Int32; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - Pop_Instance_Factory (Info.Block_Scope'Access); + Translate_If_Case_Generate_Statement (Stmt); - Pop_Identifier_Prefix (Mark2); - Clause := Get_Generate_Else_Clause (Clause); - Num := Num + 1; + -- Translate generate statement body. + Num := 0; + Alt := Get_Case_Statement_Alternative_Chain (Stmt); + while Alt /= Null_Iir loop + if not Get_Same_Alternative_Flag (Alt) then + Bod := Get_Associated_Block (Alt); + Translate_If_Case_Generate_Statement_Body (Bod, Num, Origin); + Num := Num + 1; + end if; + Alt := Get_Chain (Alt); end loop; Pop_Identifier_Prefix (Mark); - end Translate_If_Generate_Statement; + end Translate_Case_Generate_Statement; procedure Translate_For_Generate_Statement (Stmt : Iir; Origin : Iir) is @@ -835,6 +874,8 @@ package body Trans.Chap9 is Translate_For_Generate_Statement (El, Origin); when Iir_Kind_If_Generate_Statement => Translate_If_Generate_Statement (El, Origin); + when Iir_Kind_Case_Generate_Statement => + Translate_Case_Generate_Statement (El, Origin); when others => Error_Kind ("translate_block_declarations", El); end case; @@ -1012,6 +1053,25 @@ package body Trans.Chap9 is Clause := Get_Generate_Else_Clause (Clause); end loop; end; + when Iir_Kind_Case_Generate_Statement => + declare + Alt : Iir; + Bod : Iir; + Mark2 : Id_Mark_Type; + begin + Alt := Get_Case_Statement_Alternative_Chain (Stmt); + while Alt /= Null_Iir loop + if not Get_Same_Alternative_Flag (Alt) then + Bod := Get_Associated_Block (Alt); + Push_Identifier_Prefix + (Mark2, Get_Alternative_Label (Bod)); + Translate_Generate_Statement_Body_Subprograms + (Bod, Base_Info); + Pop_Identifier_Prefix (Mark2); + end if; + Alt := Get_Chain (Alt); + end loop; + end; when others => Error_Kind ("translate_block_subprograms", Stmt); end case; @@ -1687,15 +1747,18 @@ package body Trans.Chap9 is end; end Translate_Entity_Instantiation; - procedure Elab_Decl_If_Generate_Statement - (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) + procedure Elab_Decl_If_Case_Generate_Statement + (Stmt : Iir; Parent : Iir; Base_Block : Iir) is + Kind : constant Iir_Kinds_If_Case_Generate_Statement := Get_Kind (Stmt); Parent_Info : constant Block_Info_Acc := Get_Info (Parent); -- Used to get Block_Parent_Field, set in the first generate statement -- body. Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt); + Label : O_Snode; + -- Set the instance field in the parent. procedure Set_Parent_Field (Val : O_Enode; Num : Nat32) is @@ -1710,21 +1773,13 @@ package body Trans.Chap9 is New_Assign_Stmt (V, New_Lit (New_Index_Lit (Unsigned_64 (Num)))); end Set_Parent_Field; - procedure Elab_If_Clause (Clause : Iir) + procedure Elab_Decl_If_Case_Generate_Body (Bod : 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, @@ -1741,31 +1796,186 @@ package body Trans.Chap9 is New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field), Get_Instance_Access (Base_Block)); - -- Elaborate 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; + end Elab_Decl_If_Case_Generate_Body; begin - Elab_If_Clause (Stmt); - end Elab_Decl_If_Generate_Statement; + Start_Loop_Stmt (Label); - procedure Elab_Stmt_If_Generate_Statement - (Stmt : Iir_Generate_Statement; Parent : Iir) + case Kind is + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + Condition : Iir; + Blk : O_If_Block; + Num : Nat32; + begin + Clause := Stmt; + Num := 0; + loop + Condition := Get_Condition (Clause); + Open_Temp; + + if Condition /= Null_Iir then + Start_If_Stmt + (Blk, Chap7.Translate_Expression (Condition)); + end if; + + Open_Temp; + Elab_Decl_If_Case_Generate_Body + (Get_Generate_Statement_Body (Clause)); + Close_Temp; + + Num := Num + 1; + + New_Exit_Stmt (Label); + + if Condition /= Null_Iir then + Finish_If_Stmt (Blk); + end if; + + Close_Temp; + + exit when Condition = Null_Iir; + + Clause := Get_Generate_Else_Clause (Clause); + if Clause = Null_Iir then + -- No block. + Set_Parent_Field + (New_Lit (New_Null_Access (Ghdl_Ptr_Type)), Num); + New_Exit_Stmt (Label); + exit; + end if; + end loop; + end; + when Iir_Kind_Case_Generate_Statement => + -- FIXME: handle one-dimensional expressions. + declare + Expr : constant Iir := Get_Expression (Stmt); + Expr_Type : constant Iir := Get_Type (Expr); + Base_Type : constant Iir := Get_Base_Type (Expr_Type); + Tinfo : constant Type_Info_Acc := Get_Info (Base_Type); + E : O_Dnode; + Alt : Iir; + Cur_Alt : Iir; + Cond : O_Enode; + Sub_Cond : O_Enode; + Var_Rng : O_Dnode; + Rng : Mnode; + C1, C2 : O_Enode; + Blk : O_If_Block; + begin + Open_Temp; + Alt := Get_Case_Statement_Alternative_Chain (Stmt); + E := Create_Temp_Init + (Tinfo.Ortho_Type (Mode_Value), + Chap7.Translate_Expression (Expr, Base_Type)); + + loop + Open_Temp; + + Cur_Alt := Alt; + Cond := O_Enode_Null; + loop + case Get_Kind (Alt) is + when Iir_Kind_Choice_By_Others => + pragma Assert (Cond = O_Enode_Null); + pragma Assert (Get_Chain (Alt) = Null_Iir); + Sub_Cond := O_Enode_Null; + when Iir_Kind_Choice_By_Expression => + Sub_Cond := New_Compare_Op + (ON_Eq, + New_Obj_Value (E), + Chap7.Translate_Expression + (Get_Choice_Expression (Alt), Base_Type), + Ghdl_Bool_Type); + when Iir_Kind_Choice_By_Range => + Var_Rng := Create_Temp (Tinfo.T.Range_Type); + Rng := Dv2M (Var_Rng, Tinfo, Mode_Value, + Tinfo.T.Range_Type, + Tinfo.T.Range_Ptr_Type); + Chap7.Translate_Discrete_Range + (Rng, Get_Choice_Range (Alt)); + C1 := New_Dyadic_Op + (ON_And, + New_Compare_Op + (ON_Eq, + M2E (Chap3.Range_To_Dir (Rng)), + New_Lit (Ghdl_Dir_To_Node), + Ghdl_Bool_Type), + New_Dyadic_Op + (ON_And, + New_Compare_Op + (ON_Ge, + New_Obj_Value (E), + M2E (Chap3.Range_To_Left (Rng)), + Ghdl_Bool_Type), + New_Compare_Op + (ON_Le, + New_Obj_Value (E), + M2E (Chap3.Range_To_Right (Rng)), + Ghdl_Bool_Type))); + C2 := New_Dyadic_Op + (ON_And, + New_Compare_Op + (ON_Eq, + M2E (Chap3.Range_To_Dir (Rng)), + New_Lit (Ghdl_Dir_Downto_Node), + Ghdl_Bool_Type), + New_Dyadic_Op + (ON_And, + New_Compare_Op + (ON_Le, + New_Obj_Value (E), + M2E (Chap3.Range_To_Left (Rng)), + Ghdl_Bool_Type), + New_Compare_Op + (ON_Ge, + New_Obj_Value (E), + M2E (Chap3.Range_To_Right (Rng)), + Ghdl_Bool_Type))); + Sub_Cond := New_Dyadic_Op (ON_Or, C1, C2); + when others => + Error_Kind + ("Elab_Decl_If_Case_Generate_Statement", Alt); + end case; + if Cond = O_Enode_Null then + Cond := Sub_Cond; + else + Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond); + end if; + Alt := Get_Chain (Alt); + exit when Alt = Null_Iir; + exit when not Get_Same_Alternative_Flag (Alt); + end loop; + + if Cond /= O_Enode_Null then + Start_If_Stmt (Blk, Cond); + end if; + + Open_Temp; + Elab_Decl_If_Case_Generate_Body + (Get_Associated_Block (Cur_Alt)); + Close_Temp; + + New_Exit_Stmt (Label); + + if Cond /= O_Enode_Null then + Finish_If_Stmt (Blk); + end if; + + Close_Temp; + exit when Alt = Null_Iir; + end loop; + Close_Temp; + end; + end case; + Finish_Loop_Stmt (Label); + end Elab_Decl_If_Case_Generate_Statement; + + procedure Elab_Stmt_If_Case_Generate_Statement (Stmt : Iir; Parent : Iir) is Parent_Info : constant Block_Info_Acc := Get_Info (Parent); @@ -1774,46 +1984,68 @@ package body Trans.Chap9 is Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt); Case_Blk : O_Case_Block; - Clause : Iir; - Var : O_Dnode; + + procedure Elab_Stmt_If_Case_Generate_Statement_Body (Bod : Iir) + is + Info : constant Block_Info_Acc := Get_Info (Bod); + Var : O_Dnode; + begin + Start_Choice (Case_Blk); + New_Expr_Choice + (Case_Blk, New_Index_Lit (Unsigned_64 (Info.Block_Id))); + Finish_Choice (Case_Blk); + + Open_Temp; + Var := Create_Temp_Init + (Info.Block_Decls_Ptr_Type, + New_Convert_Ov + (New_Value (New_Selected_Element + (Get_Instance_Ref (Parent_Info.Block_Scope), + Stmt_Info.Generate_Parent_Field)), + Info.Block_Decls_Ptr_Type)); + + Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); + Elab_Block_Statements (Bod, Bod); + Clear_Scope (Info.Block_Scope); + Close_Temp; + end Elab_Stmt_If_Case_Generate_Statement_Body; begin Start_Case_Stmt (Case_Blk, New_Value (New_Selected_Element (Get_Instance_Ref (Parent_Info.Block_Scope), Stmt_Info.Generate_Body_Id))); - Clause := Stmt; - while Clause /= Null_Iir loop - declare - Bod : constant Iir := Get_Generate_Statement_Body (Clause); - Info : constant Block_Info_Acc := Get_Info (Bod); - begin - Start_Choice (Case_Blk); - New_Expr_Choice - (Case_Blk, New_Index_Lit (Unsigned_64 (Info.Block_Id))); - Finish_Choice (Case_Blk); - - Open_Temp; - Var := Create_Temp_Init - (Info.Block_Decls_Ptr_Type, - New_Convert_Ov - (New_Value (New_Selected_Element - (Get_Instance_Ref (Parent_Info.Block_Scope), - Stmt_Info.Generate_Parent_Field)), - Info.Block_Decls_Ptr_Type)); - - Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Elab_Block_Statements (Bod, Bod); - Clear_Scope (Info.Block_Scope); - Close_Temp; - end; - Clause := Get_Generate_Else_Clause (Clause); - end loop; + case Iir_Kinds_If_Case_Generate_Statement (Get_Kind (Stmt)) is + when Iir_Kind_If_Generate_Statement => + declare + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Elab_Stmt_If_Case_Generate_Statement_Body + (Get_Generate_Statement_Body (Clause)); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end; + when Iir_Kind_Case_Generate_Statement => + declare + Alt : Iir; + begin + Alt := Get_Case_Statement_Alternative_Chain (Stmt); + while Alt /= Null_Iir loop + if not Get_Same_Alternative_Flag (Alt) then + Elab_Stmt_If_Case_Generate_Statement_Body + (Get_Associated_Block (Alt)); + end if; + Alt := Get_Chain (Alt); + end loop; + end; + end case; Start_Choice (Case_Blk); New_Default_Choice (Case_Blk); Finish_Choice (Case_Blk); Finish_Case_Stmt (Case_Blk); - end Elab_Stmt_If_Generate_Statement; + end Elab_Stmt_If_Case_Generate_Statement; procedure Elab_Decl_For_Generate_Statement (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) @@ -2266,12 +2498,14 @@ package body Trans.Chap9 is Elab_Block_Declarations (Stmt, Base_Block); Pop_Identifier_Prefix (Mark); end; - when Iir_Kind_If_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_Case_Generate_Statement => declare Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - Elab_Decl_If_Generate_Statement (Stmt, Block, Base_Block); + Elab_Decl_If_Case_Generate_Statement + (Stmt, Block, Base_Block); Pop_Identifier_Prefix (Mark); end; when Iir_Kind_For_Generate_Statement => @@ -2318,12 +2552,13 @@ package body Trans.Chap9 is Elab_Block_Statements (Stmt, Base_Block); Pop_Identifier_Prefix (Mark); end; - when Iir_Kind_If_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_Case_Generate_Statement => declare Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - Elab_Stmt_If_Generate_Statement (Stmt, Block); + Elab_Stmt_If_Case_Generate_Statement (Stmt, Block); Pop_Identifier_Prefix (Mark); end; when Iir_Kind_For_Generate_Statement => -- cgit v1.2.3