paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-30 14:18:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Automatic Snapshots on breakpoint

Browse Source 
git-svn-id: trunk@31111 -
This commit is contained in:
martin 2011-06-06 01:41:20 +00:00
parent 283669a413
commit 7e94016e3a
5 changed files with 93 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
debugger/breakpropertydlg.lfm
View File

@ -1,6 +1,6 @@
inherited BreakPropertyDlg: TBreakPropertyDlg
Left = 620
Height = 424
Height = 440
Top = 132
Width = 450
HorzScrollBar.Page = 386
@ -11,7 +11,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Breakpoint Properties'
ClientHeight = 424
ClientHeight = 440
ClientWidth = 450
Constraints.MinWidth = 450
Position = poScreenCenter
@ -180,14 +180,14 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 6
Height = 194
Height = 213
Top = 180
Width = 438
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Actions'
ClientHeight = 176
ClientHeight = 195
ClientWidth = 434
TabOrder = 4
object chkActionBreak: TCheckBox
@ -377,13 +377,26 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
Caption = 'lblLogCallStackLimit'
ParentColor = False
end
object chkTakeSnap: TCheckBox
AnchorSideLeft.Control = gbActions
AnchorSideTop.Control = edtLogCallStack
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 176
Width = 90
BorderSpacing.Left = 6
BorderSpacing.Top = 6
Caption = 'chkTakeSnap'
TabOrder = 11
end
end
object ButtonPanel: TButtonPanel[12]
AnchorSideTop.Control = gbActions
AnchorSideTop.Side = asrBottom
Left = 6
Height = 38
Top = 380
Height = 35
Top = 399
Width = 438
Anchors = [akTop, akLeft, akRight, akBottom]
OKButton.Name = 'OKButton'

4
debugger/breakpropertydlg.pas
View File

@ -16,6 +16,7 @@ type
TBreakPropertyDlg = class(TDebuggerDlg)
ButtonPanel: TButtonPanel;
chkTakeSnap: TCheckBox;
chkLogCallStack: TCheckBox;
chkEnableGroups: TCheckBox;
chkDisableGroups: TCheckBox;
@ -138,6 +139,7 @@ begin
// if chkEvalExpression.Checked then Include(Actions, bpaEValExpression);
if chkLogMessage.Checked then Include(Actions, bpaLogMessage);
if chkLogCallStack.Checked then Include(Actions, bpaLogCallStack);
if chkTakeSnap.Checked then include(Actions, bpaTakeSnapshot);
FBreakpoint.Actions := Actions;
FBreakpoint.LogMessage := edtLogMessage.Text;
FBreakpoint.LogCallStackLimit := edtLogCallStack.Value;
@ -195,6 +197,7 @@ begin
edtLogMessage.Text := FBreakpoint.LogMessage;
chkLogCallStack.Checked := bpaLogCallStack in Actions;
edtLogCallStack.Value := FBreakpoint.LogCallStackLimit;
chkTakeSnap.Checked := bpaTakeSnapshot in Actions;
end;
constructor TBreakPropertyDlg.Create(AOwner: TComponent; ABreakPoint: TIDEBreakPoint);
@ -230,6 +233,7 @@ begin
chkLogMessage.Caption := lisLogMessage;
chkLogCallStack.Caption := lisLogCallStack;
lblLogCallStackLimit.Caption := lisLogCallStackLimit;
chkTakeSnap.Caption := lisTakeSnapshot;
edtCondition.Items.Assign(InputHistories.HistoryLists.GetList('BreakPointExpression', True));
FBreakpoint := ABreakPoint;

53
debugger/debugger.pp
View File

