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

fpDebug: Ability to do simple function-calls

Browse Source 
git-svn-id: trunk@63751 -
This commit is contained in:
joost 2020-08-16 10:20:37 +00:00
parent 00242caf3c
commit a733105c1c
5 changed files with 492 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
components/fpdebug/fpdbgclasses.pp
View File

@ -208,6 +208,8 @@ type
procedure BeforeContinue; virtual;
procedure ApplyWatchPoints(AWatchPointData: TFpWatchPointData); virtual;
function DetectHardwareWatchpoint: Pointer; virtual;
// This function changes the value of a register in the debugee.
procedure SetRegisterValue(AName: string; AValue: QWord); virtual; abstract;
function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract;
@ -218,6 +220,11 @@ type
function FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
function FindCallStackEntryByInstructionPointer(AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
procedure ClearCallStack;
// Use these functions to 'save' the value of all registers, and to reset
// them to their original values. (Used to be able to restore the original
// situation after calling functions inside the debugee)
procedure StoreRegisters; virtual; abstract;
procedure RestoreRegisters; virtual; abstract;
destructor Destroy; override;
function CompareStepInfo(AnAddr: TDBGPtr = 0; ASubLine: Boolean = False): TFPDCompareStepInfo;
function IsAtStartOfLine: boolean;
@ -304,6 +311,10 @@ type
procedure Clear; reintroduce;
procedure AddLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint; AnIgnoreIfExists: Boolean = True);
procedure RemoveLocotion(const ALocation: TDBGPtr; const AInternalBreak: TFpInternalBreakpoint);
// When the debugger modifies the debuggee's code, it might be that the
// original value underneeth the breakpoint has to be changed. This function
// makes this possible.
procedure AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte);
function GetInternalBreaksAtLocation(const ALocation: TDBGPtr): TFpInternalBreakpointArray;
function GetOrigValueAtLocation(const ALocation: TDBGPtr): Byte; // returns Int3, if there is no break at this location
function HasInsertedBreakInstructionAtLocation(const ALocation: TDBGPtr): Boolean;
@ -533,8 +544,8 @@ type
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; virtual;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; virtual;
procedure RemoveAllBreakPoints;
procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr); virtual;
procedure AfterChangingInstructionCode(const ALocation: TDBGPtr); virtual;
procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual;
procedure AfterChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer); virtual;
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
// Should create a TDbgThread-instance for the given ThreadIdentifier.
@ -608,6 +619,8 @@ public
procedure LoadInfo; override;
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
// Modify the debugee's code.
function WriteInstructionCode(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
procedure TerminateProcess; virtual; abstract;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;
@ -1077,6 +1090,15 @@ begin
Result := TBreakLocationMapEnumerator.Create(Self);
end;
procedure TBreakLocationMap.AdaptOriginalValueAtLocation(const ALocation: TDBGPtr; const NewOrigValue: Byte);
var
LocData: PInternalBreakLocationEntry;
begin
LocData := GetDataPtr(ALocation);
if Assigned(LocData) then
LocData^.OrigValue := NewOrigValue;
end;
{ TDbgCallstackEntry }
function TDbgCallstackEntry.GetProcSymbol: TFpSymbol;
@ -2138,7 +2160,7 @@ begin
if ALocation = FTmpRemovedBreaks[i] then
exit;
BeforeChangingInstructionCode(ALocation);
BeforeChangingInstructionCode(ALocation, 1);
Result := FProcess.WriteData(ALocation, 1, Int3);
DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['Breakpoint Int3 set to '+FormatAddress(ALocation), ' Result:',Result, ' OVal:', OrigValue]);
@ -2146,7 +2168,7 @@ begin
DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, 'Unable to set breakpoint at '+FormatAddress(ALocation));
if Result then
AfterChangingInstructionCode(ALocation);
AfterChangingInstructionCode(ALocation, 1);
end;
function TDbgProcess.RemoveBreakInstructionCode(const ALocation: TDBGPtr;
@ -2155,14 +2177,14 @@ begin
if OrigValue = Int3 then
exit(True); // breakpoint on a hardcoded breakpoint
BeforeChangingInstructionCode(ALocation);
BeforeChangingInstructionCode(ALocation, 1);
Result := WriteData(ALocation, 1, OrigValue);
DebugLn(DBG_VERBOSE or DBG_BREAKPOINTS, ['Breakpoint Int3 removed from '+FormatAddress(ALocation), ' Result:',Result, ' OVal:', OrigValue]);
DebugLn((not Result) and (not GotExitProcess) and (DBG_WARNINGS or DBG_BREAKPOINTS), 'Unable to reset breakpoint at %s', [FormatAddress(ALocation)]);
if Result then
AfterChangingInstructionCode(ALocation);
AfterChangingInstructionCode(ALocation, 1);
end;
procedure TDbgProcess.RemoveAllBreakPoints;
@ -2189,12 +2211,12 @@ begin
assert(FBreakMap.Count = 0, 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0');
end;
procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr);
procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer);
begin
//
end;
procedure TDbgProcess.AfterChangingInstructionCode(const ALocation: TDBGPtr);
procedure TDbgProcess.AfterChangingInstructionCode(const ALocation: TDBGPtr; ACount: Integer);
begin
//
end;
@ -2285,6 +2307,21 @@ begin
Result := False;
end;
function TDbgProcess.WriteInstructionCode(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
var
i: Integer;
begin
BeforeChangingInstructionCode(AAdress, ASize);
for i := 0 to ASize -1 do
begin
if HasInsertedBreakInstructionAtLocation(AAdress+i) then
FBreakMap.AdaptOriginalValueAtLocation(AAdress+i, PByte(@AData+i)^);
end;
Result := WriteData(AAdress, ASize, AData);
AfterChangingInstructionCode(AAdress, ASize);
end;
{ TDbgStackFrameInfo }
procedure TDbgStackFrameInfo.DoAfterRun;

223
components/fpdebug/fpdbgcontroller.pas
View File

@ -158,6 +158,48 @@ type
constructor Create(AController: TDbgController);
end;
{ TDbgControllerCallRoutineCmd }
// This command is used to call a function of the debugee.
// First the state of the debugee is preserved, then the function is
// called from the current location of the instruction pointer and afterwards
// the debugee is restored into the original state.
// The provided context is used to store the register values just after
// the call has been made. This way it is possible to evaluate expressions to
// gather the function-result, using this context.
TDbgControllerCallRoutineCmd = class(TDbgControllerCmd)
protected
// Calling the function is done in two steps:
// - first execute one instruction so that the debugee jumps into the function (sSingleStep)
// - then run until the function has been completed (sRunRoutine)
type TStep = (sSingleStep, sRunRoutine);
protected
FOriginalCode: array of byte;
FOriginalInstructionPointer: TDBGPtr;
FReturnAdress: TDBGPtr;
FRoutineAddress: TDBGPtr;
FStep: TStep;
FHiddenBreakpoint: TFpInternalBreakpoint;
FCallContext: TFpDbgInfoCallContext;
procedure Init; override;
procedure InsertCallInstructionCode;
procedure RestoreOriginalCode;
procedure SetHiddenBreakpointAtReturnAddress(AnAddress: TDBGPtr);
procedure RemoveHiddenBreakpointAtReturnAddress();
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure StoreInstructionPointer;
procedure RestoreInstructionPointer;
procedure StoreRoutineResult;
procedure StoreRegisters;
procedure RestoreRegisters;
public
constructor Create(AController: TDbgController; ARoutineAddress: TFpDbgMemLocation; ACallContext:TFpDbgInfoCallContext);
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
end;
{ TDbgControllerStepOutCmd }
TDbgControllerStepOutCmd = class(TDbgControllerLineStepBaseCmd)
@ -260,6 +302,7 @@ type
procedure StepOverInstr;
procedure Next;
procedure Step;
function Call(const FunctionAddress: TFpDbgMemLocation; const ABaseContext: TFpDbgInfoContext; const AMemReader: TFpDbgMemReaderBase; const AMemConverter: TFpDbgMemConvertor): TFpDbgInfoCallContext;
procedure StepOut(AForceStoreStepInfo: Boolean = False);
function Pause: boolean;
function Detach: boolean;
@ -363,6 +406,176 @@ uses
var
DBG_VERBOSE, DBG_WARNINGS, FPDBG_COMMANDS: PLazLoggerLogGroup;
{ TDbgControllerCallRoutineCmd }
constructor TDbgControllerCallRoutineCmd.Create(AController: TDbgController; ARoutineAddress: TFpDbgMemLocation; ACallContext: TFpDbgInfoCallContext);
begin
inherited Create(AController);
{$IFNDEF Linux}
raise Exception.Create('Calling functions is only supported on Linux');
{$ENDIF}
if FController.CurrentProcess.Mode <> dm64 then
raise Exception.Create('Calling functions is only supported on 64-bits (x86_64)');
FRoutineAddress := LocToAddr(ARoutineAddress);
FCallContext := ACallContext;
end;
procedure TDbgControllerCallRoutineCmd.Init;
begin
inherited Init;
FStep := sSingleStep;
StoreInstructionPointer;
StoreRegisters;
InsertCallInstructionCode;
end;
procedure TDbgControllerCallRoutineCmd.InsertCallInstructionCode;
var
CurrentIP : TDBGPtr;
Buf: array of Byte;
RelAddr: Int32;
DW: PInt32;
begin
// Get the address of the current instruction.
CurrentIP := FController.CurrentThread.GetInstructionPointerRegisterValue;
// Store the original code of the current instruction
SetLength(FOriginalCode, 5);
if not FProcess.ReadData(CurrentIP, 5, FOriginalCode[0]) then
raise Exception.Create('Failed to read the original code at the instruction pointer');
// Calculate the relative offset between the address of the current instruction
// and the address of the function we want to call.
if Abs(Int64(FRoutineAddress)-Int64(CurrentIP))>=MaxSIntValue then
raise Exception.Create('Calling this function is not supported. Offset to the function that is to be called is too high.');
RelAddr := Int32(FRoutineAddress) - (Int32(CurrentIP) + 5); // 5 is the size of the instruction we are about to add.
// Construct the code to call the function.
SetLength(Buf, 5);
Buf[0] := $e8; // CALL
DW := pointer(@Buf[1]);
DW^ := RelAddr;
// Overwrite the current code with the new code to call the function
FProcess.WriteInstructionCode(CurrentIP, 5, Buf[0]);
// Store the address where the debugee should return at after the function
// finished. It is used to determine if the call has been completed succesfully.
FReturnAdress := CurrentIP + 5;
end;
procedure TDbgControllerCallRoutineCmd.DoContinue(AProcess: TDbgProcess; AThread: TDbgThread);
begin
case FStep of
sSingleStep: AProcess.Continue(AProcess, AThread, True); // Single step into the function
sRunRoutine: AProcess.Continue(AProcess, AThread, False); // Continue running the function
end;
end;
procedure TDbgControllerCallRoutineCmd.DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
var
CurrentIP: TDBGPtr;
begin
case FStep of
sSingleStep: begin
// The debugee is in the routine now. Restore the original code.
// (Remove the code that made the debugee jump into this routine)
RestoreOriginalCode;
// Set a breakpoint at the return-adres, so the debugee stops when the
// routine has been completed.
if AnEvent=deBreakpoint then begin
SetHiddenBreakpointAtReturnAddress(FReturnAdress);
AnEvent := deInternalContinue;
Finished := false;
FStep := sRunRoutine;
end else
raise Exception.Create('Fatal debugger-result during function-call.');
end;
sRunRoutine: begin
// Now the debugee has stopped while running the routine.
if not (AnEvent in [deException, deBreakpoint]) then
// Bail out. It can be anything, even deExitProcess. Maybe that handling
// some events can be implemented somewhere in the future.
raise Exception.Create('Fatal debugger-result during function-call.');
CurrentIP := FController.CurrentThread.GetInstructionPointerRegisterValue;
if CurrentIP<>FReturnAdress then
begin
// If we are not at the return-adres, the debugee has stopped due to some
// unforeseen reason. Skip setting up the call-context, but assign an
// error instead.
if (AnEvent = deBreakpoint) then
// Note that deBreakpoint does not necessarily mean that it it stopped
// at an actual breakpoint.
FCallContext.SetError('The function stopped unexpectedly. (Breakpoint, Exception, etc)')
else
FCallContext.SetError('The function stopped due to an exception.')
end
else
// Store the necessary data into the context to obtain the function-result
// later
StoreRoutineResult();
// We are at the return-adres. (Phew...)
//remove the hidden breakpoint.
RemoveHiddenBreakpointAtReturnAddress;
// Restore the debugee in the original state. So debugging can continue...
RestoreInstructionPointer();
RestoreRegisters();
Finished := true;
end
else
Finished := True;
end;
end;
procedure TDbgControllerCallRoutineCmd.RestoreOriginalCode;
begin
if not FProcess.WriteInstructionCode(FOriginalInstructionPointer, Length(FOriginalCode), FOriginalCode[0]) then
raise Exception.Create('Failed to restore the original code at the instruction-pointer');
end;
procedure TDbgControllerCallRoutineCmd.SetHiddenBreakpointAtReturnAddress(AnAddress: TDBGPtr);
begin
FHiddenBreakpoint := FProcess.AddInternalBreak(AnAddress);
end;
procedure TDbgControllerCallRoutineCmd.StoreInstructionPointer;
begin
FOriginalInstructionPointer := FController.CurrentThread.GetInstructionPointerRegisterValue;
end;
procedure TDbgControllerCallRoutineCmd.RestoreInstructionPointer;
begin
FController.CurrentThread.SetRegisterValue('rip', FOriginalInstructionPointer);
end;
procedure TDbgControllerCallRoutineCmd.StoreRoutineResult;
begin
FCallContext.SetRegisterValue(0, FController.CurrentThread.RegisterValueList.FindRegisterByDwarfIndex(0).NumValue);
end;
procedure TDbgControllerCallRoutineCmd.RestoreRegisters;
begin
FController.CurrentThread.RestoreRegisters;
end;
procedure TDbgControllerCallRoutineCmd.RemoveHiddenBreakpointAtReturnAddress();
begin
FHiddenBreakpoint.Free;
end;
procedure TDbgControllerCallRoutineCmd.StoreRegisters;
begin
FController.CurrentThread.StoreRegisters;
end;
{ TDbgControllerCmd }
procedure TDbgControllerCmd.SetThread(AValue: TDbgThread);
@ -1638,6 +1851,16 @@ begin
FNextOnlyStopOnStartLine := true;
end;
function TDbgController.Call(const FunctionAddress: TFpDbgMemLocation; const ABaseContext: TFpDbgInfoContext; const AMemReader: TFpDbgMemReaderBase; const AMemConverter: TFpDbgMemConvertor): TFpDbgInfoCallContext;
var
Context: TFpDbgInfoCallContext;
begin
Context := TFpDbgInfoCallContext.Create(ABaseContext, AMemReader, AMemConverter);
Context.AddReference;
InitializeCommand(TDbgControllerCallRoutineCmd.Create(self, FunctionAddress, Context));
Result := Context;
end;
initialization
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );

