synth: elaborate case generate statements

6 files changed, 74 insertions, 18 deletions

diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb
index 8ac6c65cf..eca3ac783 100644
--- a/src/simul/simul-vhdl_elab.adb
+++ b/src/simul/simul-vhdl_elab.adb
@@ -852,7 +852,8 @@ package body Simul.Vhdl_Elab is
                Gather_Connections_Instantiation_Statement
                  (Inst, Stmt, Sub_Inst);
             end;
-         when Iir_Kind_If_Generate_Statement =>
+         when Iir_Kind_If_Generate_Statement
+            | Iir_Kind_Case_Generate_Statement =>
             declare
                Sub : constant Synth_Instance_Acc :=
                  Get_Sub_Instance (Inst, Stmt);
diff --git a/src/synth/elab-vhdl_annotations.adb b/src/synth/elab-vhdl_annotations.adb
index 296b3daff..4341d4747 100644
--- a/src/synth/elab-vhdl_annotations.adb
+++ b/src/synth/elab-vhdl_annotations.adb
@@ -896,6 +896,8 @@ package body Elab.Vhdl_Annotations is
       Info : Sim_Info_Acc;
       Clause : Iir;
    begin
+      --  Create info for the if-generate statement so that we can know the
+      --  slot of the generate body.
       Info := Create_Block_Info (Block_Info, Stmt);
       pragma Unreferenced (Info);
 
@@ -928,11 +930,20 @@ package body Elab.Vhdl_Annotations is
    procedure Annotate_Case_Generate_Statement
      (Block_Info : Sim_Info_Acc; Stmt : Iir)
    is
+      Info : Sim_Info_Acc;
       Assoc : Iir;
    begin
+      --  Create info for the case-generate statement so that we can know the
+      --  slot of the generate body.
+      Info := Create_Block_Info (Block_Info, Stmt);
+      pragma Unreferenced (Info);
+
       Assoc := Get_Case_Statement_Alternative_Chain (Stmt);
       while Assoc /= Null_Iir loop
          if not Get_Same_Alternative_Flag (Assoc) then
+            --  Use the same slot as the case-generate statement.
+            Block_Info.Nbr_Objects := Block_Info.Nbr_Objects - 1;
+
             Annotate_Generate_Statement_Body
               (Block_Info, Get_Associated_Block (Assoc), Null_Iir);
          end if;
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
index e6ebb707e..c2c72c9fa 100644
--- a/src/synth/elab-vhdl_insts.adb
+++ b/src/synth/elab-vhdl_insts.adb
@@ -542,7 +542,8 @@ package body Elab.Vhdl_Insts is
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kinds_Process_Statement =>
             null;
-         when Iir_Kind_If_Generate_Statement =>
+         when Iir_Kind_If_Generate_Statement
+            | Iir_Kind_Case_Generate_Statement =>
             declare
                Sub_Inst : constant Synth_Instance_Acc :=
                  Get_Sub_Instance (Syn_Inst, Stmt);
diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb
index 7d6b6f01d..0609e971a 100644
--- a/src/synth/elab-vhdl_stmts.adb
+++ b/src/synth/elab-vhdl_stmts.adb
@@ -28,6 +28,7 @@ with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;
 with Elab.Vhdl_Insts; use Elab.Vhdl_Insts;
 
 with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
+with Synth.Vhdl_Stmts;
 
 package body Elab.Vhdl_Stmts is
    function Elab_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc;
@@ -194,6 +195,37 @@ package body Elab.Vhdl_Stmts is
       Create_Sub_Instance (Syn_Inst, Stmt, null);
    end Elab_If_Generate_Statement;
 
+   procedure Elab_Case_Generate_Statement
+     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+   is
+      Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
+      Marker : Mark_Type;
+      Expr : Node;
+      Val : Valtyp;
+      Gen : Node;
+      Bod : Node;
+      Config : Node;
+      Sub_Inst : Synth_Instance_Acc;
+   begin
+      Mark_Expr_Pool (Marker);
+
+      --  Execute expression.
+      Expr := Get_Expression (Stmt);
+      Val := Synth_Expression (Syn_Inst, Expr);
+      Strip_Const (Val);
+
+      Gen := Synth.Vhdl_Stmts.Execute_Static_Choices_Scalar
+        (Syn_Inst, Choices, Read_Discrete (Val));
+      Bod := Get_Associated_Block (Gen);
+      Release_Expr_Pool (Marker);
+
+      Config := Get_Generate_Block_Configuration (Bod);
+
+      Apply_Block_Configuration (Config, Bod);
+      Sub_Inst := Elab_Generate_Statement_Body (Syn_Inst, Bod, Config);
+      Create_Sub_Instance (Syn_Inst, Bod, Sub_Inst);
+   end Elab_Case_Generate_Statement;
+
    procedure Elab_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node)
    is
       Hdr : constant Node := Get_Block_Header (Blk);
