paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 07:29:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Renamed TFpDbgHardcodedContext to TFpDbgHardcodedScope

Browse Source 
git-svn-id: trunk@63899 -
This commit is contained in:
joost 2020-09-20 19:21:53 +00:00
parent 90afc72ac7
commit 539c1f9a2b
14 changed files with 365 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/fpdebug/fpdbgclasses.pp
View File

@ -136,6 +136,8 @@ type
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override;
function RegisterSize(ARegNum: Cardinal): Integer; override;
function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override;
end;
{ TDbgStackFrameInfo
@ -1198,7 +1200,10 @@ var
Process: TDbgProcess;
begin
Process := GetDbgProcess;
if not Process.GetThread(AContext.ThreadId, Result) then
// In fact, AContext should always be assigned, assuming that the main thread
// should be used is dangerous. But functions like TFpDbgMemManager.ReadSignedInt
// have a default value of nil for the context. Which is a lot of work to fix.
if not Assigned(AContext) or not Process.GetThread(AContext.ThreadId, Result) then
Result := Process.MainThread;
end;
@ -1258,6 +1263,34 @@ begin
end;
end;
function TDbgMemReader.WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean;
var
ARegister: TDbgRegisterValue;
StackFrame: Integer;
AFrame: TDbgCallstackEntry;
CtxThread: TDbgThread;
begin
result := false;
CtxThread := GetDbgThread(AContext);
if CtxThread = nil then
exit;
if AContext <> nil then // TODO: Always true?
StackFrame := AContext.StackFrame
else
StackFrame := 0;
if StackFrame = 0 then
begin
ARegister:=CtxThread.RegisterValueList.FindRegisterByDwarfIndex(ARegNum);
if assigned(ARegister) then
begin
CtxThread.SetRegisterValue(ARegister.Name, AValue);
CtxThread.LoadRegisterValues;
result := true;
end;
end
end;
function TDbgMemReader.RegisterSize(ARegNum: Cardinal): Integer;
var
ARegister: TDbgRegisterValue;

7
components/fpdebug/fpdbgcontroller.pas
View File

@ -11,8 +11,8 @@ uses
Maps,
LazLoggerBase, LazClasses,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
FpDbgDisasX86, FpDbgUtil,
FpDbgClasses,
FpDbgDisasX86,
FpDbgClasses, FpDbgCallContextInfo, FpDbgUtil,
{$ifdef windows} FpDbgWinClasses, {$endif}
{$ifdef darwin} FpDbgDarwinClasses, {$endif}
{$ifdef linux} FpDbgLinuxClasses, {$endif}
@ -425,6 +425,8 @@ begin
FRoutineAddress := LocToAddr(ARoutineAddress);
FCallContext := ACallContext;
StoreRegisters;
end;
procedure TDbgControllerCallRoutineCmd.Init;
@ -433,7 +435,6 @@ begin
FStep := sSingleStep;
StoreInstructionPointer;
StoreRegisters;
InsertCallInstructionCode;
end;

105
components/fpdebug/fpdbgdwarf.pas
View File

@ -262,6 +262,7 @@ type
function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsCardinal: QWord; override;
function GetAsInteger: Int64; override;
procedure SetAsInteger(AValue: Int64); override;
end;
{ TFpValueDwarfCardinal }
@ -271,6 +272,7 @@ type
FValue: QWord;
protected
function GetAsCardinal: QWord; override;
procedure SetAsCardinal(AValue: QWord); override;
function GetFieldFlags: TFpValueFieldFlags; override;
end;
@ -291,6 +293,7 @@ type
protected
function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsBool: Boolean; override;
procedure SetAsBool(AValue: Boolean); override;
end;
{ TFpValueDwarfChar }
@ -311,6 +314,7 @@ type
function GetDerefAddress: TFpDbgMemLocation;
protected
function GetAsCardinal: QWord; override;
procedure SetAsCardinal(AValue: QWord); override;
function GetFieldFlags: TFpValueFieldFlags; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetAsString: AnsiString; override;
@ -331,7 +335,9 @@ type
//function IsValidTypeCast: Boolean; override;
function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsCardinal: QWord; override;
procedure SetAsCardinal(AValue: QWord); override;
function GetAsString: AnsiString; override;
procedure SetAsString(AValue: AnsiString); override;
// Has exactly 0 (if the ordinal value is out of range) or 1 member (the current value's enum)
function GetMemberCount: Integer; override;
function GetMember({%H-}AIndex: Int64): TFpValue; override;
@ -397,6 +403,7 @@ type
procedure Reset; override;
function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsCardinal: QWord; override;
procedure SetAsCardinal(AValue: QWord); override;
function GetDataSize: TFpDbgValueSize; override;
end;
@ -2103,7 +2110,7 @@ begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
Result := inherited GetAsInteger
else
if not MemManager.ReadSignedInt(OrdOrDataAddr, Size, Result) then begin
if not MemManager.ReadSignedInt(OrdOrDataAddr, Size, Result, Context) then begin
Result := 0; // TODO: error
SetLastError(MemManager.LastError);
end;
@ -2111,6 +2118,19 @@ begin
FIntValue := Result;
end;
procedure TFpValueDwarfInteger.SetAsInteger(AValue: Int64);
var
Size: TFpDbgValueSize;
begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then
inherited SetAsCardinal(AValue)
else
if not MemManager.WriteSignedInt(OrdOrDataAddr, Size, AValue, Context) then begin
SetLastError(MemManager.LastError);
end;
Exclude(FEvaluated, doneUInt);
end;
{ TDbgDwarfCardinalSymbolValue }
function TFpValueDwarfCardinal.GetAsCardinal: QWord;
@ -2126,7 +2146,7 @@ begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
Result := inherited GetAsCardinal
else
if not MemManager.ReadUnsignedInt(OrdOrDataAddr, Size, Result) then begin
if not MemManager.ReadUnsignedInt(OrdOrDataAddr, Size, Result, Context) then begin
Result := 0; // TODO: error
SetLastError(MemManager.LastError);
end;
@ -2140,6 +2160,19 @@ begin
Result := Result + [svfCardinal];
end;
procedure TFpValueDwarfCardinal.SetAsCardinal(AValue: QWord);
var
Size: TFpDbgValueSize;
begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then
inherited SetAsCardinal(AValue)
else
if not MemManager.WriteUnsignedInt(OrdOrDataAddr, Size, AValue, Context) then begin
SetLastError(MemManager.LastError);
end;
Exclude(FEvaluated, doneUInt);
end;
{ TFpValueDwarfFloat }
function TFpValueDwarfFloat.GetFieldFlags: TFpValueFieldFlags;
@ -2166,7 +2199,7 @@ begin
SetLastError(CreateError(fpErrorBadFloatSize));
end
else
if not MemManager.ReadFloat(OrdOrDataAddr, Size, Result) then begin
if not MemManager.ReadFloat(OrdOrDataAddr, Size, Result, Context) then begin
Result := 0; // TODO: error
SetLastError(MemManager.LastError);
end;
@ -2187,6 +2220,11 @@ begin
Result := QWord(GetAsCardinal) <> 0;
end;
procedure TFpValueDwarfBoolean.SetAsBool(AValue: Boolean);
begin
SetAsCardinal(QWord(AValue));
end;
{ TFpValueDwarfChar }
function TFpValueDwarfChar.GetFieldFlags: TFpValueFieldFlags;
@ -2249,7 +2287,7 @@ begin
if (Size > 0) then begin
Addr := OrdOrDataAddr;
if not IsNilLoc(Addr) then begin
if not MemManager.ReadAddress(Addr, SizeVal(Context.SizeOfAddress), Result) then
if not MemManager.ReadAddress(Addr, SizeVal(Context.SizeOfAddress), Result, Context) then
SetLastError(MemManager.LastError);
end;
end;
@ -2333,7 +2371,7 @@ begin
exit;
end;
if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], nil, [mmfPartialRead]) then begin
if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], Context, [mmfPartialRead]) then begin
Result := '';
SetLastError(MemManager.LastError);
exit;
@ -2369,7 +2407,7 @@ begin
exit;
end;
if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], nil, [mmfPartialRead]) then begin
if not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], Context, [mmfPartialRead]) then begin
Result := '';
SetLastError(MemManager.LastError);
exit;
@ -2432,6 +2470,12 @@ begin
end;
end;
procedure TFpValueDwarfPointer.SetAsCardinal(AValue: QWord);
begin
if not MemManager.WriteSignedInt(OrdOrDataAddr, SizeVal(Context.SizeOfAddress), AValue, Context) then
SetLastError(MemManager.LastError);
end;
{ TFpValueDwarfEnum }
procedure TFpValueDwarfEnum.InitMemberIndex;
@ -2477,7 +2521,7 @@ begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
Result := inherited GetAsCardinal
else
if not MemManager.ReadEnum(OrdOrDataAddr, Size, Result) then begin
if not MemManager.ReadEnum(OrdOrDataAddr, Size, Result, Context) then begin
SetLastError(MemManager.LastError);
Result := 0; // TODO: error
end;
@ -2485,6 +2529,19 @@ begin
FValue := Result;
end;
procedure TFpValueDwarfEnum.SetAsCardinal(AValue: QWord);
var
Size: TFpDbgValueSize;
begin
if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(AValue)) then
inherited SetAsCardinal(AValue)
else
if not MemManager.WriteEnum(OrdOrDataAddr, Size, AValue, Context) then begin
SetLastError(MemManager.LastError);
end;
Exclude(FEvaluated, doneUInt);
end;
function TFpValueDwarfEnum.GetAsString: AnsiString;
begin
InitMemberIndex;
@ -2515,6 +2572,18 @@ begin
Result := nil;
end;
procedure TFpValueDwarfEnum.SetAsString(AValue: AnsiString);
var
EnumSymbol: TFpSymbol;
begin
EnumSymbol := TypeInfo.NestedSymbolByName[AValue];
if Assigned(EnumSymbol) then begin
SetAsCardinal(EnumSymbol.OrdinalValue);
end
else
SetLastError(CreateError(fpErrAnyError, ['Not a valid enum-value']));
end;
{ TFpValueDwarfEnumMember }
function TFpValueDwarfEnumMember.GetFieldFlags: TFpValueFieldFlags;
@ -2581,7 +2650,7 @@ begin
if t = nil then exit;
GetDwarfDataAddress(DAddr);
if not MemManager.ReadSet(DAddr, Size, FMem) then begin
if not MemManager.ReadSet(DAddr, Size, FMem, Context) then begin
SetLastError(MemManager.LastError);
exit; // TODO: error
end;
@ -2799,6 +2868,19 @@ begin
Result := QWord(LocToAddrOrNil(Addr));
end;
procedure TFpValueDwarfStruct.SetAsCardinal(AValue: QWord);
var
Addr: TFpDbgMemLocation;
begin
Addr := Address;
if not IsValidLoc(Addr) then
SetLastError(CreateError(fpErrFailedWriteMem))
else begin
if not MemManager.WriteUnsignedInt(Addr, SizeVal(Context.SizeOfAddress), AValue, Context) then
SetLastError(MemManager.LastError);
end;
end;
function TFpValueDwarfStruct.GetDataSize: TFpDbgValueSize;
begin
Assert((FDataSymbol = nil) or (FDataSymbol.TypeInfo is TFpSymbolDwarf));
@ -2949,7 +3031,7 @@ end;
function TFpValueDwarfArray.GetAsCardinal: QWord;
begin
// TODO cache
if not MemManager.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result) then begin
if not MemManager.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result, Context) then begin
SetLastError(MemManager.LastError);
Result := 0;
end;
@ -4829,7 +4911,10 @@ var
i: Integer;
s, s1, s2: String;
begin
if AIndex = '' then
if AIndex = '' then begin
Result := nil;
Exit;
end;
s1 := UTF8UpperCase(AIndex);
s2 := UTF8LowerCase(AIndex);
CreateMembers;

