vhdl08: add support of case-generate statement

7 files changed, 422 insertions, 154 deletions

diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index c54c6aa13..3bff1a42e 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -777,7 +777,7 @@ package body Trans.Chap1 is
       end case;
    end Translate_For_Generate_Block_Configuration_Calls;
 
-   procedure Translate_If_Generate_Block_Configuration_Calls
+   procedure Translate_If_Case_Generate_Block_Configuration_Calls
      (Block_Config : Iir_Block_Configuration;
       Parent_Info  : Block_Info_Acc)
    is
@@ -815,13 +815,52 @@ package body Trans.Chap1 is
       Close_Temp;
 
       Finish_If_Stmt (If_Blk);
-   end Translate_If_Generate_Block_Configuration_Calls;
+   end Translate_If_Case_Generate_Block_Configuration_Calls;
 
    procedure Translate_Block_Configuration_Calls
      (Block_Config : Iir_Block_Configuration;
       Base_Block   : Iir;
       Base_Info    : Block_Info_Acc)
    is
+      procedure Translate_Block_Block_Configuration_Calls (Item : Iir)
+      is
+         Block : Iir;
+      begin
+         Block := Get_Block_Specification (Item);
+         case Get_Kind (Block) is
+            when Iir_Kind_Indexed_Name
+              | Iir_Kind_Slice_Name =>
+               Block := Get_Named_Entity (Get_Prefix (Block));
+            when Iir_Kinds_Denoting_Name
+              | Iir_Kind_Parenthesis_Name =>
+               Block := Get_Named_Entity (Block);
+            when others =>
+               null;
+         end case;
+
+         case Get_Kind (Block) is
+            when Iir_Kind_Block_Statement =>
+               Translate_Block_Configuration_Calls
+                 (Item, Base_Block, Get_Info (Block));
+            when Iir_Kind_Generate_Statement_Body =>
+               case Get_Kind (Get_Parent (Block)) is
+                  when Iir_Kind_If_Generate_Statement
+                    | Iir_Kind_If_Generate_Else_Clause
+                    | Iir_Kind_Case_Generate_Statement => --  FIXME
+                     Translate_If_Case_Generate_Block_Configuration_Calls
+                       (Item, Base_Info);
+                  when Iir_Kind_For_Generate_Statement =>
+                     Translate_For_Generate_Block_Configuration_Calls
+                       (Item, Base_Info);
+                  when others =>
+                     Error_Kind ("translate_block_configuration_calls(3)",
+                                 Get_Parent (Block));
+               end case;
+            when others =>
+               Error_Kind ("translate_block_configuration_calls(4)", Block);
+         end case;
+      end Translate_Block_Block_Configuration_Calls;
+
       El : Iir;
    begin
       El := Get_Configuration_Item_Chain (Block_Config);
@@ -832,44 +871,7 @@ package body Trans.Chap1 is
                Translate_Component_Configuration_Call
                  (El, Base_Block, Base_Info);
             when Iir_Kind_Block_Configuration =>
-               declare
-                  Block : Iir;
-               begin
-                  Block := Get_Block_Specification (El);
-                  case Get_Kind (Block) is
-                     when Iir_Kind_Indexed_Name
-                       | Iir_Kind_Slice_Name =>
-                        Block := Get_Named_Entity (Get_Prefix (Block));
-                     when Iir_Kinds_Denoting_Name
-                       | Iir_Kind_Parenthesis_Name =>
-                        Block := Get_Named_Entity (Block);
-                     when others =>
-                        null;
-                  end case;
-
-                  case Get_Kind (Block) is
-                     when Iir_Kind_Block_Statement =>
-                        Translate_Block_Configuration_Calls
-                          (El, Base_Block, Get_Info (Block));
-                     when Iir_Kind_Generate_Statement_Body =>
-                        case Get_Kind (Get_Parent (Block)) is
-                           when Iir_Kind_If_Generate_Statement
-                             | Iir_Kind_If_Generate_Else_Clause =>
-                              Translate_If_Generate_Block_Configuration_Calls
-                                (El, Base_Info);
-                           when Iir_Kind_For_Generate_Statement =>
-                              Translate_For_Generate_Block_Configuration_Calls
-                                (El, Base_Info);
-                           when others =>
-                              Error_Kind
-                                ("translate_block_configuration_calls(3)",
-                                 Get_Parent (Block));
-                        end case;
-                     when others =>
-                        Error_Kind
-                          ("translate_block_configuration_calls(4)", Block);
-                  end case;
-               end;
+               Translate_Block_Block_Configuration_Calls (El);
             when others =>
                Error_Kind ("translate_block_configuration_calls(2)", El);
          end case;
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index a01c4c088..e39d42ed6 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -306,8 +306,7 @@ package body Trans.Chap3 is
       end if;
    end Get_Type_Precision;
 
