vhdl08: block configuration for if-generate statements.

7 files changed, 177 insertions, 62 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index f6d106182..c4fd69969 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -2470,6 +2470,11 @@ 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_Parenthesis_Name =>
+                     Sub_Blk := Get_Named_Entity (Sub_Blk);
+                     Set_Prev_Block_Configuration
+                       (El, Get_Generate_Block_Configuration (Sub_Blk));
+                     Set_Generate_Block_Configuration (Sub_Blk, El);
                   when Iir_Kind_Generate_Statement_Body =>
                      Set_Generate_Block_Configuration (Sub_Blk, El);
                   when others =>
@@ -2547,13 +2552,19 @@ package body Canon is
                end if;
             when Iir_Kind_If_Generate_Statement =>
                declare
-                  Bod : constant Iir := Get_Generate_Statement_Body (El);
-                  Blk_Config : constant Iir_Block_Configuration :=
-                    Get_Generate_Block_Configuration (Bod);
+                  Clause : Iir;
+                  Bod : Iir;
+                  Blk_Config : Iir_Block_Configuration;
                begin
-                  if Blk_Config = Null_Iir then
-                     Create_Default_Block_Configuration (Bod);
-                  end if;
+                  Clause := El;
+                  while Clause /= Null_Iir loop
+                     Bod := Get_Generate_Statement_Body (Clause);
+                     Blk_Config := Get_Generate_Block_Configuration (Bod);
+                     if Blk_Config = Null_Iir then
+                        Create_Default_Block_Configuration (Bod);
+                     end if;
+                     Clause := Get_Generate_Else_Clause (Clause);
+                  end loop;
                end;
             when Iir_Kind_For_Generate_Statement =>
                declare
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index db100e438..b492a9139 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -834,6 +834,9 @@ package body Iirs_Utils is
             return Get_Named_Entity (Get_Prefix (Block_Spec));
          when Iir_Kind_Simple_Name =>
             return Get_Named_Entity (Block_Spec);
+         when Iir_Kind_Parenthesis_Name =>
+            --  An alternative label.
+            return Get_Named_Entity (Block_Spec);
          when others =>
             Error_Kind ("get_block_from_block_specification", Block_Spec);
             return Null_Iir;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index a865da63d..e9f7c9909 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -6166,9 +6166,7 @@ package body Parse is
       case Current_Token is
          when Tok_Elsif
            | Tok_Else =>
-            if Get_Kind (Parent) = Iir_Kind_If_Generate_Statement
-              or else Get_Kind (Parent) = Iir_Kind_If_Generate_Else_Clause
-            then
+            if Get_Kind (Parent) = Iir_Kind_If_Generate_Statement then
                return Bod;
             end if;
          when others =>
@@ -6309,6 +6307,11 @@ package body Parse is
          Alt_Label := Null_Identifier;
          if Current_Token = Tok_Colon then
             if Get_Kind (Cond) = Iir_Kind_Simple_Name then
+               if Vhdl_Std < Vhdl_08 then
+                  Error_Msg_Parse
+                    ("alternative label not allowed before vhdl08");
+               end if;
+
                --  In fact the parsed condition was an alternate label.
                Alt_Label := Get_Identifier (Cond);
                Free_Iir (Cond);
@@ -6330,7 +6333,7 @@ package body Parse is
          Scan;
 
          Set_Generate_Statement_Body
-           (Clause, Parse_Generate_Statement_Body (Clause, Alt_Label));
+           (Clause, Parse_Generate_Statement_Body (Res, Alt_Label));
 
          if Last /= Null_Iir then
             Set_Generate_Else_Clause (Last, Clause);
@@ -6341,6 +6344,10 @@ package body Parse is
       end loop;
 
       if Current_Token = Tok_Else then
+         if Vhdl_Std < Vhdl_08 then
+            Error_Msg_Parse ("else generate not allowed before vhdl08");
+         end if;
+
          Clause := Create_Iir (Iir_Kind_If_Generate_Else_Clause);
          Set_Location (Clause);
 
@@ -6366,7 +6373,7 @@ package body Parse is
          Scan;
 
          Set_Generate_Statement_Body
-           (Clause, Parse_Generate_Statement_Body (Clause, Alt_Label));
+           (Clause, Parse_Generate_Statement_Body (Res, Alt_Label));
 
          Set_Generate_Else_Clause (Last, Clause);
       end if;
@@ -7005,14 +7012,14 @@ package body Parse is
    --  precond : FOR
    --  postcond: ';'
    --
-   --  [ §1.3.1 ]
+   --  [ 1.3.1 ]
    --  block_configuration ::=
    --      FOR block_specification
    --          { use_clause }
    --          { configuration_item }
    --      END FOR ;
    --
