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

LazDebugger(Fp)Lldb: Cancel watch eval, on receiving run/step request

Browse Source 
git-svn-id: trunk@60651 -
This commit is contained in:
martin 2019-03-11 13:45:20 +00:00
parent 691606d9bc
commit 767e4c056c
2 changed files with 88 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -188,7 +188,7 @@ type
protected
procedure DoExecute; override;
procedure DoFree; override;
// procedure DoCancel; override;
procedure DoCancel; override;
public
constructor Create(AOwner: TFPLldbWatches);
end;
@ -199,9 +199,10 @@ type
private
FWatchEvalLock: Integer;
FEvaluationCmdObj: TFpLldbDebuggerCommandEvaluate;
FWatchEvalCancel: Boolean;
protected
function FpDebugger: TFpLldbDebugger;
//procedure DoStateChange(const AOldState: TDBGState); override;
procedure DoStateChange(const AOldState: TDBGState); override;
procedure ProcessEvalList;
procedure QueueCommand;
procedure InternalRequestData(AWatchValue: TWatchValue); override;
@ -219,6 +220,7 @@ type
procedure DoLocalsFreed(Sender: TObject);
protected
procedure DoExecute; override;
procedure DoCancel; override;
public
constructor Create(AOwner: TFPLldbLocals; ALocals: TLocals);
end;
@ -227,9 +229,11 @@ type
TFPLldbLocals = class(TLocalsSupplier)
private
FLocalsEvalCancel: Boolean;
procedure ProcessLocals(ALocals: TLocals);
protected
function FpDebugger: TFpLldbDebugger;
procedure DoStateChange(const AOldState: TDBGState); override;
public
procedure RequestData(ALocals: TLocals); override;
end;
@ -367,12 +371,19 @@ begin
Finished;
end;
procedure TFpLldbDebuggerCommandLocals.DoCancel;
begin
inherited DoCancel;
FOwner.FLocalsEvalCancel := True;
end;
constructor TFpLldbDebuggerCommandLocals.Create(AOwner: TFPLldbLocals; ALocals: TLocals);
begin
inherited Create(AOwner.FpDebugger);
FOwner := AOwner;
FLocals := ALocals;
FLocals.AddFreeNotification(@DoLocalsFreed);
CancelableForRun := True;
////// Priority := 1; // before watches
end;
@ -386,6 +397,11 @@ var
m: TFpDbgValue;
n, v: String;
begin
if FLocalsEvalCancel then begin
ALocals.SetDataValidity(ddsInvalid);
exit;
end;
Ctx := FpDebugger.GetInfoContextForContext(ALocals.ThreadId, ALocals.StackFrame);
try
if (Ctx = nil) or (Ctx.SymbolAtAddress = nil) then begin
@ -404,6 +420,10 @@ begin
ALocals.Clear;
for i := 0 to ProcVal.MemberCount - 1 do begin
if FLocalsEvalCancel then begin
ALocals.SetDataValidity(ddsInvalid);
exit;
end;
m := ProcVal.Member[i];
if m <> nil then begin
if m.DbgSymbol <> nil then
@ -425,6 +445,12 @@ begin
Result := TFpLldbDebugger(Debugger);
end;
procedure TFPLldbLocals.DoStateChange(const AOldState: TDBGState);
begin
inherited DoStateChange(AOldState);
FLocalsEvalCancel := False;
end;
procedure TFPLldbLocals.RequestData(ALocals: TLocals);
var
LocalsCmdObj: TFpLldbDebuggerCommandLocals;
@ -460,6 +486,12 @@ begin
inherited DoFree;
end;
procedure TFpLldbDebuggerCommandEvaluate.DoCancel;
begin
inherited DoCancel;
FOwner.FWatchEvalCancel := True;
end;
//procedure TFpLldbDebuggerCommandEvaluate.DoCancel;
//begin
// FOwner.FpDebugger.FWatchEvalList.Clear;
@ -471,6 +503,7 @@ constructor TFpLldbDebuggerCommandEvaluate.Create(AOwner: TFPLldbWatches);
begin
inherited Create(AOwner.FpDebugger);
FOwner := AOwner;
CancelableForRun := True;
//Priority := 0;
end;
@ -723,6 +756,12 @@ begin
Result := TFpLldbDebugger(Debugger);
end;
procedure TFPLldbWatches.DoStateChange(const AOldState: TDBGState);
begin
inherited DoStateChange(AOldState);
FWatchEvalCancel := False;
end;
procedure TFPLldbWatches.ProcessEvalList;
var
WatchValue: TWatchValue;
@ -734,13 +773,14 @@ var
Result := (FpDebugger.FWatchEvalList.Count > 0) and (FpDebugger.FWatchEvalList[0] = Pointer(WatchValue));
end;
begin
if (FpDebugger.FWatchEvalList.Count = 0) or (FWatchEvalLock > 0) then
if (FpDebugger.FWatchEvalList.Count = 0) or (FWatchEvalLock > 0) or FWatchEvalCancel then
exit;
debugln(['ProcessEvalList ']);
inc(FWatchEvalLock);
try // TODO: if the stack/thread is changed, registers will be wrong
while (FpDebugger.FWatchEvalList.Count > 0) and (FEvaluationCmdObj = nil) do begin
while (FpDebugger.FWatchEvalList.Count > 0) and (FEvaluationCmdObj = nil) and (not FWatchEvalCancel)
do begin
WatchValue := TWatchValue(FpDebugger.FWatchEvalList[0]);
if FpDebugger.Registers.CurrentRegistersList[WatchValue.ThreadId, WatchValue.StackFrame].Count = 0 then begin
// trigger register
@ -889,6 +929,7 @@ begin
FAddr := AnAddr;
FBeforeAddr := FAddr - Min(ALinesBefore * DAssBytesPerCommandAvg, DAssMaxRangeSize);
FLinesAfter := ALinesAfter;
CancelableForRun := True;
end;
procedure TFpLldbDebuggerCommandDisassemble.CmdFinished(Sender: TObject);

