paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 03:48:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: mem-manager

Browse Source 
git-svn-id: trunk@44068 -
This commit is contained in:
martin 2014-02-14 01:38:45 +00:00
parent e7d4722d9d
commit f580daeb56
7 changed files with 679 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1291,6 +1291,7 @@ components/fpdebug/test/testdwarfsetuparray.pas svneol=native#text/pascal
components/fpdebug/test/testdwarfsetupbasic.pas svneol=native#text/pascal
components/fpdebug/test/testdwarfvarious.pas svneol=native#text/pascal
components/fpdebug/test/testhelperclasses.pas svneol=native#text/pascal
components/fpdebug/test/testmemmanager.pas svneol=native#text/pascal
components/fpdebug/test/testpascalparser.pas svneol=native#text/pascal
components/fpdebug/test/testtypeinfo.pas svneol=native#text/pascal
components/fppkg/images/archive.png -text

112
components/fpdebug/fpdbgdwarf.pas
View File

@ -629,6 +629,8 @@ type
private
FSize: Integer;
protected
function OrdOrDataAddr: TFpDbgMemLocation;
function DataAddr: TFpDbgMemLocation;
function ReadMemory(ADest: Pointer): Boolean; // ADest must point to FSize amount of bytes
function CanUseTypeCastAddress: Boolean;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
@ -646,7 +648,6 @@ type
FEvaluated: set of (doneUInt, doneInt);
protected
procedure Reset; override;
function GetCardinalValue: QWord;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function IsValidTypeCast: Boolean; override;
function GetAsCardinal: QWord; override;
@ -2095,6 +2096,25 @@ end;
{ TDbgDwarfSizedSymbolValue }
function TDbgDwarfSizedSymbolValue.OrdOrDataAddr: TFpDbgMemLocation;
begin
if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
else
Result := DataAddr;
end;
function TDbgDwarfSizedSymbolValue.DataAddr: TFpDbgMemLocation;
begin
if FValueSymbol <> nil then
Result := FValueSymbol.Address
else
if HasTypeCastInfo then
Result := FTypeCastSourceValue.Address
else
Result := InvalidLoc;
end;
function TDbgDwarfSizedSymbolValue.ReadMemory(ADest: Pointer): Boolean;
var
addr: TFpDbgMemLocation;
@ -2102,15 +2122,8 @@ begin
// TODO: memory representation of values is not dwarf, but platform - move
Result := False;
if ( (FValueSymbol <> nil) or
(HasTypeCastInfo and CanUseTypeCastAddress)
) and (MemManager <> nil)
then begin
if FValueSymbol <> nil then
addr := FValueSymbol.Address
else
addr := FTypeCastSourceValue.Address;
if (MemManager <> nil) then begin
addr := DataAddr;
Result := IsReadableLoc(addr);
if not Result then
exit;
@ -2566,26 +2579,6 @@ begin
FEvaluated := [];
end;
function TDbgDwarfNumericSymbolValue.GetCardinalValue: QWord;
begin
if (FSize <= 0) or (FSize > SizeOf(Result)) then begin
Result := inherited GetAsCardinal;
end
else
if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then begin
Result := FTypeCastSourceValue.AsCardinal;
Result := Result and (QWord(-1) shr ((SizeOf(Result)-FSize) * 8));
end
else begin
// TODO endian
Result := 0; // GetMem only reads FSize
if not ReadMemory(@Result) then // ReadMemory stores to FValue
Result := inherited GetAsCardinal;
end;
end;
function TDbgDwarfNumericSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -2610,7 +2603,12 @@ begin
end;
Include(FEvaluated, doneUInt);
Result := GetCardinalValue;
if (FSize <= 0) or (FSize > SizeOf(Result)) then
Result := inherited GetAsCardinal
else
if not MemManager.ReadUnsignedInt(OrdOrDataAddr, FSize, Result) then
Result := 0; // TODO: error
FValue := Result;
end;
@ -2622,10 +2620,11 @@ begin
end;
Include(FEvaluated, doneInt);
Result := Int64(GetCardinalValue);
// sign extend
if Result and (int64(1) shl (FSize * 8 - 1)) <> 0 then
Result := Result or (int64(-1) shl (FSize * 8));
if (FSize <= 0) or (FSize > SizeOf(Result)) then
Result := inherited GetAsInteger
else
if not MemManager.ReadSignedInt(OrdOrDataAddr, FSize, Result) then
Result := 0; // TODO: error
FIntValue := Result;
end;
@ -5252,9 +5251,6 @@ end;
function TDbgDwarfTypeIdentifierRef.GetDataAddress(var AnAddress: TFpDbgMemLocation;
ATargetType: TDbgDwarfTypeIdentifier): Boolean;
//var
// Addr4: DWORD;
// Addr8: QWord;
begin
if ATargetType = Self then begin
Result := True;
@ -5264,18 +5260,6 @@ begin
if not Result then
exit;
AnAddress := FCU.FOwner.MemManager.ReadAddress(AnAddress, FCU.FAddressSize);
//case FCU.FAddressSize of
// 4: begin
// FCU.FOwner.MemManager.ReadMemory(AnAddress, 4, @Addr4);
// AnAddress := Addr4;
// end;
// 8: begin
// FCU.FOwner.MemManager.ReadMemory(AnAddress, 8, @Addr8);
// AnAddress := Addr8;
// end;
// else
// Result := False;
//end;
if Result then
Result := inherited GetDataAddress(AnAddress, ATargetType);
end;
@ -5340,9 +5324,6 @@ end;
function TDbgDwarfTypeIdentifierPointer.GetDataAddress(var AnAddress: TFpDbgMemLocation;
ATargetType: TDbgDwarfTypeIdentifier): Boolean;
//var
// Addr4: DWORD;
// Addr8: QWord;
begin
if ATargetType = Self then begin
Result := True;
@ -5352,18 +5333,7 @@ begin
if not Result then
exit;
AnAddress := FCU.FOwner.MemManager.ReadAddress(AnAddress, FCU.FAddressSize);
//case FCU.FAddressSize of
// 4: begin
// FCU.FOwner.MemManager.ReadMemory(AnAddress, 4, @Addr4);
// AnAddress := Addr4;
// end;
// 8: begin
// FCU.FOwner.MemManager.ReadMemory(AnAddress, 8, @Addr8);
// AnAddress := Addr8;
// end;
// else
// Result := False;
//end;
Result := IsTargetNotNil(AnAddress);
if Result then
Result := inherited GetDataAddress(AnAddress, ATargetType);
end;
@ -5467,7 +5437,9 @@ begin
exit;
Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress');
AnAddress := Address;
Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType);
Result := IsReadableLoc(AnAddress);
if Result then
Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType);
end;
procedure TDbgDwarfValueIdentifier.KindNeeded;
@ -7751,10 +7723,10 @@ end;
function TDwarfCompilationUnit.ReadAddressAtPointer(var AData: Pointer;
AIncPointer: Boolean): TFpDbgMemLocation;
begin
Result := FOwner.MemManager.ReadAddress(SelfLoc(AData), FAddressSize); // TODO Dwarf3 depends on FIsDwarf64
//if FAddressSize = 4 // TODO Dwarf3 depends on FIsDwarf64
//then Result := PLongWord(AData)^
//else Result := PQWord(AData)^;
// do not need mem reader, address is in dwarf. Should be in correct format
if FAddressSize = 4 // TODO Dwarf3 depends on FIsDwarf64
then Result := TargetLoc(PLongWord(AData)^)
else Result := TargetLoc(PQWord(AData)^);
if AIncPointer then inc(AData, FAddressSize);
end;

