grt: reorganize simulation loop.

6 files changed, 124 insertions, 50 deletions

diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index ceaef6a8e..e050eefd3 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -127,8 +127,10 @@ package Grt.Errors is
    Run_Resumed : constant Integer := 2;
    --  Simulation is finished.
    Run_Finished : constant Integer := 3;
+   --  Simulation finished because of a user-defined time or delta limit.
+   Run_Limit : constant Integer := 4;
    --  Stop/finish request from user (via std.env).
-   Run_Stop : constant Integer := 4;
+   Run_Stop : constant Integer := 5;
 
    --  Hook called in case of error.
    Error_Hook : Grt.Hooks.Proc_Hook_Type := null;
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 6fae4c871..44abf5439 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -22,11 +22,9 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
-with System.Storage_Elements; --  Work around GNAT bug.
-pragma Unreferenced (System.Storage_Elements);
 with Grt.Types; use Grt.Types;
 with Grt.Stdio;
-with Grt.Errors;
+with Grt.Errors; use Grt.Errors;
 with Grt.Processes;
 with Grt.Signals;
 with Grt.Options; use Grt.Options;
@@ -105,11 +103,7 @@ package body Grt.Main is
       end if;
    end Check_Flag_String;
 
-   procedure Run
-   is
-      use Grt.Errors;
-      Stop : Boolean;
-      Status : Integer;
+   procedure Run_Elab (Stop : out Boolean) is
    begin
       --  Set stream for error messages
       Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout);
@@ -149,6 +143,7 @@ package body Grt.Main is
       --  Elaboration.  Run through longjump to catch errors.
       if Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0 then
          Grt.Errors.Error ("error during elaboration");
+         Stop := True;
          return;
       end if;
 
@@ -173,11 +168,23 @@ package body Grt.Main is
          if Disp_Sensitivity then
             Grt.Disp_Signals.Disp_All_Sensitivity;
          end if;
+      end if;
 
-         --  Do the simulation.
-         Status := Run_Through_Longjump (Grt.Processes.Simulation'Access);
+      --  Can continue.
+      Stop := False;
+   end Run_Elab;
+
+   function Run_Simul return Integer is
+   begin
+      if Flag_No_Run then
+         return 0;
       end if;
 
+      return Run_Through_Longjump (Grt.Processes.Simulation'Access);
+   end Run_Simul;
+
+   procedure Run_Finish (Status : Integer) is
+   begin
       Grt.Hooks.Call_Finish_Hooks;
 
       if Flag_Stats then
@@ -194,6 +201,21 @@ package body Grt.Main is
             Error ("simulation failed");
          end if;
       end if;
+   end Run_Finish;
+
+   procedure Run
+   is
+      Stop : Boolean;
+      Status : Integer;
+   begin
+      Run_Elab (Stop);
+      if Stop then
+         return;
+      end if;
+
+      Status := Run_Simul;
+
+      Run_Finish (Status);
    end Run;
 
 end Grt.Main;
diff --git a/src/grt/grt-main.ads b/src/grt/grt-main.ads
index 9fbf7b167..e4a6bff9c 100644
--- a/src/grt/grt-main.ads
+++ b/src/grt/grt-main.ads
@@ -27,6 +27,17 @@ package Grt.Main is
    --  Elaborate and simulate the design.
    procedure Run;
 
+   --  What Run does.
+
+   --  Elaborate the design.
+   procedure Run_Elab (Stop : out Boolean);
+
+   --  Do the whole simulation.
+   function Run_Simul return Integer;
+
+   --  Finalization.
+   procedure Run_Finish (Status : Integer);
+
    --  This function is called by elaboration code once default values have
    --  been assigned to generics, but before being used.
    procedure Ghdl_Init_Top_Generics;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index a1137210d..d5fcb4de7 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -808,10 +808,6 @@ package body Grt.Processes is
       end if;
    end Run_Processes;
 
-   --  Updated by Initialization_Phase and Simulation_Cycle to the time of the
-   --  next cycle.  Unchanged in case of delta-cycle.
-   Next_Time : Std_Time;
-
    procedure Initialization_Phase
    is
       Status : Integer;
@@ -877,7 +873,6 @@ package body Grt.Processes is
    end Initialization_Phase;
 
    --  Launch a simulation cycle.
-   --  Set FINISHED to true if this is the last cycle.
    function Simulation_Cycle return Integer
    is
       Tn : Std_Time;
@@ -889,8 +884,11 @@ package body Grt.Processes is
       --  a) The current time, Tc is set equal to Tn.  Simulation is complete
       --     when Tn = TIME'HIGH and there are no active drivers or process
       --     resumptions at Tn.
-      --  GHDL: this is done at the last step of the cycle.
-      null;
+      --  GHDL: the check is done at the last step of the cycle.
+      Current_Time := Next_Time;
+      if Grt.Options.Disp_Time then
+         Grt.Disp.Disp_Now;
+      end if;
 
       --  b) The following actions occur in the indicated order:
       --     1) If the current simulation cycle is not a delta cycle, each
@@ -1051,6 +1049,13 @@ package body Grt.Processes is
          Update_Active_Chain;
          Next_Time := Tn;
          Current_Delta := 0;
+
+         --  Statistics.
+         Nbr_Cycles := Nbr_Cycles + 1;
+
+         --  For wave dumpers.
+         Grt.Hooks.Call_Cycle_Hooks;
+
          return Run_Resumed;
       end if;
 