43
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -52,6 +52,7 @@ type
constructor Create(ADebugger: TLldbDebugger);
destructor Destroy; override;
procedure CancelAll;
procedure CancelForRun;
procedure LockQueueRun;
procedure UnLockQueueRun;
property Items[Index: Integer]: TLldbDebuggerCommand read Get write Put; default;
@ -64,6 +65,7 @@ type
TLldbDebuggerCommand = class(TRefCountedObject)
private
FCancelableForRun: Boolean;
FOwner: TLldbDebugger;
FIsRunning: Boolean;
function GetDebuggerState: TDBGState;
@ -89,6 +91,7 @@ type
destructor Destroy; override;
procedure Execute;
procedure Cancel;
property CancelableForRun: Boolean read FCancelableForRun write FCancelableForRun;
end;
{ TLldbDebuggerCommandInit }
@ -253,6 +256,7 @@ type
procedure RegisterInstructionFinished(Sender: TObject);
protected
procedure DoExecute; override;
procedure DoCancel; override;
public
constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
destructor Destroy; override;
@ -392,6 +396,7 @@ type
private
procedure ThreadInstructionSucceeded(Sender: TObject);
protected
constructor Create(AOwner: TLldbDebugger);
procedure DoExecute; override;
end;
@ -1328,6 +1333,7 @@ constructor TLldbDebuggerCommandLocals.Create(AOwner: TLldbDebugger;
begin
FLocals := ALocals;
FLocals.AddFreeNotification(@DoLocalsFreed);
CancelableForRun := True;
inherited Create(AOwner);
end;
@ -1357,6 +1363,12 @@ begin
Finished;
end;
constructor TLldbDebuggerCommandThreads.Create(AOwner: TLldbDebugger);
begin
CancelableForRun := True;
inherited Create(AOwner);
end;
procedure TLldbDebuggerCommandThreads.DoExecute;
var
Instr: TLldbInstructionThreadList;
@ -1546,6 +1558,7 @@ begin
inherited Create(AOwner);
FCurrentCallStack := ACurrentCallStack;
FCurrentCallStack.AddFreeNotification(@DoCallstackFreed);
CancelableForRun := True;
end;
destructor TLldbDebuggerCommandCallStack.Destroy;
@ -1940,11 +1953,19 @@ begin
Instr.ReleaseReference;
end;
procedure TLldbDebuggerCommandRegister.DoCancel;
begin
if FRegisters <> nil then
FRegisters.DataValidity := ddsInvalid;
inherited DoCancel;
end;
constructor TLldbDebuggerCommandRegister.Create(AOwner: TLldbDebugger;
ARegisters: TRegisters);
begin
FRegisters := ARegisters;
FRegisters.AddReference;
CancelableForRun := True;
inherited Create(AOwner);
end;
@ -2071,6 +2092,22 @@ begin
FRunningCommand.Cancel;
end;
procedure TLldbDebuggerCommandQueue.CancelForRun;
var
i: Integer;
begin
i := Count - 1;
while i >= 0 do begin
if Items[i].CancelableForRun then
Items[i].Cancel;
dec(i);
if i > Count then
i := Count - 1;
end;
if (FRunningCommand <> nil) and (FRunningCommand.CancelableForRun) then
FRunningCommand.Cancel;
end;
procedure TLldbDebuggerCommandQueue.LockQueueRun;
begin
inc(FLockQueueRun);
@ -2159,9 +2196,11 @@ end;
procedure TLldbDebuggerCommand.Cancel;
begin
AddReference;
Debugger.CommandQueue.Remove(Self); // current running command is not on queue // dec refcount, may call destroy
if FIsRunning then
DoCancel; // should call CommandQueue.CommandFinished
ReleaseReference;
end;
procedure TLldbDebuggerCommand.DoLineDataReceived(var ALine: String);
@ -2520,6 +2559,7 @@ constructor TLldbDebuggerCommandEvaluate.Create(AOwner: TLldbDebugger;
begin
FWatchValue := AWatchValue;
FWatchValue.AddFreeNotification(@DoWatchFreed);
CancelableForRun := True;
inherited Create(AOwner);
end;
@ -2530,6 +2570,7 @@ begin
FExpr := AnExpr;
FFlags := AFlags;
FCallback := ACallback;
CancelableForRun := True;
inherited Create(AOwner);
end;
@ -2640,6 +2681,7 @@ begin
Result := True;
if State in [dsPause, dsInternalPause, dsRun] then begin // dsRun in case of exception
CommandQueue.CancelForRun;
LldbStep(saContinue);
exit;
end;
@ -2714,6 +2756,7 @@ var
Cmd: TLldbDebuggerCommandRunStep;
begin
Result := True;
CommandQueue.CancelForRun;
Cmd := TLldbDebuggerCommandRunStep.Create(Self, AStepAction);
QueueCommand(Cmd);
Cmd.ReleaseReference;