diff options
author | Tristan Gingold <tgingold@free.fr> | 2017-12-18 19:15:43 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2017-12-20 20:58:40 +0100 |
commit | bb95ef066af608754d8ddb626d956c7a2a13563b (patch) | |
tree | 210eae08fca97f7f78eb760b9f2735773aa9fcf7 /src | |
parent | 7d1b6da515251a33f10f85793aeb02c60171ca95 (diff) | |
download | ghdl-bb95ef066af608754d8ddb626d956c7a2a13563b.tar.gz ghdl-bb95ef066af608754d8ddb626d956c7a2a13563b.tar.bz2 ghdl-bb95ef066af608754d8ddb626d956c7a2a13563b.zip |
simul-debugger: add run command.
Diffstat (limited to 'src')
-rw-r--r-- | src/grt/grt-processes.adb | 7 | ||||
-rw-r--r-- | src/grt/grt-processes.ads | 2 | ||||
-rw-r--r-- | src/vhdl/simulate/simul-debugger.adb | 44 | ||||
-rw-r--r-- | src/vhdl/simulate/simul-debugger.ads | 7 | ||||
-rw-r--r-- | src/vhdl/simulate/simul-execution.adb | 2 | ||||
-rw-r--r-- | src/vhdl/simulate/simul-simulation-main.adb | 23 |
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; |