GdbmiDebugger, Windows: Improved speed. Wait for gdb responses, with less sleep calls (increase cpu usage) / Option to disable for laptops/etc.

git-svn-id: trunk@61117 -

components/lazdebuggergdbmi/cmdlinedebugger.pp

@@ -55,6 +55,9 @@ type
 
   TCmdLineDebugger = class(TDebuggerIntf)
   private
+    {$IFdef MSWindows}
+    FAggressiveWaitTime: Cardinal;
+    {$EndIf}
     FDbgProcess: TProcessUTF8;   // The process used to call the debugger
     FLineEnds: TStringDynArray;  // List of strings considered as lineends
     FOutputBuf: String;
@@ -89,6 +92,9 @@ type
   public
     property DebugProcess: TProcessUTF8 read FDbgProcess;
     property DebugProcessRunning: Boolean read GetDebugProcessRunning;
+    {$IFdef MSWindows}
+    property AggressiveWaitTime: Cardinal read FAggressiveWaitTime write FAggressiveWaitTime;
+    {$EndIf}
   end;
 
 
@@ -222,15 +228,17 @@ var
   TotalBytesAvailable: dword;
   R: LongBool;
   n: integer;
-  Step: Integer;
+  Step, FullTimeOut: Integer;
-  t, t2, t3: DWord;
+  t, t2, t3: QWord;
   CurCallStamp: Int64;
 begin
   Result := 0;
   CurCallStamp := FReadLineCallStamp;
   Step:=IDLE_STEP_COUNT-1;
-  if ATimeOut > 0
+  //if ATimeOut > 0
-  then t := GetTickCount;
+  //then
+  t := GetTickCount64;
+  FullTimeOut := ATimeOut;
 
   while Result=0 do
   begin
@@ -255,37 +263,54 @@ begin
     if CurCallStamp <> FReadLineCallStamp then
       exit;
 
-    if (ATimeOut > 0) then begin
+    t2 := GetTickCount64;
-      t2 := GetTickCount;
+    if t2 < t
-      if t2 < t
+    then t3 := t2 + (High(t) - t)
-      then t3 := t2 + (High(t) - t)
+    else t3 := t2 - t;
-      else t3 := t2 - t;
+
-      if (t3 >= ATimeOut)
+    if (FullTimeOut > 0) then begin
+      if (t3 >= FullTimeOut)
       then begin
         ATimeOut := 0;
         break;
       end
       else begin
-        ATimeOut := ATimeOut - t3;
+        ATimeOut := FullTimeOut - t3;
-        t := t2;
       end;
     end;
 
-    ProcessWhileWaitForHandles;
+    {$IFdef MSWindows}
-    // process messages
+    if (t3 > FAggressiveWaitTime) or (FAggressiveWaitTime = 0) then begin
-    inc(Step);
+    {$EndIf}
-    if Step=IDLE_STEP_COUNT then begin
+      ProcessWhileWaitForHandles;
-      Step:=0;
+      // process messages
-      Application.Idle(false);
+      inc(Step);
+      if Step=IDLE_STEP_COUNT then begin
+        Step:=0;
+        Application.Idle(false);
+      end;
+      try
+        Application.ProcessMessages;
+      except
+        Application.HandleException(Application);
+      end;
+      if Application.Terminated or not DebugProcessRunning then Break;
+      // sleep a bit
+      Sleep(10);
+    {$IFdef MSWindows}
+    end
+    else
+    if t3 div 64 > Step then begin;
+      ProcessWhileWaitForHandles;
+      inc(Step);
+      try
+        Application.ProcessMessages;
+      except
+        Application.HandleException(Application);
+      end;
     end;
-    try
+    {$EndIf}
-      Application.ProcessMessages;
+
-    except
-      Application.HandleException(Application);
-    end;
-    if Application.Terminated or not DebugProcessRunning then Break;
-    // sleep a bit
-    Sleep(10);
   end;
 end;
 {$ELSE win32}