23
components/fpdebug/fpdbgdwarf.pas
View File

@ -576,6 +576,15 @@ type
AnInitLocParserData: PInitLocParserData): Boolean; override;
end;
{ TFpSymbolDwarfFunctionResult }
TFpSymbolDwarfFunctionResult = class(TFpSymbolDwarfDataWithLocation)
protected
function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override;
procedure Init; override;
end;
{ TFpSymbolDwarfType }
(* Types and allowed tags in dwarf 2
@ -1003,6 +1012,20 @@ begin
WriteStr(Result, ASubRangeBoundReadState);
end;
{ TFpSymbolDwarfFunctionResult }
function TFpSymbolDwarfFunctionResult.GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean;
begin
AnAddress := Address;
Result := IsInitializedLoc(AnAddress);
end;
procedure TFpSymbolDwarfFunctionResult.Init;
begin
inherited Init;
EvaluatedFields := EvaluatedFields + [sfiAddress];
end;
{ TFpValueDwarfStructBase }
function TFpValueDwarfStructBase.GetMember(AIndex: Int64): TFpValue;

162
components/fpdebug/fpdbginfo.pas
View File

@ -506,6 +506,56 @@ type
constructor Create(AMemManager: TFpDbgMemManager; AnAddress: TDbgPtr; AnSizeOfAddr, AThreadId: Integer; AStackFrame: Integer);
end;
{ TFpDbgCallMemReader }
// This is basically a wrapper on another TFpDbgMemReaderBase. But with the
// possibility to override the value of some registers.
// It is used to evaluate function-results.
TFpDbgCallMemReader = class(TFpDbgMemReaderBase)
private
type TRegisterValue = record IsSet: boolean; Value: TDBGPtr end;
private
FRegisterCache: array of TRegisterValue;
FBaseMemReader: TFpDbgMemReaderBase;
public
constructor Create(ABaseMemReader: TFpDbgMemReaderBase);
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean; override;
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgAddressContext): Boolean; override;
function RegisterSize(ARegNum: Cardinal): Integer; override;
procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
end;
{ TFpDbgInfoCallContext }
// This class is used to represent the context, just after the debugger made
// the debugee call some function.
// The special addition to make this work is that it is possible to set a
// register-value by calling SetRegisterValue. Further this class is an empty
// wrapper.
TFpDbgInfoCallContext = class(TFpDbgInfoContext)
private
FBaseContext: TFpDbgInfoContext;
FMemManager: TFpDbgMemManager;
FMemReader: TFpDbgCallMemReader;
FIsValid: Boolean;
FMessage: string;
protected
function GetMemManager: TFpDbgMemManager; override;
function GetAddress: TDbgPtr; override;
function GetThreadId: Integer; override;
function GetStackFrame: Integer; override;
function GetSizeOfAddress: Integer; override;
public
constructor Create(const ABaseContext: TFpDbgInfoContext; AMemReader: TFpDbgMemReaderBase; AMemConverter: TFpDbgMemConvertor);
destructor Destroy; override;
procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
procedure SetError(Message: string);
property IsValid: Boolean read FIsValid;
property Message: string read FMessage;
end;
{ TDbgInfo }
TDbgInfo = class(TObject)
@ -543,6 +593,118 @@ begin
WriteStr(Result, ADbgSymbolKind);
end;
{ TFpDbgCallMemReader }
constructor TFpDbgCallMemReader.Create(ABaseMemReader: TFpDbgMemReaderBase);
begin
FBaseMemReader := ABaseMemReader;
end;
function TFpDbgCallMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
Result := FBaseMemReader.ReadMemory(AnAddress, ASize, ADest);
end;
function TFpDbgCallMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean;
begin
Result := FBaseMemReader.ReadMemory(AnAddress, ASize, ADest, ABytesRead);
end;
function TFpDbgCallMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
Result := FBaseMemReader.ReadMemoryEx(AnAddress, AnAddressSpace, ASize, ADest);
end;
function TFpDbgCallMemReader.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgAddressContext): Boolean;
begin
if (ARegNum < Length(FRegisterCache)) and (FRegisterCache[ARegNum].IsSet) then
begin
AValue := FRegisterCache[ARegNum].Value;
Result := True;
end
else
Result := FBaseMemReader.ReadRegister(ARegNum, AValue, AContext);
end;
function TFpDbgCallMemReader.RegisterSize(ARegNum: Cardinal): Integer;
begin
Result := FBaseMemReader.RegisterSize(ARegNum);
end;
procedure TFpDbgCallMemReader.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
var
OldSize, i: Integer;
begin
if High(FRegisterCache) < ARegNum then
begin
OldSize := Length(FRegisterCache);
SetLength(FRegisterCache, ARegNum +1);
for i := OldSize to High(FRegisterCache) do
FRegisterCache[i].IsSet := False;
end;
FRegisterCache[ARegNum].IsSet := True;
FRegisterCache[ARegNum].Value := AValue;
end;
{ TFpDbgInfoCallContext }
constructor TFpDbgInfoCallContext.Create(const ABaseContext: TFpDbgInfoContext; AMemReader: TFpDbgMemReaderBase; AMemConverter: TFpDbgMemConvertor);
begin
FBaseContext:=ABaseContext;
FBaseContext.AddReference;
FMemReader := TFpDbgCallMemReader.Create(AMemReader);
FMemManager := TFpDbgMemManager.Create(FMemReader, AMemConverter);
FIsValid := True;
Inherited Create;
end;
destructor TFpDbgInfoCallContext.Destroy;
begin
FMemManager.Free;
FMemReader.Free;
FBaseContext.ReleaseReference;
inherited Destroy;
end;
function TFpDbgInfoCallContext.GetAddress: TDbgPtr;
begin
Result := FBaseContext.GetAddress;
end;
function TFpDbgInfoCallContext.GetMemManager: TFpDbgMemManager;
begin
Result := FMemManager;
end;
function TFpDbgInfoCallContext.GetSizeOfAddress: Integer;
begin
Result := FBaseContext.GetSizeOfAddress;
end;
function TFpDbgInfoCallContext.GetStackFrame: Integer;
begin
Result := FBaseContext.GetSizeOfAddress;
end;
function TFpDbgInfoCallContext.GetThreadId: Integer;
begin
Result := FBaseContext.GetThreadId;
end;
procedure TFpDbgInfoCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
begin
FMemReader.SetRegisterValue(ARegNum, AValue);
end;
procedure TFpDbgInfoCallContext.SetError(Message: string);
begin
FIsValid := False;
FMessage := Message;
end;
{ TFpValueConstString }
function TFpValueConstString.GetKind: TDbgSymbolKind;

