Debugger: limit the depth of stack evaluation / avoid long wait, if stack is very deep, and only top is needed.

git-svn-id: trunk@42461 -
This commit is contained in:
martin 2013-08-23 13:19:30 +00:00
parent 02baf26d2a
commit 5944e6f470
4 changed files with 214 additions and 36 deletions

View File

@ -272,7 +272,7 @@ var
n: Integer;
Item: TListItem;
Entry: TCallStackEntry;
First, Count: Integer;
First, Count, MaxCnt: Integer;
Source: String;
Snap: TSnapshot;
CStack: TCallStack;
@ -297,10 +297,11 @@ begin
FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already
CStack := GetSelectedCallstack;
if CStack <> nil then CStack.Count; // trigger the update-notification, if executed immediately
MaxCnt := FViewStart + FViewLimit + 1;
if CStack <> nil then CStack.CountLimited(MaxCnt); // trigger the update-notification, if executed immediately
FInUpdateView := False;
if (CStack = nil) or ((Snap <> nil) and (CStack.Count = 0)) then begin
if (CStack = nil) or ((Snap <> nil) and (CStack.CountLimited(MaxCnt) = 0)) then begin
lvCallStack.Items.Clear;
Item := lvCallStack.Items.Add;
Item.SubItems.Add('');
@ -310,7 +311,7 @@ begin
exit;
end;
if (CStack.Count=0)
if (CStack.CountLimited(MaxCnt)=0)
then begin
txtGoto.Text:= '0';
lvCallStack.Items.Clear;
@ -320,10 +321,10 @@ begin
if Snap <> nil then begin
First := 0;
Count := CStack.Count;
Count := CStack.CountLimited(MaxCnt);
end else begin
First := FViewStart;
if First + FViewLimit <= CStack.Count
if First + FViewLimit <= CStack.CountLimited(MaxCnt)
then Count := FViewLimit
else Count := CStack.Count - First;
end;
@ -467,7 +468,7 @@ begin
if CurItem = nil then Exit;
idx := FViewStart + CurItem.Index;
if idx >= GetSelectedCallstack.Count then Exit;
if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit;
Result := GetSelectedCallstack.Entries[idx];
end;
@ -519,8 +520,9 @@ begin
DisableAllActions;
if (Item <> nil) and (BreakPoints <> nil) then
begin
GetSelectedCallstack.CountLimited(lvCallStack.Items[lvCallStack.Items.Count - 1].Index+1); // get max limit
idx := FViewStart + Item.Index;
if idx >= GetSelectedCallstack.Count then Exit;
if idx >= GetSelectedCallstack.CountLimited(idx+1) then Exit;
Entry := GetSelectedCallstack.Entries[idx];
if not DebugBoss.GetFullFilename(Entry.UnitInfo, FileName, False) then
Exit;
@ -682,10 +684,11 @@ begin
if (BreakPoints = nil) or (Stack = nil) then
Exit;
Stack.CountLimited(lvCallStack.Items[lvCallStack.Items.Count - 1].Index+1);
for i := 0 to lvCallStack.Items.Count - 1 do
begin
idx := FViewStart + lvCallStack.Items[i].Index;
if idx >= Stack.Count then
if idx >= Stack.CountLimited(idx+1) then
Continue;
Entry := Stack.Entries[idx];
if Entry <> nil then
@ -767,7 +770,7 @@ begin
ToolButtonPower.Down := True;
ToolButtonPowerClick(nil);
if (AStart > GetSelectedCallstack.Count - FViewLimit)
if (AStart > GetSelectedCallstack.CountLimited(AStart+FViewLimit+1) - FViewLimit)
then AStart := GetSelectedCallstack.Count - FViewLimit;
if AStart < 0 then AStart := 0;
if FViewStart = AStart then Exit;
@ -790,7 +793,7 @@ begin
ToolButtonPowerClick(nil);
if FViewLimit = AValue then Exit;
if (GetSelectedCallstack <> nil)
and (FViewStart + FViewLimit >= GetSelectedCallstack.Count)
and (FViewStart + FViewLimit >= GetSelectedCallstack.CountLimited(FViewStart + FViewLimit+1))
and (AValue > FViewLimit)
then begin
FViewStart := GetSelectedCallstack.Count - AValue;
@ -808,7 +811,7 @@ end;
procedure TCallStackDlg.GotoIndex(AIndex: Integer);
begin
if AIndex < 0 then Exit;
if AIndex >= GetSelectedCallstack.Count then Exit;
if AIndex >= GetSelectedCallstack.CountLimited(AIndex+1) then Exit;
end;