21
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -738,6 +738,7 @@ type
procedure PushCopy(AFromIndex: Integer);
procedure PushConst(const AVal: TDBGPtr);
procedure PushTargetMem(const AVal: TDBGPtr);
procedure PushTargetRegister(const ARegNum: Cardinal);
function Peek: PFpDbgMemLocation;
function PeekForDeref: PFpDbgMemLocation;
function PeekKind: TFpDbgMemLocationType; // Can be called on empty stack
@ -1874,6 +1875,15 @@ begin
inc(FCount);
end;
procedure TDwarfLocationStack.PushTargetRegister(const ARegNum: Cardinal);
begin
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := Default(TFpDbgMemLocation);
FList[FCount] := RegisterLoc(ARegNum);
inc(FCount);
end;
function TDwarfLocationStack.Peek: PFpDbgMemLocation;
begin
Assert(0 < FCount);
@ -2089,11 +2099,12 @@ begin
FStack.PushConst(NewValue);
end;
DW_OP_regx: begin
if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue, FContext) then begin
SetError;
exit;
end;
FStack.PushConst(NewValue);
//if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue, FContext) then begin
// SetError;
// exit;
//end;
//FStack.PushConst(NewValue);
FStack.PushTargetRegister(ULEB128toOrdinal(CurData));
end;
DW_OP_breg0..DW_OP_breg31: begin