-   procedure Translate_Integer_Type
-     (Def : Iir_Integer_Type_Definition)
+   procedure Translate_Integer_Type (Def : Iir_Integer_Type_Definition)
    is
       Info : Type_Info_Acc;
    begin
@@ -2284,9 +2283,8 @@ package body Trans.Chap3 is
 
    function Range_To_Dir (R : Mnode) return Mnode
    is
-      Tinfo : Type_Info_Acc;
+      Tinfo : constant Type_Info_Acc := Get_Type_Info (R);
    begin
-      Tinfo := Get_Type_Info (R);
       return Lv2M (New_Selected_Element (M2Lv (R),
                    Tinfo.T.Range_Dir),
                    Tinfo,
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 6b375d71c..8706dd3b3 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4292,7 +4292,7 @@ package body Trans.Chap7 is
             | Iir_Kind_Range_Expression =>
             Translate_Range (Res, Arange, Get_Type (Arange));
          when others =>
-            Error_Kind ("translate_discrete_range_ptr", Arange);
+            Error_Kind ("translate_discrete_range", Arange);
       end case;
    end Translate_Discrete_Range;
 
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index c2dbf4ed7..c8f270174 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -1158,8 +1158,7 @@ package body Trans.Chap8 is
          if not Get_Same_Alternative_Flag (Choice) then
             Choice_State := Choice_State + 1;
             State_Start (Choice_State);
-            Translate_Statements_Chain
-              (Get_Associated_Chain (Choice));
+            Translate_Statements_Chain (Get_Associated_Chain (Choice));
             State_Jump (Next_State);
          end if;
          Choice := Get_Chain (Choice);
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 9500bbd88..9b453bf4c 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -662,55 +662,94 @@ package body Trans.Chap9 is
       end case;
    end Translate_Psl_Directive_Statement;
 
-   procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir)
+   procedure Translate_If_Case_Generate_Statement_Body
+     (Bod : Iir; Num : Int32; Origin : Iir)
    is
-      Clause : Iir;
-      Bod : Iir;
       Info : Block_Info_Acc;
-      Stmt_Info : Ortho_Info_Acc;
-      Mark : Id_Mark_Type;
       Mark2 : Id_Mark_Type;
-      Num : Int32;
    begin
-      Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+      Info := Add_Info (Bod, Kind_Block);
+
+      Push_Identifier_Prefix (Mark2, Get_Alternative_Label (Bod));
 
