From 7e94016e3a4e6b4b4ecc8901b3ec87207029e010 Mon Sep 17 00:00:00 2001 From: martin Date: Mon, 6 Jun 2011 01:41:20 +0000 Subject: [PATCH] DBG: Automatic Snapshots on breakpoint git-svn-id: trunk@31111 - --- debugger/breakpropertydlg.lfm | 25 +++++++++++++---- debugger/breakpropertydlg.pas | 4 +++ debugger/debugger.pp | 53 ++++++++++++++++++++--------------- debugger/gdbmidebugger.pp | 31 ++++++++++---------- ide/debugmanager.pas | 34 ++++++++++++++-------- 5 files changed, 93 insertions(+), 54 deletions(-) diff --git a/debugger/breakpropertydlg.lfm b/debugger/breakpropertydlg.lfm index 280e59af05..db47c94888 100644 --- a/debugger/breakpropertydlg.lfm +++ b/debugger/breakpropertydlg.lfm @@ -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' diff --git a/debugger/breakpropertydlg.pas b/debugger/breakpropertydlg.pas index 9d2da87b8d..c79ea35dec 100644 --- a/debugger/breakpropertydlg.pas +++ b/debugger/breakpropertydlg.pas @@ -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; diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 6f79d67e3b..7716245ec3 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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); diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 6231a4051c..9fce09ce25 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index e7df9ec276..dfcdd16982 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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;