12
components/fpdebug/fpdbghardcodedfreepascalinfo.pas
View File

@ -202,11 +202,11 @@ type
function GetClassName: string;
end;
{ TFpDbgHardcodedContext }
{ TFpDbgHardcodedScope }
// Just a hack to simulate a real context, when FindSymbolScope does not return
// a context.
TFpDbgHardcodedContext = class(TFpDbgSymbolScope)
// Just a hack to simulate a real scope, when FindSymbolScope does not return
// a scope.
TFpDbgHardcodedScope = class(TFpDbgSymbolScope)
public
constructor Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer);
end;
@ -311,9 +311,9 @@ begin
end;
end;
{ TFpDbgHardcodedContext }
{ TFpDbgHardcodedScope }
constructor TFpDbgHardcodedContext.Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer);
constructor TFpDbgHardcodedScope.Create(AMemManager: TFpDbgMemManager; AnAdressSize: Integer; AThreadId: Integer);
begin
inherited Create(
TFpDbgSimpleLocationContext.Create(AMemManager, 0, AnAdressSize, AThreadId, 0)

70
components/fpdebug/fpdbginfo.pas
View File

@ -121,6 +121,11 @@ type
function GetAsWideString: WideString; virtual;
function GetAsFloat: Extended; virtual;
procedure SetAsCardinal(AValue: QWord); virtual;
procedure SetAsInteger(AValue: Int64); virtual;
procedure SetAsBool(AValue: Boolean); virtual;
procedure SetAsString(AValue: AnsiString); virtual;
function GetAddress: TFpDbgMemLocation; virtual;
function DoGetSize(out ASize: TFpDbgValueSize): Boolean; virtual;
function GetDataAddress: TFpDbgMemLocation; virtual;
@ -153,10 +158,10 @@ type
property Kind: TDbgSymbolKind read GetKind;
property FieldFlags: TFpValueFieldFlags read GetFieldFlags;
property AsInteger: Int64 read GetAsInteger;
property AsCardinal: QWord read GetAsCardinal;
property AsBool: Boolean read GetAsBool;
property AsString: AnsiString read GetAsString;
property AsInteger: Int64 read GetAsInteger write SetAsInteger;
property AsCardinal: QWord read GetAsCardinal write SetAsCardinal;
property AsBool: Boolean read GetAsBool write SetAsBool;
property AsString: AnsiString read GetAsString write SetAsString;
property AsWideString: WideString read GetAsWideString;
property AsFloat: Extended read GetAsFloat;
@ -488,6 +493,7 @@ type
function GetProcedureAtAddress: TFpValue; virtual;
function GetMemManager: TFpDbgMemManager; virtual;
function GetSizeOfAddress: Integer; virtual;
procedure DoReferenceReleased; override;
public
constructor Create(ALocationContext: TFpDbgLocationContext);
destructor Destroy; override;
@ -536,18 +542,19 @@ type
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: TFpDbgLocationContext): Boolean; override;
function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; override;
function RegisterSize(ARegNum: Cardinal): Integer; override;
procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
end;
{ TFpDbgInfoCallContext }
{ TFpDbgInfoAbstractCallContext }
// 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(TFpDbgLocationContext)
TFpDbgAbstractCallContext = class(TFpDbgLocationContext)
private
FBaseContext: TFpDbgLocationContext;
FMemManager: TFpDbgMemManager;
@ -563,6 +570,9 @@ type
public
constructor Create(const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase; AMemConverter: TFpDbgMemConvertor);
destructor Destroy; override;
function CreateParamSymbol(AParamIndex: Integer; ASymbolType: TFpSymbol): TFpValue; virtual; abstract;
procedure SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
procedure SetError(const Message: string);
property IsValid: Boolean read FIsValid;
@ -658,9 +668,12 @@ begin
FRegisterCache[ARegNum].Value := AValue;
end;
{ TFpDbgInfoCallContext }
function TFpDbgCallMemReader.WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean;
begin
Result := FBaseMemReader.WriteRegister(ARegNum, AValue, AContext);
end;
constructor TFpDbgInfoCallContext.Create(
constructor TFpDbgAbstractCallContext.Create(
const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase;
AMemConverter: TFpDbgMemConvertor);
begin
@ -675,7 +688,7 @@ begin
Inherited Create;
end;
destructor TFpDbgInfoCallContext.Destroy;
destructor TFpDbgAbstractCallContext.Destroy;
begin
FMemManager.Free;
FMemReader.Free;
@ -683,37 +696,37 @@ begin
inherited Destroy;
end;
function TFpDbgInfoCallContext.GetAddress: TDbgPtr;
function TFpDbgAbstractCallContext.GetAddress: TDbgPtr;
begin
Result := FBaseContext.Address;
end;
function TFpDbgInfoCallContext.GetMemManager: TFpDbgMemManager;
function TFpDbgAbstractCallContext.GetMemManager: TFpDbgMemManager;
begin
Result := FMemManager;
end;
function TFpDbgInfoCallContext.GetSizeOfAddress: Integer;
function TFpDbgAbstractCallContext.GetSizeOfAddress: Integer;
begin
Result := FBaseContext.SizeOfAddress;
end;
function TFpDbgInfoCallContext.GetStackFrame: Integer;
function TFpDbgAbstractCallContext.GetStackFrame: Integer;
begin
Result := FBaseContext.StackFrame;
end;
function TFpDbgInfoCallContext.GetThreadId: Integer;
function TFpDbgAbstractCallContext.GetThreadId: Integer;
begin
Result := FBaseContext.ThreadId;
end;
procedure TFpDbgInfoCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
procedure TFpDbgAbstractCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
begin
FMemReader.SetRegisterValue(ARegNum, AValue);
end;
procedure TFpDbgInfoCallContext.SetError(const Message: string);
procedure TFpDbgAbstractCallContext.SetError(const Message: string);
begin
FIsValid := False;
FMessage := Message;
@ -990,6 +1003,26 @@ begin
Result := 0;
end;
procedure TFpValue.SetAsCardinal(AValue: QWord);
begin
SetLastError(CreateError(fpErrChangeVariableNotSupported));
end;
procedure TFpValue.SetAsInteger(AValue: Int64);
begin
SetLastError(CreateError(fpErrChangeVariableNotSupported));
end;
procedure TFpValue.SetAsBool(AValue: Boolean);
begin
SetLastError(CreateError(fpErrChangeVariableNotSupported));
end;
procedure TFpValue.SetAsString(AValue: AnsiString);
begin
SetLastError(CreateError(fpErrChangeVariableNotSupported));
end;
{ TPasParserConstNumberSymbolValue }
function TFpValueConstNumber.GetKind: TDbgSymbolKind;
@ -1168,6 +1201,11 @@ begin
Result := nil;
end;
procedure TFpDbgSymbolScope.DoReferenceReleased;
begin
inherited DoReferenceReleased;
end;
function TFpDbgSimpleLocationContext.GetMemManager: TFpDbgMemManager;
begin
Result := FMemManager;

21
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -733,7 +733,28 @@ begin
begin
case AName of
'rax': FUserRegs.regs64[rax] := AValue;
'rbx': FUserRegs.regs64[rbx] := AValue;
'rcx': FUserRegs.regs64[rcx] := AValue;
'rdx': FUserRegs.regs64[rdx] := AValue;
'rsi': FUserRegs.regs64[rsi] := AValue;
'rdi': FUserRegs.regs64[rdi] := AValue;
'rbp': FUserRegs.regs64[rbp] := AValue;
'rsp': FUserRegs.regs64[rsp] := AValue;
'r8': FUserRegs.regs64[r8] := AValue;
'r9': FUserRegs.regs64[r9] := AValue;
'r10': FUserRegs.regs64[r10] := AValue;
'r11': FUserRegs.regs64[r11] := AValue;
'r12': FUserRegs.regs64[r12] := AValue;
'r13': FUserRegs.regs64[r13] := AValue;
'r14': FUserRegs.regs64[r14] := AValue;
'r15': FUserRegs.regs64[r15] := AValue;
'rip': FUserRegs.regs64[rip] := AValue;
'cs': FUserRegs.regs64[cs] := AValue;
'fs': FUserRegs.regs64[fs] := AValue;
'gs': FUserRegs.regs64[gs] := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;

6
components/fpdebug/fpdebug.lpk
View File

@ -216,7 +216,11 @@ File(s) with other licenses (see also header in file(s):
</Item>
<Item>
<Filename Value="fpdbghardcodedfreepascalinfo.pas"/>
<UnitName Value="fpdbghardcodedfreepascalinfo"/>
<UnitName Value="FpDbgHardcodedFreepascalInfo"/>
</Item>
<Item>
<Filename Value="fpdbgcallcontextinfo.pas"/>
<UnitName Value="fpdbgcallcontextinfo"/>
</Item>
</Files>
<i18n>

3
components/fpdebug/fpdebug.pas
View File

@ -13,7 +13,8 @@ uses
macho, FpImgReaderMachoFile, FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, FpdMemoryTools,
FpErrorMessages, FPDbgController, FpDbgDwarfVerbosePrinter, FpDbgDwarfDataClasses,
FpDbgDwarfFreePascal, fpDbgSymTableContext, fpDbgSymTable, FpDbgAvrClasses, FpDbgDisasAvr,
FpDbgRsp, FpDbgCommon, FpImgReaderWinPETypes, FpDbgHardcodedFreepascalInfo, LazarusPackageIntf;
FpDbgRsp, FpDbgCommon, FpImgReaderWinPETypes, FpDbgHardcodedFreepascalInfo, FpDbgCallContextInfo,
LazarusPackageIntf;
implementation

111
components/fpdebug/fpdmemorytools.pas
View File

@ -100,6 +100,7 @@ type
// Register with reduced size are treated as unsigned
// TODO: ReadRegister should only take THREAD-ID, not context
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; virtual; abstract;
function WriteRegister(ARegNum: Cardinal; const AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean; virtual; abstract;
function RegisterSize(ARegNum: Cardinal): Integer; virtual; abstract;
// Registernum from name
end;
@ -342,6 +343,11 @@ type
const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags = []
): Boolean;
function WriteMemory(AReadDataType: TFpDbgMemReadDataType;
const ADestLocation: TFpDbgMemLocation; const ADestSize: TFpDbgValueSize;
const ASource: Pointer; const ASourceSize: QWord; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags = []
): Boolean;
public
procedure SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase);
property CacheManager: TFpDbgMemCacheManagerBase read GetCacheManager;
@ -360,6 +366,11 @@ type
*)
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext {= nil}): Boolean;
function WriteMemory(const ADestLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize;
const ASource: Pointer; AContext: TFpDbgLocationContext = nil;
const AFlags: TFpDbgMemManagerFlags = []
): Boolean;
// location will be invalid, if read failed
function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
AContext: TFpDbgLocationContext = nil): TFpDbgMemLocation;
@ -375,17 +386,25 @@ type
// AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean;
function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline;
function WriteUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean;
//function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean;
function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: Int64; AContext: TFpDbgLocationContext = nil): Boolean; inline;
function WriteSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: Int64; AContext: TFpDbgLocationContext = nil): Boolean;
//function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: Int64;
// AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean;
// //enum/set: may need bitorder swapped
function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline;
function WriteEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord; AContext: TFpDbgLocationContext = nil): Boolean; inline;
//function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgLocationContext = nil): Boolean;
@ -1438,8 +1457,10 @@ begin
SourceReadSize := FMemReader.RegisterSize(Cardinal(ConvData.SourceLocation.Address));
if SourceReadSize = 0 then
exit; // failed
if not FMemReader.ReadRegister(Cardinal(ConvData.SourceLocation.Address), TmpVal, AContext) then
if not FMemReader.ReadRegister(Cardinal(ConvData.SourceLocation.Address), TmpVal, AContext) then begin
FLastError := CreateError(fpErrFailedReadRegister);
exit; // failed
end
end;
end;
if SourceReadSize > ConvData.SourceSize.Size then
@ -1474,6 +1495,68 @@ begin
FLastError := CreateError(fpInternalErrFailedReadMem);
end;
function TFpDbgMemManager.WriteMemory(AReadDataType: TFpDbgMemReadDataType;
const ADestLocation: TFpDbgMemLocation; const ADestSize: TFpDbgValueSize; const ASource: Pointer;
const ASourceSize: QWord; AContext: TFpDbgLocationContext; const AFlags: TFpDbgMemManagerFlags
): Boolean;
var
WriteData, WriteData2: Pointer;
TmpVal: TDbgPtr;
BitOffset, DestExtraSize: Integer;
DestWriteSize, DestFullSize: QWord;
begin
Result := False;
DebugLn(FPDBG_VERBOSE_MEM, ['$WriteMem: ', dbgs(AReadDataType),' ', dbgs(ADestLocation), ' ', dbgs(ADestSize), ' Source ', ASource]);
if (ADestLocation.MType in [mlfInvalid, mlfUninitialized]) or
(ADestSize <= 0)
then begin
FLastError := CreateError(fpInternalErrCanNotWriteInvalidMem);
exit;
end;
FLastError := NoError;
if AContext = nil then
AContext := FDefaultContext;
// ToDo: Use a TargetMemConverter
BitOffset := ADestLocation.BitOffset;
DestExtraSize := (BitOffset + ADestSize.BitSize + 7) div 8;
case ADestLocation.MType of
// ToDo: Add the ability to write to memory
mlfTargetRegister:
begin
If (BitOffset <> 0) or (not IsByteSize(ADestSize)) then begin
// Not yet supported
FLastError := CreateError(fpErrCanNotWriteMemAtAddr, [ADestLocation.Address]);
Result := False;
exit;
end;
DestWriteSize := FMemReader.RegisterSize(Cardinal(ADestLocation.Address));
if DestWriteSize = 0 then
exit; // failed
if SizeOf(TmpVal) < DestWriteSize then
Exit; // failed
move(ASource^, TmpVal, Min(SizeOf(TmpVal), Int64(ASourceSize))); // Little Endian only
if not FMemReader.WriteRegister(Cardinal(ADestLocation.Address), TmpVal, AContext) then
exit; // failed
Result := True;
end;
end;
if (not Result) and (not IsError(FLastError)) then
FLastError := CreateError(fpErrFailedWriteMem);
end;
procedure TFpDbgMemManager.SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase);
begin
if FCacheManager = ACacheMgr then exit;
@ -1520,6 +1603,13 @@ begin
Result := ReadMemory(rdtRawRead, ASourceLocation, ASize, ADest, ASize.Size, AContext, AFlags);
end;
function TFpDbgMemManager.WriteMemory(const ADestLocation: TFpDbgMemLocation;
const ASize: TFpDbgValueSize; const ASource: Pointer; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags): Boolean;
begin
Result := WriteMemory(rdtRawRead, ADestLocation, ASize, ASource, ASize.Size, AContext, AFlags);
end;
function TFpDbgMemManager.ReadMemoryEx(
const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgLocationContext
@ -1589,6 +1679,12 @@ begin
Result := ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.WriteUnsignedInt(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; const AValue: QWord; AContext: TFpDbgLocationContext): Boolean;
begin
Result := WriteMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.ReadSignedInt(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: Int64; AContext: TFpDbgLocationContext
): Boolean;
@ -1596,6 +1692,12 @@ begin
Result := ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.WriteSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: Int64; AContext: TFpDbgLocationContext): Boolean;
begin
Result := WriteMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.ReadEnum(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgLocationContext
): Boolean;
@ -1603,6 +1705,12 @@ begin
Result := ReadMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.WriteEnum(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord; AContext: TFpDbgLocationContext): Boolean;
begin
Result := WriteMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext);
end;
function TFpDbgMemManager.ReadSet(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: TBytes; AContext: TFpDbgLocationContext
): Boolean;
@ -1678,6 +1786,7 @@ begin
Result := True;
end;
initialization
FPDBG_VERBOSE_MEM := DebugLogger.FindOrRegisterLogGroup('FPDBG_VERBOSE_MEM' {$IFDEF FPDBG_VERBOSE_MEM} , True {$ENDIF} );