+      Chap1.Start_Block_Decl (Bod);
+      Push_Instance_Factory (Info.Block_Scope'Access);
+
+      --  Add a parent field in the current instance.
+      Info.Block_Origin_Field := Add_Instance_Factory_Field
+        (Get_Identifier ("ORIGIN"),
+         Get_Info (Origin).Block_Decls_Ptr_Type);
+
+      Info.Block_Id := Num;
+
+      Chap9.Translate_Block_Declarations (Bod, Bod);
+
+      Pop_Instance_Factory (Info.Block_Scope'Access);
+
+      Pop_Identifier_Prefix (Mark2);
+   end Translate_If_Case_Generate_Statement_Body;
+
+   procedure Translate_If_Case_Generate_Statement (Stmt : Iir)
+   is
+      Stmt_Info : Ortho_Info_Acc;
+   begin
       Stmt_Info := Add_Info (Stmt, Kind_Generate);
       Stmt_Info.Generate_Parent_Field := Add_Instance_Factory_Field
         (Create_Identifier_Without_Prefix (Stmt), Ghdl_Ptr_Type);
       Stmt_Info.Generate_Body_Id := Add_Instance_Factory_Field
         (Create_Identifier_Without_Prefix (Get_Identifier (Stmt), "_ID"),
          Ghdl_Index_Type);
+   end Translate_If_Case_Generate_Statement;
+
+   procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir)
+   is
+      Clause : Iir;
+      Bod : Iir;
+      Mark : Id_Mark_Type;
+      Num : Int32;
+   begin
+      Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+
+      Translate_If_Case_Generate_Statement (Stmt);
 
       --  Translate generate statement body.
       Num := 0;
       Clause := Stmt;
       while Clause /= Null_Iir loop
          Bod := Get_Generate_Statement_Body (Clause);
-         Info := Add_Info (Bod, Kind_Block);
-
-         Push_Identifier_Prefix (Mark2, Get_Alternative_Label (Bod));
-
-         Chap1.Start_Block_Decl (Bod);
-         Push_Instance_Factory (Info.Block_Scope'Access);
-
-         --  Add a parent field in the current instance.
-         Info.Block_Origin_Field := Add_Instance_Factory_Field
-           (Get_Identifier ("ORIGIN"),
-            Get_Info (Origin).Block_Decls_Ptr_Type);
+         Translate_If_Case_Generate_Statement_Body (Bod, Num, Origin);
+         Clause := Get_Generate_Else_Clause (Clause);
+         Num := Num + 1;
+      end loop;
 
-         Info.Block_Id := Num;
+      Pop_Identifier_Prefix (Mark);
+   end Translate_If_Generate_Statement;
 
-         Chap9.Translate_Block_Declarations (Bod, Bod);
+   procedure Translate_Case_Generate_Statement (Stmt : Iir; Origin : Iir)
+   is
+      Alt : Iir;
+      Bod : Iir;
+      Mark : Id_Mark_Type;
+      Num : Int32;
+   begin
+      Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
 
-         Pop_Instance_Factory (Info.Block_Scope'Access);
+      Translate_If_Case_Generate_Statement (Stmt);
 
-         Pop_Identifier_Prefix (Mark2);
-         Clause := Get_Generate_Else_Clause (Clause);
-         Num := Num + 1;
+      --  Translate generate statement body.
+      Num := 0;
+      Alt := Get_Case_Statement_Alternative_Chain (Stmt);
+      while Alt /= Null_Iir loop
+         if not Get_Same_Alternative_Flag (Alt) then
+            Bod := Get_Associated_Block (Alt);
+            Translate_If_Case_Generate_Statement_Body (Bod, Num, Origin);
+            Num := Num + 1;
+         end if;
+         Alt := Get_Chain (Alt);
       end loop;
 
       Pop_Identifier_Prefix (Mark);
-   end Translate_If_Generate_Statement;
+   end Translate_Case_Generate_Statement;
 
    procedure Translate_For_Generate_Statement (Stmt : Iir; Origin : Iir)
    is
@@ -835,6 +874,8 @@ package body Trans.Chap9 is
                Translate_For_Generate_Statement (El, Origin);
             when Iir_Kind_If_Generate_Statement =>
                Translate_If_Generate_Statement (El, Origin);
+            when Iir_Kind_Case_Generate_Statement =>
+               Translate_Case_Generate_Statement (El, Origin);
             when others =>
                Error_Kind ("translate_block_declarations", El);
          end case;
@@ -1012,6 +1053,25 @@ package body Trans.Chap9 is
                      Clause := Get_Generate_Else_Clause (Clause);
                   end loop;
                end;
+            when Iir_Kind_Case_Generate_Statement =>
+               declare
+                  Alt : Iir;
+                  Bod : Iir;
+                  Mark2 : Id_Mark_Type;
+               begin
+                  Alt := Get_Case_Statement_Alternative_Chain (Stmt);
+                  while Alt /= Null_Iir loop
+                     if not Get_Same_Alternative_Flag (Alt) then
+                        Bod := Get_Associated_Block (Alt);
+                        Push_Identifier_Prefix
+                          (Mark2, Get_Alternative_Label (Bod));
+                        Translate_Generate_Statement_Body_Subprograms
+                          (Bod, Base_Info);
+                        Pop_Identifier_Prefix (Mark2);
+                     end if;
+                     Alt := Get_Chain (Alt);
+                  end loop;
+               end;
             when others =>
                Error_Kind ("translate_block_subprograms", Stmt);
          end case;
@@ -1687,15 +1747,18 @@ package body Trans.Chap9 is
       end;
    end Translate_Entity_Instantiation;
 
-   procedure Elab_Decl_If_Generate_Statement
-     (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
+   procedure Elab_Decl_If_Case_Generate_Statement
+     (Stmt : Iir; Parent : Iir; Base_Block : Iir)
    is
+      Kind : constant Iir_Kinds_If_Case_Generate_Statement := Get_Kind (Stmt);
       Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
 
       --  Used to get Block_Parent_Field, set in the first generate statement
       --  body.
       Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt);
 
+      Label : O_Snode;
+
       --  Set the instance field in the parent.
       procedure Set_Parent_Field (Val : O_Enode; Num : Nat32)
       is
@@ -1710,21 +1773,13 @@ package body Trans.Chap9 is
          New_Assign_Stmt (V, New_Lit (New_Index_Lit (Unsigned_64 (Num))));
       end Set_Parent_Field;
 
-      procedure Elab_If_Clause (Clause : Iir)
+      procedure Elab_Decl_If_Case_Generate_Body (Bod : Iir)
       is
-         Condition   : constant Iir := Get_Condition (Clause);
-         Bod         : constant Iir := Get_Generate_Statement_Body (Clause);
          Info        : constant Block_Info_Acc := Get_Info (Bod);
          Var         : O_Dnode;
-         Blk         : O_If_Block;
-         N_Clause : Iir;
       begin
-         Open_Temp;
-
          Var := Create_Temp (Info.Block_Decls_Ptr_Type);
-         if Condition /= Null_Iir then
-            Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition));
-         end if;
+
          New_Assign_Stmt
            (New_Obj (Var),
             Gen_Alloc (Alloc_System,
@@ -1741,31 +1796,186 @@ package body Trans.Chap9 is
          New_Assign_Stmt
            (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
             Get_Instance_Access (Base_Block));
-         --  Elaborate block
+            --  Elaborate block
          Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
          Elab_Block_Declarations (Bod, Bod);
          Clear_Scope (Info.Block_Scope);
-
-         if Condition /= Null_Iir then
-            New_Else_Stmt (Blk);
-            N_Clause := Get_Generate_Else_Clause (Clause);
-            if N_Clause /= Null_Iir then
-               Elab_If_Clause (N_Clause);
-            else
-               Set_Parent_Field
-                 (New_Lit (New_Null_Access (Ghdl_Ptr_Type)),
-                  Info.Block_Id + 1);
-            end if;
-            Finish_If_Stmt (Blk);
-         end if;
-         Close_Temp;
-      end Elab_If_Clause;
+      end Elab_Decl_If_Case_Generate_Body;
    begin
-      Elab_If_Clause (Stmt);
-   end Elab_Decl_If_Generate_Statement;
+      Start_Loop_Stmt (Label);
 
-   procedure Elab_Stmt_If_Generate_Statement
-     (Stmt : Iir_Generate_Statement; Parent : Iir)
+      case Kind is
+         when Iir_Kind_If_Generate_Statement =>
+            declare
+               Clause    : Iir;
+               Condition : Iir;
+               Blk       : O_If_Block;
+               Num       : Nat32;
+            begin
+               Clause := Stmt;
+               Num := 0;
+               loop
+                  Condition := Get_Condition (Clause);
+                  Open_Temp;
+
+                  if Condition /= Null_Iir then
+                     Start_If_Stmt
+                       (Blk, Chap7.Translate_Expression (Condition));
+                  end if;
+
+                  Open_Temp;
+                  Elab_Decl_If_Case_Generate_Body
+                    (Get_Generate_Statement_Body (Clause));
+                  Close_Temp;
+
+                  Num := Num + 1;
+
+                  New_Exit_Stmt (Label);
+
+                  if Condition /= Null_Iir then
+                     Finish_If_Stmt (Blk);
+                  end if;
+
+                  Close_Temp;
+
+                  exit when Condition = Null_Iir;
+
+                  Clause := Get_Generate_Else_Clause (Clause);
+                  if Clause = Null_Iir then
+                     --  No block.
+                     Set_Parent_Field
+                       (New_Lit (New_Null_Access (Ghdl_Ptr_Type)), Num);
+                     New_Exit_Stmt (Label);
+                     exit;
+                  end if;
+               end loop;
+            end;
+         when Iir_Kind_Case_Generate_Statement =>
+            --  FIXME: handle one-dimensional expressions.
+            declare
+               Expr : constant Iir := Get_Expression (Stmt);
+               Expr_Type : constant Iir := Get_Type (Expr);
+               Base_Type : constant Iir := Get_Base_Type (Expr_Type);
+               Tinfo : constant Type_Info_Acc := Get_Info (Base_Type);
+               E : O_Dnode;
+               Alt : Iir;
+               Cur_Alt : Iir;
+               Cond : O_Enode;
+               Sub_Cond : O_Enode;
+               Var_Rng : O_Dnode;
+               Rng : Mnode;
+               C1, C2 : O_Enode;
+               Blk       : O_If_Block;
+            begin
+               Open_Temp;
+               Alt := Get_Case_Statement_Alternative_Chain (Stmt);
+               E := Create_Temp_Init
+                 (Tinfo.Ortho_Type (Mode_Value),
+                  Chap7.Translate_Expression (Expr, Base_Type));
+
+               loop
+                  Open_Temp;
+
+                  Cur_Alt := Alt;
+                  Cond := O_Enode_Null;
+                  loop
+                     case Get_Kind (Alt) is
+                        when Iir_Kind_Choice_By_Others =>
+                           pragma Assert (Cond = O_Enode_Null);
+                           pragma Assert (Get_Chain (Alt) = Null_Iir);
+                           Sub_Cond := O_Enode_Null;
+                        when Iir_Kind_Choice_By_Expression =>
+                           Sub_Cond := New_Compare_Op
+                             (ON_Eq,
+                              New_Obj_Value (E),
+                              Chap7.Translate_Expression
+                                (Get_Choice_Expression (Alt), Base_Type),
+                              Ghdl_Bool_Type);
+                        when Iir_Kind_Choice_By_Range =>
+                           Var_Rng := Create_Temp (Tinfo.T.Range_Type);
+                           Rng := Dv2M (Var_Rng, Tinfo, Mode_Value,
+                                        Tinfo.T.Range_Type,
+                                        Tinfo.T.Range_Ptr_Type);
+                           Chap7.Translate_Discrete_Range
+                             (Rng, Get_Choice_Range (Alt));
+                           C1 := New_Dyadic_Op
+                             (ON_And,
+                              New_Compare_Op
+                                (ON_Eq,
+                                 M2E (Chap3.Range_To_Dir (Rng)),
+                                 New_Lit (Ghdl_Dir_To_Node),
+                                 Ghdl_Bool_Type),
+                              New_Dyadic_Op
+                                (ON_And,
+                                 New_Compare_Op
+                                   (ON_Ge,
+                                    New_Obj_Value (E),
+                                    M2E (Chap3.Range_To_Left (Rng)),
+                                    Ghdl_Bool_Type),
+                                 New_Compare_Op
+                                   (ON_Le,
+                                    New_Obj_Value (E),
+                                    M2E (Chap3.Range_To_Right (Rng)),
+                                    Ghdl_Bool_Type)));
+                           C2 := New_Dyadic_Op
+                             (ON_And,
+                              New_Compare_Op
+                                (ON_Eq,
+                                 M2E (Chap3.Range_To_Dir (Rng)),
+                                 New_Lit (Ghdl_Dir_Downto_Node),
+                                 Ghdl_Bool_Type),
+                              New_Dyadic_Op
+                                (ON_And,
+                                 New_Compare_Op
+                                   (ON_Le,
+                                    New_Obj_Value (E),
+                                    M2E (Chap3.Range_To_Left (Rng)),
+                                    Ghdl_Bool_Type),
+                                 New_Compare_Op
+                                   (ON_Ge,
+                                    New_Obj_Value (E),
+                                    M2E (Chap3.Range_To_Right (Rng)),
+                                    Ghdl_Bool_Type)));
+                           Sub_Cond := New_Dyadic_Op (ON_Or, C1, C2);
+                        when others =>
+                           Error_Kind
+                             ("Elab_Decl_If_Case_Generate_Statement", Alt);
+                     end case;
+                     if Cond = O_Enode_Null then
+                        Cond := Sub_Cond;
+                     else
+                        Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond);
+                     end if;
+                     Alt := Get_Chain (Alt);
+                     exit when Alt = Null_Iir;
+                     exit when not Get_Same_Alternative_Flag (Alt);
+                  end loop;
+
+                  if Cond /= O_Enode_Null then
+                     Start_If_Stmt (Blk, Cond);
+                  end if;
+
+                  Open_Temp;
+                  Elab_Decl_If_Case_Generate_Body
+                    (Get_Associated_Block (Cur_Alt));
+                  Close_Temp;
+
+                  New_Exit_Stmt (Label);
+
+                  if Cond /= O_Enode_Null then
+                     Finish_If_Stmt (Blk);
+                  end if;
+
+                  Close_Temp;
+                  exit when Alt = Null_Iir;
+               end loop;
+               Close_Temp;
+            end;
+      end case;
+      Finish_Loop_Stmt (Label);
+   end Elab_Decl_If_Case_Generate_Statement;
+
+   procedure Elab_Stmt_If_Case_Generate_Statement (Stmt : Iir; Parent : Iir)
    is
       Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
 
@@ -1774,46 +1984,68 @@ package body Trans.Chap9 is
       Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt);
 
       Case_Blk : O_Case_Block;
-      Clause : Iir;
-      Var : O_Dnode;
+
+      procedure Elab_Stmt_If_Case_Generate_Statement_Body (Bod : Iir)
+      is
+         Info : constant Block_Info_Acc := Get_Info (Bod);
+         Var : O_Dnode;
+      begin
+         Start_Choice (Case_Blk);
+         New_Expr_Choice
+           (Case_Blk, New_Index_Lit (Unsigned_64 (Info.Block_Id)));
+         Finish_Choice (Case_Blk);
+
+         Open_Temp;
+         Var := Create_Temp_Init
+           (Info.Block_Decls_Ptr_Type,
+            New_Convert_Ov
+              (New_Value (New_Selected_Element
+                            (Get_Instance_Ref (Parent_Info.Block_Scope),
+                             Stmt_Info.Generate_Parent_Field)),
+               Info.Block_Decls_Ptr_Type));
+
+         Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
+         Elab_Block_Statements (Bod, Bod);
+         Clear_Scope (Info.Block_Scope);
+         Close_Temp;
+      end Elab_Stmt_If_Case_Generate_Statement_Body;
    begin
       Start_Case_Stmt
         (Case_Blk, New_Value (New_Selected_Element
                                 (Get_Instance_Ref (Parent_Info.Block_Scope),
                                  Stmt_Info.Generate_Body_Id)));
 
-      Clause := Stmt;
-      while Clause /= Null_Iir loop
-         declare
-            Bod  : constant Iir := Get_Generate_Statement_Body (Clause);
-            Info : constant Block_Info_Acc := Get_Info (Bod);
-         begin
-            Start_Choice (Case_Blk);
-            New_Expr_Choice
-              (Case_Blk, New_Index_Lit (Unsigned_64 (Info.Block_Id)));
-            Finish_Choice (Case_Blk);
-
-            Open_Temp;
-            Var := Create_Temp_Init
-              (Info.Block_Decls_Ptr_Type,
-               New_Convert_Ov
-                 (New_Value (New_Selected_Element
-                               (Get_Instance_Ref (Parent_Info.Block_Scope),
-                                Stmt_Info.Generate_Parent_Field)),
-                  Info.Block_Decls_Ptr_Type));
-
-            Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
-            Elab_Block_Statements (Bod, Bod);
-            Clear_Scope (Info.Block_Scope);
-            Close_Temp;
-         end;
-         Clause := Get_Generate_Else_Clause (Clause);
-      end loop;
+      case Iir_Kinds_If_Case_Generate_Statement (Get_Kind (Stmt)) is
+         when Iir_Kind_If_Generate_Statement =>
+            declare
+               Clause : Iir;
+            begin
+               Clause := Stmt;
+               while Clause /= Null_Iir loop
+                  Elab_Stmt_If_Case_Generate_Statement_Body
+                    (Get_Generate_Statement_Body (Clause));
+                  Clause := Get_Generate_Else_Clause (Clause);
+               end loop;
+            end;
+         when Iir_Kind_Case_Generate_Statement =>
+            declare
+               Alt : Iir;
+            begin
+               Alt := Get_Case_Statement_Alternative_Chain (Stmt);
+               while Alt /= Null_Iir loop
+                  if not Get_Same_Alternative_Flag (Alt) then
+                     Elab_Stmt_If_Case_Generate_Statement_Body
+                       (Get_Associated_Block (Alt));
+                  end if;
+                  Alt := Get_Chain (Alt);
+               end loop;
+            end;
+      end case;
       Start_Choice (Case_Blk);
       New_Default_Choice (Case_Blk);
       Finish_Choice (Case_Blk);
       Finish_Case_Stmt (Case_Blk);
-   end Elab_Stmt_If_Generate_Statement;
+   end Elab_Stmt_If_Case_Generate_Statement;
 
    procedure Elab_Decl_For_Generate_Statement
      (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
@@ -2266,12 +2498,14 @@ package body Trans.Chap9 is
                   Elab_Block_Declarations (Stmt, Base_Block);
                   Pop_Identifier_Prefix (Mark);
                end;
-            when Iir_Kind_If_Generate_Statement =>
+            when Iir_Kind_If_Generate_Statement
+              | Iir_Kind_Case_Generate_Statement =>
                declare
                   Mark : Id_Mark_Type;
                begin
                   Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
-                  Elab_Decl_If_Generate_Statement (Stmt, Block, Base_Block);
+                  Elab_Decl_If_Case_Generate_Statement
+                    (Stmt, Block, Base_Block);
                   Pop_Identifier_Prefix (Mark);
                end;
             when Iir_Kind_For_Generate_Statement =>
@@ -2318,12 +2552,13 @@ package body Trans.Chap9 is
                   Elab_Block_Statements (Stmt, Base_Block);
                   Pop_Identifier_Prefix (Mark);
                end;
-            when Iir_Kind_If_Generate_Statement =>
+            when Iir_Kind_If_Generate_Statement
+              | Iir_Kind_Case_Generate_Statement =>
                declare
                   Mark : Id_Mark_Type;
                begin
                   Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
-                  Elab_Stmt_If_Generate_Statement (Stmt, Block);
+                  Elab_Stmt_If_Case_Generate_Statement (Stmt, Block);
                   Pop_Identifier_Prefix (Mark);
                end;
             when Iir_Kind_For_Generate_Statement =>
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 8dd86b282..297edaf8c 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -190,6 +190,9 @@ package body Trans.Rtis is
            (Constr, Get_Identifier ("__ghdl_rtik_if_generate"),
             Ghdl_Rtik_If_Generate);
          New_Enum_Literal
+           (Constr, Get_Identifier ("__ghdl_rtik_case_generate"),
+            Ghdl_Rtik_Case_Generate);
+         New_Enum_Literal
            (Constr, Get_Identifier ("__ghdl_rtik_for_generate"),
             Ghdl_Rtik_For_Generate);
          New_Enum_Literal
@@ -2032,7 +2035,8 @@ package body Trans.Rtis is
    end Generate_Psl_Directive;
 
    procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode);
-   procedure Generate_If_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode);
+   procedure Generate_If_Case_Generate_Statement
+     (Blk : Iir; Parent_Rti : O_Dnode);
    procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode);
    procedure Generate_Declaration_Chain (Chain : Iir);
 