-   --  [ §1.3.1 ]
+   --  [ 1.3.1 ]
    --  block_specification ::=
    --      ARCHITECTURE_name
    --    | BLOCK_STATEMENT_label
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 2ecee9321..2028ebb01 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -681,6 +681,9 @@ package body Sem is
       Prev : Iir_Block_Configuration;
       Block : Iir;
       Res : Iir;
+      Assoc : Iir;
+      Clause : Iir;
+      Gen_Spec : Iir;
    begin
       Block_Spec := Get_Block_Specification (Block_Conf);
       case Get_Kind (Block_Spec) is
@@ -694,7 +697,7 @@ package body Sem is
             return Null_Iir;
       end case;
 
-      --  Analyze the label.
+      --  Analyze the label and generate specification.
       Block_Name := Sem_Denoting_Name (Block_Name);
       Block := Get_Named_Entity (Block_Name);
       case Get_Kind (Block) is
@@ -703,39 +706,84 @@ package body Sem is
                Error_Msg_Sem ("label does not denote a generate statement",
                               Block_Spec);
             end if;
+            Set_Block_Specification (Block_Conf, Block_Name);
             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;
 
+         when Iir_Kind_For_Generate_Statement =>
             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);
+            Prev := Get_Generate_Block_Configuration (Res);
+
+            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;
+
+         when Iir_Kind_If_Generate_Statement =>
+            case Get_Kind (Block_Spec) is
+               when Iir_Kind_Simple_Name =>
+                  --  LRM08 3.4.2 Block configuration
+                  --  If no generate specification appears in such a block
+                  --  configuration, then it applies to exactly one of the
+                  --  following sets of blocks:
+                  --  [...]
+                  --  - The implicit block generated by the corresponding
+                  --    generate statement, if and only if the corresponding
+                  --    generate is an if generate statement and if the first
+                  --    condition after IF evaluates to TRUE.
+                  Res := Get_Generate_Statement_Body (Block);
+                  Set_Block_Specification (Block_Conf, Block_Name);
+               when Iir_Kind_Parenthesis_Name =>
+                  if Vhdl_Std < Vhdl_08 then
+                     Error_Msg_Sem ("alternative label only allowed by vhdl08",
+                                    Block_Spec);
+                     return Null_Iir;
+                  end if;
+                  Assoc := Get_Association_Chain (Block_Spec);
+                  pragma Assert
+                    (Get_Kind (Assoc)
+                       = Iir_Kind_Association_Element_By_Expression);
+                  Gen_Spec := Get_Actual (Assoc);
+                  if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
+                     Error_Msg_Sem
+                       ("alternative label expected for if-generate",
+                        Gen_Spec);
+                     return Null_Iir;
+                  end if;
+                  --  Search label.
+                  Clause := Block;
+                  while Clause /= Null_Iir loop
+                     Res := Get_Generate_Statement_Body (Clause);
+                     exit when Get_Alternative_Label (Res)
+                       = Get_Identifier (Gen_Spec);
+                     Clause := Get_Generate_Else_Clause (Clause);
+                  end loop;
+                  if Clause = Null_Iir then
+                     Error_Msg_Sem
+                       ("alternative label " & Image_Identifier (Gen_Spec)
+                          & " not found for if-generate", Gen_Spec);
+                     return Null_Iir;
+                  end if;
+                  Set_Named_Entity (Block_Spec, Res);
+                  Set_Prefix (Block_Spec, Block_Name);
+                  Set_Block_Specification (Block_Conf, Block_Spec);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            Set_Named_Entity (Block_Name, Res);
+            Prev := Get_Generate_Block_Configuration (Res);
          when others =>
             Error_Msg_Sem ("block statement label expected", Block_Conf);
             return Null_Iir;
@@ -754,16 +802,43 @@ package body Sem is
          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);
+      case Get_Kind (Block) is
+         when Iir_Kind_Block_Statement =>
+            --  LRM93 1.3
+            --  It is an error if, in a given block configuration, more than
+            --  one configuration item is defined for the same block [or
+            --  component instance].
+            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 (Res, Block_Conf);
+
+         when Iir_Kind_If_Generate_Statement =>
+            --  LRM93 1.3
+            --  It is an error if, in a given block configuration, more than
+            --  one configuration item is defined for the same block [or
+            --  component instance].
+            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_Generate_Block_Configuration (Res, Block_Conf);
+
+         when Iir_Kind_For_Generate_Statement =>
+            --  LRM93 1.3
+            --  For any name that is the label of a generate statement
+            --  immediately wihin a given block, one or more corresponding
+            --  block configuration may appear as configuration items
+            --  immediately within a block configuration corresponding to the
+            --  given block.
+            --  GHDL: keep them in a linked list, but don't try to detect
+            --  duplicate as values may not be static.  FIXME: try for
+            --  static values only ?
+            Set_Prev_Block_Configuration (Block_Conf, Prev);
+            Set_Generate_Block_Configuration (Res, Block_Conf);
          when others =>
             raise Internal_Error;
       end case;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index da7b1b2be..1332ff979 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1495,9 +1495,9 @@ package body Sem_Decls is
       end if;
    end Sem_Subtype_Declaration;
 
