From 5944e6f4707a0a950bfddafea879ab38bbfeedc7 Mon Sep 17 00:00:00 2001 From: martin Date: Fri, 23 Aug 2013 13:19:30 +0000 Subject: [PATCH] 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 - --- debugger/callstackdlg.pp | 27 ++++---- debugger/debugger.pp | 128 +++++++++++++++++++++++++++++++++++--- debugger/gdbmidebugger.pp | 90 +++++++++++++++++++++++---- ide/debugmanager.pas | 5 +- 4 files changed, 214 insertions(+), 36 deletions(-) diff --git a/debugger/callstackdlg.pp b/debugger/callstackdlg.pp index 29c84b873b..ce7bf9d0c4 100644 --- a/debugger/callstackdlg.pp +++ b/debugger/callstackdlg.pp @@ -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; diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 29fa6997d3..b712f977e0 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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); diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index fe09d31a59..7ba9b339df 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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 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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 5a2eb00c13..756c29a513 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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