469
components/fpdebug/fpdmemorytools.pas
View File

@ -2,10 +2,29 @@ unit FpdMemoryTools;
{$mode objfpc}{$H+}
(* Tools to read data from Target or Own memory.
This is to deal in one place with all conversion of data from target format
to debugger format.
A typical read would involve the following steps:
The code calls MemoryManager with an Address, a Size and a space for the data.
If the data needs to be extended (SizeOf(data) > TargetSize), then
MemConvertor is called to decide where in rovided space the read data should
initially be stored.
Then the data is read using MemReader.
And finally MemConvertor is given a chance to extend or convert the data.
*)
interface
uses
Classes, SysUtils;
Classes, SysUtils, math;
type
TDbgPtr = QWord; // TODO, use from IdeDebuggerInterface, once that is done.
@ -14,38 +33,120 @@ type
public
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual; abstract;
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual; abstract;
// ReadRegister may need TargetMemConvertor
// Register with reduced size are treated as unsigned
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean; virtual; abstract;
function RegisterSize(ARegNum: Cardinal): Integer; virtual; abstract;
// Registernum from name
end;
(* Options for all read operation // TODO *)
TFpDbgMemReadOptions = record
(* potential flags
target bit start/shift (method to map dwarf2/3 bit offse to dwarf 4
target bit size
target assume big/little endian
float precisson
AddressSpace
( rmBigEndian, rmLittleEndian, rmUseAddressSpace, UseBitSize)
AddressSpace, BitOffset, precission
*)
end;
TFpDbgMemReadDataType = (
rdtAddress, rdtSignedInt, rdtUnsignedInt
);
TFpDbgMemConvData = record
NewTargetAddress: TDbgPtr;
NewDestAddress: Pointer;
NewReadSize: Cardinal;
PrivData1, PrivData2: Pointer;
end;
// Todo, cpu/language specific operations, endianess, sign extend, float .... default int value for bool
// convert from debugge format to debuger format and back
// TODO: currently it assumes target and own mem are in the same format
TFpDbgMemConvertor = class
public
(* To copy a smaller int/cardinal (e.g. word) into a bigger (e.g. dword),
(* PrepareTargetRead
called before every Read operation.
In case of reading from a bit-offset more memory may be needed, and must be allocated here
*)
function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
out AConvertorData: TFpDbgMemConvData
): boolean; virtual; abstract;
function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
AnOpts: TFpDbgMemReadOptions;
out AConvertorData: TFpDbgMemConvData
): boolean; virtual; abstract;
(* FinishTargetRead
called after every Read operation.
*)
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
AConvertorData: TFpDbgMemConvData
): boolean; virtual; abstract;
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
AnOpts: TFpDbgMemReadOptions;
AConvertorData: TFpDbgMemConvData
): boolean; virtual; abstract;
// just to free any data
procedure FailedTargetRead(AConvertorData: TFpDbgMemConvData); virtual; abstract;
(* AdjustIntPointer:
To copy a smaller int/cardinal (e.g. word) into a bigger (e.g. dword),
adjust ADestPointer so it points to the low value part of the dest
No conversion
*)
procedure AdjustIntPointer(var ADestPointer: Pointer; ASourceSize, ADestSize: Cardinal); virtual; abstract;
(* Expects a signed integer value of ASourceSize bytes in the low value end
of the memory (total memory ADataPointer, ADestSize)
Does zero fill the memory, if no sign extend is needed
*)
procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); virtual; abstract;
(* Expects an unsigned integer value of ASourceSize bytes in the low value end
of the memory (total memory ADataPointer, ADestSize)
Basically zero fill the memory
*)
procedure UnsignSignedExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); virtual; abstract;
procedure AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); virtual; abstract;
//(* SignExtend:
// Expects a signed integer value of ASourceSize bytes in the low value end
// of the memory (total memory ADataPointer, ADestSize)
// Does zero fill the memory, if no sign extend is needed
//*)
//procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); virtual; abstract;
//(* Expects an unsigned integer value of ASourceSize bytes in the low value end
// of the memory (total memory ADataPointer, ADestSize)
// Basically zero fill the memory
//*)
//procedure UnsignedExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); virtual; abstract;
end;
{ TFpDbgMemConvertorLittleEndian }
TFpDbgMemConvertorLittleEndian = class(TFpDbgMemConvertor)
public
procedure AdjustIntPointer(var ADestPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
procedure UnsignSignedExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
out AConvertorData: TFpDbgMemConvData
): boolean; override;
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
ATargetSize, ADestSize: Cardinal;
AConvertorData: TFpDbgMemConvData
): boolean; override;
procedure FailedTargetRead(AConvertorData: TFpDbgMemConvData); override;
procedure AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); override;
//procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
//procedure UnsignedExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
end;
(* TFpDbgMemManager
@ -68,7 +169,6 @@ type
mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...)
// the below will be mapped (and extended) according to endianess
mlfTargetRegister, // reads from the register
mlfTargetRegisterSigned, // reads from the register and sign extends if needed (may be limited to 8 bytes)
mlfConstant // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process)
);
@ -77,30 +177,70 @@ type
MType: TFpDbgMemLocationType;
end;
{ TFpDbgMemManager }
TFpDbgMemManager = class
private
FMemReader: TFpDbgMemReaderBase;
FMemConvertor: TFpDbgMemConvertor;
FTargetMemConvertor: TFpDbgMemConvertor;
FSelfMemConvertor: TFpDbgMemConvertor; // used when resizing constants (or register values, which are already in self format)
protected
function ReadMemory(AReadDataType: TFpDbgMemReadDataType;
const ALocation: TFpDbgMemLocation; ATargetSize: Cardinal;
ADest: Pointer; ADestSize: Cardinal): Boolean;
public
constructor Create(AMemReader: TFpDbgMemReaderBase; AMemConvertor: TFpDbgMemConvertor);
constructor Create(AMemReader: TFpDbgMemReaderBase; ATargenMemConvertor, ASelfMemConvertor: TFpDbgMemConvertor);
function ReadMemory(ALocation: TFpDbgMemLocation; ASize: Cardinal; ADest: Pointer): Boolean;
function ReadMemoryEx(ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
function ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal; ADest: Pointer): Boolean;
function ReadMemoryEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean;
function ReadAddress(ALocation: TFpDbgMemLocation; ASize: Cardinal): TFpDbgMemLocation;
function ReadAddressEx(ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemLocation;
// location will be invalid, if read failed
function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal): TFpDbgMemLocation;
function ReadAddressEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemLocation;
property MemConvertor: TFpDbgMemConvertor read FMemConvertor;
function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AnAddress: TFpDbgMemLocation): Boolean; inline;
//function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AnAddress: TFpDbgMemLocation;
// AnOpts: TFpDbgMemReadOptions): Boolean;
function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AValue: QWord): Boolean; inline;
//function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions): Boolean;
function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AValue: Int64): Boolean; inline;
//function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: Int64;
// AnOpts: TFpDbgMemReadOptions): Boolean;
// //enum/set: may need bitorder swapped
//function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: QWord): Boolean; inline;
//function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions): Boolean;
//function ReadSet (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: TBytes): Boolean; inline;
//function ReadSet (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: TBytes;
// AnOpts: TFpDbgMemReadOptions): Boolean;
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: Double): Boolean; inline;
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
// out AValue: Double;
// AnOpts: TFpDbgMemReadOptions): Boolean;
property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor;
property SelfMemConvertor: TFpDbgMemConvertor read FSelfMemConvertor;
end;
function NilLoc: TFpDbgMemLocation; inline;
function InvalidLoc: TFpDbgMemLocation; inline;
function TargetLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline;
function RegisterLoc(ARegNum: Cardinal): TFpDbgMemLocation; inline;
function RegisterSignedLoc(ARegNum: Cardinal): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; inline;
function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline;
@ -114,6 +254,8 @@ function IsTargetNotNil(ALocation: TFpDbgMemLocation): Boolean; inline; // valid
function LocToAddr(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid
function LocToAddrOrNil(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version
function EmptyMemReadOpts:TFpDbgMemReadOptions;
function dbgs(ALocation: TFpDbgMemLocation): String; overload;
implementation
@ -142,12 +284,6 @@ begin
Result.MType := mlfTargetRegister;
end;
function RegisterSignedLoc(ARegNum: Cardinal): TFpDbgMemLocation;
begin
Result.Address := ARegNum;
Result.MType := mlfTargetRegisterSigned;
end;
function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation;
begin
Result.Address := AnAddress;
@ -208,6 +344,11 @@ begin
Result := 0;
end;
function EmptyMemReadOpts: TFpDbgMemReadOptions;
begin
//
end;
function dbgs(ALocation: TFpDbgMemLocation): String;
begin
Result := '';
@ -219,52 +360,169 @@ end;
{ TFpDbgMemConvertorLittleEndian }
procedure TFpDbgMemConvertorLittleEndian.AdjustIntPointer(var ADestPointer: Pointer;
ASourceSize, ADestSize: Cardinal);
function TFpDbgMemConvertorLittleEndian.PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal; out
AConvertorData: TFpDbgMemConvData): boolean;
begin
Result := True;
case AReadDataType of
rdtAddress, rdtSignedInt, rdtUnsignedInt: begin
Result := ATargetSize <= ADestSize;
// just read to begin of data
AConvertorData.NewTargetAddress := ATargetPointer;
AConvertorData.NewDestAddress := ADestPointer;
AConvertorData.NewReadSize := Min(ATargetSize, ADestSize);
end;
end;
end;
function TFpDbgMemConvertorLittleEndian.FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal;
AConvertorData: TFpDbgMemConvData): boolean;
begin
Result := True;
case AReadDataType of
rdtAddress, rdtUnsignedInt: begin
if ATargetSize < ADestSize then
FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $00)
end;
rdtSignedInt: begin
if ATargetSize < ADestSize then
if (ATargetSize > 0) and ((PByte(ADestPointer + ATargetSize - 1)^ and $80) <> 0)
then
FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $FF)
else
FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $00);
end;
end;
end;
procedure TFpDbgMemConvertorLittleEndian.FailedTargetRead(AConvertorData: TFpDbgMemConvData);
begin
//
end;
procedure TFpDbgMemConvertorLittleEndian.AdjustIntPointer(var ADataPointer: Pointer;
ADataSize, ANewSize: Cardinal);
begin
Assert(ANewSize <= ADataSize, 'TFpDbgMemConvertorLittleEndian.AdjustIntPointer');
// no adjustment needed
end;
procedure TFpDbgMemConvertorLittleEndian.SignExtend(ADataPointer: Pointer; ASourceSize,
ADestSize: Cardinal);
begin
Assert(ASourceSize > 0, 'TFpDbgMemConvertorLittleEndian.SignExtend');
if ASourceSize >= ADestSize then
exit;
if (PByte(ADataPointer + ASourceSize - 1)^ and $80) <> 0 then
FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $ff)
else
FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $00)
end;
procedure TFpDbgMemConvertorLittleEndian.UnsignSignedExtend(ADataPointer: Pointer;
ASourceSize, ADestSize: Cardinal);
begin
Assert(ASourceSize > 0, 'TFpDbgMemConvertorLittleEndian.SignExtend');
if ASourceSize >= ADestSize then
exit;
FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $00)
end;
//procedure TFpDbgMemConvertorLittleEndian.SignExtend(ADataPointer: Pointer; ASourceSize,
// ADestSize: Cardinal);
//begin
// Assert(ASourceSize > 0, 'TFpDbgMemConvertorLittleEndian.SignExtend');
// if ASourceSize >= ADestSize then
// exit;
//
// if (PByte(ADataPointer + ASourceSize - 1)^ and $80) <> 0 then
// FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $ff)
// else
// FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $00)
//end;
//
//procedure TFpDbgMemConvertorLittleEndian.UnsignedExtend(ADataPointer: Pointer;
// ASourceSize, ADestSize: Cardinal);
//begin
// Assert(ASourceSize > 0, 'TFpDbgMemConvertorLittleEndian.SignExtend');
// if ASourceSize >= ADestSize then
// exit;
//
// FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $00)
//end;
{ TFpDbgMemManager }
function TFpDbgMemManager.ReadMemory(AReadDataType: TFpDbgMemReadDataType;
const ALocation: TFpDbgMemLocation; ATargetSize: Cardinal; ADest: Pointer;
ADestSize: Cardinal): Boolean;
var
Addr2: Pointer;
i: Integer;
TmpVal: TDbgPtr;
ConvData: TFpDbgMemConvData;
begin
Result := False;
case ALocation.MType of
mlfInvalid: ;
mlfTargetMem, mlfSelfMem: begin
Result := TargetMemConvertor.PrepareTargetRead(AReadDataType, ALocation.Address,
ADest, ATargetSize, ADestSize, ConvData);
if not Result then exit;
if ALocation.MType = mlfTargetMem then
Result := FMemReader.ReadMemory(ConvData.NewTargetAddress, ConvData.NewReadSize, ConvData.NewDestAddress)
else
begin
move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize);
Result := True;
end;
if Result then
Result := TargetMemConvertor.FinishTargetRead(AReadDataType, ALocation.Address,
ADest, ATargetSize, ADestSize, ConvData)
else
TargetMemConvertor.FailedTargetRead(ConvData);
end;
mlfConstant, mlfTargetRegister:
begin
case ALocation.MType of
mlfConstant: begin
TmpVal := ALocation.Address;
i := SizeOf(ALocation.Address);
end;
mlfTargetRegister: begin
i := FMemReader.RegisterSize(Cardinal(ALocation.Address));
if i = 0 then
exit; // failed
if not FMemReader.ReadRegister(Cardinal(ALocation.Address), TmpVal) then
exit; // failed
end;
end;
if i > ATargetSize then
i := ATargetSize;
Addr2 := @TmpVal;
if SizeOf(TmpVal) <> i then
FSelfMemConvertor.AdjustIntPointer(Addr2, SizeOf(TmpVal), i);
Result := FSelfMemConvertor.PrepareTargetRead(AReadDataType, TDbgPtr(Addr2),
ADest, i, ADestSize, ConvData);
if not Result then exit;
move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize);
Result := TargetMemConvertor.FinishTargetRead(AReadDataType, TDbgPtr(Addr2),
ADest, i, ADestSize, ConvData);
Result := True;
end;
end;
end;
constructor TFpDbgMemManager.Create(AMemReader: TFpDbgMemReaderBase;
AMemConvertor: TFpDbgMemConvertor);
begin
FMemReader := AMemReader;
FMemConvertor := AMemConvertor;
FTargetMemConvertor := AMemConvertor;
FSelfMemConvertor := AMemConvertor;
end;
function TFpDbgMemManager.ReadMemory(ALocation: TFpDbgMemLocation; ASize: Cardinal;
constructor TFpDbgMemManager.Create(AMemReader: TFpDbgMemReaderBase; ATargenMemConvertor,
ASelfMemConvertor: TFpDbgMemConvertor);
begin
FMemReader := AMemReader;
FTargetMemConvertor := ATargenMemConvertor;
FSelfMemConvertor := ASelfMemConvertor;
end;
function TFpDbgMemManager.ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
ADest: Pointer): Boolean;
const
ConstValSize = SizeOf(ALocation.Address);
var
Addr2: Pointer;
i: Integer;
TmpVal: TDbgPtr;
ConvData: TFpDbgMemConvData;
begin
Result := False;
case ALocation.MType of
@ -276,14 +534,14 @@ begin
move(Pointer(ALocation.Address)^, ADest^, ASize);
Result := True;
end;
mlfConstant, mlfTargetRegister, mlfTargetRegisterSigned:
mlfConstant, mlfTargetRegister:
begin
case ALocation.MType of
mlfConstant: begin
TmpVal := ALocation.Address;
i := ConstValSize;
i := SizeOf(ALocation.Address);
end;
mlfTargetRegister, mlfTargetRegisterSigned: begin
mlfTargetRegister: begin
i := FMemReader.RegisterSize(Cardinal(ALocation.Address));
if i = 0 then
exit; // failed
@ -292,29 +550,27 @@ begin
end;
end;
if ASize < i then begin
Addr2 := @TmpVal;
FMemConvertor.AdjustIntPointer(Addr2, ASize, i);
move(Addr2^, ADest^, i);
end
else begin
Addr2 := ADest;
FMemConvertor.AdjustIntPointer(Addr2, i, ASize);
PQWord(Addr2)^ := TmpVal;
if ALocation.MType = mlfTargetRegisterSigned then
FMemConvertor.SignExtend(ADest, i, ASize)
else
FMemConvertor.UnsignSignedExtend(ADest, i, ASize);
end;
Addr2 := @TmpVal;
if SizeOf(TmpVal) <> i then
FSelfMemConvertor.AdjustIntPointer(Addr2, SizeOf(TmpVal), i);
Result := FSelfMemConvertor.PrepareTargetRead(rdtUnsignedInt, TDbgPtr(Addr2),
ADest, i, ASize, ConvData);
if not Result then exit;
move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize);
Result := TargetMemConvertor.FinishTargetRead(rdtUnsignedInt, TDbgPtr(Addr2),
ADest, i, ASize, ConvData);
Result := True;
end;
end;
end;
function TFpDbgMemManager.ReadMemoryEx(ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: Cardinal; ADest: Pointer): Boolean;
function TFpDbgMemManager.ReadMemoryEx(const ALocation: TFpDbgMemLocation;
AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
begin
// AnAddressSpace is ignored, except for target address
// AnAddressSpace is ignored, when not actually reading from target address
case ALocation.MType of
mlfTargetMem: Result := FMemReader.ReadMemoryEx(ALocation.Address, AnAddressSpace, ASize, ADest);
else
@ -327,44 +583,39 @@ begin
Result := FMemReader.ReadRegister(ARegNum, AValue);
end;
function TFpDbgMemManager.ReadAddress(ALocation: TFpDbgMemLocation;
function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation;
ASize: Cardinal): TFpDbgMemLocation;
var
Dest: PQWord;
begin
Assert(ASize < SizeOf(Result.Address), 'TFpDbgMemManager.ReadAddress');
if ASize > SizeOf(Result.Address) then begin
Result := InvalidLoc;
exit;
end;
Result.Address := 0;
Dest := @Result.Address;
MemConvertor.AdjustIntPointer(Dest, ASize, SizeOf(Result.Address));
if ReadMemory(ALocation, ASize, Dest) then
Result.MType := mlfTargetMem
else
Result.MType := mlfTargetMem;
if not ReadMemory(rdtAddress, ALocation, ASize, @Result.Address, SizeOf(Result.Address)) then
Result := InvalidLoc;
end;
function TFpDbgMemManager.ReadAddressEx(ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: Cardinal): TFpDbgMemLocation;
var
Dest: PQWord;
function TFpDbgMemManager.ReadAddressEx(const ALocation: TFpDbgMemLocation;
AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemLocation;
begin
Assert(ASize < SizeOf(Result.Address), 'TFpDbgMemManager.ReadAddress');
if ASize > SizeOf(Result.Address) then begin
Result := InvalidLoc;
exit;
end;
Result := InvalidLoc;
end;
Result.Address := 0;
Dest := @Result.Address;
MemConvertor.AdjustIntPointer(Dest, ASize, SizeOf(Result.Address));
if ReadMemoryEx(ALocation, AnAddressSpace, ASize, Dest) then
Result.MType := mlfTargetMem
else
Result := InvalidLoc;
function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out
AnAddress: TFpDbgMemLocation): Boolean;
begin
Result := ReadMemory(rdtAddress, ALocation, ASize, @AnAddress, SizeOf(AnAddress));
if Result
then AnAddress.MType := mlfTargetMem
else AnAddress.MType := mlfInvalid;
end;
function TFpDbgMemManager.ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AValue: QWord): Boolean;
begin
Result := ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, SizeOf(AValue));
end;
function TFpDbgMemManager.ReadSignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AValue: Int64): Boolean;
begin
Result := ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, SizeOf(AValue));
end;
end.

