synth: handle null-range loops

5 files changed, 40 insertions, 21 deletions

diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index 341e574d8..95048757b 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -533,15 +533,14 @@ package body Simul.Vhdl_Simul is
                   Param : constant Node :=
                     Get_Parameter_Specification (Parent);
                   Val : Valtyp;
+                  Valid : Boolean;
                begin
                   --  Update index
                   Val := Get_Value (Process.Instance, Param);
-                  Update_Index (Val.Typ.Drange, Val);
+                  Update_Index (Val.Typ.Drange, Valid, Val);
 
                   --  Test.
-                  if Elab.Vhdl_Objtypes.In_Range (Val.Typ.Drange,
-                                                  Read_Discrete (Val))
-                  then
+                  if Valid then
                      Stmt := Get_Sequential_Statement_Chain (Parent);
                      return;
                   end if;
diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb
index 3dc7cd1e2..0dff785a8 100644
--- a/src/synth/elab-vhdl_values.adb
+++ b/src/synth/elab-vhdl_values.adb
@@ -565,17 +565,24 @@ package body Elab.Vhdl_Values is
       end case;
    end Get_Memtyp;
 
-   procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp)
+   procedure Update_Index
+     (Rng : Discrete_Range_Type; Valid : out Boolean; V : in out Valtyp)
    is
       T : Int64;
    begin
       T := Read_Discrete (V);
+      if T = Rng.Right then
+         Valid := False;
+         return;
+      end if;
+
       case Rng.Dir is
          when Dir_To =>
             T := T + 1;
          when Dir_Downto =>
             T := T - 1;
       end case;
+      Valid := True;
       Write_Discrete (V, T);
    end Update_Index;
 end Elab.Vhdl_Values;
diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads
index de06d7941..4ed86da22 100644
--- a/src/synth/elab-vhdl_values.ads
+++ b/src/synth/elab-vhdl_values.ads
@@ -229,5 +229,7 @@ package Elab.Vhdl_Values is
 
    procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp);
 
-   procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp);
+   --  If V is at the right bound of RNG, VALID is set to False.
+   procedure Update_Index
+     (Rng : Discrete_Range_Type; Valid : out Boolean; V : in out Valtyp);
 end Elab.Vhdl_Values;
diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb
index 0df274872..192f84a70 100644
--- a/src/synth/synth-vhdl_aggr.adb
+++ b/src/synth/synth-vhdl_aggr.adb
@@ -284,6 +284,7 @@ package body Synth.Vhdl_Aggr is
                      Ch : constant Node := Get_Choice_Range (Assoc);
                      Rng : Discrete_Range_Type;
                      Val : Valtyp;
+                     Valid : Boolean;
                      Rng_Len : Width;
                      Off : Uns32;
                   begin
@@ -299,8 +300,9 @@ package body Synth.Vhdl_Aggr is
                            Err_P := Err_P or Sub_Err;
                            exit when Err_P;
                            Set_Elem (First_Pos + Nat32 (Off) * Stride);
-                           Update_Index (Rng, Val);
                            exit when Err_P;
+                           Update_Index (Rng, Valid, Val);
+                           exit when not Valid;
                         end loop;
                      else
                         --  The direction must be the same.
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index d6ee49bab..bf30d8e08 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -3277,6 +3277,7 @@ package body Synth.Vhdl_Stmts is
    is
       Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
       Val : Valtyp;
+      Valid : Boolean;
       Lc : aliased Loop_Context (Mode_Dynamic);
    begin
       Lc := (Mode => Mode_Dynamic,
@@ -3293,17 +3294,21 @@ package body Synth.Vhdl_Stmts is
 
       Init_For_Loop_Statement (C.Inst, Stmt, Val);
 
-      while In_Range (Val.Typ.Drange, Read_Discrete (Val)) loop
-         Synth_Sequential_Statements (C, Stmts);
+      if In_Range (Val.Typ.Drange, Read_Discrete (Val)) then
+         loop
+            Synth_Sequential_Statements (C, Stmts);
 
-         Update_Index (Val.Typ.Drange, Val);
-         Loop_Control_Update (C);
+            Loop_Control_Update (C);
 
-         --  Constant exit.
-         exit when Is_Static_Bit0 (C.W_En);
+            --  Constant exit.
+            exit when Is_Static_Bit0 (C.W_En);
 
-         --  FIXME: dynamic exits.
-      end loop;
+            Update_Index (Val.Typ.Drange, Valid, Val);
+            exit when not Valid;
+
+            --  FIXME: dynamic exits.
+         end loop;
+      end if;
       Loop_Control_Finish (C);
 
       Finish_For_Loop_Statement (C.Inst, Stmt);
@@ -3316,6 +3321,7 @@ package body Synth.Vhdl_Stmts is
    is
       Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
       Val : Valtyp;
+      Valid : Boolean;
       Lc : aliased Loop_Context (Mode_Static);
    begin
       Lc := (Mode_Static,
@@ -3327,14 +3333,17 @@ package body Synth.Vhdl_Stmts is
 
       Init_For_Loop_Statement (C.Inst, Stmt, Val);
 
-      while In_Range (Val.Typ.Drange, Read_Discrete (Val)) loop
-         Synth_Sequential_Statements (C, Stmts);
-         C.S_En := True;
+      if In_Range (Val.Typ.Drange, Read_Discrete (Val)) then
+         loop
+            Synth_Sequential_Statements (C, Stmts);
+            C.S_En := True;
 
-         Update_Index (Val.Typ.Drange, Val);
+            Update_Index (Val.Typ.Drange, Valid, Val);
+            exit when not Valid;
 
-         exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0;
-      end loop;
+            exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0;
+         end loop;
+      end if;
 
       Finish_For_Loop_Statement (C.Inst, Stmt);