-   --  If DECL is a constant declaration, and there is already a constant
-   --  declaration in the current scope with the same name, then return it.
-   --  Otherwise, return NULL.
+   --  If DECL is a constant declaration, and there is already a incomplete
+   --  constant declaration in the current scope with the same name, then
+   --  return it. Otherwise, return NULL.
    function Get_Deferred_Constant (Decl : Iir) return Iir
    is
       Deferred_Const : Iir;
@@ -1523,6 +1523,10 @@ package body Sem_Decls is
       if Get_Kind (Deferred_Const) /= Iir_Kind_Constant_Declaration then
          return Null_Iir;
       end if;
+      if not Get_Deferred_Declaration_Flag (Deferred_Const) then
+         --  Just a 'normal' duplicate declaration
+         return Null_Iir;
+      end if;
       --  LRM93 4.3.1.1
       --  The corresponding full constant declaration, which defines the value
       --  of the constant, must appear in the body of the package.
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index ac153f2e6..8e9f6b2ed 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -1511,9 +1511,7 @@ package body Sem_Stmts is
       Close_Declarative_Region;
    end Sem_Block_Statement;
 
-   procedure Sem_Generate_Statement_Body (Parent : Iir)
-   is
-      Bod : constant Iir := Get_Generate_Statement_Body (Parent);
+   procedure Sem_Generate_Statement_Body (Bod : Iir) is
    begin
       Sem_Block (Bod, True); -- Flags.Vhdl_Std /= Vhdl_87);
    end Sem_Generate_Statement_Body;
@@ -1542,7 +1540,7 @@ package body Sem_Stmts is
       end if;
 
       --  In the same declarative region.
-      Sem_Generate_Statement_Body (Stmt);
+      Sem_Generate_Statement_Body (Get_Generate_Statement_Body (Stmt));
 
       Close_Declarative_Region;
    end Sem_For_Generate_Statement;
@@ -1550,7 +1548,9 @@ package body Sem_Stmts is
    procedure Sem_If_Generate_Statement (Stmt : Iir)
    is
       Clause : Iir;
+      Bod : Iir;
       Condition : Iir;
+      Alt_Label : Name_Id;
    begin
       --  LRM93 10.1 Declarative region.
       --  12. A generate statement.
@@ -1579,8 +1579,21 @@ package body Sem_Stmts is
             null;
          end if;
 
-         --  In the same declarative region.
-         Sem_Generate_Statement_Body (Clause);
+         Bod := Get_Generate_Statement_Body (Clause);
+         Alt_Label := Get_Alternative_Label (Bod);
+         if Alt_Label /= Null_Identifier then
+            --  Declare label.  This doesn't appear in the LRM (bug ?), but
+            --  used here to detect duplicated labels.
+            Sem_Scopes.Add_Name (Bod);
+            Xref_Decl (Bod);
+         end if;
+
+         --  Contrary to the LRM, a new declarative region is declared.  This
+         --  is required so that declarations in a generate statement body are
+         --  not in the scope of the following generate bodies.
+         Open_Declarative_Region;
+         Sem_Generate_Statement_Body (Bod);
+         Close_Declarative_Region;
 
          Clause := Get_Generate_Else_Clause (Clause);
       end loop;
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 1f0e7d3e7..5911e954f 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -785,7 +785,8 @@ package body Trans.Chap1 is
                      when Iir_Kind_Indexed_Name
                        | Iir_Kind_Slice_Name =>
                         Block := Get_Named_Entity (Get_Prefix (Block));
-                     when Iir_Kinds_Denoting_Name =>
+                     when Iir_Kinds_Denoting_Name
+                       | Iir_Kind_Parenthesis_Name =>
                         Block := Get_Named_Entity (Block);
                      when others =>
                         null;
@@ -797,7 +798,8 @@ package body Trans.Chap1 is
                           (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 =>
+                           when Iir_Kind_If_Generate_Statement
+                             | Iir_Kind_If_Generate_Else_Clause =>
                               Translate_If_Generate_Block_Configuration_Calls
                                 (El, Base_Info);
                            when Iir_Kind_For_Generate_Statement =>