mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 21:55:56 +02:00
LLDB Debugger: register
git-svn-id: trunk@58330 -
This commit is contained in:
martin
parent
4aa02d5b80
commit
2de4bca7db
@ -422,15 +422,6 @@ var
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
InStr := TLldbInstructionRegister.Create(AContext.ThreadId, AContext.StackFrame);
|
||||
InStr.AddReference;
|
||||
FDebugger.DebugInstructionQueue.QueueInstruction(InStr);
|
||||
while not InStr.IsCompleted do begin
|
||||
Application.ProcessMessages;
|
||||
sleep(30);
|
||||
end;
|
||||
|
||||
|
||||
// WINDOWS gdb dwarf names
|
||||
{$IFDEF cpu64}
|
||||
case ARegNum of
|
||||
@ -471,11 +462,25 @@ begin
|
||||
{$ENDIF}
|
||||
assert(AContext <> nil, 'TFpLldbDbgMemReader.ReadRegister: AContext <> nil');
|
||||
|
||||
v := InStr.Res.Values[rname];
|
||||
InStr.ReleaseReference;
|
||||
|
||||
AValue := StrToQWordDef(v, 0);
|
||||
Result := True;
|
||||
Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
|
||||
for i := 0 to Reg.Count - 1 do
|
||||
if UpperCase(Reg[i].Name) = rname then
|
||||
begin
|
||||
RegVObj := Reg[i].ValueObjFormat[rdDefault];
|
||||
if RegVObj <> nil then
|
||||
v := RegVObj.Value[rdDefault]
|
||||
else
|
||||
v := '';
|
||||
if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
|
||||
Result := true;
|
||||
try
|
||||
AValue := StrToQWord(v);
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpLldbDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;
|
||||
|
||||
@ -154,7 +154,7 @@ type
|
||||
function CreateBreakPoints: TDBGBreakPoints; override;
|
||||
//function CreateLocals: TLocalsSupplier; override;
|
||||
//function CreateLineInfo: TDBGLineInfo; override;
|
||||
//function CreateRegisters: TRegisterSupplier; override;
|
||||
function CreateRegisters: TRegisterSupplier; override;
|
||||
function CreateCallStack: TCallStackSupplier; override;
|
||||
//function CreateDisassembler: TDBGDisassembler; override;
|
||||
function CreateWatches: TWatchesSupplier; override;
|
||||
@ -228,11 +228,13 @@ type
|
||||
TLldbDebuggerCommandCallStack = class(TLldbDebuggerCommand)
|
||||
private
|
||||
FCurrentCallStack: TCallStackBase;
|
||||
procedure DoCallstackFreed(Sender: TObject);
|
||||
procedure StackInstructionFinished(Sender: TObject);
|
||||
protected
|
||||
procedure DoExecute; override;
|
||||
public
|
||||
property CurrentCallStack: TCallStackBase read FCurrentCallStack write FCurrentCallStack;
|
||||
property CurrentCallStack: TCallStackBase read FCurrentCallStack;
|
||||
constructor Create(AOwner: TLldbDebugger; ACurrentCallStack: TCallStackBase);
|
||||
end;
|
||||
|
||||
{ TLldbCallStack }
|
||||
@ -252,6 +254,11 @@ type
|
||||
|
||||
{%endregion ^^^^^ CallStack ^^^^^ }
|
||||
|
||||
{%region
|
||||
*****
|
||||
***** Watches
|
||||
***** }
|
||||
|
||||
{ TLldbWatches }
|
||||
|
||||
TLldbWatches = class(TWatchesSupplier)
|
||||
@ -261,6 +268,13 @@ type
|
||||
public
|
||||
end;
|
||||
|
||||
{%endregion ^^^^^ Watches ^^^^^ }
|
||||
|
||||
{%region
|
||||
*****
|
||||
***** BreakPoint
|
||||
***** }
|
||||
|
||||
{ TLldbBreakPoint }
|
||||
|
||||
TLldbBreakPoint = class(TDBGBreakPoint)
|
||||
@ -285,6 +299,37 @@ type
|
||||
// function FindById(AnId: Integer): TGDBMIBreakPoint;
|
||||
end;
|
||||
|
||||
{%endregion ^^^^^ BreakPoint ^^^^^ }
|
||||
|
||||
{%region
|
||||
*****
|
||||
***** 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)
|
||||
public
|
||||
procedure Changed;
|
||||
procedure RequestData(ARegisters: TRegisters); override;
|
||||
end;
|
||||
|
||||
{%endregion ^^^^^ Register ^^^^^ }
|
||||
|
||||
{%region
|
||||
*****
|
||||
***** Threads
|
||||
@ -396,7 +441,12 @@ var
|
||||
IsCur: Boolean;
|
||||
addr: TDBGPtr;
|
||||
begin
|
||||
It := TMapIterator.Create(Instr.Callstack.RawEntries);
|
||||
if FCurrentCallStack = nil then begin
|
||||
Finished;
|
||||
exit;
|
||||
end;
|
||||
|
||||
It := TMapIterator.Create(FCurrentCallStack.RawEntries);
|
||||
|
||||
for i := 0 to Length(Instr.Res) - 1 do begin
|
||||
s := Instr.Res[i];
|
||||
@ -408,25 +458,44 @@ begin
|
||||
end;
|
||||
It.Free;
|
||||
|
||||
TLldbCallStack(Debugger.CallStack).ParentRequestEntries(Instr.Callstack);
|
||||
TLldbCallStack(Debugger.CallStack).ParentRequestEntries(FCurrentCallStack);
|
||||
|
||||
Finished;
|
||||
end;
|
||||
|
||||
procedure TLldbDebuggerCommandCallStack.DoCallstackFreed(Sender: TObject);
|
||||
begin
|
||||
FCurrentCallStack := nil;
|
||||
//cancel
|
||||
end;
|
||||
|
||||
procedure TLldbDebuggerCommandCallStack.DoExecute;
|
||||
var
|
||||
StartIdx, EndIdx: Integer;
|
||||
Instr: TLldbInstructionStackTrace;
|
||||
begin
|
||||
if FCurrentCallStack = nil then begin
|
||||
Finished;
|
||||
exit;
|
||||
end;
|
||||
|
||||
StartIdx := Max(FCurrentCallStack.LowestUnknown, 0);
|
||||
EndIdx := FCurrentCallStack.HighestUnknown;
|
||||
|
||||
Instr := TLldbInstructionStackTrace.Create(EndIdx, FCurrentCallStack);
|
||||
Instr := TLldbInstructionStackTrace.Create(EndIdx, FCurrentCallStack.ThreadId);
|
||||
Instr.OnFinish := @StackInstructionFinished;
|
||||
QueueInstruction(Instr);
|
||||
Instr.ReleaseReference;
|
||||
end;
|
||||
|
||||
constructor TLldbDebuggerCommandCallStack.Create(AOwner: TLldbDebugger;
|
||||
ACurrentCallStack: TCallStackBase);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FCurrentCallStack := ACurrentCallStack;
|
||||
FCurrentCallStack.AddFreeNotification(@DoCallstackFreed);
|
||||
end;
|
||||
|
||||
{ TLldbCallStack }
|
||||
|
||||
procedure TLldbCallStack.ParentRequestEntries(ACallstack: TCallStackBase);
|
||||
@ -487,8 +556,7 @@ begin
|
||||
if not (Debugger.State in [dsPause, dsInternalPause]) then
|
||||
exit;
|
||||
|
||||
Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger));
|
||||
Cmd.CurrentCallStack := ACallstack;
|
||||
Cmd := TLldbDebuggerCommandCallStack.Create(TLldbDebugger(Debugger), ACallstack);
|
||||
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
||||
Cmd.ReleaseReference;
|
||||
end;
|
||||
@ -575,6 +643,87 @@ begin
|
||||
SetBreakPoint;
|
||||
end;
|
||||
|
||||
{%region
|
||||
*****
|
||||
***** Register
|
||||
***** }
|
||||
|
||||
{ TLldbDebuggerCommandRegister }
|
||||
|
||||
procedure TLldbDebuggerCommandRegister.RegisterInstructionFinished(
|
||||
Sender: TObject);
|
||||
var
|
||||
Instr: TLldbInstructionRegister absolute Sender;
|
||||
RegVal: TRegisterValue;
|
||||
n: String;
|
||||
i: Integer;
|
||||
begin
|
||||
if not Instr.IsSuccess then begin
|
||||
if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
|
||||
FRegisters.DataValidity := ddsInvalid;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FRegisters.DataValidity := ddsEvaluating;
|
||||
|
||||
for i := 0 to Instr.Res.Count - 1 do begin
|
||||
n := Instr.Res.Names[i];
|
||||
RegVal := FRegisters.EntriesByName[n];
|
||||
RegVal.Value := Instr.Res.Values[n];
|
||||
RegVal.DataValidity := ddsValid;
|
||||
end;
|
||||
|
||||
FRegisters.DataValidity := ddsValid;
|
||||
Finished;
|
||||
end;
|
||||
|
||||
procedure TLldbDebuggerCommandRegister.DoExecute;
|
||||
var
|
||||
Instr: TLldbInstructionRegister;
|
||||
begin
|
||||
// TODO: store thread/frame when command is created
|
||||
Instr := TLldbInstructionRegister.Create(Debugger.FCurrentThreadId, Debugger.FCurrentStackFrame);
|
||||
Instr.OnFinish := @RegisterInstructionFinished;
|
||||
QueueInstruction(Instr);
|
||||
Instr.ReleaseReference;
|
||||
end;
|
||||
|
||||
constructor TLldbDebuggerCommandRegister.Create(AOwner: TLldbDebugger;
|
||||
ARegisters: TRegisters);
|
||||
begin
|
||||
FRegisters := ARegisters;
|
||||
FRegisters.AddReference;
|
||||
inherited Create(AOwner);
|
||||
end;
|
||||
|
||||
destructor TLldbDebuggerCommandRegister.Destroy;
|
||||
begin
|
||||
ReleaseRefAndNil(FRegisters);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TLldbRegisterSupplier }
|
||||
|
||||
procedure TLldbRegisterSupplier.Changed;
|
||||
begin
|
||||
if CurrentRegistersList <> nil
|
||||
then CurrentRegistersList.Clear;
|
||||
end;
|
||||
|
||||
procedure TLldbRegisterSupplier.RequestData(ARegisters: TRegisters);
|
||||
var
|
||||
Cmd: TLldbDebuggerCommandRegister;
|
||||
begin
|
||||
if (Debugger = nil) or not(Debugger.State in [dsPause, dsStop]) then
|
||||
exit;
|
||||
|
||||
Cmd := TLldbDebuggerCommandRegister.Create(TLldbDebugger(Debugger), ARegisters);
|
||||
TLldbDebugger(Debugger).QueueCommand(Cmd);
|
||||
Cmd.ReleaseReference;
|
||||
end;
|
||||
|
||||
{%endregion ^^^^^ Register ^^^^^ }
|
||||
|
||||
{ TLldbDebuggerCommandQueue }
|
||||
|
||||
function TLldbDebuggerCommandQueue.Get(Index: Integer): TLldbDebuggerCommand;
|
||||
@ -997,6 +1146,11 @@ begin
|
||||
Result := TLldbBreakPoints.Create(Self, TLldbBreakPoint);
|
||||
end;
|
||||
|
||||
function TLldbDebugger.CreateRegisters: TRegisterSupplier;
|
||||
begin
|
||||
Result := TLldbRegisterSupplier.Create(Self);
|
||||
end;
|
||||
|
||||
function TLldbDebugger.CreateCallStack: TCallStackSupplier;
|
||||
begin
|
||||
Result := TLldbCallStack.Create(Self);
|
||||
|
||||
@ -209,16 +209,14 @@ type
|
||||
|
||||
TLldbInstructionStackTrace = class(TLldbInstruction)
|
||||
private
|
||||
FCallstack: TCallStackBase;
|
||||
FRes: TStringArray;
|
||||
FReading: Boolean;
|
||||
protected
|
||||
procedure SendCommandDataToDbg(); override;
|
||||
function ProcessInputFromDbg(const AData: String): Boolean; override;
|
||||
public
|
||||
constructor Create(FrameCount: Integer; ACallstack: TCallStackBase);
|
||||
constructor Create(FrameCount: Integer; AThread: Integer);
|
||||
property Res: TStringArray read FRes;
|
||||
property Callstack: TCallStackBase read FCallstack;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -821,10 +819,9 @@ begin
|
||||
end;
|
||||
|
||||
constructor TLldbInstructionStackTrace.Create(FrameCount: Integer;
|
||||
ACallstack: TCallStackBase);
|
||||
AThread: Integer);
|
||||
begin
|
||||
FCallstack := ACallstack;
|
||||
inherited Create(Format('bt %d', [FrameCount]), ACallstack.ThreadId);
|
||||
inherited Create(Format('bt %d', [FrameCount]), AThread);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user