@@ -2305,9 +2309,10 @@ package body Trans.Rtis is
                Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
                Generate_Block (Stmt, Parent_Rti);
                Pop_Identifier_Prefix (Mark);
-            when Iir_Kind_If_Generate_Statement =>
+            when Iir_Kind_If_Generate_Statement
+              | Iir_Kind_Case_Generate_Statement =>
                Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
-               Generate_If_Generate_Statement (Stmt, Parent_Rti);
+               Generate_If_Case_Generate_Statement (Stmt, Parent_Rti);
                Pop_Identifier_Prefix (Mark);
             when Iir_Kind_For_Generate_Statement =>
                Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
@@ -2350,10 +2355,10 @@ package body Trans.Rtis is
       end loop;
    end Generate_Concurrent_Statement_Chain;
 
-   procedure Generate_If_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode)
+   procedure Generate_If_Case_Generate_Statement
+     (Blk : Iir; Parent_Rti : O_Dnode)
    is
       Info : constant Generate_Info_Acc := Get_Info (Blk);
-      Clause : Iir;
       Bod : Iir;
 
       Name : O_Dnode;
@@ -2361,6 +2366,7 @@ package body Trans.Rtis is
       Num : Natural;
 
       Rti : O_Dnode;
+      Rtik : O_Cnode;
       Arr       : O_Dnode;
 
       Prev : Rti_Block;
