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

DBG: History values: evaluate in background, if windows are closed

Browse Source 
git-svn-id: trunk@30752 -
This commit is contained in:
martin 2011-05-16 00:45:19 +00:00
parent 156372ea58
commit 65b111ae79
8 changed files with 117 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
debugger/callstackdlg.pp
View File

@ -256,6 +256,7 @@ var
First, Count: Integer;
Source: String;
Snap: TSnapshot;
CStack: TCallStack;
begin
if (not ToolButtonPower.Down) or FInUpdateView then exit;
BeginUpdate;
@ -267,22 +268,35 @@ begin
else Caption:= lisMenuViewCallStack;
FInUpdateView := True; // ignore change triggered by count, if there is a change event, then Count will be updated already
if (GetSelectedCallstack = nil) or (GetSelectedCallstack.Count=0)
CStack := GetSelectedCallstack;
FInUpdateView := False;
if (CStack = nil) or ((Snap <> nil) and (CStack.Count = 0)) then begin
lvCallStack.Items.Clear;
Item := lvCallStack.Items.Add;
Item.SubItems.Add('');
Item.SubItems.Add(lisCallStackNotEvaluated);
Item.SubItems.Add('');
Item.SubItems.Add('');
exit;
end;
if (CStack.Count=0)
then begin
txtGoto.Text:= '0';
lvCallStack.Items.Clear;
exit;
end;
FInUpdateView := False;
if Snap <> nil then begin
First := 0;
Count := GetSelectedCallstack.Count;
Count := CStack.Count;
end else begin
First := FViewStart;
if First + FViewLimit <= GetSelectedCallstack.Count
if First + FViewLimit <= CStack.Count
then Count := FViewLimit
else Count := GetSelectedCallstack.Count - First;
else Count := CStack.Count - First;
end;
// Reuse entries, so add and remove only
@ -301,12 +315,12 @@ begin
end;
FInUpdateView := True;
GetSelectedCallstack.PrepareRange(First, Count);
CStack.PrepareRange(First, Count);
FInUpdateView := False;
for n := 0 to Count - 1 do
begin
Item := lvCallStack.Items[n];
Entry := GetSelectedCallstack.Entries[First + n];
Entry := CStack.Entries[First + n];
if Entry = nil
then begin
Item.Caption := '';
@ -653,16 +667,18 @@ procedure TCallStackDlg.BreakPointChanged(const ASender: TIDEBreakPoints;
var
i, idx: Integer;
Entry: TCallStackEntry;
Stack: TCallStack;
begin
if BreakPoints = nil then
Stack := GetSelectedCallstack;
if (BreakPoints = nil) or (Stack = nil) then
Exit;
for i := 0 to lvCallStack.Items.Count - 1 do
begin
idx := FViewStart + lvCallStack.Items[i].Index;
if idx >= GetSelectedCallstack.Count then
if idx >= Stack.Count then
Continue;
Entry := GetSelectedCallstack.Entries[idx];
Entry := Stack.Entries[idx];
if Entry <> nil then
lvCallStack.Items[i].ImageIndex := GetImageIndex(Entry)
else

56
debugger/debugger.pp
View File

@ -1937,6 +1937,8 @@ type
end;
{ TSnapshotManager }
TSnapshotManagerRequestedFlags = set of
(smrThreads, smrCallStackCnt, smrCallStack, smrLocals, smrWatches);
TSnapshotManager = class
private
@ -1948,6 +1950,7 @@ type
FThreads: TThreadsMonitor;
FCurrentState: TDBGState;
FCurrentSnapshot: TSnapshot; // snapshot fo rcurrent pause. Not yet in list
FRequestsDone: TSnapshotManagerRequestedFlags;
private
FActive: Boolean;
FHistoryCapacity: Integer;
@ -1969,6 +1972,7 @@ type
procedure AddNotification(const ANotification: TSnapshotNotification);
procedure RemoveNotification(const ANotification: TSnapshotNotification);
procedure DoStateChange(const AOldState: TDBGState);
procedure DoDebuggerIdle;
property Active: Boolean read FActive write SetActive;
public
function SelectedId: Pointer;
@ -2315,6 +2319,7 @@ type
FLineInfo: TDBGLineInfo;
FOnConsoleOutput: TDBGOutputEvent;
FOnFeedback: TDBGFeedbackEvent;
FOnIdle: TNotifyEvent;
FRegisters: TDBGRegisters;
FShowConsole: Boolean;
FSignals: TDBGSignals;
@ -2363,6 +2368,7 @@ type
function GetSupportedCommands: TDBGCommands; virtual;
function GetTargetWidth: Byte; virtual;
function GetWaiting: Boolean; virtual;
function GetIsIdle: Boolean; virtual;
function RequestCommand(const ACommand: TDBGCommand;
const AParams: array of const): Boolean;
virtual; abstract; // True if succesful
@ -2433,6 +2439,7 @@ type
property Watches: TWatchesSupplier read FWatches; // list of all watches etc
property Threads: TThreadsSupplier read FThreads;
property WorkingDir: String read FWorkingDir write FWorkingDir; // The working dir of the exe being debugged
property IsIdle: Boolean read GetIsIdle; // Nothing queued
// Events
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput; // Passes all debuggeroutput
@ -2443,6 +2450,7 @@ type
property OnBreakPointHit: TDebuggerBreakPointHitEvent read FOnBreakPointHit write FOnBreakPointHit; // Fires when the program is paused at a breakpoint
property OnConsoleOutput: TDBGOutputEvent read FOnConsoleOutput write FOnConsoleOutput; // Passes Application Console Output
property OnFeedback: TDBGFeedbackEvent read FOnFeedback write FOnFeedback;
property OnIdle: TNotifyEvent read FOnIdle write FOnIdle; // Called if all outstanding requests are processed (queue empty)
end;
TDebuggerClass = class of TDebugger;
@ -2719,6 +2727,7 @@ begin
FCurrentState := Debugger.State;
if FDebugger.State = dsPause then begin
FRequestsDone := [];
if FActive then CreateHistoryEntry;
HistorySelected := False;
end
@ -2737,6 +2746,48 @@ begin
end;
end;
procedure TSnapshotManager.DoDebuggerIdle;
var
i, j, k: LongInt;
w: TCurrentWatches;
begin
if FCurrentState <> dsPause then exit;
if not(smrThreads in FRequestsDone) then begin
include(FRequestsDone, smrThreads);
FThreads.CurrentThreads.Count;
if not Debugger.IsIdle then exit;
end;
if not(smrCallStackCnt in FRequestsDone) then begin
include(FRequestsDone, smrCallStackCnt);
i := FThreads.CurrentThreads.CurrentThreadId;
FCallStack.CurrentCallStackList.EntriesForThreads[i].Count;
if not Debugger.IsIdle then exit;
end;
if not(smrCallStack in FRequestsDone) then begin
include(FRequestsDone, smrCallStack);
i := FThreads.CurrentThreads.CurrentThreadId;
k := FCallStack.CurrentCallStackList.EntriesForThreads[i].Count;
if k > 0
then FCallStack.CurrentCallStackList.EntriesForThreads[i].PrepareRange(0, Min(5, k));
if not Debugger.IsIdle then exit;
end;
if not(smrLocals in FRequestsDone) then begin
include(FRequestsDone, smrLocals);
i := FThreads.CurrentThreads.CurrentThreadId;
j := FCallStack.CurrentCallStackList.EntriesForThreads[i].CurrentIndex;
FLocals.CurrentLocalsList.Entries[i, j].Count;
if not Debugger.IsIdle then exit;
end;
if not(smrWatches in FRequestsDone) then begin
include(FRequestsDone, smrWatches);
i := FThreads.CurrentThreads.CurrentThreadId;
j := FCallStack.CurrentCallStackList.EntriesForThreads[i].CurrentIndex;
w := FWatches.CurrentWatches;
for k := 0 to w.Count - 1 do w[k].Values[i, j].Value;
if not Debugger.IsIdle then exit;
end;
end;
function TSnapshotManager.SelectedId: Pointer;
begin
if (HistoryIndex < 0) or (HistoryIndex >= HistoryCount) or (not FHistorySelected)
@ -4607,6 +4658,11 @@ begin
FCurEnvironment.Assign(FEnvironment);
end;
function TDebugger.GetIsIdle: Boolean;
begin
Result := False;
end;
function TDebugger.Evaluate(const AExpression: String; var AResult: String;
var ATypeInfo: TDBGType; EvalFlags: TDBGEvaluateFlags = []): Boolean;
begin

10
debugger/gdbmidebugger.pp
View File

@ -387,6 +387,7 @@ type
function ParseInitialization: Boolean; virtual;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
procedure ClearCommandQueue;
function GetIsIdle: Boolean; override;
procedure DoState(const OldState: TDBGState); override;
procedure DoThreadChanged;
property TargetPID: Integer read FTargetInfo.TargetPID;
@ -5609,6 +5610,10 @@ begin
FInExecuteCount := SavedInExecuteCount;
FCurrentCommand := NestedCurrentCmd;
end;
if (FCommandQueue.Count = 0) and assigned(OnIdle)
then OnIdle(Self);
end;
procedure TGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False);
@ -6402,6 +6407,11 @@ begin
FCommandQueue.Clear;
end;
function TGDBMIDebugger.GetIsIdle: Boolean;
begin
Result := FCommandQueue.Count = 0;
end;
procedure TGDBMIDebugger.ClearSourceInfo;
var
n: Integer;

