diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index 18464396a7..13e43f318b 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/components/lazdebuggergdbmi/gdbmidebugger.pp @@ -165,20 +165,26 @@ type FDisableStartupShell: Boolean; FEncodeCurrentDirPath: TGDBMIDebuggerFilenameEncoding; FEncodeExeFileName: TGDBMIDebuggerFilenameEncoding; + FGdbLocalsValueMemLimit: Integer; {$IFDEF UNIX} FConsoleTty: String; {$ENDIF} FGDBOptions: String; FGdbValueMemLimit: Integer; FInternalStartBreak: TGDBMIDebuggerStartBreak; + FMaxDisplayLengthForStaticArray: Integer; FMaxDisplayLengthForString: Integer; + FMaxLocalsLengthForStaticArray: Integer; FTimeoutForEval: Integer; FUseAsyncCommandMode: Boolean; FUseNoneMiRunCommands: TGDBMIUseNoneMiRunCmdsState; FWarnOnSetBreakpointError: TGDBMIWarnOnSetBreakpointError; FWarnOnInternalError: TGDBMIDebuggerShowWarning; FWarnOnTimeOut: Boolean; + procedure SetGdbLocalsValueMemLimit(AValue: Integer); + procedure SetMaxDisplayLengthForStaticArray(AValue: Integer); procedure SetMaxDisplayLengthForString(AValue: Integer); + procedure SetMaxLocalsLengthForStaticArray(AValue: Integer); procedure SetTimeoutForEval(const AValue: Integer); procedure SetWarnOnTimeOut(const AValue: Boolean); public @@ -189,7 +195,9 @@ type {$IFDEF UNIX} property ConsoleTty: String read FConsoleTty write FConsoleTty; {$ENDIF} - property MaxDisplayLengthForString: Integer read FMaxDisplayLengthForString write SetMaxDisplayLengthForString; + property MaxDisplayLengthForString: Integer read FMaxDisplayLengthForString write SetMaxDisplayLengthForString default 2500; + property MaxDisplayLengthForStaticArray: Integer read FMaxDisplayLengthForStaticArray write SetMaxDisplayLengthForStaticArray default 500; + property MaxLocalsLengthForStaticArray: Integer read FMaxLocalsLengthForStaticArray write SetMaxLocalsLengthForStaticArray default 25; property TimeoutForEval: Integer read FTimeoutForEval write SetTimeoutForEval; property WarnOnTimeOut: Boolean read FWarnOnTimeOut write SetWarnOnTimeOut; property WarnOnInternalError: TGDBMIDebuggerShowWarning @@ -212,6 +220,7 @@ type property WarnOnSetBreakpointError: TGDBMIWarnOnSetBreakpointError read FWarnOnSetBreakpointError write FWarnOnSetBreakpointError default gdbwAll; property GdbValueMemLimit: Integer read FGdbValueMemLimit write FGdbValueMemLimit default $60000000; + property GdbLocalsValueMemLimit: Integer read FGdbLocalsValueMemLimit write SetGdbLocalsValueMemLimit default 32000; property AssemblerStyle: TGDBMIDebuggerAssemblerStyle read FAssemblerStyle write FAssemblerStyle default gdasDefault; property DisableStartupShell: Boolean read FDisableStartupShell write FDisableStartupShell default False; @@ -224,6 +233,8 @@ type property ConsoleTty; {$ENDIF} property MaxDisplayLengthForString; + property MaxDisplayLengthForStaticArray; + property MaxLocalsLengthForStaticArray; property TimeoutForEval; property WarnOnTimeOut; property WarnOnInternalError; @@ -237,6 +248,7 @@ type //property WarnOnSetBreakpointError; property CaseSensitivity; property GdbValueMemLimit; + property GdbLocalsValueMemLimit; property AssemblerStyle; property DisableStartupShell; end; @@ -7273,6 +7285,30 @@ begin FMaxDisplayLengthForString := AValue; end; +procedure TGDBMIDebuggerPropertiesBase.SetMaxDisplayLengthForStaticArray(AValue: Integer); +begin + if FMaxDisplayLengthForStaticArray = AValue then Exit; + if AValue < 0 then + AValue := 0; + FMaxDisplayLengthForStaticArray := AValue; +end; + +procedure TGDBMIDebuggerPropertiesBase.SetGdbLocalsValueMemLimit(AValue: Integer); +begin + if FGdbLocalsValueMemLimit = AValue then Exit; + if AValue < 0 then + AValue := 0; + FGdbLocalsValueMemLimit := AValue; +end; + +procedure TGDBMIDebuggerPropertiesBase.SetMaxLocalsLengthForStaticArray(AValue: Integer); +begin + if FMaxLocalsLengthForStaticArray = AValue then Exit; + if AValue < 0 then + AValue := 0; + FMaxLocalsLengthForStaticArray := AValue; +end; + procedure TGDBMIDebuggerPropertiesBase.SetWarnOnTimeOut(const AValue: Boolean); begin if FWarnOnTimeOut = AValue then exit; @@ -7285,6 +7321,8 @@ begin FConsoleTty := ''; {$ENDIF} FMaxDisplayLengthForString := 2500; + FMaxDisplayLengthForStaticArray := 500; + FMaxLocalsLengthForStaticArray := 25; {$IFDEF darwin} FTimeoutForEval := 250; {$ELSE darwin} @@ -7302,6 +7340,7 @@ begin FWarnOnSetBreakpointError := gdbwAll; FCaseSensitivity := gdcsSmartOff; FGdbValueMemLimit := $60000000; + FGdbLocalsValueMemLimit := 32000; FAssemblerStyle := gdasDefault; FDisableStartupShell := False; inherited; @@ -7315,6 +7354,8 @@ begin FConsoleTty := TGDBMIDebuggerPropertiesBase(Source).FConsoleTty; {$ENDIF} FMaxDisplayLengthForString := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForString; + FMaxDisplayLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxDisplayLengthForStaticArray; + FMaxLocalsLengthForStaticArray := TGDBMIDebuggerPropertiesBase(Source).FMaxLocalsLengthForStaticArray; FTimeoutForEval := TGDBMIDebuggerPropertiesBase(Source).FTimeoutForEval; FWarnOnTimeOut := TGDBMIDebuggerPropertiesBase(Source).FWarnOnTimeOut; FWarnOnInternalError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnInternalError; @@ -7328,6 +7369,7 @@ begin FWarnOnSetBreakpointError := TGDBMIDebuggerPropertiesBase(Source).FWarnOnSetBreakpointError; FCaseSensitivity := TGDBMIDebuggerPropertiesBase(Source).FCaseSensitivity; FGdbValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbValueMemLimit; + FGdbLocalsValueMemLimit := TGDBMIDebuggerPropertiesBase(Source).FGdbLocalsValueMemLimit; FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle; FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell; end; @@ -10486,6 +10528,30 @@ begin ContextStackFrame, [], ATimeOut); Instr.AddReference; Instr.Cmd := Self; + + if (pos('-stack-list-', ACommand) = 1) or + (pos('-thread-info', ACommand) = 1) + then begin + // includes locals + Instr.ApplyMemLimit(DebuggerProperties.GdbLocalsValueMemLimit); + if FTheDebugger.FGDBVersionMajor >= 7 then + Instr.ApplyArrayLenLimit(DebuggerProperties.MaxLocalsLengthForStaticArray); + end + else + if not( (pos('-exec-', ACommand) = 1) or + (pos('-break-', ACommand) = 1) or + (pos('-data-list-register-', ACommand) = 1) or + (pos('-data-list-changed-registers', ACommand) = 1) or + (pos('-data-disassemble', ACommand) = 1) or + (pos('-data-read-memory', ACommand) = 1) or + (pos('-gdb-exit', ACommand) = 1) + ) + then begin + Instr.ApplyMemLimit(DebuggerProperties.GdbValueMemLimit); + if FTheDebugger.FGDBVersionMajor >= 7 then + Instr.ApplyArrayLenLimit(DebuggerProperties.MaxDisplayLengthForStaticArray); + end; + FTheDebugger.FInstructionQueue.RunInstruction(Instr); Result := Instr.IsSuccess and Instr.FHasResult; diff --git a/components/lazdebuggergdbmi/gdbmidebuginstructions.pp b/components/lazdebuggergdbmi/gdbmidebuginstructions.pp index b56abc5712..e6cd2b4928 100644 --- a/components/lazdebuggergdbmi/gdbmidebuginstructions.pp +++ b/components/lazdebuggergdbmi/gdbmidebuginstructions.pp @@ -22,7 +22,9 @@ type TGDBInstructionFlag = ( ifRequiresThread, - ifRequiresStackFrame + ifRequiresStackFrame, + ifRequiresMemLimit, + ifRequiresArrayLimit ); TGDBInstructionFlags = set of TGDBInstructionFlag; @@ -51,8 +53,10 @@ type TGDBInstruction = class(TRefCountedObject) private + FArrayLenLimit: Integer; FCommand: String; FFlags: TGDBInstructionFlags; + FMemLimit: Integer; FStackFrame: Integer; FThreadId: Integer; protected @@ -84,6 +88,8 @@ type AOtherFlags: TGDBInstructionFlags = []; ATimeOut: Integer = 0 ); + procedure ApplyArrayLenLimit(ALimit: Integer); + procedure ApplyMemLimit(ALimit: Integer); function IsSuccess: Boolean; function IsCompleted: boolean; virtual; // No more InputFromGdb required @@ -100,6 +106,8 @@ type property Command: String read FCommand; property ThreadId: Integer read FThreadId; property StackFrame: Integer read FStackFrame; + property ArrayLenLimit: Integer read FArrayLenLimit; + property MemLimit: Integer read FMemLimit; property Flags: TGDBInstructionFlags read FFlags; property ResultFlags: TGDBInstructionResultFlags read FResultFlags; property ErrorFlags: TGDBInstructionErrorFlags read FErrorFlags; @@ -139,6 +147,40 @@ type procedure HandleNoGdbRunning; override; end; + { TGDBInstructionChangeMemLimit } + + TGDBInstructionChangeMemLimit = class(TGDBInstruction) + private + FNewLimit: Integer; + FQueue: TGDBInstructionQueue; + //FDone: Boolean; + protected + procedure SendCommandDataToGDB(AQueue: TGDBInstructionQueue); override; + function ProcessInputFromGdb(const AData: String): Boolean; override; + function DebugText: String; + public + constructor Create(AQueue: TGDBInstructionQueue; ANewLimit: Integer); +// procedure HandleError(AnError: TGDBInstructionErrorFlag; AMarkAsFailed: Boolean = True); override; + end; + + { TGDBInstructionChangeArrayLimit } + + TGDBInstructionChangeArrayLimit = class(TGDBInstruction) + private + FNewLimit: Integer; + FQueue: TGDBInstructionQueue; + //FDone: Boolean; + protected + procedure SendCommandDataToGDB(AQueue: TGDBInstructionQueue); override; + function ProcessInputFromGdb(const AData: String): Boolean; override; + function DebugText: String; + public + constructor Create(AQueue: TGDBInstructionQueue; ANewLimit: Integer); + + procedure HandleError(AnError: TGDBInstructionErrorFlag; AMarkAsFailed: Boolean = True); + override; + end; + { TGDBInstructionChangeThread } TGDBInstructionChangeThread = class(TGDBInstruction) @@ -187,6 +229,8 @@ type FCurrentInstruction: TGDBInstruction; FCurrentStackFrame: Integer; FCurrentThreadId: Integer; + FCurrentArrayLimit: Integer; + FCurrentMemLimit: Integer; FExeCurInstructionStamp: Int64; FDebugger: TGDBMICmdLineDebugger; FFlags: TGDBInstructionQueueFlags; @@ -280,6 +324,90 @@ begin Result := '[' + Result + ']'; end; +{ TGDBInstructionChangeMemLimit } + +procedure TGDBInstructionChangeMemLimit.SendCommandDataToGDB(AQueue: TGDBInstructionQueue); +begin + if FNewLimit > 0 then + AQueue.SendDataToGDB(Self, 'set max-value-size %d', [FNewLimit]) + else + if FNewLimit = 0 then + AQueue.SendDataToGDB(Self, 'set max-value-size unlimited'); +end; + +function TGDBInstructionChangeMemLimit.ProcessInputFromGdb(const AData: String): Boolean; +begin + Result := False; + if (AData = '(gdb) ') then begin + Result := True; + MarkAsSuccess; + FQueue.FCurrentMemLimit := FNewLimit; + end + + else + begin + debugln(DBG_VERBOSE, ['GDBMI TGDBInstructionChangeArrayLimit ignoring: ', AData]); + end; +end; + +function TGDBInstructionChangeMemLimit.DebugText: String; +begin + Result := ClassName; +end; + +constructor TGDBInstructionChangeMemLimit.Create(AQueue: TGDBInstructionQueue; + ANewLimit: Integer); +begin + inherited Create('', [], TIMEOUT_FOR_QUEUE_INSTR); + FQueue := AQueue; +// FDone := False; + FNewLimit := ANewLimit; +end; + +{ TGDBInstructionChangeArrayLimit } + +procedure TGDBInstructionChangeArrayLimit.SendCommandDataToGDB(AQueue: TGDBInstructionQueue); +begin + AQueue.SendDataToGDB(Self, 'set print elements %d', [FNewLimit]); +end; + +function TGDBInstructionChangeArrayLimit.ProcessInputFromGdb(const AData: String): Boolean; +begin + Result := False; + if (AData = '(gdb) ') then begin + Result := True; + MarkAsSuccess; + FQueue.FCurrentArrayLimit := FNewLimit; + end + + else + begin + debugln(DBG_VERBOSE, ['GDBMI TGDBInstructionChangeArrayLimit ignoring: ', AData]); + end; +end; + +function TGDBInstructionChangeArrayLimit.DebugText: String; +begin + Result := ClassName; +end; + +constructor TGDBInstructionChangeArrayLimit.Create(AQueue: TGDBInstructionQueue; + ANewLimit: Integer); +begin + inherited Create('', [], TIMEOUT_FOR_QUEUE_INSTR); + FQueue := AQueue; +// FDone := False; + FNewLimit := ANewLimit; +end; + +procedure TGDBInstructionChangeArrayLimit.HandleError(AnError: TGDBInstructionErrorFlag; + AMarkAsFailed: Boolean); +begin + inherited HandleError(AnError, AMarkAsFailed); +// FQueue.FCurrentArrayLimit := -2; + FQueue.FCurrentArrayLimit := FNewLimit; // ignore error +end; + { TGDBMICmdLineDebugger } procedure TGDBMICmdLineDebugger.DoReadError; @@ -408,6 +536,18 @@ begin Init; end; +procedure TGDBInstruction.ApplyArrayLenLimit(ALimit: Integer); +begin + FFlags := FFlags + [ifRequiresArrayLimit]; + FArrayLenLimit := ALimit; +end; + +procedure TGDBInstruction.ApplyMemLimit(ALimit: Integer); +begin + FFlags := FFlags + [ifRequiresMemLimit]; + FMemLimit := ALimit; +end; + function TGDBInstruction.IsSuccess: Boolean; begin Result := ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted] @@ -729,6 +869,18 @@ end; { TGDBInstructionQueue } procedure TGDBInstructionQueue.ExecuteCurrentInstruction; + function RunHelpInstruction(AnHelpInstr: TGDBInstruction): boolean; + begin + AnHelpInstr.AddReference; + try + FCurrentInstruction := AnHelpInstr; + FCurrentInstruction.SendCommandDataToGDB(Self); + FinishCurrentInstruction; + Result := AnHelpInstr.IsSuccess; + finally + AnHelpInstr.ReleaseReference; + end; + end; var ExeInstr, HelpInstr: TGDBInstruction; CurStamp: Int64; @@ -747,23 +899,25 @@ begin while true do begin CurStamp := FExeCurInstructionStamp; + If (ifRequiresMemLimit in ExeInstr.Flags) and (FCurrentMemLimit <> ExeInstr.MemLimit) then begin + HelpInstr := TGDBInstructionChangeMemLimit.Create(Self, ExeInstr.MemLimit); + RunHelpInstruction(HelpInstr); // ignore result + end; + + If (ifRequiresArrayLimit in ExeInstr.Flags) and (FCurrentArrayLimit <> ExeInstr.ArrayLenLimit) then begin + HelpInstr := TGDBInstructionChangeArrayLimit.Create(Self, ExeInstr.ArrayLenLimit); + RunHelpInstruction(HelpInstr); // ignore result + end; + if not HasCorrectThreadIdFor(ExeInstr) then begin HelpInstr := GetSelectThreadInstruction(ExeInstr.ThreadId); DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Thread from: ', FCurrentThreadId, ' - ', dbgs(FFlags), ' to ', ExeInstr.ThreadId, ' using [', HelpInstr.DebugText, '] for [', ExeInstr.DebugText, ']']); - HelpInstr.AddReference; - try - FCurrentInstruction := HelpInstr; - FCurrentInstruction.SendCommandDataToGDB(Self); - FinishCurrentInstruction; - if not HelpInstr.IsSuccess then begin - DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Thread FAILED']); - ExeInstr.HandleError(ifeInvalidThreadId); - exit; - end; - finally - HelpInstr.ReleaseReference; - end; + if not RunHelpInstruction(HelpInstr) then begin + DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Thread FAILED']); + ExeInstr.HandleError(ifeInvalidThreadId); + exit; + end end; if not HasCorrectThreadIdFor(ExeInstr) then begin @@ -782,18 +936,10 @@ begin HelpInstr := GetSelectFrameInstruction(ExeInstr.StackFrame); DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Stack from: ', FCurrentStackFrame, ' - ', dbgs(FFlags), ' to ', ExeInstr.StackFrame, ' using [', HelpInstr.DebugText, '] for [', ExeInstr.DebugText, ']']); - HelpInstr.AddReference; - try - FCurrentInstruction := HelpInstr; - FCurrentInstruction.SendCommandDataToGDB(Self); - FinishCurrentInstruction; - if not HelpInstr.IsSuccess then begin - DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Stackframe FAILED']); - ExeInstr.HandleError(ifeInvalidStackFrame); - exit; - end; - finally - HelpInstr.ReleaseReference; + if not RunHelpInstruction(HelpInstr) then begin + DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Stackframe FAILED']); + ExeInstr.HandleError(ifeInvalidStackFrame); + exit; end; end; diff --git a/components/lazdebuggergdbmi/gdbmiserverdebugger.pas b/components/lazdebuggergdbmi/gdbmiserverdebugger.pas index f7941e5320..77d3a52a50 100644 --- a/components/lazdebuggergdbmi/gdbmiserverdebugger.pas +++ b/components/lazdebuggergdbmi/gdbmiserverdebugger.pas @@ -68,6 +68,8 @@ type property ConsoleTty; {$ENDIF} property MaxDisplayLengthForString; + property MaxDisplayLengthForStaticArray; + property MaxLocalsLengthForStaticArray; property TimeoutForEval; property WarnOnTimeOut; property WarnOnInternalError; @@ -79,6 +81,7 @@ type //property WarnOnSetBreakpointError; property CaseSensitivity; property GdbValueMemLimit; + property GdbLocalsValueMemLimit; property AssemblerStyle; property DisableStartupShell; end; diff --git a/components/lazdebuggergdbmi/sshgdbmidebugger.pas b/components/lazdebuggergdbmi/sshgdbmidebugger.pas index 7e5d18d93e..6b9dafef9b 100644 --- a/components/lazdebuggergdbmi/sshgdbmidebugger.pas +++ b/components/lazdebuggergdbmi/sshgdbmidebugger.pas @@ -82,6 +82,8 @@ type property ConsoleTty; {$ENDIF} property MaxDisplayLengthForString; + property MaxDisplayLengthForStaticArray; + property MaxLocalsLengthForStaticArray; property TimeoutForEval; property WarnOnTimeOut; property WarnOnInternalError; @@ -93,6 +95,7 @@ type //property WarnOnSetBreakpointError; property CaseSensitivity; property GdbValueMemLimit; + property GdbLocalsValueMemLimit; property AssemblerStyle; property DisableStartupShell; end;