paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-28 13:33:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

GdbmiDebugger, Windows: Improved speed. Wait for gdb responses, using WaitForSingleObject

Browse Source 
git-svn-id: trunk@61239 -
This commit is contained in:
martin 2019-05-18 14:26:24 +00:00
parent 6dc1e4fd75
commit 636383149c
1 changed files with 37 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
components/lazdebuggergdbmi/cmdlinedebugger.pp
View File

@ -219,7 +219,7 @@ const
IDLE_STEP_COUNT = 20;
var
PipeHandle: Integer;
TotalBytesAvailable: dword;
TotalBytesAvailable, WaitRes: dword;
R: LongBool;
n: integer;
Step: Integer;
@ -234,22 +234,40 @@ begin
while Result=0 do
begin
for n:= 0 to High(AHandles) do
begin
PipeHandle := AHandles[n];
R := Windows.PeekNamedPipe(PipeHandle, nil, 0, nil, @TotalBytesAvailable, nil);
if not R then begin
// PeekNamedPipe failed
DebugLn('PeekNamedPipe failed, GetLastError is ', IntToStr(GetLastError));
Exit;
end;
if R then begin
// PeekNamedPipe successfull
if (TotalBytesAvailable>0) then begin
Result := 1 shl n;
Break;
if Length(AHandles) > 1 then
WaitRes := WaitForMultipleObjects(Length(AHandles), @AHandles[0], False, 30)
else
WaitRes := WaitForSingleObject(AHandles[0], 30);
if (WaitRes >= WAIT_OBJECT_0) and (WaitRes < WAIT_OBJECT_0 + Length(AHandles)) then begin
Result := 1 shl (WaitRes - WAIT_OBJECT_0);
end
else
if (WaitRes >= WAIT_ABANDONED_0) and (WaitRes < WAIT_ABANDONED_0 + Length(AHandles)) then begin
Result := 1 shl (WaitRes - WAIT_ABANDONED_0); // caller will pick up error
end
else
if WaitRes <> WAIT_TIMEOUT then begin
debugln(['WaitForMultipleObjects(failed) ', GetLastOSError]);
for n:= 0 to High(AHandles) do
begin
PipeHandle := AHandles[n];
R := Windows.PeekNamedPipe(PipeHandle, nil, 0, nil, @TotalBytesAvailable, nil);
if not R then begin
// PeekNamedPipe failed
DebugLn('PeekNamedPipe failed, GetLastError is ', IntToStr(GetLastError));
Exit;
end;
if R then begin
// PeekNamedPipe successfull
if (TotalBytesAvailable>0) then begin
Result := 1 shl n;
Break;
end;
end;
end;
// sleep a bit
if Result = 0 then
sleep(10);
end;
if CurCallStamp <> FReadLineCallStamp then
@ -284,8 +302,6 @@ begin
Application.HandleException(Application);
end;
if Application.Terminated or not DebugProcessRunning then Break;
// sleep a bit
Sleep(10);
end;
end;
{$ELSE win32}
@ -351,6 +367,7 @@ begin
{$endif windows}
FDbgProcess.ShowWindow := swoNone;
FDbgProcess.Environment:=DebuggerEnvironment;
FDbgProcess.PipeBufferSize:=64*1024;
except
FreeAndNil(FDbgProcess);
end;
@ -428,11 +445,12 @@ end;
function TCmdLineDebugger.ReadLine(const APeek: Boolean; ATimeOut: Integer = -1): String;
function ReadData(const AStream: TStream; var ABuffer: String): Integer;
const READ_LEN = 32*1024;
var
S: String;
begin
SetLength(S, 8192);
Result := AStream.Read(S[1], 8192);
SetLength(S, READ_LEN);
Result := AStream.Read(S[1], READ_LEN);
if Result > 0
then begin
SetLength(S, Result);