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

FpDebugServer: Replaced TThreadList in combination with a sleep with a TLazThreadedQueue to improve performance

Browse Source 
git-svn-id: trunk@49153 -
This commit is contained in:
joost 2015-05-23 20:11:42 +00:00
parent 9fcceeb930
commit 3be8873d05
1 changed files with 8 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/fpdebug/app/fpdserver/debugthread.pas
View File

@ -11,6 +11,8 @@ uses
FPDbgController, FPDbgController,
DbgIntfBaseTypes, DbgIntfBaseTypes,
DbgIntfDebuggerBase, DbgIntfDebuggerBase,
lazCollections,
syncobjs,
lazfglhash, lazfglhash,
fpjson, fpjson,
FpDbgClasses; FpDbgClasses;
@ -98,12 +100,13 @@ type
property ListenerIdentifier: integer read FListenerIdentifier; property ListenerIdentifier: integer read FListenerIdentifier;
end; end;
TFpDebugThreadCommandClass = class of TFpDebugThreadCommand; TFpDebugThreadCommandClass = class of TFpDebugThreadCommand;
TFpDebugThreadCommandQueue = specialize TLazThreadedQueue<TFpDebugThreadCommand>;
{ TFpDebugThread } { TFpDebugThread }
TFpDebugThread = class(TThread) TFpDebugThread = class(TThread)
private private
FCommandQueue: TThreadList; FCommandQueue: TFpDebugThreadCommandQueue;
FController: TDbgController; FController: TDbgController;
FListenerList: TThreadList; FListenerList: TThreadList;
protected protected
@ -269,7 +272,6 @@ end;
procedure TFpDebugThread.Execute; procedure TFpDebugThread.Execute;
var var
AList: TList;
ACommand: TFpDebugThreadCommand; ACommand: TFpDebugThreadCommand;
ARunLoop: boolean; ARunLoop: boolean;
AnEvent: TFpDebugEvent; AnEvent: TFpDebugEvent;
@ -283,17 +285,8 @@ begin
try try
repeat repeat
try try
ACommand:=nil; if FCommandQueue.PopItem(ACommand)<>wrSignaled then
AList := FCommandQueue.LockList; ACommand:=nil;
try
if AList.Count>0 then
begin
ACommand:=TFpDebugThreadCommand(AList.Items[0]);
AList.Delete(0);
end;
finally
FCommandQueue.UnlockList;
end;
if assigned(ACommand) then if assigned(ACommand) then
begin begin
@ -323,8 +316,6 @@ begin
FController.SendEvents(ARunLoop); FController.SendEvents(ARunLoop);
end; end;
end; end;
sleep(100);
except except
on E: Exception do on E: Exception do
writeln('Exception in debug-thread: '+e.Message); // just continue writeln('Exception in debug-thread: '+e.Message); // just continue
@ -355,7 +346,7 @@ end;
constructor TFpDebugThread.Create; constructor TFpDebugThread.Create;
begin begin
inherited create(false); inherited create(false);
FCommandQueue := TThreadList.Create; FCommandQueue := TFpDebugThreadCommandQueue.create(100, INFINITE, 100);
FListenerList:=TThreadList.Create; FListenerList:=TThreadList.Create;
end; end;
@ -391,7 +382,7 @@ begin
end; end;
if DoQueueCommand then if DoQueueCommand then
begin begin
FCommandQueue.Add(ACommand); FCommandQueue.PushItem(ACommand);
end end
else else
begin begin