@@ -264,6 +296,9 @@ package body Elab.Vhdl_Stmts is
          when Iir_Kind_If_Generate_Statement =>
             Elab_If_Generate_Statement (Syn_Inst, Stmt);
 
+         when Iir_Kind_Case_Generate_Statement =>
+            Elab_Case_Generate_Statement (Syn_Inst, Stmt);
+
          when Iir_Kind_Block_Statement =>
             Elab_Block_Statement (Syn_Inst, Stmt);
 
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index a72a3ac09..116dafd03 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -1558,9 +1558,8 @@ package body Synth.Vhdl_Stmts is
    end Synth_Case_Statement_Dynamic;
 
    function Execute_Static_Case_Statement_Array
-     (Inst : Synth_Instance_Acc; Stmt : Node; Sel : Valtyp) return Node
+     (Inst : Synth_Instance_Acc; Choices : Node; Sel : Valtyp) return Node
    is
-      Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
       Choice : Node;
       Stmts : Node;
       Sel_Expr : Node;
@@ -1591,38 +1590,37 @@ package body Synth.Vhdl_Stmts is
       end loop;
    end Execute_Static_Case_Statement_Array;
 
-   function Execute_Static_Case_Statement_Scalar
-     (Inst : Synth_Instance_Acc; Stmt : Node; Sel : Int64) return Node
+   function Execute_Static_Choices_Scalar
+     (Inst : Synth_Instance_Acc; Choices : Node; Sel : Int64) return Node
    is
-      Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
       Choice : Node;
-      Stmts : Node;
+      Res : Node;
       Sel_Expr : Node;
    begin
       --  Synth statements, extract choice value.
-      Stmts := Null_Node;
+      Res := Null_Node;
       Choice := Choices;
       loop
          pragma Assert (Is_Valid (Choice));
          if not Get_Same_Alternative_Flag (Choice) then
-            Stmts := Get_Associated_Chain (Choice);
+            Res := Choice;
          end if;
 
          case Get_Kind (Choice) is
             when Iir_Kind_Choice_By_Expression =>
                Sel_Expr := Get_Choice_Expression (Choice);
                if Vhdl.Evaluation.Eval_Pos (Sel_Expr) = Sel then
-                  return Stmts;
+                  return Res;
                end if;
             when Iir_Kind_Choice_By_Others =>
-               return Stmts;
+               return Res;
             when Iir_Kind_Choice_By_Range =>
                declare
                   Bnd : Discrete_Range_Type;
                begin
                   Synth_Discrete_Range (Inst, Get_Choice_Range (Choice), Bnd);
                   if In_Range (Bnd, Sel) then
-                     return Stmts;
+                     return Res;
                   end if;
                end;
             when others =>
@@ -1630,20 +1628,24 @@ package body Synth.Vhdl_Stmts is
          end case;
          Choice := Get_Chain (Choice);
       end loop;
-   end Execute_Static_Case_Statement_Scalar;
+   end Execute_Static_Choices_Scalar;
 
    function Execute_Static_Case_Statement
-     (Inst : Synth_Instance_Acc; Stmt : Node; Sel : Valtyp) return Node is
+     (Inst : Synth_Instance_Acc; Stmt : Node; Sel : Valtyp) return Node
+   is
+      Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
+      Choice : Node;
    begin
       case Sel.Typ.Kind is
          when Type_Bit
            | Type_Logic
            | Type_Discrete =>
-            return Execute_Static_Case_Statement_Scalar
-              (Inst, Stmt, Read_Discrete (Sel));
+            Choice := Execute_Static_Choices_Scalar (Inst, Choices,
+                                                     Read_Discrete (Sel));
+            return Get_Associated_Chain (Choice);
          when Type_Vector
            | Type_Array =>
-            return Execute_Static_Case_Statement_Array (Inst, Stmt, Sel);
+            return Execute_Static_Case_Statement_Array (Inst, Choices, Sel);
          when others =>
             raise Internal_Error;
       end case;
diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads
index ac9cd13d8..e9eda5c25 100644
--- a/src/synth/synth-vhdl_stmts.ads
+++ b/src/synth/synth-vhdl_stmts.ads
@@ -157,6 +157,12 @@ package Synth.Vhdl_Stmts is
                                   Func : Node;
                                   Arg : Valtyp) return Valtyp;
 
+   --  Return the associated choice from CHOICES chain selected by SEL.
+   --  It returns the choice (not the associated expression or chain) which
+   --  carries the association.
+   function Execute_Static_Choices_Scalar
+     (Inst : Synth_Instance_Acc; Choices : Node; Sel : Int64) return Node;
+
    --  Return the statements chain to be executed.
    function Execute_Static_Case_Statement
      (Inst : Synth_Instance_Acc; Stmt : Node; Sel : Valtyp) return Node;