3
debugger/localsdlg.pp
View File

@ -184,6 +184,9 @@ begin
if Locals = nil
then begin
lvLocals.Items.Clear;
Item := lvLocals.Items.Add;
Item.Caption := '';
Item.SubItems.add(lisLocalsNotEvaluated);
Exit;
end;

10
debugger/threaddlg.pp
View File

@ -69,9 +69,15 @@ begin
Caption:= lisThreads;
end;
if Threads = nil then begin
if (Threads = nil) or ((Snap <> nil) and (Threads.Count=0)) then begin
lvThreads.Clear;
// Todo: display "no info available"
Item := lvThreads.Items.Add;
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add('');
Item.SubItems.add(lisThreadsNotEvaluated);
Item.SubItems.add('');
Item.SubItems.add('');
exit;
end;

3
debugger/watchesdlg.pp
View File

@ -727,7 +727,8 @@ begin
include(FStateFlags, wdsfUpdating);
AItem.Caption := AWatch.Expression;
WatchValue := AWatch.Values[GetThreadId, GetStackframe];
if WatchValue <> nil
if (WatchValue <> nil) and
( (GetSelectedSnapshot = nil) or not(WatchValue.Validity in [ddsUnknown, ddsEvaluating, ddsRequested]) )
then AItem.SubItems[0] := ClearMultiline(WatchValue.Value)
else AItem.SubItems[0] := '<not evaluated>';
exclude(FStateFlags, wdsfUpdating);