@@ -351,6 +376,7 @@ begin
       {$endif windows}
       FDbgProcess.ShowWindow := swoNone;
       FDbgProcess.Environment:=DebuggerEnvironment;
+      FDbgProcess.PipeBufferSize:=64*1024;
     except
       FreeAndNil(FDbgProcess);
     end;
@@ -428,11 +454,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);
+    SetLength(S, READ_LEN);
-    Result := AStream.Read(S[1], 8192);
+    Result := AStream.Read(S[1], READ_LEN);
     if Result > 0
     then begin
       SetLength(S, Result);

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -187,6 +187,10 @@ type
     FWarnOnSetBreakpointError: TGDBMIWarnOnSetBreakpointError;
     FWarnOnInternalError: TGDBMIDebuggerShowWarning;
     FWarnOnTimeOut: Boolean;
+    {$IFdef MSWindows}
+    FAggressiveWaitTime: Cardinal;
+    procedure SetAggressiveWaitTime(AValue: Cardinal);
+    {$EndIf}
     procedure SetGdbLocalsValueMemLimit(AValue: Integer);
     procedure SetMaxDisplayLengthForStaticArray(AValue: Integer);
     procedure SetMaxDisplayLengthForString(AValue: Integer);
@@ -233,6 +237,9 @@ type
     property FixStackFrameForFpcAssert: Boolean read FFixStackFrameForFpcAssert
              write FFixStackFrameForFpcAssert default True;
     property FixIncorrectStepOver: Boolean read FFixIncorrectStepOver write FFixIncorrectStepOver default False;
+    {$IFdef MSWindows}
+    property AggressiveWaitTime: Cardinal read FAggressiveWaitTime write SetAggressiveWaitTime default 100;
+    {$EndIf}
   end;
 
   TGDBMIDebuggerProperties = class(TGDBMIDebuggerPropertiesBase)
@@ -262,6 +269,9 @@ type
     property DisableStartupShell;
     property FixStackFrameForFpcAssert;
     property FixIncorrectStepOver;
+    {$IFdef MSWindows}
+    property AggressiveWaitTime;
+    {$EndIf}
   end;
 
   TGDBMIDebuggerBase = class;
@@ -7614,6 +7624,16 @@ begin
   FGdbLocalsValueMemLimit := AValue;
 end;
 
+{$IFdef MSWindows}
+procedure TGDBMIDebuggerPropertiesBase.SetAggressiveWaitTime(AValue: Cardinal);
+begin
+  if AValue > 500 then
+    AValue := 500;
+  if FAggressiveWaitTime = AValue then Exit;
+  FAggressiveWaitTime := AValue;
+end;
+{$EndIf}
+
 procedure TGDBMIDebuggerPropertiesBase.SetMaxLocalsLengthForStaticArray(AValue: Integer);
 begin
   if FMaxLocalsLengthForStaticArray = AValue then Exit;
@@ -7658,6 +7678,9 @@ begin
   FDisableStartupShell := False;
   FFixStackFrameForFpcAssert := True;
   FFixIncorrectStepOver := False;
+  {$IFdef MSWindows}
+  FAggressiveWaitTime := 100;
+  {$EndIf}
   inherited;
 end;
 
@@ -7689,6 +7712,9 @@ begin
   FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
   FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
   FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver;
+  {$IFdef MSWindows}
+  FAggressiveWaitTime := TGDBMIDebuggerPropertiesBase(Source).FAggressiveWaitTime;
+  {$EndIf}
 end;
 
 
@@ -9105,6 +9131,9 @@ begin
 {$ifNdef MSWindows}
     DebuggerEnvironment.Values['LANG'] := 'C'; // try to prevent GDB from using localized messages
 {$ENDIF}
+{$ifdef MSWindows}
+    AggressiveWaitTime := TGDBMIDebuggerPropertiesBase(GetProperties).AggressiveWaitTime;
+{$ENDIF}
 
     if CreateDebugProcess(Options)
     then begin