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

DBG: more checks on parentfp

Browse Source 
git-svn-id: trunk@36404 -
This commit is contained in:
martin 2012-03-28 21:10:48 +00:00
parent 0a1779a998
commit 69c5e7d27f
1 changed files with 91 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
debugger/gdbmidebugger.pp
View File

@ -11612,95 +11612,121 @@ var
var var
R: TGDBMIExecResult; R: TGDBMIExecResult;
List: TGDBMINameValueList; List: TGDBMINameValueList;
ParentFp, Fp: String; ParentFp, Fp, LastFp: String;
i, j, ThreadId: Integer; i, j, ThreadId: Integer;
FrameCache: PGDBMIDebuggerParentFrameCache; FrameCache: PGDBMIDebuggerParentFrameCache;
ParentFpNum, FpNum, FpDiff, LastFpDiff: QWord;
FpDir: Integer;
begin begin
if FWatchValue <> nil if FWatchValue <> nil
then ThreadId := FWatchValue.ThreadId then ThreadId := FWatchValue.ThreadId
else ThreadId := FTheDebugger.FCurrentThreadId; else ThreadId := FTheDebugger.FCurrentThreadId;
FrameCache := TGDBMIWatches(FTheDebugger.Watches).GetParentFPList(ThreadId); FrameCache := TGDBMIWatches(FTheDebugger.Watches).GetParentFPList(ThreadId);
List := nil; List := nil;
try
i := length(FrameCache^.ParentFPList);
j := Max(i, aFrameIdx+1);
if j >= i
then SetLength(FrameCache^.ParentFPList, j + 3);
// Did a previous check for parentfp fail?
ParentFP := FrameCache^.ParentFPList[aFrameIdx].parentfp;
if ParentFp = '-'
then Exit(False);
if ParentFp = '' then begin
// not yet evaluated
if ExecuteCommand('-data-evaluate-expression parentfp', R)
and (R.State <> dsError)
then begin
List := TGDBMINameValueList.Create(R);
ParentFP := List.Values['value'];
end;
if ParentFp = '' then begin
FrameCache^.ParentFPList[aFrameIdx].parentfp := '-'; // mark as no parentfp
List.Free;
Exit(False);
end;
FrameCache^.ParentFPList[aFrameIdx].parentfp := ParentFp;
end;
if StrToQWordDef(ParentFp, 0) = 0 then begin
FrameCache^.ParentFPList[aFrameIdx].parentfp := '-'; // mark as no parentfp
List.Free;
Exit(False);
end;
if List = nil
then List := TGDBMINameValueList.Create('');
repeat
Inc(aFrameIdx);
i := length(FrameCache^.ParentFPList); i := length(FrameCache^.ParentFPList);
j := Max(i, aFrameIdx+1); j := Max(i, aFrameIdx+1);
if j >= i if j >= i
then SetLength(FrameCache^.ParentFPList, j + 5); then SetLength(FrameCache^.ParentFPList, j + 3);
Fp := FrameCache^.ParentFPList[aFrameIdx].Fp; // Did a previous check for parentfp fail?
if Fp = '-' ParentFP := FrameCache^.ParentFPList[aFrameIdx].parentfp;
then begin if ParentFp = '-'
List.Free; then Exit(False);
if ParentFp = '' then begin
// not yet evaluated
if ExecuteCommand('-data-evaluate-expression parentfp', R)
and (R.State <> dsError)
then begin
List := TGDBMINameValueList.Create(R);
ParentFP := List.Values['value'];
end;
if ParentFp = '' then begin
FrameCache^.ParentFPList[aFrameIdx].parentfp := '-'; // mark as no parentfp
Exit(False);
end;
FrameCache^.ParentFPList[aFrameIdx].parentfp := ParentFp;
end;
ParentFpNum := StrToQWordDef(ParentFp, 0);
if ParentFpNum = 0 then begin
FrameCache^.ParentFPList[aFrameIdx].parentfp := '-'; // mark as no parentfp
Exit(False); Exit(False);
end; end;
if (Fp = '') or (Fp = ParentFP) then begin if List = nil
if not ExecuteCommand('-stack-select-frame %u', [aFrameIdx], R) then List := TGDBMINameValueList.Create('');
or (R.State = dsError)
then begin LastFp := '';
FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible) LastFpDiff := 0;
List.Free; FpDir := 0;
repeat
Inc(aFrameIdx);
i := length(FrameCache^.ParentFPList);
j := Max(i, aFrameIdx+1);
if j >= i
then SetLength(FrameCache^.ParentFPList, j + 5);
Fp := FrameCache^.ParentFPList[aFrameIdx].Fp;
if Fp = '-'
then begin
Exit(False); Exit(False);
end; end;
FStackFrameChanged := True; // Force UnSelectContext() to restore current frame
FTheDebugger.FInternalStackFrame := aFrameIdx;
if (Fp = '') then begin if (Fp = '') or (Fp = ParentFP) then begin
if not ExecuteCommand('-data-evaluate-expression $fp', R) if not ExecuteCommand('-stack-select-frame %u', [aFrameIdx], R)
or (R.State = dsError) or (R.State = dsError)
then begin then begin
FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible) FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible)
List.Free;
Exit(False); Exit(False);
end; end;
List.Init(R.Values); FStackFrameChanged := True; // Force UnSelectContext() to restore current frame
Fp := List.Values['value']; FTheDebugger.FInternalStackFrame := aFrameIdx;
if Fp = ''
then Fp := '-';
FrameCache^.ParentFPList[aFrameIdx].Fp := Fp;
end;
end;
until ParentFP = Fp;
List.Free;
Result := True; if (Fp = '') then begin
if not ExecuteCommand('-data-evaluate-expression $fp', R)
or (R.State = dsError)
then begin
FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible)
Exit(False);
end;
List.Init(R.Values);
Fp := List.Values['value'];
if Fp = ''
then Fp := '-';
FrameCache^.ParentFPList[aFrameIdx].Fp := Fp;
end;
end;
if FP = LastFp then // Propably top of stack, FP no longer changes
Exit(False);
LastFp := Fp;
// check that FP gets closer to ParentFp
FpNum := StrToQWordDef(Fp, 0);
if FpNum > ParentFpNum then begin
if FpDir = 1 then exit; // went to far
FpDir := -1;
FpDiff := FpNum - ParentFpNum;
end else begin
if FpDir = -1 then exit; // went to far
FpDir := 1;
FpDiff := ParentFpNum - FpNum;
end;
if (LastFpDiff <> 0) and (FpDir >= LastFpDiff) then
Exit(False);
LastFpDiff := FpDiff;
until ParentFP = Fp;
Result := True;
finally
List.Free;
end;
end; end;
function PascalizePointer(AString: String; const TypeCast: String = ''): String; function PascalizePointer(AString: String; const TypeCast: String = ''): String;