7
ide/debugmanager.pas
View File

@ -65,6 +65,7 @@ type
{ TDebugManager }
TDebugManager = class(TBaseDebugManager)
procedure DebuggerIdle(Sender: TObject);
private
procedure BreakAutoContinueTimer(Sender: TObject);
procedure OnRunTimer(Sender: TObject);
@ -613,6 +614,11 @@ begin
Result := ExecuteFeedbackDialog(AText, AInfo, AType, AButtons);
end;
procedure TDebugManager.DebuggerIdle(Sender: TObject);
begin
FSnapshots.DoDebuggerIdle;
end;
procedure TDebugManager.BreakAutoContinueTimer(Sender: TObject);
begin
FAutoContinueTimer.Enabled := False;
@ -1806,6 +1812,7 @@ begin
FDebugger.OnException := @DebuggerException;
FDebugger.OnConsoleOutput := @DebuggerConsoleOutput;
FDebugger.OnFeedback := @DebuggerFeedback;
FDebugger.OnIdle := @DebuggerIdle;
if FDebugger.State = dsNone
then begin

5
ide/lazarusidestrconsts.pas
View File

@ -4692,10 +4692,14 @@ resourcestring
lisRecordStruct = 'Record/Structure';
lisMemoryDump = 'Memory Dump';
// Callstack
lisCallStackNotEvaluated = 'Stack not evaluated';
// Locals Dialog
lisLocals = 'Locals';
lisLocalsDlgName = 'Name';
lisLocalsDlgValue = 'Value';
lisLocalsNotEvaluated = 'Locals not evaluated';
// Registers Dialog
lisRegisters = 'Registers';
@ -4712,6 +4716,7 @@ resourcestring
lisThreadsFunc = 'Function';
lisThreadsCurrent = 'Current';
lisThreadsGoto = 'Goto';
lisThreadsNotEvaluated = 'Threads not evaluated';
// HistoryDlg
histdlgFormName = 'History';