@ -81,6 +81,7 @@ type
dsIdle,
dsStop,
dsPause,
dsInternalPause,
dsInit,
dsRun,
dsError,
@ -114,6 +115,10 @@ type
dsPause:
The debugger has paused the target. Target variables can be examined
dsInternalPause:
Pause, not visible to user.
For examble auto continue breakpoint: Allow collection of Snapshot data
dsInit:
(Optional, Internal) The debugger is about to run
@ -2030,7 +2035,7 @@ type
procedure AddNotification(const ANotification: TSnapshotNotification);
procedure RemoveNotification(const ANotification: TSnapshotNotification);
procedure DoStateChange(const AOldState: TDBGState);
procedure DoDebuggerIdle;
procedure DoDebuggerIdle(AForce: Boolean = False);
property Active: Boolean read FActive write SetActive;
public
function SelectedId: Pointer;
@ -2554,6 +2559,7 @@ const
'Idle',
'Stop',
'Pause',
'InternalPause',
'Init',
'Run',
'Error',
@ -2594,6 +2600,8 @@ const
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
dcStepOut, dcRunTo, dcJumpto, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
{dsInternalPause} // same as run, so not really used
[dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
{dsInit } [],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
{dsError} [dcStop],
@ -2972,14 +2980,14 @@ begin
BeginUpdate;
try
if FDebugger.State = dsPause then begin
if FDebugger.State in [dsPause, dsInternalPause] then begin
FRequestsDone := [];
CreateHistoryEntry;
HistorySelected := False;
SnapshotSelected := False;
end
else begin
if FCurrentSnapshot <> nil then begin
if (FCurrentSnapshot <> nil) and (FActive or (AOldState = dsInternalPause)) then begin
HistoryIndex := FHistoryList.Add(FCurrentSnapshot);
ReleaseAndNil(FCurrentSnapshot);
while FHistoryList.Count > HistoryCapacity do RemoveHistoryEntry(0);
@ -2994,24 +3002,25 @@ begin
end;
end;
procedure TSnapshotManager.DoDebuggerIdle;
procedure TSnapshotManager.DoDebuggerIdle(AForce: Boolean = False);
var
i, j, k: LongInt;
w: TCurrentWatches;
begin
if (not FActive) then exit;
if (FCurrentState <> dsPause) or (not Debugger.IsIdle) then exit;
if (not FActive) and (not AForce) then exit;
if not(FCurrentState in [dsPause, dsInternalPause]) then exit;
if (not Debugger.IsIdle) and (not AForce) then exit;
if not(smrThreads in FRequestsDone) then begin
include(FRequestsDone, smrThreads);
FThreads.CurrentThreads.Count;
if not Debugger.IsIdle then exit;
if (not Debugger.IsIdle) and (not AForce) 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;
if (not Debugger.IsIdle) and (not AForce) then exit;
end;
if not(smrCallStack in FRequestsDone) then begin
include(FRequestsDone, smrCallStack);
@ -3019,14 +3028,14 @@ begin
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;
if (not Debugger.IsIdle) and (not AForce) 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;
if (not Debugger.IsIdle) and (not AForce) then exit;
end;
if not(smrWatches in FRequestsDone) then begin
include(FRequestsDone, smrWatches);
@ -3034,7 +3043,7 @@ begin
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;
if (not Debugger.IsIdle) and (not AForce) then exit;
end;
end;
@ -3316,7 +3325,7 @@ procedure TLocalsSupplier.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger = nil) or (CurrentLocalsList = nil) then Exit;
if FDebugger.State = dsPause
if FDebugger.State in [dsPause, dsInternalPause]
then begin
if Monitor<> nil
then Monitor.Clear;
@ -3324,7 +3333,7 @@ begin
else begin
CurrentLocalsList.SnapShot := nil;
if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }
if (AOldState in [dsPause, dsInternalPause]) or (AOldState = dsNone) { Force clear on initialisation }
then begin
if Monitor<> nil
then Monitor.Clear;
@ -3707,7 +3716,7 @@ end;
procedure TWatchesSupplier.RequestData(AWatchValue: TCurrentWatchValue);
begin
if FNotifiedState = dsPause
if FNotifiedState in [dsPause, dsInternalPause]
then InternalRequestData(AWatchValue)
else AWatchValue.SetValidity(ddsInvalid);
end;
@ -3722,7 +3731,7 @@ begin
if (Debugger = nil) or (CurrentWatches = nil) then Exit;
FNotifiedState := Debugger.State;
if FDebugger.State = dsPause
if FDebugger.State in [dsPause, dsInternalPause]
then begin
CurrentWatches.ClearValues;
Monitor.NotifyUpdate(CurrentWatches, nil);
@ -3730,7 +3739,7 @@ begin
else begin
CurrentWatches.SnapShot := nil;
if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }
if (AOldState in [dsPause, dsInternalPause]) or (AOldState = dsNone) { Force clear on initialisation }
then begin
CurrentWatches.ClearValues;
Monitor.NotifyUpdate(CurrentWatches, nil);
@ -4326,14 +4335,14 @@ procedure TThreadsSupplier.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger = nil) or (CurrentThreads = nil) then Exit;
if Debugger.State in [dsPause]
if Debugger.State in [dsPause, dsInternalPause]
then begin
CurrentThreads.SetValidity(ddsUnknown);
end
else begin
CurrentThreads.SnapShot := nil;
if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }
if (AOldState in [dsPause, dsInternalPause]) or (AOldState = dsNone) { Force clear on initialisation }
then begin
if Monitor <> nil
then Monitor.Clear;
@ -5900,7 +5909,7 @@ var
Entry: TCallStackEntry;
StackString: String;
begin
Debugger.SetState(dsPause);
Debugger.SetState(dsInternalPause);
CallStack := Debugger.CallStack.CurrentCallStackList.EntriesForThreads[Debugger.Threads.CurrentThreads.CurrentThreadId];
if Limit = 0 then
begin
@ -7322,7 +7331,7 @@ end;
function TDBGRegisters.Count: Integer;
begin
if (FDebugger <> nil)
and (FDebugger.State = dsPause)
and (FDebugger.State in [dsPause, dsInternalPause])
then Result := GetCount
else Result := 0;
end;
@ -7769,7 +7778,7 @@ procedure TCallStackSupplier.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger = nil) or (CurrentCallStackList = nil) then Exit;
if FDebugger.State = dsPause
if FDebugger.State in [dsPause, dsInternalPause]
then begin
CurrentCallStackList.Clear;
Changed;
@ -7777,7 +7786,7 @@ begin
else begin
CurrentCallStackList.SnapShot := nil;
if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }
if (AOldState in [dsPause, dsInternalPause]) or (AOldState = dsNone) { Force clear on initialisation }
then begin
CurrentCallStackList.Clear;
Monitor.CallStackClear(Self);

