mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-05 07:58:16 +02:00
LazDebuggerFpLldb: retrieve register for other stackframes, while evaluation is running (required for nested procedures)
git-svn-id: trunk@60008 -
This commit is contained in:
parent
5dc6bda9b0
commit
89171482cc
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user