mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 18:16:06 +02:00
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:
parent
02baf26d2a
commit
5944e6f470
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user