diff options
| -rw-r--r-- | src/grt/grt-errors.ads | 4 | ||||
| -rw-r--r-- | src/grt/grt-main.adb | 42 | ||||
| -rw-r--r-- | src/grt/grt-main.ads | 11 | ||||
| -rw-r--r-- | src/grt/grt-processes.adb | 81 | ||||
| -rw-r--r-- | src/grt/grt-processes.ads | 13 | ||||
| -rw-r--r-- | src/vhdl/simulate/simul-simulation-main.adb | 23 |
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; |