simul-debugger: add run command.

6 files changed, 72 insertions, 13 deletions

diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index d5fcb4de7..a76eda7ed 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -1072,7 +1072,7 @@ package body Grt.Processes is
       end if;
    end Simulation_Cycle;
 
-   procedure Simulation_Init
+   function Simulation_Init return Integer
    is
       use Options;
    begin
@@ -1097,6 +1097,8 @@ package body Grt.Processes is
          --  zero after initialization.
          Grt.Hooks.Call_Cycle_Hooks;
       end if;
+
+      return 0;
    end Simulation_Init;
 
    function Has_Simulation_Timeout return Boolean
@@ -1164,7 +1166,8 @@ package body Grt.Processes is
       use Grt.Options;
       Status : Integer;
    begin
-      Simulation_Init;
+      Status := Simulation_Init;
+      pragma Assert (Status = 0);
 
       Status := Simulation_Main_Loop;
 
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index f431c7e2b..cd2475691 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -44,7 +44,7 @@ package Grt.Processes is
    function Simulation return Integer;
 
    --  Broken down version of Simulation.
-   procedure Simulation_Init;
+   function Simulation_Init return Integer;
    function Simulation_Cycle return Integer;
    procedure Simulation_Finish;
 
diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb
index d2bfcf2b1..80c8f7baa 100644
--- a/src/vhdl/simulate/simul-debugger.adb
+++ b/src/vhdl/simulate/simul-debugger.adb
@@ -40,11 +40,12 @@ with Disp_Vhdl;
 with Simul.Execution; use Simul.Execution;
 with Iirs_Walk; use Iirs_Walk;
 with Areapools; use Areapools;
-with Grt.Types;
 with Grt.Disp;
 with Grt.Readline;
 with Grt.Errors;
 with Grt.Disp_Signals;
+with Grt.Processes;
+with Grt.Options;
 
 package body Simul.Debugger is
    --  This exception can be raised by a debugger command to directly return
@@ -1859,8 +1860,7 @@ package body Simul.Debugger is
       raise Debugger_Quit;
    end Quit_Proc;
 
-   procedure Cont_Proc (Line : String) is
-      pragma Unreferenced (Line);
+   procedure Prepare_Continue is
    begin
       Command_Status := Status_Quit;
 
@@ -1870,6 +1870,30 @@ package body Simul.Debugger is
          Flag_Need_Debug := True;
          exit;
       end loop;
