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

DBG: Refactor Locals (more usage of new queue)

Browse Source 
git-svn-id: trunk@28381 -
This commit is contained in:
martin 2010-11-21 22:12:50 +00:00
parent 2d1c6a8e08
commit 05ac0535fa
1 changed files with 194 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

355
debugger/gdbmidebugger.pp
View File

@ -197,6 +197,7 @@ type
AFlags: TGDBMICommandFlags = [] AFlags: TGDBMICommandFlags = []
): Boolean; overload; ): Boolean; overload;
function ProcessResult(var AResult: TGDBMIExecResult): Boolean; function ProcessResult(var AResult: TGDBMIExecResult): Boolean;
function ProcessGDBResultText(S: String): String;
function GetFrame(const AIndex: Integer): String; function GetFrame(const AIndex: Integer): String;
function GetText(const ALocation: TDBGPtr): String; overload; function GetText(const ALocation: TDBGPtr): String; overload;
function GetText(const AExpression: String; const AValues: array of const): String; overload; function GetText(const AExpression: String; const AValues: array of const): String; overload;
@ -288,17 +289,13 @@ type
procedure ClearSourceInfo; procedure ClearSourceInfo;
procedure GDBStopCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt); procedure GDBStopCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt);
function FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint; function FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
function GetText(const ALocation: TDBGPtr): String; overload; // To be deprecated / moved to TGDBMIDebuggerCommand
function GetText(const AExpression: String; const AValues: array of const): String; overload; //**** once GetText is removed, make ProcessGDBResultText local to CommandObject
procedure SelectStackFrame(AIndex: Integer); procedure SelectStackFrame(AIndex: Integer);
// All ExecuteCommand functions are wrappers for the real (full) implementation // All ExecuteCommand functions are wrappers for the real (full) implementation
// ExecuteCommandFull is never called directly // ExecuteCommandFull is never called directly
function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags): Boolean; overload; function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt): Boolean; overload; function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags; var AResult: TGDBMIExecResult): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean; overload; function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; var AResult: TGDBMIExecResult): Boolean; overload; function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; var AResult: TGDBMIExecResult): Boolean; overload;
function ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload; function ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload;
procedure RunQueue; procedure RunQueue;
@ -523,14 +520,14 @@ type
TGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand) TGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand)
private private
FArgs: String; FResult: TStringList;
FVars: String;
protected protected
function DoExecute: Boolean; override; function DoExecute: Boolean; override;
public public
constructor Create(AOwner: TGDBMIDebugger);
destructor Destroy; override;
function DebugText: String; override; function DebugText: String; override;
property Args: String read FArgs; property Result: TStringList read FResult;
property Vars: String read FVars;
end; end;
{ TGDBMILocals } { TGDBMILocals }
@ -543,7 +540,6 @@ type
FLocals: TStringList; FLocals: TStringList;
procedure LocalsNeeded; procedure LocalsNeeded;
procedure CancelEvaluation; procedure CancelEvaluation;
procedure AddLocals(const AParams:String);
procedure DoEvaluationDestroyed(Sender: TObject); procedure DoEvaluationDestroyed(Sender: TObject);
procedure DoEvaluationFinished(Sender: TObject); procedure DoEvaluationFinished(Sender: TObject);
protected protected
@ -1239,109 +1235,6 @@ begin
Result := '"' + Result + '"'; Result := '"' + Result + '"';
end; end;
(* Part of GetText method
Until all commands have moved to TGDBMIDebuggerCommand classes the GetText method is
required on the TGDBMIDebuggerCommand and TGDBMIDebugger class.
To reduce duplicated code, both use this function
*)
function ProcessGDBResultText(S: String): String;
var
Trailor: String;
n, len, idx: Integer;
v: Integer;
begin
// don't use ' as end terminator, there might be one as part of the text
// since ' will be the last char, simply strip it.
S := GetPart(['\t '], [], S);
// Scan the string
len := Length(S);
// Set the resultstring initially to the same size
SetLength(Result, len);
n := 0;
idx := 1;
Trailor:='';
while idx <= len do
begin
case S[idx] of
'''': begin
Inc(idx);
// scan till end
while idx <= len do
begin
case S[idx] of
'''' : begin
Inc(idx);
if idx > len then Break;
if S[idx] <> '''' then Break;
end;
'\' : begin
Inc(idx);
if idx > len then Break;
case S[idx] of
't': S[idx] := #9;
'n': S[idx] := #10;
'r': S[idx] := #13;
end;
end;
end;
Inc(n);
Result[n] := S[idx];
Inc(idx);
end;
end;
'#': begin
Inc(idx);
v := 0;
// scan till non number (correct input is assumed)
while (idx <= len) and (S[idx] >= '0') and (S[idx] <= '9') do
begin
v := v * 10 + Ord(S[idx]) - Ord('0');
Inc(idx)
end;
Inc(n);
Result[n] := Chr(v and $FF);
end;
',', ' ': begin
Inc(idx); //ignore them;
end;
'<': begin
// Debugger has returned something like <repeats 10 times>
v := StrToIntDef(GetPart(['<repeats '], [' times>'], S), 0);
// Since we deleted the first part of S, reset idx
idx := 8; // the char after ' times>'
len := Length(S);
if v <= 1 then Continue;
// limit the amount of repeats
if v > 1000
then begin
Trailor := Trailor + Format('###(repeat truncated: %u -> 1000)###', [v]);
v := 1000;
end;
// make sure result has some room
SetLength(Result, Length(Result) + v - 1);
while v > 1 do begin
Inc(n);
Result[n] := Result[n - 1];
Dec(v);
end;
end;
else
// Debugger has returned something we don't know of
// Append the remainder to our parsed result
Delete(S, 1, idx - 1);
Trailor := Trailor + '###(gdb unparsed remainder:' + S + ')###';
Break;
end;
end;
SetLength(Result, n);
Result := Result + Trailor;
end;
function PCLenToString(const AVal: TPCharWithLen; UnQuote: Boolean = False): String; function PCLenToString(const AVal: TPCharWithLen; UnQuote: Boolean = False): String;
begin begin
if UnQuote and (AVal.Len >= 2) and (AVal.Ptr[0] = '"') and (AVal.Ptr[AVal.Len-1] = '"') if UnQuote and (AVal.Len >= 2) and (AVal.Ptr[0] = '"') and (AVal.Ptr[AVal.Len-1] = '"')
@ -3078,17 +2971,11 @@ begin
then begin then begin
CommandObj := TGDBMIDebuggerCommandExecute.Create(FTheDebugger, ectRun); CommandObj := TGDBMIDebuggerCommandExecute.Create(FTheDebugger, ectRun);
CommandObj.Execute; CommandObj.Execute;
//CommandObj.KeepFinished := True;
//FTheDebugger.QueueCommand(CommandObj);
//if CommandObj.State in [dcsExecuting, dcsFinished]
//then begin
// some versions of gdb (OSX) output the PID here // some versions of gdb (OSX) output the PID here
R := CommandObj.Result; R := CommandObj.Result;
TargetPIDPart := GetPart(['process '], [' local', ']'], R.Values, True); TargetPIDPart := GetPart(['process '], [' local', ']'], R.Values, True);
TargetInfo^.TargetPID := StrToIntDef(TargetPIDPart, 0); TargetInfo^.TargetPID := StrToIntDef(TargetPIDPart, 0);
R.State := dsNone; R.State := dsNone;
//end;
//CommandObj.KeepFinished := False;
CommandObj.DoFinished; CommandObj.DoFinished;
end; end;
@ -4690,12 +4577,6 @@ begin
Result := ExecuteCommandFull(ACommand, [], AFlags, ACallback, ATag, R); Result := ExecuteCommandFull(ACommand, [], AFlags, ACallback, ATag, R);
end; end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags;
var AResult: TGDBMIExecResult): Boolean;
begin
Result := ExecuteCommandFull(ACommand, [], AFlags, nil, 0, AResult);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean; const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean;
var var
@ -4704,15 +4585,6 @@ begin
Result := ExecuteCommandFull(ACommand, AValues, AFlags, nil, 0, R); Result := ExecuteCommandFull(ACommand, AValues, AFlags, nil, 0, R);
end; end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AValues: array of const; const AFlags: TGDBMICmdFlags;
const ACallback: TGDBMICallback; const ATag: PtrInt): Boolean;
var
R: TGDBMIExecResult;
begin
Result := ExecuteCommandFull(ACommand, AValues, AFlags, ACallback, ATag, R);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AValues: array of const; const AFlags: TGDBMICmdFlags; const AValues: array of const; const AFlags: TGDBMICmdFlags;
var AResult: TGDBMIExecResult): Boolean; var AResult: TGDBMIExecResult): Boolean;
@ -5220,27 +5092,6 @@ begin
then SetState(dsStop); then SetState(dsStop);
end; end;
function TGDBMIDebugger.GetText(const ALocation: TDBGPtr): String;
var
S: String;
begin
Str(ALocation, S);
Result := GetText(S, []);
end;
function TGDBMIDebugger.GetText(const AExpression: String;
const AValues: array of const): String;
var
R: TGDBMIExecResult;
begin
if not ExecuteCommand('x/s ' + AExpression, AValues, [cfNoMICommand, cfIgnoreError], R)
then begin
Result := '';
Exit;
end;
Result := ProcessGDBResultText(StripLN(R.Values));
end;
function TGDBMIDebugger.GetSupportedCommands: TDBGCommands; function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
begin begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto, Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto,
@ -6153,11 +6004,12 @@ end;
{%endregion ^^^^^ BreakPoints ^^^^^ } {%endregion ^^^^^ BreakPoints ^^^^^ }
{ =========================================================================== } {%region ***** Locals ***** }
{ TGDBMILocals } { TGDBMIDebuggerCommandLocals }
{ =========================================================================== }
procedure TGDBMILocals.AddLocals(const AParams: String); function TGDBMIDebuggerCommandLocals.DoExecute: Boolean;
procedure AddLocals(const AParams: String);
var var
n, e: Integer; n, e: Integer;
addr: TDbgPtr; addr: TDbgPtr;
@ -6185,15 +6037,61 @@ begin
if e=0 then ; if e=0 then ;
if addr = 0 if addr = 0
then Value := '''''' then Value := ''''''
else Value := '''' + TGDBMIDebugger(Debugger).GetText(addr) + ''''; else Value := '''' + GetText(addr) + '''';
end; end;
FLocals.Add(Name + '=' + Value); FResult.Add(Name + '=' + Value);
end; end;
FreeAndNil(List); FreeAndNil(List);
FreeAndNil(LocList); FreeAndNil(LocList);
end; end;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
begin
Result := True;
// args
ExecuteCommand('-stack-list-arguments 1 %0:d %0:d',
[FTheDebugger.FCurrentStackFrame], R);
if R.State <> dsError
then begin
List := TGDBMINameValueList.Create(R, ['stack-args', 'frame']);
AddLocals(List.Values['args']);
FreeAndNil(List);
end;
// variables
ExecuteCommand('-stack-list-locals 1', R);
if R.State <> dsError
then begin
List := TGDBMINameValueList.Create(R);
AddLocals(List.Values['locals']);
FreeAndNil(List);
end;
end;
constructor TGDBMIDebuggerCommandLocals.Create(AOwner: TGDBMIDebugger);
begin
inherited Create(AOwner);
FResult := TStringList.Create;
end;
destructor TGDBMIDebuggerCommandLocals.Destroy;
begin
inherited Destroy;
FreeAndNil(FResult);
end;
function TGDBMIDebuggerCommandLocals.DebugText: String;
begin
Result := Format('%s:', [ClassName]);
end;
{ =========================================================================== }
{ TGDBMILocals }
{ =========================================================================== }
procedure TGDBMILocals.Changed; procedure TGDBMILocals.Changed;
begin begin
Invalidate; Invalidate;
@ -6285,10 +6183,7 @@ begin
FEvaluatedState := esValid; FEvaluatedState := esValid;
FEvaluationCmdObj := nil; FEvaluationCmdObj := nil;
Cmd := TGDBMIDebuggerCommandLocals(Sender); Cmd := TGDBMIDebuggerCommandLocals(Sender);
if Cmd.Args <> '' FLocals.Assign(Cmd.Result);
then AddLocals(Cmd.Args);
if Cmd.Vars <> ''
then AddLocals(Cmd.Vars);
// Do not recursively call, whoever is requesting the locals // Do not recursively call, whoever is requesting the locals
if not FInLocalsNeeded if not FInLocalsNeeded
then inherited Changed; then inherited Changed;
@ -6322,6 +6217,8 @@ begin
FEvaluationCmdObj := nil; FEvaluationCmdObj := nil;
end; end;
{%endregion ^^^^^ BreakPoints ^^^^^ }
{ =========================================================================== } { =========================================================================== }
{ TGDBMIRegisters } { TGDBMIRegisters }
{ =========================================================================== } { =========================================================================== }
@ -8015,6 +7912,103 @@ begin
until not FTheDebugger.DebugProcessRunning; until not FTheDebugger.DebugProcessRunning;
end; end;
function TGDBMIDebuggerCommand.ProcessGDBResultText(S: String): String;
var
Trailor: String;
n, len, idx: Integer;
v: Integer;
begin
// don't use ' as end terminator, there might be one as part of the text
// since ' will be the last char, simply strip it.
S := GetPart(['\t '], [], S);
// Scan the string
len := Length(S);
// Set the resultstring initially to the same size
SetLength(Result, len);
n := 0;
idx := 1;
Trailor:='';
while idx <= len do
begin
case S[idx] of
'''': begin
Inc(idx);
// scan till end
while idx <= len do
begin
case S[idx] of
'''' : begin
Inc(idx);
if idx > len then Break;
if S[idx] <> '''' then Break;
end;
'\' : begin
Inc(idx);
if idx > len then Break;
case S[idx] of
't': S[idx] := #9;
'n': S[idx] := #10;
'r': S[idx] := #13;
end;
end;
end;
Inc(n);
Result[n] := S[idx];
Inc(idx);
end;
end;
'#': begin
Inc(idx);
v := 0;
// scan till non number (correct input is assumed)
while (idx <= len) and (S[idx] >= '0') and (S[idx] <= '9') do
begin
v := v * 10 + Ord(S[idx]) - Ord('0');
Inc(idx)
end;
Inc(n);
Result[n] := Chr(v and $FF);
end;
',', ' ': begin
Inc(idx); //ignore them;
end;
'<': begin
// Debugger has returned something like <repeats 10 times>
v := StrToIntDef(GetPart(['<repeats '], [' times>'], S), 0);
// Since we deleted the first part of S, reset idx
idx := 8; // the char after ' times>'
len := Length(S);
if v <= 1 then Continue;
// limit the amount of repeats
if v > 1000
then begin
Trailor := Trailor + Format('###(repeat truncated: %u -> 1000)###', [v]);
v := 1000;
end;
// make sure result has some room
SetLength(Result, Length(Result) + v - 1);
while v > 1 do begin
Inc(n);
Result[n] := Result[n - 1];
Dec(v);
end;
end;
else
// Debugger has returned something we don't know of
// Append the remainder to our parsed result
Delete(S, 1, idx - 1);
Trailor := Trailor + '###(gdb unparsed remainder:' + S + ')###';
Break;
end;
end;
SetLength(Result, n);
Result := Result + Trailor;
end;
function TGDBMIDebuggerCommand.GetFrame(const AIndex: Integer): String; function TGDBMIDebuggerCommand.GetFrame(const AIndex: Integer): String;
var var
R: TGDBMIExecResult; R: TGDBMIExecResult;
@ -9144,39 +9138,6 @@ begin
Result := Format('%s: %s', [ClassName, FExpression]); Result := Format('%s: %s', [ClassName, FExpression]);
end; end;
{ TGDBMIDebuggerCommandLocals }
function TGDBMIDebuggerCommandLocals.DoExecute: Boolean;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
begin
Result := True;
// args
ExecuteCommand('-stack-list-arguments 1 %0:d %0:d',
[FTheDebugger.FCurrentStackFrame], R);
if R.State <> dsError
then begin
List := TGDBMINameValueList.Create(R, ['stack-args', 'frame']);
FArgs := List.Values['args'];
FreeAndNil(List);
end;
// variables
ExecuteCommand('-stack-list-locals 1', R);
if R.State <> dsError
then begin
List := TGDBMINameValueList.Create(R);
FVars := List.Values['locals'];
FreeAndNil(List);
end;
end;
function TGDBMIDebuggerCommandLocals.DebugText: String;
begin
Result := Format('%s:', [ClassName]);
end;
initialization initialization
RegisterDebugger(TGDBMIDebugger); RegisterDebugger(TGDBMIDebugger);