mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 07:29:25 +02:00
FpDebug: Basic support for getting register-values.
git-svn-id: trunk@44626 -
This commit is contained in:
joost
parent
64593db3de
commit
0eaa8042c5
@ -38,7 +38,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgWinExtra, FpDbgLoader,
|
||||
FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazClasses, DbgIntfBaseTypes;
|
||||
FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazClasses, DbgIntfBaseTypes, fgl;
|
||||
|
||||
type
|
||||
TFPDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
|
||||
@ -46,15 +46,49 @@ type
|
||||
TFPDMode = (dm32, dm64);
|
||||
TOnLog = procedure(AString: string) of object;
|
||||
|
||||
{ TDbgRegisterValue }
|
||||
|
||||
TDbgRegisterValue = class
|
||||
private
|
||||
FName: string;
|
||||
FNuwValue: TDBGPtr;
|
||||
FStrValue: string;
|
||||
FValue: TDBGPtr;
|
||||
public
|
||||
constructor Create(AName: String);
|
||||
procedure SetValue(ANumValue: TDBGPtr; AStrValue: string);
|
||||
property Name: string read FName;
|
||||
property NumValue: TDBGPtr read FValue;
|
||||
property StrValue: string read FStrValue;
|
||||
end;
|
||||
|
||||
TGDbgRegisterValueList = specialize TFPGList<TDbgRegisterValue>;
|
||||
|
||||
{ TDbgRegisterValueList }
|
||||
|
||||
TDbgRegisterValueList = class(TGDbgRegisterValueList)
|
||||
private
|
||||
function GetDbgRegister(AName: string): TDbgRegisterValue;
|
||||
function GetDbgRegisterAutoCreate(AName: string): TDbgRegisterValue;
|
||||
public
|
||||
property DbgRegisterAutoCreate[AName: string]: TDbgRegisterValue read GetDbgRegisterAutoCreate;
|
||||
end;
|
||||
|
||||
TDbgProcess = class;
|
||||
|
||||
{ TDbgThread }
|
||||
|
||||
TDbgThread = class(TObject)
|
||||
private
|
||||
FProcess: TDbgProcess;
|
||||
FID: Integer;
|
||||
FHandle: THandle;
|
||||
FSingleStepping: Boolean;
|
||||
function GetRegisterValueList: TDbgRegisterValueList;
|
||||
protected
|
||||
FRegisterValueListValid: boolean;
|
||||
FRegisterValueList: TDbgRegisterValueList;
|
||||
procedure LoadRegisterValues; virtual;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual;
|
||||
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
|
||||
@ -63,6 +97,7 @@ type
|
||||
property ID: Integer read FID;
|
||||
property Handle: THandle read FHandle;
|
||||
property SingleStepping: boolean read FSingleStepping;
|
||||
property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList;
|
||||
end;
|
||||
TDbgThreadClass = class of TDbgThread;
|
||||
|
||||
@ -188,6 +223,7 @@ type
|
||||
property ExitCode: DWord read FExitCode;
|
||||
property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
property MainThread: TDbgThread read FMainThread;
|
||||
end;
|
||||
TDbgProcessClass = class of TDbgProcess;
|
||||
|
||||
@ -242,6 +278,44 @@ begin
|
||||
result := GOSDbgClasses;
|
||||
end;
|
||||
|
||||
{ TDbgRegisterValueList }
|
||||
|
||||
function TDbgRegisterValueList.GetDbgRegister(AName: string): TDbgRegisterValue;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 0 to Count -1 do
|
||||
if Items[i].Name=AName then
|
||||
begin
|
||||
result := items[i];
|
||||
exit;
|
||||
end;
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TDbgRegisterValueList.GetDbgRegisterAutoCreate(AName: string): TDbgRegisterValue;
|
||||
begin
|
||||
result := GetDbgRegister(AName);
|
||||
if not Assigned(result) then
|
||||
begin
|
||||
result := TDbgRegisterValue.Create(AName);
|
||||
add(result);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgRegisterValue }
|
||||
|
||||
constructor TDbgRegisterValue.Create(AName: String);
|
||||
begin
|
||||
FName:=AName;
|
||||
end;
|
||||
|
||||
procedure TDbgRegisterValue.SetValue(ANumValue: TDBGPtr; AStrValue: string);
|
||||
begin
|
||||
FStrValue:=AStrValue;
|
||||
FNuwValue:=ANumValue;
|
||||
end;
|
||||
|
||||
{ TDbgInstance }
|
||||
|
||||
function TDbgInstance.AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint;
|
||||
@ -512,11 +586,24 @@ end;
|
||||
|
||||
{ TDbgThread }
|
||||
|
||||
function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;
|
||||
begin
|
||||
if not FRegisterValueListValid then
|
||||
LoadRegisterValues;
|
||||
result := FRegisterValueList;
|
||||
end;
|
||||
|
||||
procedure TDbgThread.LoadRegisterValues;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
constructor TDbgThread.Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle);
|
||||
begin
|
||||
FID := AID;
|
||||
FHandle := AHandle;
|
||||
FProcess := AProcess;
|
||||
FRegisterValueList:=TDbgRegisterValueList.Create;
|
||||
|
||||
inherited Create;
|
||||
end;
|
||||
@ -524,6 +611,7 @@ end;
|
||||
destructor TDbgThread.Destroy;
|
||||
begin
|
||||
FProcess.ThreadDestroyed(Self);
|
||||
FRegisterValueList.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
@ -54,9 +54,12 @@ type
|
||||
{ TDbgWinThread }
|
||||
|
||||
TDbgWinThread = class(TDbgThread)
|
||||
protected
|
||||
procedure LoadRegisterValues; override;
|
||||
public
|
||||
function SingleStep: Boolean; virtual;
|
||||
function ResetInstructionPointerAfterBreakpoint: boolean; override;
|
||||
function ReadThreadState: boolean;
|
||||
end;
|
||||
|
||||
|
||||
@ -752,9 +755,8 @@ begin
|
||||
if AThread <> nil
|
||||
then begin
|
||||
// TODO: move to TDbgThread
|
||||
GCurrentContext^.ContextFlags := CONTEXT_SEGMENTS or CONTEXT_INTEGER or CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
|
||||
SetLastError(0);
|
||||
if not GetThreadContext(AThread.Handle, GCurrentContext^)
|
||||
|
||||
if not TDbgWinThread(AThread).ReadThreadState
|
||||
then DebugLn('LOOP: Unable to retrieve thread context');
|
||||
end;
|
||||
|
||||
@ -908,6 +910,52 @@ end;
|
||||
|
||||
{ TDbgWinThread }
|
||||
|
||||
procedure TDbgWinThread.LoadRegisterValues;
|
||||
var
|
||||
FlagS: string;
|
||||
begin
|
||||
with GCurrentContext^ do
|
||||
begin
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eax'].SetValue(Eax, IntToStr(Eax));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ecx'].SetValue(Ecx, IntToStr(Ecx));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['edx'].SetValue(Edx, IntToStr(Edx));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ebx'].SetValue(Ebx, IntToStr(Ebx));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['esp'].SetValue(Esp, IntToStr(Esp));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ebp'].SetValue(Ebp, IntToStr(Ebp));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['esi'].SetValue(Esi, IntToStr(Esi));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['edi'].SetValue(Edi, IntToStr(Edi));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eip'].SetValue(Eip, IntToStr(Eip));
|
||||
|
||||
FlagS := '';
|
||||
if EFlags and (1 shl 0) <> 0 then FlagS := FlagS + 'CF ';
|
||||
if EFlags and (1 shl 2) <> 0 then FlagS := FlagS + 'PF ';
|
||||
if EFlags and (1 shl 4) <> 0 then FlagS := FlagS + 'AF ';
|
||||
if EFlags and (1 shl 6) <> 0 then FlagS := FlagS + 'ZF ';
|
||||
if EFlags and (1 shl 7) <> 0 then FlagS := FlagS + 'SF ';
|
||||
if EFlags and (1 shl 8) <> 0 then FlagS := FlagS + 'TF ';
|
||||
if EFlags and (1 shl 9) <> 0 then FlagS := FlagS + 'IF ';
|
||||
if EFlags and (1 shl 10) <> 0 then FlagS := FlagS + 'DF ';
|
||||
if EFlags and (1 shl 11) <> 0 then FlagS := FlagS + 'OF ';
|
||||
if (EFlags shr 12) and 3 <> 0 then FlagS := FlagS + 'IOPL=' + IntToStr((EFlags shr 12) and 3);
|
||||
if EFlags and (1 shl 14) <> 0 then FlagS := FlagS + 'NT ';
|
||||
if EFlags and (1 shl 16) <> 0 then FlagS := FlagS + 'RF ';
|
||||
if EFlags and (1 shl 17) <> 0 then FlagS := FlagS + 'VM ';
|
||||
if EFlags and (1 shl 18) <> 0 then FlagS := FlagS + 'AC ';
|
||||
if EFlags and (1 shl 19) <> 0 then FlagS := FlagS + 'VIF ';
|
||||
if EFlags and (1 shl 20) <> 0 then FlagS := FlagS + 'VIP ';
|
||||
if EFlags and (1 shl 21) <> 0 then FlagS := FlagS + 'ID ';
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eflags'].SetValue(EFlags, trim(FlagS));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['cs'].SetValue(SegCs, IntToStr(SegCs));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ss'].SetValue(SegSs, IntToStr(SegSs));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ds'].SetValue(SegDs, IntToStr(SegDs));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['es'].SetValue(SegEs, IntToStr(SegEs));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['fs'].SetValue(SegFs, IntToStr(SegFs));
|
||||
FRegisterValueList.DbgRegisterAutoCreate['gs'].SetValue(SegGs, IntToStr(SegGs));
|
||||
end;
|
||||
FRegisterValueListValid:=true;
|
||||
end;
|
||||
|
||||
function TDbgWinThread.SingleStep: Boolean;
|
||||
var
|
||||
_UC: record
|
||||
@ -973,5 +1021,13 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDbgWinThread.ReadThreadState: boolean;
|
||||
begin
|
||||
GCurrentContext^.ContextFlags := CONTEXT_SEGMENTS or CONTEXT_INTEGER or CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
|
||||
SetLastError(0);
|
||||
result := GetThreadContext(Handle, GCurrentContext^);
|
||||
FRegisterValueListValid:=False;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -48,6 +48,7 @@ type
|
||||
procedure FDbgControllerExceptionEvent(var continue: boolean);
|
||||
protected
|
||||
function CreateWatches: TWatchesSupplier; override;
|
||||
function CreateRegisters: TRegisterSupplier; override;
|
||||
function RequestCommand(const ACommand: TDBGCommand;
|
||||
const AParams: array of const): Boolean; override;
|
||||
function ChangeFileName: Boolean; override;
|
||||
@ -75,6 +76,13 @@ type
|
||||
public
|
||||
end;
|
||||
|
||||
{ TFPRegisters }
|
||||
|
||||
TFPRegisters = class(TRegisterSupplier)
|
||||
public
|
||||
procedure RequestData(ARegisters: TRegisters); override;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
@ -84,6 +92,28 @@ begin
|
||||
RegisterDebugger(TFpDebugDebugger);
|
||||
end;
|
||||
|
||||
{ TFPRegisters }
|
||||
|
||||
procedure TFPRegisters.RequestData(ARegisters: TRegisters);
|
||||
var
|
||||
ARegisterList: TDbgRegisterValueList;
|
||||
i: Integer;
|
||||
ARegisterValue: TRegisterValue;
|
||||
begin
|
||||
if (Debugger = nil) or not(Debugger.State in [dsPause, dsStop]) then
|
||||
exit;
|
||||
|
||||
ARegisterList := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.MainThread.RegisterValueList;
|
||||
for i := 0 to ARegisterList.Count-1 do
|
||||
begin
|
||||
ARegisterValue := ARegisters.EntriesByName[ARegisterList[i].Name];
|
||||
ARegisterValue.ValueObj.SetAsNum(ARegisterList[i].NumValue, SizeOf(ARegisterList[i].NumValue));
|
||||
ARegisterValue.ValueObj.SetAsText(ARegisterList[i].StrValue);
|
||||
ARegisterValue.DataValidity:=ddsValid;
|
||||
end;
|
||||
ARegisters.DataValidity:=ddsValid;
|
||||
end;
|
||||
|
||||
{ TFPWatches }
|
||||
|
||||
function TFPWatches.FpDebugger: TFpDebugDebugger;
|
||||
@ -164,6 +194,11 @@ begin
|
||||
Result := TFPWatches.Create(Self);
|
||||
end;
|
||||
|
||||
function TFpDebugDebugger.CreateRegisters: TRegisterSupplier;
|
||||
begin
|
||||
Result := TFPRegisters.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.FreeDebugThread;
|
||||
begin
|
||||
FFpDebugThread.Terminate;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user