+   end Prepare_Continue;
+
+   procedure Run_Proc (Line : String)
+   is
+      use Grt.Types;
+      Delta_Time : Std_Time;
+      P : Positive;
+   begin
+      P := Skip_Blanks (Line);
+      if P <= Line'Last then
+         Delta_Time := Grt.Options.Parse_Time (Line (P .. Line'Last));
+         if Delta_Time = -1 then
+            return;
+         end if;
+         Break_Time := Grt.Processes.Next_Time + Delta_Time;
+      end if;
+
+      Prepare_Continue;
+   end Run_Proc;
+
+   procedure Cont_Proc (Line : String) is
+      pragma Unreferenced (Line);
+   begin
+      Prepare_Continue;
    end Cont_Proc;
 
    Menu_Info_Instances : aliased Menu_Entry :=
@@ -2016,10 +2040,16 @@ package body Simul.Debugger is
       Next => Menu_Print'Access,
       Proc => Cont_Proc'Access);
 
+   Menu_Run : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("r*un"),
+      Next => Menu_Cont'Access,
+      Proc => Run_Proc'Access);
+
    Menu_Quit : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("q*uit"),
-      Next => Menu_Cont'Access,
+      Next => Menu_Run'Access,
       Proc => Quit_Proc'Access);
 
    Menu_Help1 : aliased Menu_Entry :=
@@ -2175,7 +2205,8 @@ package body Simul.Debugger is
             if not Flag_Interractive then
                return;
             end if;
-         when Reason_Break =>
+         when Reason_Break
+           | Reason_Time =>
             null;
       end case;
 
@@ -2194,6 +2225,9 @@ package body Simul.Debugger is
             else
                Set_Top_Frame (Current_Process.Instance);
             end if;
+         when Reason_Time =>
+            Break_Time := Grt.Types.Std_Time'Last;
+            Exec_State := Exec_Run;
          when Reason_Break =>
             case Exec_State is
                when Exec_Run =>
diff --git a/src/vhdl/simulate/simul-debugger.ads b/src/vhdl/simulate/simul-debugger.ads
index 9deba556b..f2aabd536 100644
--- a/src/vhdl/simulate/simul-debugger.ads
+++ b/src/vhdl/simulate/simul-debugger.ads
@@ -18,6 +18,7 @@
 
 with Iirs; use Iirs;
 with Simul.Environments; use Simul.Environments;
+with Grt.Types;
 
 package Simul.Debugger is
    Flag_Debugger : Boolean := False;
@@ -71,6 +72,9 @@ package Simul.Debugger is
       --  At end of elaboration, for an interractive session
       Reason_Elab,
 
+      --  Simulation time limit reached.
+      Reason_Time,
+
       --  Before execution of a statement.
       Reason_Break,
 
@@ -83,6 +87,9 @@ package Simul.Debugger is
 
    Debugger_Quit : exception;
 
+   --  Time at which simulation must stop and return to user interraction.
+   Break_Time : Grt.Types.Std_Time;
+
    --  Interractive debugger.
    procedure Debug (Reason: Debug_Reason);
 
diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb
index 9cb1189ec..48c5470b1 100644
--- a/src/vhdl/simulate/simul-execution.adb
+++ b/src/vhdl/simulate/simul-execution.adb
@@ -1605,6 +1605,8 @@ package body Simul.Execution is
             File_Operation.Untruncated_Text_Read
               (Args (0), Args (1), Args (2));
          when Std_Names.Name_Control_Simulation =>
+            --  FIXME: handle stop properly.
+            --  FIXME: this is the only place where longjump is called.
             Grt.Lib.Ghdl_Control_Simulation
               (Args (0).B1, Args (1).B1, Std_Integer (Args (2).I64));
             --  Do not return.
diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb
index a83f0988e..24f56f49b 100644
--- a/src/vhdl/simulate/simul-simulation-main.adb
+++ b/src/vhdl/simulate/simul-simulation-main.adb
@@ -1127,9 +1127,12 @@ package body Simul.Simulation.Main is
 
    procedure Simulation_Entity (Top_Conf : Iir_Design_Unit)
    is
+      use Grt.Errors;
       Stop : Boolean;
       Status : Integer;
    begin
+      Break_Time := Std_Time'Last;
+
       Top_Config := Top_Conf;
 
       Grt.Errors.Error_Hook := Debug_Error'Access;
@@ -1143,13 +1146,23 @@ package body Simul.Simulation.Main is
          return;
       end if;
 
-      Grt.Processes.Simulation_Init;
-
       Status := Grt.Main.Run_Through_Longjump
-        (Grt.Processes.Simulation_Main_Loop'Access);
+        (Grt.Processes.Simulation_Init'Access);
+
+      if Status = 0 then
+         loop
+            Status := Grt.Main.Run_Through_Longjump
+              (Grt.Processes.Simulation_Cycle'Access);
+            exit when Status < 0 or Status = Run_Stop or Status = Run_Finished;
+
+            if Grt.Processes.Next_Time >= Break_Time
+              and then Break_Time /= Std_Time'Last
+            then
+               Debug (Reason_Time);
+            end if;
 
-      if Status = Grt.Errors.Run_Limit then
-         Grt.Processes.Simulation_Explain_Limit;
+            exit when Grt.Processes.Has_Simulation_Timeout;
+         end loop;
       end if;
 
       Grt.Processes.Simulation_Finish;