LazDebuggerFpLldb: retrieve register for other stackframes, while evaluation is running (required for nested procedures)

git-svn-id: trunk@60008 -
This commit is contained in:
martin 2019-01-05 16:21:44 +00:00
parent 5dc6bda9b0
commit 89171482cc
2 changed files with 40 additions and 14 deletions

View File

@ -158,6 +158,7 @@ type
EvalFlags: TDBGEvaluateFlags = []): Boolean;
property CurrentThreadId;
property CurrentStackFrame;
property CommandQueue;
public
class function Caption: String; override;
class function RequiredCompilerOpts(ATargetCPU, ATargetOS: String): TDebugCompilerRequirements; override;
@ -572,6 +573,8 @@ var
i: Integer;
Reg: TRegisters;
RegVObj: TRegisterDisplayValue;
CmdQueue: TLldbDebuggerCommandQueue;
QItem: TLldbDebuggerCommand;
begin
Result := False;
@ -618,6 +621,29 @@ begin
assert(AContext <> nil, 'TFpLldbDbgMemReader.ReadRegister: AContext <> nil');
Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
Reg.Count; // trigger
if (reg.DataValidity = ddsRequested) then begin
CmdQueue := FDebugger.CommandQueue;
if CmdQueue.Count > 0 then begin;
QItem := CmdQueue.Items[CmdQueue.Count - 1];
if (QItem is TLldbDebuggerCommandRegister) and (TLldbDebuggerCommandRegister(QItem).Registers = Reg) then begin
QItem.AddReference;
CmdQueue.Delete(CmdQueue.Count - 1);
QItem.Execute;
while Reg.DataValidity = ddsRequested do begin
Application.ProcessMessages;
CheckSynchronize(25);
end;
QItem.ReleaseReference;
end;
end;
end;
if (reg.Count = 0) or (reg.DataValidity <> ddsValid) then begin
DebugLn(DBG_VERBOSE, ['Cant get Registers for context ', AContext.ThreadId, ', ', AContext.StackFrame, ', ', dbgs(Reg.DataValidity), ' Reg:', rname]);
exit;
end;
for i := 0 to Reg.Count - 1 do
if UpperCase(Reg[i].Name) = rname then
begin

View File

@ -241,6 +241,20 @@ type
property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
end;
{ TLldbDebuggerCommandRegister }
TLldbDebuggerCommandRegister = class(TLldbDebuggerCommand)
private
FRegisters: TRegisters;
procedure RegisterInstructionFinished(Sender: TObject);
protected
procedure DoExecute; override;
public
constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
destructor Destroy; override;
property Registers: TRegisters read FRegisters;
end;
(*
* Debugger
*)
@ -485,20 +499,6 @@ type
***** Register
***** }
{ TLldbDebuggerCommandRegister }
TLldbDebuggerCommandRegister = class(TLldbDebuggerCommand)
private
FRegisters: TRegisters;
procedure RegisterInstructionFinished(Sender: TObject);
protected
procedure DoExecute; override;
public
constructor Create(AOwner: TLldbDebugger; ARegisters: TRegisters);
destructor Destroy; override;
property Registers: TRegisters read FRegisters;
end;
{ TLldbRegisterSupplier }
TLldbRegisterSupplier = class(TRegisterSupplier)