31
debugger/gdbmidebugger.pp
View File

@ -1736,7 +1736,7 @@ var
begin
if Debugger = nil then Exit;
if (Debugger.State = dsPause)
if (Debugger.State in [dsPause, dsInternalPause])
then begin
FGetThreadsCmdObj := TGDBMIDebuggerCommandThreads.Create(Debugger);
FGetThreadsCmdObj.OnExecuted := @DoThreadsFinished;
@ -1784,7 +1784,7 @@ var
ForceQueue: Boolean;
begin
if Debugger = nil then Exit;
if (Debugger.State <> dsPause) then exit;
if not(Debugger.State in [dsPause, dsInternalPause]) then exit;
if FChangeThreadsCmdObj <> nil then begin
if FChangeThreadsCmdObj.State = dcsQueued then
@ -2358,7 +2358,7 @@ var
ForceQueue: Boolean;
begin
Result := False;
if (Debugger = nil) or (Debugger.State <> dsPause)
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause])
then exit;
if (FDisassembleEvalCmdObj <> nil)
@ -4346,6 +4346,7 @@ begin
BreakPoint.Hit(CanContinue);
if CanContinue
then begin
SetDebuggerState(dsInternalPause);
//ExecuteCommand('-exec-continue');
Result := True;
exit;
@ -4634,7 +4635,7 @@ begin
NextExecCmdObj := TGDBMIDebuggerCommandExecute.Create(FTheDebugger, ectContinue);
// Queue it, so we execute once this Cmd exits; do not execute recursive
FTheDebugger.QueueExecuteLock;
FTheDebugger.QueueCommand(NextExecCmdObj);
FTheDebugger.QueueCommand(NextExecCmdObj, DebuggerState = dsInternalPause); // TODO: ForceQueue, only until better means of queue control... (allow snapshot to run)
FTheDebugger.QueueExecuteUnlock;
end;
@ -5166,7 +5167,7 @@ end;
procedure TGDBMILineInfo.DoStateChange(const AOldState: TDBGState);
begin
if not (Debugger.State in [dsPause, dsRun]) then
if not (Debugger.State in [dsPause, dsInternalPause, dsRun]) then
ClearSources;
end;
@ -5485,7 +5486,7 @@ begin
SendCmdLn('kill'); // try to kill the debugged process. bypass all queues.
DebugProcess.Terminate(0);
end;
if (OldState = dsPause) and (State = dsRun)
if (OldState in [dsPause, dsInternalPause]) and (State = dsRun)
then begin
FPauseWaitState := pwsNone;
{$IFDEF MSWindows}
@ -6995,7 +6996,7 @@ begin
if (Address = AValue) then exit;
inherited;
if (Debugger = nil) then Exit;
if TGDBMIDebugger(Debugger).State in [dsPause, dsRun]
if TGDBMIDebugger(Debugger).State in [dsPause, dsInternalPause, dsRun]
then SetBreakpoint;
end;
@ -7159,7 +7160,7 @@ begin
if (Source = ASource) and (Line = ALine) then exit;
inherited;
if (Debugger = nil) or (Source = '') then Exit;
if TGDBMIDebugger(Debugger).State in [dsPause, dsRun]
if TGDBMIDebugger(Debugger).State in [dsPause, dsInternalPause, dsRun]
then SetBreakpoint;
end;
@ -7363,7 +7364,7 @@ var
ForceQueue: Boolean;
EvaluationCmdObj: TGDBMIDebuggerCommandLocals;
begin
if (Debugger = nil) or (Debugger.State <> dsPause) then Exit;
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
EvaluationCmdObj := TGDBMIDebuggerCommandLocals.Create(TGDBMIDebugger(Debugger), ALocals);
EvaluationCmdObj.OnDestroy := @DoEvaluationDestroyed;
@ -7729,7 +7730,7 @@ var
ForceQueue: Boolean;
EvaluationCmdObj: TGDBMIDebuggerCommandEvaluate;
begin
if (Debugger = nil) or not(Debugger.State = dsPause) then begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
AWatchValue.Validity := ddsInvalid;
Exit;
end;
@ -7785,7 +7786,7 @@ procedure TGDBMICallStack.RequestCount(ACallstack: TCurrentCallStack);
var
DepthEvalCmdObj: TGDBMIDebuggerCommandStackDepth;
begin
if (Debugger = nil) or (Debugger.State <> dsPause)
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause])
then begin
ACallstack.SetCountValidity(ddsInvalid);
exit;
@ -7802,7 +7803,7 @@ end;
procedure TGDBMICallStack.RequestCurrent(ACallstack: TCurrentCallStack);
begin
if (Debugger = nil) or (Debugger.State <> dsPause) then begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
ACallstack.SetCurrentValidity(ddsInvalid);
Exit;
end;
@ -7817,7 +7818,7 @@ procedure TGDBMICallStack.RequestEntries(ACallstack: TCurrentCallStack);
var
FramesEvalCmdObj: TGDBMIDebuggerCommandStackFrames;
begin
if (Debugger = nil) or (Debugger.State <> dsPause) then Exit;
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then Exit;
FramesEvalCmdObj := TGDBMIDebuggerCommandStackFrames.Create(TGDBMIDebugger(Debugger), ACallstack);
//FramesEvalCmdObj.OnExecuted := @DoFramesCommandExecuted;
@ -7858,7 +7859,7 @@ var
IndexCmd: TGDBMIDebuggerCommandStackSetCurrent;
cs: TCurrentCallStack;
begin
if (Debugger = nil) or (Debugger.State <> dsPause) then begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
exit;
end;
@ -7882,7 +7883,7 @@ var
IndexCmd: TGDBMIDebuggerCommandStackSetCurrent;
cs: TCurrentCallStack;
begin
if (Debugger = nil) or (Debugger.State <> dsPause) then begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
exit;
end;