6
components/fpdebug/fperrormessages.pas
View File

@ -32,6 +32,7 @@ resourcestring
MsgfpErrReadMemSizeLimit = 'Memory read size exceeds limit';
MsgfpErrCanNotReadMemAtAddr = 'Failed to read Mem at Address $%1:x';
MsgfpErrFailedReadRegiseter = 'Failed to read data from register';
MsgfpInternalErrFailedWriteMem = 'Failed to write data';
// 200 LocationParser
MsgfpErrLocationParser = 'Internal Error: Cannot calculate location.';
MsgfpErrLocationParserMemRead = '%1:s (while calculating location)'; // Pass on nested error
@ -56,6 +57,7 @@ const
fpErrInvalidNumber = TFpErrorCode(28);
fpErrCannotDereferenceType = TFpErrorCode(29);
fpErrTypeHasNoIndex = TFpErrorCode(30);
fpErrChangeVariableNotSupported = TFpErrorCode(31);
// 100 memreader error
fpInternalErrFailedReadMem = TFpErrorCode(100);
@ -63,6 +65,9 @@ const
fpErrReadMemSizeLimit = TFpErrorCode(102);
fpErrCanNotReadMemAtAddr = TFpErrorCode(103);
fpErrFailedReadRegister = TFpErrorCode(104);
fpInternalErrCanNotWriteInvalidMem= TFpErrorCode(105);
fpErrFailedWriteMem = TFpErrorCode(106);
fpErrCanNotWriteMemAtAddr = TFpErrorCode(107);
// 200 LocationParser
fpErrLocationParser = TFpErrorCode(200);
@ -200,6 +205,7 @@ begin
fpInternalErrFailedReadMem: Result := MsgfpInternalErrfpErrFailedReadMem;
fpErrCanNotReadMemAtAddr: Result := MsgfpErrCanNotReadMemAtAddr;
fpErrFailedReadRegister: Result := MsgfpErrFailedReadRegiseter;
fpErrFailedWriteMem: Result := MsgfpInternalErrFailedWriteMem;
fpErrLocationParser: Result := MsgfpErrLocationParser;
fpErrLocationParserMemRead: Result := MsgfpErrLocationParserMemRead;