39
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -245,6 +245,7 @@ type
TDbgLinuxThread = class(TDbgThread)
private
FUserRegs: TUserRegs;
FStoredUserRegs: TUserRegs;
FUserRegsChanged: boolean;
FExceptionSignal: cint;
FIsPaused, FInternalPauseRequested, FIsInInternalPause: boolean;
@ -267,6 +268,9 @@ type
function DetectHardwareWatchpoint: Pointer; override;
procedure BeforeContinue; override;
procedure LoadRegisterValues; override;
procedure SetRegisterValue(AName: string; AValue: QWord); override;
procedure StoreRegisters; override;
procedure RestoreRegisters; override;
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
@ -714,6 +718,41 @@ begin
result := FUserRegs.regs64[rsp];
end;
procedure TDbgLinuxThread.SetRegisterValue(AName: string; AValue: QWord);
begin
if Process.Mode=dm32 then
begin
case AName of
'eip': FUserRegs.regs32[eip] := AValue;
'eax': FUserRegs.regs32[eax] := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
FUserRegsChanged:=true;
end else
begin
case AName of
'rax': FUserRegs.regs64[rax] := AValue;
'rip': FUserRegs.regs64[rip] := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
FUserRegsChanged:=true;
end;
end;
procedure TDbgLinuxThread.RestoreRegisters;
begin
FUserRegs:=FStoredUserRegs;
FUserRegsChanged := true;
end;
procedure TDbgLinuxThread.StoreRegisters;
begin
Assert(FHasThreadState);
FStoredUserRegs := FUserRegs;
end;
{ TDbgLinuxProcess }
function TDbgLinuxProcess.GetRequiresExecutionInDebuggerThread: boolean;