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 | |
| parent | 4e27c73749284b46b899851f3b1ef00fe5187b47 (diff) | |
| download | ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.gz ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.bz2 ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.zip | |
Initial rework for vhdl 2008 generate statements.
| -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)); | 
