aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/grt/grt-errors.ads4
-rw-r--r--src/grt/grt-main.adb42
-rw-r--r--src/grt/grt-main.ads11
-rw-r--r--src/grt/grt-processes.adb81
-rw-r--r--src/grt/grt-processes.ads13
-rw-r--r--src/vhdl/simulate/simul-simulation-main.adb23
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;