2
components/fpdebug/test/FpTest.lpr
View File

@ -4,7 +4,7 @@ program FpTest;
uses
Interfaces, Forms, GuiTestRunner, TestPascalParser, TestTypeInfo, TestHelperClasses,
TestDwarfSetup1, TestDwarfSetupBasic, TestDwarfVarious, testdwarfsetupArray;
TestDwarfSetup1, TestDwarfSetupBasic, TestDwarfVarious, testdwarfsetupArray, TestMemManager;
{$R *.res}

12
components/fpdebug/test/testhelperclasses.pas
View File

@ -17,6 +17,8 @@ type
TTestMemReader = class(TFpDbgMemReaderBase)
public
RegisterValues: array[0..30] of TDbgPtr;
RegisterSizes: array[0..30] of Integer;
constructor Create;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadMemoryEx({%H-}AnAddress, {%H-}AnAddressSpace: TDbgPtr; {%H-}ASize: Cardinal; {%H-}ADest: Pointer): Boolean; override;
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean; override;
@ -388,6 +390,14 @@ end;
{ TTestMemReader }
constructor TTestMemReader.Create;
var
i: Integer;
begin
inherited Create;
for i := 0 to length(RegisterSizes) - 1 do RegisterSizes[i] := 4;
end;
function TTestMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
ADest: Pointer): Boolean;
begin
@ -409,7 +419,7 @@ end;
function TTestMemReader.RegisterSize(ARegNum: Cardinal): Integer;
begin
Result := 4; // TODO
Result := RegisterSizes[ARegNum];
end;
{ TTestDwarfInfoEntry }