View File

@ -394,6 +394,8 @@ type
ddsError // Error, but got some Value to display (e.g. error msg)
);
TNullableBool = (nbUnknown, nbTrue, nbFalse);
{ TDebuggerDataMonitor }
TDebuggerDataMonitor = class
@ -1795,6 +1797,8 @@ type
procedure Assign(AnOther: TCallStack);
procedure PrepareRange({%H-}AIndex, {%H-}ACount: Integer); virtual;
procedure ChangeCurrentIndex(ANewIndex: Integer); virtual;
function HasAtLeastCount(ARequiredMinCount: Integer): TNullableBool; virtual; // Can be faster than getting the full count
function CountLimited(ALimit: Integer): Integer;
property Count: Integer read GetCount write SetCount;
property CurrentIndex: Integer read GetCurrent write SetCurrent;
property Entries[AIndex: Integer]: TCallStackEntry read GetEntry;
@ -1833,13 +1837,13 @@ type
TCurrentCallStack = class(TCallStack)
private
FMonitor: TCallStackMonitor;
FCountValidity: TDebuggerDataState;
FCountValidity, FAtLeastCountValidity: TDebuggerDataState;
FCurrentValidity: TDebuggerDataState;
FNewCurrentIndex: Integer;
FPreparing: Boolean;
FSnapShot: TCallStack;
FEntries: TMap; // list of created entries
FCount: Integer;
FCount, FAtLeastCount, FAtLeastCountOld: Integer;
FLowestUnknown, FHighestUnknown: Integer;
procedure SetSnapShot(const AValue: TCallStack);
protected
@ -1860,6 +1864,7 @@ type
procedure ChangeCurrentIndex(ANewIndex: Integer); override;
procedure DoEntriesCreated;
procedure DoEntriesUpdated;
function HasAtLeastCount(ARequiredMinCount: Integer): TNullableBool; override;
property LowestUnknown: Integer read FLowestUnknown;
property HighestUnknown: Integer read FHighestUnknown;
property RawEntries: TMap read FEntries;
@ -1867,6 +1872,7 @@ type
property SnapShot: TCallStack read FSnapShot write SetSnapShot;
public
procedure SetCountValidity(AValidity: TDebuggerDataState);
procedure SetHasAtLeastCountInfo(AValidity: TDebuggerDataState; AMinCount: Integer = -1);
procedure SetCurrentValidity(AValidity: TDebuggerDataState);
end;
@ -1896,6 +1902,7 @@ type
procedure SetSupplier(const AValue: TCallStackSupplier);
protected
procedure RequestCount(ACallstack: TCallStack);
procedure RequestAtLeastCount(ACallstack: TCallStack; ARequiredMinCount: Integer);
procedure RequestCurrent(ACallstack: TCallStack);
procedure RequestEntries(ACallstack: TCallStack);
procedure UpdateCurrentIndex;
@ -1922,6 +1929,7 @@ type
procedure SetMonitor(const AValue: TCallStackMonitor);
protected
procedure RequestCount(ACallstack: TCurrentCallStack); virtual;
procedure RequestAtLeastCount(ACallstack: TCurrentCallStack; ARequiredMinCount: Integer); virtual;
procedure RequestCurrent(ACallstack: TCurrentCallStack); virtual;
procedure RequestEntries(ACallstack: TCurrentCallStack); virtual;
procedure CurrentChanged;
@ -4189,7 +4197,7 @@ begin
if not(smrCallStack in FRequestsDone) then begin
i := FThreads.CurrentThreads.CurrentThreadId;
k := FCallStack.CurrentCallStackList.EntriesForThreads[i].Count;
k := FCallStack.CurrentCallStackList.EntriesForThreads[i].CountLimited(5);
if CurSnap <> FCurrentSnapshot then exit; // Debugger did "run" in between
if (k > 0) or (smrCallStackCnt in FRequestsDone) then begin
// Since DoDebuggerIdle was re-entered
@ -4210,7 +4218,7 @@ begin
if not(smrCallStackCnt in FRequestsDone) then begin
include(FRequestsDone, smrCallStackCnt);
i := FThreads.CurrentThreads.CurrentThreadId;
FCallStack.CurrentCallStackList.EntriesForThreads[i].Count;
FCallStack.CurrentCallStackList.EntriesForThreads[i].CountLimited(5);
if (not(FCurrentState in [dsPause, dsInternalPause])) or
(Debugger = nil) or ( (not Debugger.IsIdle) and (not AForce) )
then exit;
@ -5196,15 +5204,20 @@ begin
FEntries.Clear;
FCount := -1;
FAtLeastCount := -1;
FAtLeastCountOld := -1;
end;
constructor TCurrentCallStack.Create(AMonitor: TCallStackMonitor);
begin
FCount := 0;
FAtLeastCount := 0;
FAtLeastCountOld := -1;
FEntries:= TMap.Create(its4, SizeOf(TCallStackEntry));
FMonitor := AMonitor;
FPreparing := False;
FCountValidity := ddsUnknown;
FAtLeastCountValidity := ddsUnknown;
FCurrentValidity := ddsUnknown;
FLowestUnknown := -1;
FHighestUnknown := -1;
@ -5221,7 +5234,17 @@ end;
procedure TCurrentCallStack.Assign(AnOther: TCallStack);
begin
inherited Assign(AnOther);
FCount := AnOther.Count;
if AnOther is TCurrentCallStack then begin
FCount := TCurrentCallStack(AnOther).FCount;
FCountValidity := TCurrentCallStack(AnOther).FCountValidity;
FAtLeastCount := TCurrentCallStack(AnOther).FAtLeastCount;
FAtLeastCountOld := TCurrentCallStack(AnOther).FAtLeastCountOld;
end
else begin
FCount := AnOther.Count;
FAtLeastCount := -1;
FAtLeastCountOld := -1;
end;
end;
procedure TCurrentCallStack.SetSnapShot(const AValue: TCallStack);
@ -5255,14 +5278,15 @@ procedure TCurrentCallStack.SetCount(ACount: Integer);
begin
if FCount = ACount then exit;
FCount := ACount;
if FCountValidity =ddsValid then
FAtLeastCount := ACount;
if FCountValidity = ddsValid then
FMonitor.NotifyChange;
end;
function TCurrentCallStack.GetEntry(AIndex: Integer): TCallStackEntry;
begin
if (AIndex < 0)
or (AIndex >= Count) then IndexError(Aindex);
or (AIndex >= CountLimited(AIndex+1)) then IndexError(Aindex);
Result := nil;
if FEntries.GetData(AIndex, Result) then Exit;
@ -5357,6 +5381,49 @@ begin
FMonitor.NotifyChange;
end;
function TCurrentCallStack.HasAtLeastCount(ARequiredMinCount: Integer): TNullableBool;
begin
if FCountValidity = ddsValid then begin
Result := inherited HasAtLeastCount(ARequiredMinCount);
exit;
end;
if FAtLeastCountOld >= ARequiredMinCount then begin
Result := nbTrue;
exit;
end;
if (FAtLeastCountValidity = ddsValid) and (FAtLeastCount < ARequiredMinCount) then begin
FAtLeastCountOld := FAtLeastCount;
FAtLeastCountValidity := ddsUnknown;
end;
case FAtLeastCountValidity of
ddsUnknown: begin
Result := nbUnknown;
if FCountValidity in [ddsRequested, ddsEvaluating] then
exit;
FAtLeastCountValidity := ddsRequested;
FMonitor.RequestAtLeastCount(self, ARequiredMinCount);
if FAtLeastCountValidity = ddsValid then begin
if ARequiredMinCount <= FAtLeastCount then
Result := nbTrue
else
Result := nbFalse;
end;
end;
ddsRequested, ddsEvaluating: Result := nbUnknown;
ddsValid: begin
if ARequiredMinCount <= FAtLeastCount then
Result := nbTrue
else
Result := nbFalse;
end;
ddsInvalid, ddsError: Result := nbFalse;
end;
end;
procedure TCurrentCallStack.SetCountValidity(AValidity: TDebuggerDataState);
begin
if FCountValidity = AValidity then exit;
@ -5365,12 +5432,23 @@ begin
FMonitor.NotifyChange;
end;
procedure TCurrentCallStack.SetHasAtLeastCountInfo(AValidity: TDebuggerDataState;
AMinCount: Integer);
begin
if (FAtLeastCountValidity = AValidity) then exit;
DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TCurrentCallStack.SetCountMinValidity: FThreadId=', FThreadId, ' AValidity=',dbgs(AValidity)]);
FAtLeastCountOld := -1;
FAtLeastCountValidity := AValidity;
FAtLeastCount := AMinCount;
FMonitor.NotifyChange;
end;
procedure TCurrentCallStack.SetCurrentValidity(AValidity: TDebuggerDataState);
begin
if FCurrentValidity = AValidity then exit;
DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TCurrentCallStack.SetCurrentValidity: FThreadId=', FThreadId, ' AValidity=',dbgs(AValidity)]);
FCurrentValidity := AValidity;
if FCountValidity =ddsValid then
if FCurrentValidity = ddsValid then
FMonitor.NotifyChange;
FMonitor.NotifyCurrent;
end;
@ -7508,7 +7586,7 @@ begin
else
begin
Debugger.DoDbgEvent(ecBreakpoint, etBreakpointMessage, Format('Breakpoint Call Stack: Log %d stack frames', [Limit]));
Count := Min(CallStack.Count, Limit);
Count := CallStack.CountLimited(Limit);
CallStack.PrepareRange(0, Count);
end;
@ -9458,7 +9536,7 @@ end;
function TCallStack.GetEntry(AIndex: Integer): TCallStackEntry;
begin
if (AIndex < 0)
or (AIndex >= Count) then IndexError(Aindex);
or (AIndex >= CountLimited(AIndex+1)) then IndexError(Aindex);
Result := TCallStackEntry(FList[AIndex]);
end;
@ -9528,6 +9606,23 @@ begin
CurrentIndex := ANewIndex;
end;
function TCallStack.HasAtLeastCount(ARequiredMinCount: Integer): TNullableBool;
begin
if ARequiredMinCount <= Count then
Result := nbTrue
else
Result := nbFalse;
end;
function TCallStack.CountLimited(ALimit: Integer): Integer;
begin
case HasAtLeastCount(ALimit) of
nbUnknown: Result := 0;
nbTrue: Result := ALimit;
nbFalse: Result := Count;
end;
end;
procedure TCallStack.SetCount(ACount: Integer);
begin
// can not set count
@ -9597,6 +9692,13 @@ begin
then Supplier.RequestCount(TCurrentCallStack(ACallstack));
end;
procedure TCallStackMonitor.RequestAtLeastCount(ACallstack: TCallStack;
ARequiredMinCount: Integer);
begin
if (Supplier <> nil) and (ACallstack is TCurrentCallStack)
then Supplier.RequestAtLeastCount(TCurrentCallStack(ACallstack), ARequiredMinCount);
end;
procedure TCallStackMonitor.RequestCurrent(ACallstack: TCallStack);
begin
if (Supplier <> nil) and (ACallstack is TCurrentCallStack)
@ -9716,6 +9818,12 @@ begin
ACallstack.SetCountValidity(ddsInvalid);
end;
procedure TCallStackSupplier.RequestAtLeastCount(ACallstack: TCurrentCallStack;
ARequiredMinCount: Integer);
begin
RequestCount(ACallstack);
end;
procedure TCallStackSupplier.RequestCurrent(ACallstack: TCurrentCallStack);
begin
ACallstack.SetCurrentValidity(ddsInvalid);

