diff options
-rw-r--r-- | src/grt/grt-options.adb | 23 | ||||
-rw-r--r-- | src/grt/grt-options.ads | 3 | ||||
-rw-r--r-- | src/grt/grt-processes.adb | 11 |
3 files changed, 14 insertions, 23 deletions
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 806d77479..3c4acb215 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -22,12 +22,10 @@ -- 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; with Interfaces; use Interfaces; with Grt.Errors; use Grt.Errors; with Grt.Astdio; with Grt.Hooks; -with Grt.Callbacks; package body Grt.Options is @@ -221,16 +219,6 @@ package body Grt.Options is end if; end To_Lower; - Stop_Time : Std_Time := Std_Time'First; - - procedure Stop_Time_Callback (Arg : System.Address) - is - pragma Unreferenced (Arg); - begin - Break_Simulation := True; - Info ("simulation stopped by --stop-time"); - end Stop_Time_Callback; - procedure Decode_Option (Option : String; Status : out Decode_Option_Status) is @@ -530,16 +518,5 @@ package body Grt.Options is end case; end; end loop; - - if Stop_Time /= Std_Time'First then - declare - use Callbacks; - Stop_Handle : Callback_Handle; - begin - Register_Callback_At - (Hooks.Cb_After_Delay, Stop_Handle, - Stop_Time, Stop_Time_Callback'Access); - end; - end if; end Decode; end Grt.Options; diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads index 604952e20..7233232d8 100644 --- a/src/grt/grt-options.ads +++ b/src/grt/grt-options.ads @@ -121,6 +121,9 @@ package Grt.Options is -- Set by --stop-delta=XXX to stop the simulation after XXX delta cycles. Stop_Delta : Natural := 5000; + -- Set by --stop-time=X to stop the simulation at time X. + Stop_Time : Std_Time := Std_Time'Last; + -- Set by --no-run -- If set, do not simulate, only elaborate. Flag_No_Run : Boolean := False; diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb index feb312337..242a9e595 100644 --- a/src/grt/grt-processes.adb +++ b/src/grt/grt-processes.adb @@ -1088,6 +1088,17 @@ package body Grt.Processes is end if; 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; |