paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-09 19:17:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: SetRegisterValue for Windows

Browse Source 
git-svn-id: trunk@63764 -
This commit is contained in:
martin 2020-08-16 20:23:35 +00:00
parent 3ea304cd6e
commit 2bba45a96c
1 changed files with 34 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
components/fpdebug/fpdbgwinclasses.pas
View File

@ -152,6 +152,7 @@ type
function ResetInstructionPointerAfterBreakpoint: boolean; override;
function ReadThreadState: boolean;
procedure SetRegisterValue(AName: string; AValue: QWord); override;
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
function GetStackPointerRegisterValue: TDbgPtr; override;
@ -1713,6 +1714,39 @@ begin
FRegisterValueListValid:=False;
end;
procedure TDbgWinThread.SetRegisterValue(AName: string; AValue: QWord);
begin
if ReadThreadState then
exit;
{$ifdef cpui386}
case AName of
'eip': FCurrentContext^.def.Eip := AValue;
'eax': FCurrentContext^.def.Eax := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
{$else}
if (TDbgWinProcess(Process).FBitness = b32) then begin
case AName of
'eip': FCurrentContext^.WOW.Eip := AValue;
'eax': FCurrentContext^.WOW.Eax := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
end
else begin
case AName of
'eip': FCurrentContext^.def.Rip := AValue;
'eax': FCurrentContext^.def.Rax := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
end;
{$endif}
FThreadContextChanged:=True;
end;
function TDbgWinThread.GetInstructionPointerRegisterValue: TDbgPtr;
begin
Result := 0;