View File

@ -1319,11 +1319,14 @@ type
TGDBMIDebuggerCommandStackDepth = class(TGDBMIDebuggerCommandStack)
private
FDepth: Integer;
FLimit: Integer;
protected
function DoExecute: Boolean; override;
public
constructor Create(AOwner: TGDBMIDebugger; ACallstack: TCurrentCallStack);
function DebugText: String; override;
property Depth: Integer read FDepth;
property Limit: Integer read FLimit write FLimit;
end;
{ TGDBMICallStack }
@ -1331,12 +1334,15 @@ type
TGDBMICallStack = class(TCallStackSupplier)
private
FCommandList: TList;
FDepthEvalCmdObj: TGDBMIDebuggerCommandStackDepth;
FLimitSeen: Integer;
procedure DoDepthCommandExecuted(Sender: TObject);
//procedure DoFramesCommandExecuted(Sender: TObject);
procedure DoCommandDestroyed(Sender: TObject);
protected
procedure Clear;
procedure RequestCount(ACallstack: TCurrentCallStack); override;
procedure RequestAtLeastCount(ACallstack: TCurrentCallStack; ARequiredMinCount: Integer); override;
procedure RequestCurrent(ACallstack: TCurrentCallStack); override;
procedure RequestEntries(ACallstack: TCurrentCallStack); override;
procedure UpdateCurrentIndex; override;
@ -6380,7 +6386,10 @@ begin
FDepth := -1;
ExecuteCommand('-stack-info-depth', R);
if FLimit > 0 then
ExecuteCommand('-stack-info-depth %d', [FLimit], R)
else
ExecuteCommand('-stack-info-depth', R);
List := TGDBMINameValueList.Create(R);
cnt := StrToIntDef(List.Values['depth'], -1);
FreeAndNil(List);
@ -6390,6 +6399,7 @@ begin
Trying to find out how many...
We try maximum 40 frames, because sometimes a corrupt stack and a bug in
gdb may cooperate, so that -stack-info-depth X returns always X }
FLimit := 0; // this is a final result
i:=0;
repeat
inc(i);
@ -6401,11 +6411,18 @@ begin
// no valid stack-info-depth found, so the previous was the last valid one
cnt:=i - 1;
end;
until (cnt<i) or (i=40);
until (cnt < i) or (i = 40);
end;
FDepth := cnt;
end;
constructor TGDBMIDebuggerCommandStackDepth.Create(AOwner: TGDBMIDebugger;
ACallstack: TCurrentCallStack);
begin
inherited Create(AOwner, ACallstack);
FLimit := 0;
end;
function TGDBMIDebuggerCommandStackDepth.DebugText: String;
begin
Result := Format('%s:', [ClassName]);
@ -9827,19 +9844,24 @@ var
Cmd: TGDBMIDebuggerCommandStackDepth;
begin
FCommandList.Remove(Sender);
FDepthEvalCmdObj := nil;
Cmd := TGDBMIDebuggerCommandStackDepth(Sender);
if Cmd.Callstack = nil then exit;
if Cmd.Depth < 0 then begin
Cmd.Callstack.SetCountValidity(ddsInvalid);
Cmd.Callstack.SetHasAtLeastCountInfo(ddsInvalid);
end else begin
Cmd.Callstack.Count := Cmd.Depth;
Cmd.Callstack.SetCountValidity(ddsValid);
if (Cmd.Limit > 0) and not(Cmd.Depth < Cmd.Limit) then begin
Cmd.Callstack.SetHasAtLeastCountInfo(ddsValid, Cmd.Depth);
end
else begin
Cmd.Callstack.Count := Cmd.Depth;
Cmd.Callstack.SetCountValidity(ddsValid);
end;
end;
end;
procedure TGDBMICallStack.RequestCount(ACallstack: TCurrentCallStack);
var
DepthEvalCmdObj: TGDBMIDebuggerCommandStackDepth;
begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause])
then begin
@ -9847,12 +9869,52 @@ begin
exit;
end;
DepthEvalCmdObj := TGDBMIDebuggerCommandStackDepth.Create(TGDBMIDebugger(Debugger), ACallstack);
DepthEvalCmdObj.OnExecuted := @DoDepthCommandExecuted;
DepthEvalCmdObj.OnDestroy := @DoCommandDestroyed;
DepthEvalCmdObj.Priority := GDCMD_PRIOR_STACK;
FCommandList.Add(DepthEvalCmdObj);
TGDBMIDebugger(Debugger).QueueCommand(DepthEvalCmdObj);
if (FDepthEvalCmdObj <> nil) and (FDepthEvalCmdObj .State = dcsQueued) then begin
FDepthEvalCmdObj.Limit := -1;
exit;
end;
FDepthEvalCmdObj := TGDBMIDebuggerCommandStackDepth.Create(TGDBMIDebugger(Debugger), ACallstack);
FDepthEvalCmdObj.OnExecuted := @DoDepthCommandExecuted;
FDepthEvalCmdObj.OnDestroy := @DoCommandDestroyed;
FDepthEvalCmdObj.Priority := GDCMD_PRIOR_STACK;
FCommandList.Add(FDepthEvalCmdObj);
TGDBMIDebugger(Debugger).QueueCommand(FDepthEvalCmdObj);
(* DoDepthCommandExecuted may be called immediately at this point *)
end;
procedure TGDBMICallStack.RequestAtLeastCount(ACallstack: TCurrentCallStack;
ARequiredMinCount: Integer);
begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause])
then begin
ACallstack.SetCountValidity(ddsInvalid);
exit;
end;
// avoid calling with many small minimum
// FLimitSeen starts at 11;
FLimitSeen := Max(FLimitSeen, Min(ARequiredMinCount, 51)); // remember, if the user has asked for more
if ARequiredMinCount <= 11 then
ARequiredMinCount := 11
else
ARequiredMinCount := Max(ARequiredMinCount, FLimitSeen);
if (FDepthEvalCmdObj <> nil) and (FDepthEvalCmdObj .State = dcsQueued) then begin
if FDepthEvalCmdObj.Limit <= 0 then
exit;
if FDepthEvalCmdObj.Limit < ARequiredMinCount then
FDepthEvalCmdObj.Limit := ARequiredMinCount;
exit;
end;
FDepthEvalCmdObj := TGDBMIDebuggerCommandStackDepth.Create(TGDBMIDebugger(Debugger), ACallstack);
FDepthEvalCmdObj.Limit := ARequiredMinCount;
FDepthEvalCmdObj.OnExecuted := @DoDepthCommandExecuted;
FDepthEvalCmdObj.OnDestroy := @DoCommandDestroyed;
FDepthEvalCmdObj.Priority := GDCMD_PRIOR_STACK;
FCommandList.Add(FDepthEvalCmdObj);
TGDBMIDebugger(Debugger).QueueCommand(FDepthEvalCmdObj);
(* DoDepthCommandExecuted may be called immediately at this point *)
end;
@ -9887,6 +9949,8 @@ end;
procedure TGDBMICallStack.DoCommandDestroyed(Sender: TObject);
begin
FCommandList.Remove(Sender);
if FDepthEvalCmdObj = Sender then
FDepthEvalCmdObj := nil;
end;
procedure TGDBMICallStack.Clear;
@ -9900,6 +9964,7 @@ begin
Cancel;
end;
FCommandList.Clear;
FDepthEvalCmdObj := nil;
end;
procedure TGDBMICallStack.UpdateCurrentIndex;
@ -9944,6 +10009,7 @@ end;
constructor TGDBMICallStack.Create(const ADebugger: TDebugger);
begin
FCommandList := TList.Create;
FLimitSeen := 11;
inherited Create(ADebugger);
end;

View File

@ -1271,7 +1271,7 @@ var
NewSource: TCodeBuffer;
Editor: TSourceEditor;
SrcLine: Integer;
i, TId: Integer;
c, i, TId: Integer;
StackEntry: TCallStackEntry;
Flags: TJumpToCodePosFlags;
CurrentSourceUnitInfo: TDebuggerUnitInfo;
@ -1290,7 +1290,8 @@ begin
// TODO: Only below the frame supplied by debugger
i:=0;
TId := Threads.CurrentThreads.CurrentThreadId;
while (i < CallStack.CurrentCallStackList.EntriesForThreads[TId].Count) do
c := CallStack.CurrentCallStackList.EntriesForThreads[TId].CountLimited(30);
while (i < c) do
begin
StackEntry := CallStack.CurrentCallStackList.EntriesForThreads[TId].Entries[i];
if StackEntry.Line > 0