@@ -1059,6 +1064,10 @@ package body Grt.Processes is
          return Run_Finished;
       else
          Current_Delta := Current_Delta + 1;
+
+         --  Statistics.
+         Nbr_Delta_Cycles := Nbr_Delta_Cycles + 1;
+
          return Run_Resumed;
       end if;
    end Simulation_Cycle;
@@ -1090,51 +1099,48 @@ package body Grt.Processes is
       end if;
    end Simulation_Init;
 
+   function Has_Simulation_Timeout return Boolean
+   is
+      use Options;
+   begin
+      if Next_Time > Stop_Time
+        and then Next_Time /= Std_Time'Last
+      then
+         --  FIXME: Implement with a callback instead ?  This could be done
+         --  in 2 steps: an after_delay for the time and then a read_only
+         --  to finish the current cycle.  Note that no message should be
+         --  printed if the simulation is already finished at the stop time.
+         Info ("simulation stopped by --stop-time");
+         return True;
+      elsif Current_Delta >= Stop_Delta then
+         Info ("simulation stopped by --stop-delta");
+         return True;
+      else
+         return False;
+      end if;
+   end Has_Simulation_Timeout;
+
    function Simulation_Main_Loop return Integer
    is
       use Options;
       Status : Integer;
    begin
       loop
-         --  Update time.  This is the only place where Current_Time is
-         --  updated.
-         Current_Time := Next_Time;
-         if Disp_Time then
-            Grt.Disp.Disp_Now;
-         end if;
-
          Status := Simulation_Cycle;
+
+         --  Simulation has been stopped/finished by vpi.
          exit when Status = Run_Stop;
 
          if Trace_Signals then
             Grt.Disp_Signals.Disp_All_Signals;
          end if;
 
-         --  Statistics.
-         if Current_Delta = 0 then
-            Nbr_Cycles := Nbr_Cycles + 1;
-         else
-            Nbr_Delta_Cycles := Nbr_Delta_Cycles + 1;
-         end if;
-
+         --  Simulation is finished.
          exit when Status = Run_Finished;
-         if Next_Time > Stop_Time
-           and then Next_Time /= Std_Time'Last
-         then
-            --  FIXME: Implement with a callback instead ?  This could be done
-            --  in 2 steps: an after_delay for the time and then a read_only
-            --  to finish the current cycle.  Note that no message should be
-            --  printed if the simulation is already finished at the stop time.
-            Info ("simulation stopped by --stop-time");
-            exit;
-         end if;
-
-         if Current_Delta = 0 then
-            Grt.Hooks.Call_Cycle_Hooks;
-         end if;
 
-         if Current_Delta >= Stop_Delta then
-            Error ("simulation stopped by --stop-delta");
+         --  Simulation is stopped by user timeout.
+         if Has_Simulation_Timeout then
+            Status := Run_Limit;
             exit;
          end if;
       end loop;
@@ -1155,6 +1161,7 @@ package body Grt.Processes is
 
    function Simulation return Integer
    is
+      use Grt.Options;
       Status : Integer;
    begin
       Simulation_Init;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 818b81f7d..f431c7e2b 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -43,6 +43,19 @@ package Grt.Processes is
    --  < 0 in case of failure or stop request.
    function Simulation return Integer;
 
+   --  Broken down version of Simulation.
+   procedure Simulation_Init;
+   function Simulation_Cycle return Integer;
+   procedure Simulation_Finish;
+
+   --  True if simulation has reached a user timeout (--stop-time or
+   --  --stop-delta).  Emit an info message as a side effect.
+   function Has_Simulation_Timeout return Boolean;
+
+   --  Updated by Initialization_Phase and Simulation_Cycle to the time of the
+   --  next cycle.  Unchanged in case of delta-cycle.
+   Next_Time : Std_Time;
+
    --  Number of delta cycles.
    Nbr_Delta_Cycles : Integer;
    --  Number of non-delta cycles.
diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb
index 34041f645..a83f0988e 100644
--- a/src/vhdl/simulate/simul-simulation-main.adb
+++ b/src/vhdl/simulate/simul-simulation-main.adb
@@ -1125,7 +1125,10 @@ package body Simul.Simulation.Main is
       end if;
    end Ghdl_Elaborate;
 
-   procedure Simulation_Entity (Top_Conf : Iir_Design_Unit) is
+   procedure Simulation_Entity (Top_Conf : Iir_Design_Unit)
+   is
+      Stop : Boolean;
+      Status : Integer;
    begin
       Top_Config := Top_Conf;
 
@@ -1135,7 +1138,23 @@ package body Simul.Simulation.Main is
          Debug (Reason_Start);
       end if;
 
-      Grt.Main.Run;
+      Grt.Main.Run_Elab (Stop);
+      if Stop then
+         return;
+      end if;
+
+      Grt.Processes.Simulation_Init;
+
+      Status := Grt.Main.Run_Through_Longjump
+        (Grt.Processes.Simulation_Main_Loop'Access);
+
+      if Status = Grt.Errors.Run_Limit then
+         Grt.Processes.Simulation_Explain_Limit;
+      end if;
+
+      Grt.Processes.Simulation_Finish;
+
+      Grt.Main.Run_Finish (Status);
    exception
       when Debugger_Quit =>
          null;