251
components/fpdebug/test/testmemmanager.pas Normal file
View File

@ -0,0 +1,251 @@
unit TestMemManager;
{$mode objfpc}{$H+}
interface
uses
FpDbgDwarf, FpDbgUtil, FpdMemoryTools, TestHelperClasses, LazLoggerBase, LazUTF8, sysutils,
fpcunit, testregistry;
type
{ TestDwarfVarious }
{ TTestMemManager }
TTestMemManager = class(TTestCase)
protected
FCurrentTestName: String;
FMemReader: TTestMemReader;
FMemConvTarget: TFpDbgMemConvertorLittleEndian;
FMemConvSelf: TFpDbgMemConvertorLittleEndian;
FMemManager: TFpDbgMemManager;
procedure InitMemMgr;
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestMemMgr;
end;
implementation
procedure TTestMemManager.InitMemMgr;
begin
FMemReader := TTestMemReader.Create;
FMemConvTarget := TFpDbgMemConvertorLittleEndian.Create;
FMemConvSelf := TFpDbgMemConvertorLittleEndian.Create;
FMemManager := TFpDbgMemManager.Create(FMemReader, FMemConvTarget, FMemConvSelf);
end;
procedure TTestMemManager.SetUp;
begin
inherited SetUp;
FMemReader := nil;
FMemConvTarget := nil;
FMemConvSelf := nil;
FMemManager := nil;
end;
procedure TTestMemManager.TearDown;
begin
inherited TearDown;
FreeAndNil(FMemReader);
FreeAndNil(FMemConvTarget);
FreeAndNil(FMemConvSelf);
FreeAndNil(FMemManager);
end;
procedure TTestMemManager.TestMemMgr;
var
i, j: Integer;
TestBaseName: String;
Data: QWord;
MemValue: QWord;
GotRes: Boolean;
GotInt: Int64;
GotUInt: QWord;
GotAddr: TFpDbgMemLocation;
procedure SetData(Aval: QWord);
begin
Data := Aval;
FMemReader.RegisterValues[2] := Aval;
FCurrentTestName := TestBaseName + ' ' + IntToHex(Aval, 16) + ': ';
end;
procedure CheckIntRes(AName: String; AExp: int64);
begin
AssertTrue(FCurrentTestName + AName + 'Read OK', GotRes);
AssertEquals(FCurrentTestName + AName + 'Val', AExp, GotInt);
end;
procedure CheckUIntRes(AName: String; AExp: int64);
begin
AssertTrue(FCurrentTestName + AName + 'Read OK', GotRes);
AssertEquals(FCurrentTestName + AName + 'Val', AExp, GotUInt);
end;
procedure CheckAddrRes(AName: String; AExp: int64);
begin
AssertTrue(FCurrentTestName + AName + 'Read OK', GotRes);
AssertTrue(FCurrentTestName + AName + 'Valid', IsValidLoc(GotAddr));
AssertEquals(FCurrentTestName + AName + 'Val', AExp, GotAddr.Address);
end;
Procedure DoSignedIntTests(ReadSize: Cardinal; ExpIntVal: Int64);
var
a: Cardinal;
begin
GotRes := FMemManager.ReadSignedInt(TargetLoc(TDbgPtr(@Data)), ReadSize, GotInt);
CheckIntRes('signed target', ExpIntVal);
GotRes := FMemManager.ReadSignedInt(SelfLoc(@Data), ReadSize, GotInt);
CheckIntRes('signed self', ExpIntVal);
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadSignedInt(RegisterLoc(2), ReadSize, GotInt);
CheckIntRes('signed Reg ', ExpIntVal);
for a := ReadSize+1 to 8 do begin
// expanded
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadSignedInt(RegisterLoc(2), a, GotInt);
CheckIntRes('signed Reg readsize='+IntToStr(a), ExpIntVal);
FMemReader.RegisterSizes[2] := a;
GotRes := FMemManager.ReadSignedInt(RegisterLoc(2), ReadSize, GotInt);
CheckIntRes('signed Reg regsize'+IntToStr(a), ExpIntVal);
end;
GotRes := FMemManager.ReadSignedInt(ConstLoc(QWord(ExpIntVal)), ReadSize, GotInt);
CheckIntRes('signed const (pre-expanded)', ExpIntVal);
end;
Procedure DoUnsignedIntTests(ReadSize: Cardinal; ExpIntVal: QWord);
var
a: Cardinal;
begin
GotRes := FMemManager.ReadUnsignedInt(TargetLoc(TDbgPtr(@Data)), ReadSize, GotUInt);
CheckUIntRes('unsigned target', ExpIntVal);
GotRes := FMemManager.ReadUnsignedInt(SelfLoc(@Data), ReadSize, GotUInt);
CheckUIntRes('unsigned self', ExpIntVal);
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadUnsignedInt(RegisterLoc(2), ReadSize, GotUInt);
CheckUIntRes('unsigned Reg ', ExpIntVal);
for a := ReadSize+1 to 8 do begin
// expanded
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadUnsignedInt(RegisterLoc(2), a, GotUInt);
CheckUIntRes('unsigned Reg readsize='+IntToStr(a), ExpIntVal);
FMemReader.RegisterSizes[2] := a;
GotRes := FMemManager.ReadUnsignedInt(RegisterLoc(2), ReadSize, GotUInt);
CheckUIntRes('unsigned Reg regsize'+IntToStr(a), ExpIntVal);
end;
GotRes := FMemManager.ReadUnsignedInt(ConstLoc(QWord(ExpIntVal)), ReadSize, GotUInt);
CheckUIntRes('unsigned const (pre-expanded)', ExpIntVal);
//////
// Address
GotRes := FMemManager.ReadAddress(TargetLoc(TDbgPtr(@Data)), ReadSize, GotAddr);
CheckAddrRes('addr target', ExpIntVal);
GotRes := FMemManager.ReadAddress(SelfLoc(@Data), ReadSize, GotAddr);
CheckAddrRes('addr self', ExpIntVal);
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadAddress(RegisterLoc(2), ReadSize, GotAddr);
CheckAddrRes('addr Reg ', ExpIntVal);
for a := ReadSize+1 to 8 do begin
// expanded
FMemReader.RegisterSizes[2] := ReadSize;
GotRes := FMemManager.ReadAddress(RegisterLoc(2), a, GotAddr);
CheckAddrRes('addr Reg readsize='+IntToStr(a), ExpIntVal);
FMemReader.RegisterSizes[2] := a;
GotRes := FMemManager.ReadAddress(RegisterLoc(2), ReadSize, GotAddr);
CheckAddrRes('addr Reg regsize'+IntToStr(a), ExpIntVal);
end;
GotRes := FMemManager.ReadAddress(ConstLoc(QWord(ExpIntVal)), ReadSize, GotAddr);
CheckAddrRes('addr const (pre-expanded)', ExpIntVal);
//////
// Address
GotAddr := FMemManager.ReadAddress(TargetLoc(TDbgPtr(@Data)), ReadSize);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr target', ExpIntVal);
GotAddr := FMemManager.ReadAddress(SelfLoc(@Data), ReadSize);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr self', ExpIntVal);
FMemReader.RegisterSizes[2] := ReadSize;
GotAddr := FMemManager.ReadAddress(RegisterLoc(2), ReadSize);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr Reg ', ExpIntVal);
for a := ReadSize+1 to 8 do begin
// expanded
FMemReader.RegisterSizes[2] := ReadSize;
GotAddr := FMemManager.ReadAddress(RegisterLoc(2), a);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr Reg readsize='+IntToStr(a), ExpIntVal);
FMemReader.RegisterSizes[2] := a;
GotAddr := FMemManager.ReadAddress(RegisterLoc(2), ReadSize);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr Reg regsize'+IntToStr(a), ExpIntVal);
end;
GotAddr := FMemManager.ReadAddress(ConstLoc(QWord(ExpIntVal)), ReadSize);
GotRes := isValidLoc(GotAddr);
CheckAddrRes('addr const (pre-expanded)', ExpIntVal);
end;
begin
InitMemMgr;
TestBaseName := 'size 1';
SetData($00); DoSignedIntTests(1, 0);
SetData($08); DoSignedIntTests(1, 8);
SetData($7f); DoSignedIntTests(1, 127);
SetData($FB); DoSignedIntTests(1, -5);
SetData($80); DoSignedIntTests(1,-128);
SetData($FF); DoSignedIntTests(1, -1);
SetData($0108); DoSignedIntTests(1, 8);
TestBaseName := 'size 2';
SetData($0000); DoSignedIntTests(2, 0);
SetData($0108); DoSignedIntTests(2, 264);
SetData($00FB); DoSignedIntTests(2, 251);
SetData($FFFB); DoSignedIntTests(2, -5);
SetData($010208); DoSignedIntTests(2, 520);
TestBaseName := 'size 8';
SetData($7FAAFFBBFFCCFFDD); DoSignedIntTests(8, $7FAAFFBBFFCCFFDD);
SetData(QWord(-3)); DoSignedIntTests(8, -3);
TestBaseName := 'size 1';
SetData($00); DoUnsignedIntTests(1, 0);
SetData($08); DoUnsignedIntTests(1, 8);
SetData($7f); DoUnsignedIntTests(1, 127);
SetData($FB); DoUnsignedIntTests(1, 251);
SetData($80); DoUnsignedIntTests(1, 128);
SetData($FF); DoUnsignedIntTests(1, 255);
SetData($0108); DoSignedIntTests(1, 8);
end;
initialization
RegisterTest(TTestMemManager);
end.