@@ -2374,16 +2380,43 @@ package body Trans.Rtis is
                       O_Storage_Public, Ghdl_Rtin_Block);
       Push_Rti_Node (Prev);
 
-      Clause := Blk;
       Num := 0;
-      while Clause /= Null_Iir loop
-         Bod := Get_Generate_Statement_Body (Clause);
-         Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
-         Generate_Block (Bod, Rti);
-         Pop_Identifier_Prefix (Mark);
-         Clause := Get_Generate_Else_Clause (Clause);
-         Num := Num + 1;
-      end loop;
+      case Get_Kind (Blk) is
+         when Iir_Kind_If_Generate_Statement =>
+            declare
+               Clause : Iir;
+            begin
+               Clause := Blk;
+               while Clause /= Null_Iir loop
+                  Bod := Get_Generate_Statement_Body (Clause);
+                  Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
+                  Generate_Block (Bod, Rti);
+                  Pop_Identifier_Prefix (Mark);
+                  Clause := Get_Generate_Else_Clause (Clause);
+                  Num := Num + 1;
+               end loop;
+               Rtik := Ghdl_Rtik_If_Generate;
+            end;
+         when Iir_Kind_Case_Generate_Statement =>
+            declare
+               Alt : Iir;
+            begin
+               Alt := Get_Case_Statement_Alternative_Chain (Blk);
+               while Alt /= Null_Iir loop
+                  if not Get_Same_Alternative_Flag (Alt) then
+                     Bod := Get_Associated_Block (Alt);
+                     Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
+                     Generate_Block (Bod, Rti);
+                     Pop_Identifier_Prefix (Mark);
+                     Num := Num + 1;
+                  end if;
+                  Alt := Get_Chain (Alt);
+               end loop;
+               Rtik := Ghdl_Rtik_Case_Generate;
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
 
       Name := Generate_Name (Blk);
 
