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-chap1.adb | 82 +++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 40 deletions(-) (limited to 'src/vhdl/translate/trans-chap1.adb') diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index c54c6aa13..3bff1a42e 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -777,7 +777,7 @@ package body Trans.Chap1 is end case; end Translate_For_Generate_Block_Configuration_Calls; - procedure Translate_If_Generate_Block_Configuration_Calls + procedure Translate_If_Case_Generate_Block_Configuration_Calls (Block_Config : Iir_Block_Configuration; Parent_Info : Block_Info_Acc) is @@ -815,13 +815,52 @@ package body Trans.Chap1 is Close_Temp; Finish_If_Stmt (If_Blk); - end Translate_If_Generate_Block_Configuration_Calls; + end Translate_If_Case_Generate_Block_Configuration_Calls; procedure Translate_Block_Configuration_Calls (Block_Config : Iir_Block_Configuration; Base_Block : Iir; Base_Info : Block_Info_Acc) is + procedure Translate_Block_Block_Configuration_Calls (Item : Iir) + is + Block : Iir; + begin + Block := Get_Block_Specification (Item); + 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 + | Iir_Kind_Parenthesis_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 + (Item, Base_Block, Get_Info (Block)); + when Iir_Kind_Generate_Statement_Body => + case Get_Kind (Get_Parent (Block)) is + when Iir_Kind_If_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause + | Iir_Kind_Case_Generate_Statement => -- FIXME + Translate_If_Case_Generate_Block_Configuration_Calls + (Item, Base_Info); + when Iir_Kind_For_Generate_Statement => + Translate_For_Generate_Block_Configuration_Calls + (Item, 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 Translate_Block_Block_Configuration_Calls; + El : Iir; begin El := Get_Configuration_Item_Chain (Block_Config); @@ -832,44 +871,7 @@ package body Trans.Chap1 is Translate_Component_Configuration_Call (El, Base_Block, Base_Info); when Iir_Kind_Block_Configuration => - declare - Block : Iir; - begin - 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 - | Iir_Kind_Parenthesis_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 - | Iir_Kind_If_Generate_Else_Clause => - 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; + Translate_Block_Block_Configuration_Calls (El); when others => Error_Kind ("translate_block_configuration_calls(2)", El); end case; -- cgit v1.2.3