diff --git a/components/lazdebuggergdbmi/cmdlinedebugger.pp b/components/lazdebuggergdbmi/cmdlinedebugger.pp index 6921084e2f..1244ea1584 100644 --- a/components/lazdebuggergdbmi/cmdlinedebugger.pp +++ b/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; - t, t2, t3: DWord; + Step, FullTimeOut: Integer; + t, t2, t3: QWord; CurCallStamp: Int64; begin Result := 0; CurCallStamp := FReadLineCallStamp; Step:=IDLE_STEP_COUNT-1; - if ATimeOut > 0 - then t := GetTickCount; + //if ATimeOut > 0 + //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 := GetTickCount; - if t2 < t - then t3 := t2 + (High(t) - t) - else t3 := t2 - t; - if (t3 >= ATimeOut) + t2 := GetTickCount64; + if t2 < t + then t3 := t2 + (High(t) - t) + else t3 := t2 - t; + + if (FullTimeOut > 0) then begin + if (t3 >= FullTimeOut) then begin ATimeOut := 0; break; end else begin - ATimeOut := ATimeOut - t3; - t := t2; + ATimeOut := FullTimeOut - t3; end; end; - ProcessWhileWaitForHandles; - // process messages - inc(Step); - if Step=IDLE_STEP_COUNT then begin - Step:=0; - Application.Idle(false); + {$IFdef MSWindows} + if (t3 > FAggressiveWaitTime) or (FAggressiveWaitTime = 0) then begin + {$EndIf} + ProcessWhileWaitForHandles; + // process messages + 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 - Application.ProcessMessages; - except - Application.HandleException(Application); - end; - if Application.Terminated or not DebugProcessRunning then Break; - // sleep a bit - Sleep(10); + {$EndIf} + 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); - 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); diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index ce7ec757f5..dee0708a36 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/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