vhdl08: block configuration for if-generate statements.

1 files changed, 113 insertions, 38 deletions

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;