4
components/fpdebug/languages/fperrormessages.pot
View File

@ -101,6 +101,10 @@ msgstr ""
msgid "Internal error: Missing data location"
msgstr ""
#: fperrormessages.msgfpinternalerrfailedwritemem
msgid "Failed to write data"
msgstr ""
#: fperrormessages.msgfpinternalerrfperrfailedreadmem
msgid "Internal error: Failed to read data from memory"
msgstr ""

4
components/fpdebug/languages/fperrormessages.pt_BR.po
View File

@ -112,6 +112,10 @@ msgstr "Impossível acessar elemento indexado na expressão %1:s"
msgid "Internal error: Missing data location"
msgstr "Erro interno: Localização dos dados faltando"
#: fperrormessages.msgfpinternalerrfailedwritemem
msgid "Failed to write data"
msgstr ""
#: fperrormessages.msgfpinternalerrfperrfailedreadmem
msgid "Internal error: Failed to read data from memory"
msgstr "Erro interno: Falha ao ler dados da memória"

4
components/fpdebug/languages/fperrormessages.ru.po
View File

@ -111,6 +111,10 @@ msgstr "Невозможно получить доступ к элементу
msgid "Internal error: Missing data location"
msgstr "Внутренняя ошибка: неизвестно расположение данных"
#: fperrormessages.msgfpinternalerrfailedwritemem
msgid "Failed to write data"
msgstr ""
#: fperrormessages.msgfpinternalerrfperrfailedreadmem
msgid "Internal error: Failed to read data from memory"
msgstr "Внутренняя ошибка: не удалось прочитать данные из памяти"