14
components/fpdebug/test/testtypeinfo.pas
View File

@ -341,7 +341,7 @@ begin
FImageLoader.Free;
FMemReader.Free;
if FMemManager <> nil then
FMemManager.MemConvertor.Free;
FMemManager.TargetMemConvertor.Free;
FreeAndNil(FMemManager);
inherited TearDown;
end;
@ -382,6 +382,16 @@ begin
ExpResult(svfSize, SizeOf(ImgLoader.GlobalVar.VarSub5));
StartTest('QWord($1122334455667748)', skCardinal, []);
ExpResult(svfCardinal, $1122334455667748);
StartTest('ShortInt(QWord($1122334455667748))', skInteger, []);
ExpResult(svfInteger, integer($48));
StartTest('ShortInt(QWord($11223344556677F8))', skInteger, []);
ExpResult(svfInteger, -8);
end;
procedure TTestTypeInfo.TestExpressionBool;
@ -471,7 +481,9 @@ begin
StartTest('VarDynIntArray', skArray, [ttHasType]);
StartTest('VarStatIntArray1', skArray, [ttHasType]);
ImgLoader.GlobalVar.VarDynIntArray := nil;
StartInvalTest('VarDynIntArray[0]', 'xxx');
StartInvalTest('VarDynIntArray[1]', 'xxx');
SetLength(ImgLoader.GlobalVar.VarDynIntArray,33);
ImgLoader.GlobalVar.VarDynIntArray[0] := 10;