@@ -2392,7 +2425,7 @@ package body Trans.Rtis is
       Start_Init_Value (Rti);
 
       Start_Record_Aggr (List, Ghdl_Rtin_Block);
-      New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_If_Generate));
+      New_Record_Aggr_El (List, Generate_Common (Rtik));
       New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
 
       --  Field Loc: offset in the instance of the entity.
@@ -2421,7 +2454,7 @@ package body Trans.Rtis is
 
       --  Store the RTI.
       Info.Generate_Rti_Const := Rti;
-   end Generate_If_Generate_Statement;
+   end Generate_If_Case_Generate_Statement;
 
    procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode)
    is
diff --git a/src/vhdl/translate/trans-rtis.ads b/src/vhdl/translate/trans-rtis.ads
index a1b5b456b..8f51957f3 100644
--- a/src/vhdl/translate/trans-rtis.ads
+++ b/src/vhdl/translate/trans-rtis.ads
@@ -28,6 +28,7 @@ package Trans.Rtis is
    Ghdl_Rtik_Process                     : O_Cnode;
    Ghdl_Rtik_Block                       : O_Cnode;
    Ghdl_Rtik_If_Generate                 : O_Cnode;
+   Ghdl_Rtik_Case_Generate               : O_Cnode;
    Ghdl_Rtik_For_Generate                : O_Cnode;
    Ghdl_Rtik_Generate_Body               : O_Cnode;
    Ghdl_Rtik_Instance                    : O_Cnode;