paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-12 14:00:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Use one single worker-thread to to handle the debugging. On Windows, debug-events are only send to the thread that started the process.

Browse Source 
git-svn-id: trunk@44619 -
This commit is contained in:
joost 2014-04-06 13:57:43 +00:00
parent 0341bfb4de
commit 3e2a0dc513
1 changed files with 49 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -21,12 +21,18 @@ type
TFpDebugDebugger = class; TFpDebugDebugger = class;
TFpDebugThread = class(TThread) TFpDebugThread = class(TThread)
private private
FDebugLoopStoppedEvent: PRTLEvent;
FFpDebugDebugger: TFpDebugDebugger; FFpDebugDebugger: TFpDebugDebugger;
FStartDebugLoopEvent: PRTLEvent;
FStartSuccesfull: boolean;
procedure DoDebugLoopFinishedASync({%H-}Data: PtrInt); procedure DoDebugLoopFinishedASync({%H-}Data: PtrInt);
public public
constructor Create(AFpDebugDebugger: TFpDebugDebugger); constructor Create(AFpDebugDebugger: TFpDebugDebugger);
destructor Destroy; override; destructor Destroy; override;
procedure Execute; override; procedure Execute; override;
property StartSuccesfull: boolean read FStartSuccesfull;
property StartDebugLoopEvent: PRTLEvent read FStartDebugLoopEvent;
property DebugLoopStoppedEvent: PRTLEvent read FDebugLoopStoppedEvent;
end; end;
{ TFpDebugDebugger } { TFpDebugDebugger }
@ -35,7 +41,7 @@ type
private private
FDbgController: TDbgController; FDbgController: TDbgController;
FFpDebugThread: TFpDebugThread; FFpDebugThread: TFpDebugThread;
FDebugLoopRunning: boolean; procedure FreeDebugThread;
procedure FDbgControllerHitBreakpointEvent(var continue: boolean); procedure FDbgControllerHitBreakpointEvent(var continue: boolean);
procedure FDbgControllerCreateProcessEvent(var continue: boolean); procedure FDbgControllerCreateProcessEvent(var continue: boolean);
procedure FDbgControllerProcessExitEvent(AExitCode: DWord); procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
@ -99,19 +105,38 @@ end;
constructor TFpDebugThread.Create(AFpDebugDebugger: TFpDebugDebugger); constructor TFpDebugThread.Create(AFpDebugDebugger: TFpDebugDebugger);
begin begin
FDebugLoopStoppedEvent := RTLEventCreate;
FStartDebugLoopEvent := RTLEventCreate;
FFpDebugDebugger := AFpDebugDebugger; FFpDebugDebugger := AFpDebugDebugger;
inherited Create(false); inherited Create(false);
end; end;
destructor TFpDebugThread.Destroy; destructor TFpDebugThread.Destroy;
begin begin
RTLeventdestroy(FStartDebugLoopEvent);
RTLeventdestroy(FDebugLoopStoppedEvent);
inherited Destroy; inherited Destroy;
end; end;
procedure TFpDebugThread.Execute; procedure TFpDebugThread.Execute;
begin begin
FFpDebugDebugger.FDbgController.ProcessLoop; if FFpDebugDebugger.FDbgController.Run then
Application.QueueAsyncCall(@DoDebugLoopFinishedASync, 0); FStartSuccesfull:=true;
RTLeventSetEvent(FDebugLoopStoppedEvent);
if FStartSuccesfull then
begin
repeat
RTLeventWaitFor(FStartDebugLoopEvent);
RTLeventResetEvent(FStartDebugLoopEvent);
if not terminated then
begin
FFpDebugDebugger.FDbgController.ProcessLoop;
Application.QueueAsyncCall(@DoDebugLoopFinishedASync, 0);
end;
until Terminated;
end
end; end;
{ TFpDebugDebugger } { TFpDebugDebugger }
@ -120,6 +145,7 @@ procedure TFpDebugDebugger.FDbgControllerProcessExitEvent(AExitCode: DWord);
begin begin
SetExitCode(AExitCode); SetExitCode(AExitCode);
DoDbgEvent(ecProcess, etProcessExit, Format('Process exited with exit-code %d',[AExitCode])); DoDbgEvent(ecProcess, etProcessExit, Format('Process exited with exit-code %d',[AExitCode]));
FreeDebugThread;
SetState(dsStop); SetState(dsStop);
end; end;
@ -138,6 +164,15 @@ begin
Result := TFPWatches.Create(Self); Result := TFPWatches.Create(Self);
end; end;
procedure TFpDebugDebugger.FreeDebugThread;
begin
FFpDebugThread.Terminate;
RTLeventSetEvent(FFpDebugThread.StartDebugLoopEvent);
FFpDebugThread.WaitFor;
FFpDebugThread.Free;
FFpDebugThread := nil;
end;
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean); procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean);
begin begin
BreakPoints[0].Hit(continue); BreakPoints[0].Hit(continue);
@ -185,9 +220,15 @@ begin
if not assigned(FDbgController.MainProcess) then if not assigned(FDbgController.MainProcess) then
begin begin
FDbgController.ExecutableFilename:=FileName; FDbgController.ExecutableFilename:=FileName;
Result := FDbgController.Run; FFpDebugThread := TFpDebugThread.Create(Self);
if not Result then RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent);
RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent);
result := FFpDebugThread.StartSuccesfull;
if not result then
begin
FreeDebugThread;
Exit; Exit;
end;
SetState(dsInit); SetState(dsInit);
end end
else else
@ -217,17 +258,13 @@ end;
procedure TFpDebugDebugger.StartDebugLoop; procedure TFpDebugDebugger.StartDebugLoop;
begin begin
DebugLn('StartDebugLoop'); DebugLn('StartDebugLoop');
FDebugLoopRunning:=true; RTLeventSetEvent(FFpDebugThread.StartDebugLoopEvent);
FFpDebugThread := TFpDebugThread.Create(Self);
end; end;
procedure TFpDebugDebugger.DebugLoopFinished; procedure TFpDebugDebugger.DebugLoopFinished;
var var
Cont: boolean; Cont: boolean;
begin begin
FFpDebugThread.WaitFor;
FFpDebugThread.Free;
FDebugLoopRunning:=false;
DebugLn('DebugLoopFinished'); DebugLn('DebugLoopFinished');
FDbgController.SendEvents(Cont); FDbgController.SendEvents(Cont);
@ -252,6 +289,8 @@ end;
destructor TFpDebugDebugger.Destroy; destructor TFpDebugDebugger.Destroy;
begin begin
if assigned(FDbgController) then
FreeDebugThread;
FDbgController.Free; FDbgController.Free;
inherited Destroy; inherited Destroy;
end; end;