34
ide/debugmanager.pas
View File

@ -667,7 +667,6 @@ begin
FCurrentBreakPoint := nil;
if FBreakPoints = nil then Exit;
if ABreakpoint = nil then Exit;
if ACanContinue then Exit;
FCurrentBreakPoint := FBreakPoints.Find(ABreakPoint.Source, ABreakPoint.Line);
end;
@ -835,6 +834,8 @@ begin
for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
if FDialogs[DialogType] <> nil then
FDialogs[DialogType].BeginUpdate;
if Debugger.State = dsInternalPause then exit; // set debug windows to ignore / no updating
end;
procedure TDebugManager.DebuggerChangeState(ADebugger: TDebugger;
@ -842,8 +843,8 @@ procedure TDebugManager.DebuggerChangeState(ADebugger: TDebugger;
const
// dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError
TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
//dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError, dsDestroying
itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itNone, itNone
//dsNone, dsIdle, dsStop, dsPause, dsInternalPause, dsInit, dsRun, dsError, dsDestroying
itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger, itNone, itNone
);
//STATENAME: array[TDBGState] of string = (
// 'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsInit', 'dsRun', 'dsError'
@ -858,11 +859,24 @@ begin
if FDialogs[DialogType] <> nil then
FDialogs[DialogType].EndUpdate;
if (ADebugger<>FDebugger) or (ADebugger=nil) then
RaiseException('TDebugManager.OnDebuggerChangeState');
if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting)
then exit;
if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then
exit;
assert((ADebugger=FDebugger) and (ADebugger<>nil), 'TDebugManager.OnDebuggerChangeState');
if (FDebugger.State in [dsRun])
then FCurrentBreakpoint := nil;
if (FCurrentBreakpoint <> nil) and (bpaTakeSnapshot in FCurrentBreakpoint.Actions) then begin
FSnapshots.DoStateChange(OldState);
FSnapshots.Current.AddToSnapshots;
FSnapshots.DoDebuggerIdle(True);
end
else if Debugger.State <> dsInternalPause
then FSnapshots.DoStateChange(OldState);
if Debugger.State = dsInternalPause
then exit;
if FDebugger.State=dsError
then begin
@ -895,7 +909,6 @@ begin
SetForegroundWindow(FPrevShownWindow);
FPrevShownWindow := 0;
end;
FCurrentBreakPoint := nil;
end
else
if FDebugger.State <> dsInit then begin
@ -939,8 +952,6 @@ begin
and (FDialogs[ddtInspect] <> nil)
then TIDEInspectDlg(FDialogs[ddtInspect]).UpdateData;
FSnapshots.DoStateChange(OldState);
case FDebugger.State of
dsError: begin
{$ifdef VerboseDebugger}
@ -1002,6 +1013,7 @@ var
InIgnore: Boolean;
begin
if (Sender<>FDebugger) or (Sender=nil) then exit;
if Debugger.State = dsInternalPause then exit;
if Destroying then exit;
FCurrentLocation := ALocation;
@ -1866,7 +1878,7 @@ begin
ClearDebugEventsLog;
FDebugger.OnBreakPointHit := @DebuggerBreakPointHit;
FDebugger.OnBeforeState := @DebuggerBeforeChangeState;
FDebugger.OnBeforeState := @DebuggerBeforeChangeState;
FDebugger.OnState := @DebuggerChangeState;
FDebugger.OnCurrent := @DebuggerCurrentLine;
FDebugger.OnDbgOutput := @DebuggerOutput;