paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 03:37:54 +02:00
Code Issues Packages Projects Releases Wiki Activity
main
lazarus/components/fpdebug/fpdmemorytools.pas

2523 lines
91 KiB
ObjectPascal
Raw Permalink Blame History

unit FpdMemoryTools;
{$mode objfpc}{$H+}
{$ModeSwitch advancedrecords}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}
{$HINT 5024 OFF}
(* 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 the provided 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, math, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpErrorMessages, LazClasses,
AVL_Tree, LazDebuggerUtils, LazDebuggerIntfFloatTypes,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif};
const
MINIMUM_MEMREAD_LIMIT = 1024;
type
TBitAddr = 0..63; // 0-7 for mem read // 0-63 for register read
TBitSize = -7..7;
TFpDbgMemLocationType = (
mlfUninitialized := 0, // like invalid, but not known // This (0) is the initial value
mlfInvalid,
mlfTargetMem, // an address in the target (debuggee) process
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
mlfConstant, // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process)
mlfConstantDeref // A constant that can be used instead of an address (location parser),
// If a value (e.g. literal numeric constant 0x1234) has no address,
// then this is treated as its virtual address.
// If (and only if) the value is attempted to be derefed, then
// it will yield the constant as the result of the deref.
// It can also be tested for nil. The virtual address is never nil.
// Any other access must result in an error.
// Used for PFoo(1234)^ or TObject(1234).Foo
);
TFpDbgValueSize = packed record
Size: Int64; // Also used for stride => can be negative
BitSize: TBitSize; // Must have the same sign as Size
end;
PFpDbgValueSize = ^TFpDbgValueSize;
TDbgAddressClass = byte;
{ TFpDbgMemLocation }
TFpDbgMemLocation = packed record
Address: TDbgPtr;
MType: TFpDbgMemLocationType;
BitOffset: TBitAddr;
AddressClass: TDbgAddressClass; // Used by AVR. 0 = data (or unspecified), 1 = progmem, 2 = EEPROM
class operator = (a, b: TFpDbgMemLocation): boolean; inline;
// for sorting as key in lists
class operator < (a, b: TFpDbgMemLocation): boolean; inline;
class operator > (a, b: TFpDbgMemLocation): boolean; inline;
end;
PFpDbgMemLocation = ^TFpDbgMemLocation;
TFpDbgMemManager = class;
TFpDbgMemManagerFlag = (mmfPartialRead);
TFpDbgMemManagerFlags = set of TFpDbgMemManagerFlag;
TByteDynArray = array of Byte;
TFpDbgMemModel = class;
{ TDbgRegisterValue }
TDbgRegisterValue = class;
TRegisterFormatterProc = function(AReg: TDbgRegisterValue; AFormat: TRegisterDisplayFormat = rdDefault): String;
TDbgRegisterValue = class
private
FDwarfIdx: cardinal;
FName: string;
FNumValue: TDBGPtr;
FSize: byte;
FMem: Pointer;
FStrValue: string;
FFormatter: TRegisterFormatterProc;
function GetStrFormatted(AFormat: TRegisterDisplayFormat): string;
function GetStrValue: string;
public
constructor Create(const AName: String);
destructor Destroy; override;
procedure Assign(ASource: TDbgRegisterValue);
function HasEqualVal(AnOther: TDbgRegisterValue): Boolean;
procedure SetValue(ANumValue: Integer; const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
procedure SetValue(ANumValue: Int64; const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
procedure SetValue(ANumValue: Cardinal; const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
procedure SetValue(ANumValue: TDBGPtr; const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
procedure SetValue(const AData: Pointer; ASize: byte; ADwarfIdx: cardinal; AFormatter: TRegisterFormatterProc);
procedure Setx86EFlagsValue(ANumValue: TDBGPtr);
property Name: string read FName;
property NumValue: TDBGPtr read FNumValue;
property StrValue: string read GetStrValue;
property StrFormatted[AFormat: TRegisterDisplayFormat]: string read GetStrFormatted;
property Size: byte read FSize;
property Data: Pointer read FMem;
property DwarfIdx: cardinal read FDwarfIdx;
end;
{ TFpDbgLocationContext }
TFpDbgLocationContext = class;
TGetFrameBaseCallback = function(AContext: TFpDbgLocationContext; out AnError: TFpError): TDBGPtr of object;
TFpDbgLocationContext = class(TRefCountedObject)
private
FCfaFrameBaseError: TFpError;
FFrameBaseCallback: TGetFrameBaseCallback;
FCfaFrameBaseCallback: TGetFrameBaseCallback;
FFrameBaseError: TFpError;
FFrameBase, FCfaFrameBase: TDBGPtr;
function GetFrameBase: TDBGPtr;
function GetCfaFrameBase: TDBGPtr;
function GetLastMemError: TFpError;
function GetPartialReadResultLenght: QWord;
protected
function GetAddress: TDbgPtr; virtual; abstract;
function GetStackFrame: Integer; virtual; abstract;
function GetThreadId: Integer; virtual; abstract;
function GetSizeOfAddress: Integer; virtual; abstract;
function GetMemManager: TFpDbgMemManager; virtual; abstract;
function GetMemModel: TFpDbgMemModel; virtual; abstract;
public
property Address: TDbgPtr read GetAddress;
property ThreadId: Integer read GetThreadId;
property StackFrame: Integer read GetStackFrame;
property SizeOfAddress: Integer read GetSizeOfAddress;
property MemManager: TFpDbgMemManager read GetMemManager;
property MemModel: TFpDbgMemModel read GetMemModel;
public
procedure SetFrameBaseCallback(ACallback: TGetFrameBaseCallback);
procedure SetCfaFrameBaseCallback(ACallback: TGetFrameBaseCallback);
property FrameBase: TDBGPtr read GetFrameBase; // as requested by DW_OP_fbreg
property FrameBaseError: TFpError read FFrameBaseError;
property CfaFrameBase: TDBGPtr read GetCfaFrameBase; // as requested by DW_OP_call_frame_cfa
property FCfarameBaseError: TFpError read FCfaFrameBaseError;
public
procedure ClearLastMemError;
property LastMemError: TFpError read GetLastMemError;
property PartialReadResultLenght: QWord read GetPartialReadResultLenght;
public
function ReadMemory(const ASourceLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize;
const ADest: Pointer; const AFlags: TFpDbgMemManagerFlags = []
): Boolean; inline;
function ReadMemoryEx(const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: TFpDbgValueSize; ADest: Pointer): Boolean; inline;
(* ReadRegister needs a Context, to get the thread/stackframe
*)
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean; inline;
function ReadRegisterasAddress(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean; inline;
function WriteMemory(const ADestLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize;
const ASource: Pointer; const AFlags: TFpDbgMemManagerFlags = []
): Boolean; inline;
// location will be invalid, if read failed
function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize): TFpDbgMemLocation; inline;
function ReadAddressEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: TFpDbgValueSize): TFpDbgMemLocation; inline;
// ALocation and AnAddress MUST NOT be the same variable on the callers side
function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AnAddress: TFpDbgMemLocation): Boolean; inline;
//function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AnAddress: TFpDbgMemLocation;
// AnOpts: TFpDbgMemReadOptionsl): Boolean; inline;
function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: QWord): Boolean; inline;
function WriteUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord): Boolean; inline;
//function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: Int64): Boolean; inline;
function WriteSignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: Int64): Boolean; inline;
//function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: Int64;
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
// //enum/set: may need bitorder swapped
function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: QWord): Boolean; inline;
function WriteEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord): Boolean; inline;
//function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: QWord;
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
function ReadSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: TBytes): Boolean; inline;
function WriteSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: TBytes): Boolean; inline;
//function ReadSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: TBytes;
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
function ReadSingle (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: Single): Boolean; inline;
function ReadDouble (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: Double): Boolean; inline;
function ReadExtended (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: TDbgExtended): Boolean; inline;
function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
out AValue: TDbgExtended): Boolean; inline; deprecated;
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
// out AValue: TDbgExtended;
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
function ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: RawByteString; AnIgnoreMaxStringLen: boolean = False): Boolean;
function ReadWString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: WideString; AnIgnoreMaxStringLen: boolean = False): Boolean;
function GetRegister(const ARegNum: Cardinal): TDbgRegisterValue;
end;
{ TFpDbgMemReaderBase }
TFpDbgMemReaderBase = class
protected
// ReadMemoryPartial: workaround for subclasses that do not support partial mem read
function ReadMemoryPartial(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean;
public
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual; abstract; overload;
// inherited Memreaders should implement partial size ReadMemory, and forward it to the TDbgProcess class
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean; virtual; overload;
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual; abstract;
function WriteMemory(AnAddress: TDbgPtr; ASize: Cardinal; ASource: Pointer): Boolean; virtual; abstract; overload;
// ReadRegister may need TargetMemConvertor
// 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;
function RegisterNumber(ARegName: String; out ARegNum: Cardinal): Boolean; virtual; abstract;
function GetRegister(const ARegNum: Cardinal; AContext: TFpDbgLocationContext): TDbgRegisterValue; 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 = (
rdtRawRead, rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtfloat,
rdtEnum, rdtSet
);
TFpDbgMemConvData = record
SourceLocation: TFpDbgMemLocation;
SourceSize: TFpDbgValueSize;
SourceFullSize: QWord;
DestSize: QWord;
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 }
TFpDbgMemConvertor = class
public
(* 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;
var AConvData: TFpDbgMemConvData;
const ADest: Pointer
): boolean; virtual; abstract;
{function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
ASourceMemPointer: TDbgPtr; ADestPointer: Pointer;
ASourceMemSize, ADestSize: Cardinal;
AnOpts: TFpDbgMemReadOptions;
out AConvertorData: TFpDbgMemConvData
): boolean; virtual; abstract;}
(* FinishTargetRead
called after every Read operation.
*)
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
const AConvData: TFpDbgMemConvData;
const TmpData: Pointer; // can be equal to ADest
const ADest: Pointer
): boolean; virtual; abstract;
{function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
ASourceMemPointer: TDbgPtr; ADestPointer: Pointer;
ASourceMemSize, 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
*)
function AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean; 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
function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType;
var AConvData: TFpDbgMemConvData;
const ADest: Pointer
): boolean; override;
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
const AConvData: TFpDbgMemConvData; const TmpData: Pointer;
const ADest: Pointer): boolean; override;
procedure FailedTargetRead({%H-}AConvertorData: TFpDbgMemConvData); override;
function AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean; override;
//procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
//procedure UnsignedExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
end;
{ TFpDbgMemCacheBase }
TFpDbgMemCacheBase = class
private
FMemReader: TFpDbgMemReaderBase;
protected
// Init:
// will be called by Manager.AddCache after the memreader is set.
// Earliest chance to pre-read the memory
procedure Init; virtual;
property MemReader: TFpDbgMemReaderBase read FMemReader;
public
end;
{ TFpDbgMemCacheManagerBase }
TFpDbgMemCacheManagerBase = class
private
FMemReader: TFpDbgMemReaderBase;
protected
procedure InitalizeCache(ACache: TFpDbgMemCacheBase); // must be called by AddCache
public
function AddCache(AnAddress: TDbgPtr; ASize: Cardinal): TFpDbgMemCacheBase; virtual;
function AddCacheEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemCacheBase; virtual;
procedure RemoveCache(ACache: TFpDbgMemCacheBase); virtual;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual; overload;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer; ABytesRead: Cardinal): Boolean; virtual; overload;
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; virtual;
end;
{ TFpDbgMemCacheSimple
MemCache for contineous mem / does not support AddressSpace
TODO: Handle Overlaps
}
TFpDbgMemCacheSimple = class(TFpDbgMemCacheBase)
private
FCacheAddress: TDBGPtr;
FCacheSize: Cardinal;
FMem: Array of byte;
FFailed: Boolean;
public
constructor Create(ACacheAddress: TDBGPtr; ACacheSize: Cardinal);
function ContainsMemory(AnAddress: TDbgPtr; ASize: Cardinal): Boolean;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
property CacheAddress: TDBGPtr read FCacheAddress;
property CacheSize: Cardinal read FCacheSize;
end;
{ TFpDbgMemCacheManagerSimple }
TFpDbgMemCacheManagerSimple = class(TFpDbgMemCacheManagerBase)
private
FCaches: TAVLTree;
public
constructor Create;
destructor Destroy; override;
function HasMemory(AnAddress: TDbgPtr; ASize: Cardinal): Boolean;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override; overload;
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer;
ABytesRead: Cardinal): Boolean; override; overload;
function AddCache(AnAddress: TDbgPtr; ASize: Cardinal): TFpDbgMemCacheBase;
override;
procedure RemoveCache(ACache: TFpDbgMemCacheBase); override;
end;
{ TFpDbgMemLimits }
TFpDbgMemLimits = class
private
FMaxArrayLen: QWord;
FMaxMemReadSize: QWord;
FMaxNullStringSearchLen: QWord;
FMaxStringLen: QWord;
procedure SetMaxMemReadSize(AValue: QWord);
public
constructor Create;
property MaxMemReadSize: QWord read FMaxMemReadSize write SetMaxMemReadSize;
property MaxStringLen: QWord read FMaxStringLen write FMaxStringLen;
property MaxArrayLen: QWord read FMaxArrayLen write FMaxArrayLen;
property MaxNullStringSearchLen: QWord read FMaxNullStringSearchLen write FMaxNullStringSearchLen;
end;
{ TFpDbgMemModel }
// Here Location is the fpdebug representation of an address
// and Address is the target (pointer-only) representation of an address
TFpDbgMemModel = class
function UpdateLocationToCodeAddress(const ALocation: TFpDbgMemLocation): TFpDbgMemLocation; virtual;
function LocationToAddress(const ALocation: TFpDbgMemLocation): TDBGPtr; virtual;
function AddressToTargetLocation(const AAddress: TDBGPtr): TFpDbgMemLocation; virtual;
function IsReadableMemory(const ALocation: TFpDbgMemLocation): Boolean; virtual;
function IsReadableLocation(const ALocation: TFpDbgMemLocation): Boolean; virtual;
end;
(* TFpDbgMemManager
* allows to to pretend reading from the target, by using its own memory, or
a constant.
This is useful if an object expects to read data from the target, but the
caller needs to "fake" another value.
E.g. A TObject variable has the address of the (internal) pointer to the
object data:
SomeMethod expects "Address of variable". At that address in the target
memory it expects another address, the pointer to the object data.
But when doing "TObject(1234)" then 1234 is the pointer to the object data.
1234 can not be read from the target memory. MemManager will pretend.
* Provides access to TFpDbgMemConvertor
* TODO: allow to pre-read and cache Target mem (e.g. before reading all fields of a record
*)
{ TFpDbgMemManager }
TFpDbgMemManager = class
private const
TMP_MEM_SIZE = 4096;
DEF_MAX_PCHAR_LEN = 32 * 1024;
private
FCacheManager: TFpDbgMemCacheManagerBase;
FLastError: TFpError;
FMemLimits: TFpDbgMemLimits;
FMemReader: TFpDbgMemReaderBase;
FPartialReadResultLenght: QWord;
FTmpMem: array[0..(TMP_MEM_SIZE div 8)+1] of qword; // MUST have at least ONE extra byte
FTargetMemConvertor: TFpDbgMemConvertor;
FSelfMemConvertor: TFpDbgMemConvertor; // used when resizing constants (or register values, which are already in self format)
FStartWirteableSelfMem: TDBGPtr;
FLenWirteableSelfMem: Cardinal;
FMemModel: TFpDbgMemModel;
function GetCacheManager: TFpDbgMemCacheManagerBase;
procedure BitShiftMem(ASrcMem, ADestMem: Pointer; ASrcSize, ADestSize: cardinal; ABitCnt: Integer);
protected
function ReadMemory(AReadDataType: TFpDbgMemReadDataType;
const ASourceLocation: TFpDbgMemLocation; const ASourceSize: TFpDbgValueSize;
const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags = []
): Boolean; virtual;
function WriteMemory(AReadDataType: TFpDbgMemReadDataType;
const ADestLocation: TFpDbgMemLocation; const ADestSize: TFpDbgValueSize;
const ASource: Pointer; const ASourceSize: QWord; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags = []
): Boolean; virtual;
function ReadMemoryEx(const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgLocationContext = nil): Boolean;
(* ReadRegister needs a Context, to get the thread/stackframe
*)
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext {= nil}): Boolean;
function ReadRegisterAsAddress(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgLocationContext {= nil}): Boolean; virtual;
property MemReader: TFpDbgMemReaderBase read FMemReader;
public
procedure SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase);
property CacheManager: TFpDbgMemCacheManagerBase read GetCacheManager;
public
constructor Create(AMemReader: TFpDbgMemReaderBase; AMemConvertor: TFpDbgMemConvertor;
AMemModel: TFpDbgMemModel);
constructor Create(AMemReader: TFpDbgMemReaderBase; ATargenMemConvertor, ASelfMemConvertor: TFpDbgMemConvertor;
AMemModel: TFpDbgMemModel);
destructor Destroy; override;
procedure ClearLastError;
procedure SetWritableSeflMem(AStartWirteableSelfMem: TDBGPtr; ALenWirteableSelfMem: Cardinal);
procedure ClearWritableSeflMem;
function RegisterSize(ARegNum: Cardinal): Integer; // This is not context dependent
function RegisterNumber(ARegName: String; out ARegNum: Cardinal): Boolean;
function SetLength(var ADest: TByteDynArray; ALength: Int64): Boolean; overload;
function SetLength(var ADest: RawByteString; ALength: Int64): Boolean; overload;
function SetLength(var ADest: AnsiString; ALength: Int64): Boolean; overload;
function SetLength(var ADest: WideString; ALength: Int64): Boolean; overload;
function CheckDataSize(ASize: Int64): Boolean;
function ReadPChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: AnsiString; NoTrimToZero: Boolean = False): Boolean;
function ReadPWChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: WideString): Boolean;
property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor;
property SelfMemConvertor: TFpDbgMemConvertor read FSelfMemConvertor;
property PartialReadResultLenght: QWord read FPartialReadResultLenght;
property LastError: TFpError read FLastError;
property MemLimits: TFpDbgMemLimits read FMemLimits;
property MemModel: TFpDbgMemModel read FMemModel;
end;
function NilLoc: TFpDbgMemLocation; inline;
function InvalidLoc: TFpDbgMemLocation; inline;
function UnInitializedLoc: TFpDbgMemLocation; inline;
function TargetLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline;
function RegisterLoc(ARegNum: Cardinal): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; inline;
function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline;
function ConstDerefLoc(AValue: QWord): TFpDbgMemLocation; inline;
function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64): TFpDbgMemLocation; inline;
function IsTargetAddr(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsAddress(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsConstData(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsInitializedLoc(const ALocation: TFpDbgMemLocation): Boolean; inline;
function IsValidLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed
function IsReadableLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil // can be const or reg
function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and target or self <> nil
function IsNilLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid AND NIL // Does not check mlfTargetRegister
// TODO: registers should be targed.... // May have to rename some of those
function IsTargetNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed = nil
function IsTargetNotNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed <> nil
function IsTargetOrRegNotNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed <> nil
function ZeroSize: TFpDbgValueSize; inline;
function SizeVal(const ASize: Int64): TFpDbgValueSize; inline;
function SizeFromBits(const ABits: Int64): TFpDbgValueSize; inline;
function IsZeroSize(const ASize: TFpDbgValueSize): Boolean; inline;
function IsByteSize(const ASize: TFpDbgValueSize): Boolean; inline;
function SizeToFullBytes(const ASize: TFpDbgValueSize): Int64; inline; // Bytes needed to contain this size
function SizeToBits(const ASize: TFpDbgValueSize): Int64; inline; // Bytes needed to contain this size
operator = (const a,b: TFpDbgValueSize): Boolean; inline;
operator = (const a: TFpDbgValueSize; b: Int64): Boolean; inline;
operator > (const a: TFpDbgValueSize; b: Int64): Boolean; inline;
operator >= (const a: TFpDbgValueSize; b: Int64): Boolean; inline;
operator < (const a: TFpDbgValueSize; b: Int64): Boolean; inline;
operator <= (const a: TFpDbgValueSize; b: Int64): Boolean; inline;
operator + (const a,b: TFpDbgValueSize): TFpDbgValueSize; inline;
operator - (const a,b: TFpDbgValueSize): TFpDbgValueSize; inline;
operator * (const a: TFpDbgValueSize; b: Int64): TFpDbgValueSize; inline;
operator + (const AnAddr: TFpDbgMemLocation; ASize: TFpDbgValueSize): TFpDbgMemLocation; inline;
operator + (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; inline;
operator - (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; inline;
operator + (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; inline;
operator - (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; inline;
function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid
function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version
function SignExtend(ASrcVal: QWord; ASrcSize: TFpDbgValueSize): Int64;
//function EmptyMemReadOpts:TFpDbgMemReadOptions;
function dbgs(const ALocation: TFpDbgMemLocation): String; overload;
function dbgs(const ASize: TFpDbgValueSize): String; overload;
function dbgs(const AReadDataType: TFpDbgMemReadDataType): String; overload;
implementation
var
FPDBG_VERBOSE_MEM: PLazLoggerLogGroup;
function NilLoc: TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.MType := mlfTargetMem;
end;
function InvalidLoc: TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.MType := mlfInvalid;
end;
function UnInitializedLoc: TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.MType := mlfUninitialized;
end;
function TargetLoc(AnAddress: TDbgPtr): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := AnAddress;
Result.MType := mlfTargetMem;
end;
function RegisterLoc(ARegNum: Cardinal): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := ARegNum;
Result.MType := mlfTargetRegister;
end;
function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := AnAddress;
Result.MType := mlfSelfMem;
end;
function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := TDbgPtr(AnAddress);
Result.MType := mlfSelfMem;
end;
function ConstLoc(AValue: QWord): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := AValue;
Result.MType := mlfConstant;
end;
function ConstDerefLoc(AValue: QWord): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := AValue;
Result.MType := mlfConstantDeref;
end;
function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64
): TFpDbgMemLocation;
begin
{$PUSH}{$R-}{$Q-}
Result := AnAddr;
Result.Address := AnAddr.Address + ABitOffset div 8;
if (ABitOffset < 0) and ((ABitOffset and 7) <> 0) then
Result.Address := Result.Address - 1; // Going to ADD some bits back
// E.g. b=-1 means (b and 7) = 7 and that means adding 7 bits, instead of substracting 1
Result.BitOffset := ABitOffset and 7;
{$POP}
end;
function IsTargetAddr(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := ALocation.MType = mlfTargetMem;
end;
function IsAddress(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := ALocation.MType in [mlfTargetMem, mlfSelfMem, mlfConstantDeref];
end;
function IsConstData(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := not(ALocation.MType in [mlfConstant, mlfConstantDeref]);
end;
function IsInitializedLoc(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := ALocation.MType <> mlfUninitialized;
end;
function IsValidLoc(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := not(ALocation.MType in [mlfInvalid, mlfUninitialized]);
end;
function IsReadableLoc(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (not(ALocation.MType in [mlfInvalid, mlfUninitialized])) and
( (not(ALocation.MType in [mlfTargetMem, mlfSelfMem])) or
(ALocation.Address <> 0)
);
end;
function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType in [mlfTargetMem, mlfSelfMem]) and
(ALocation.Address <> 0);
end;
function IsNilLoc(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType in [mlfTargetMem, mlfSelfMem, mlfConstant]) and
(ALocation.Address = 0);
end;
function IsTargetNil(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address = 0);
end;
function IsTargetNotNil(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address <> 0);
end;
function IsTargetOrRegNotNil(const ALocation: TFpDbgMemLocation): Boolean;
begin
Result := ((ALocation.MType = mlfTargetMem) and (ALocation.Address <> 0)) or
(ALocation.MType = mlfTargetRegister);
end;
function ZeroSize: TFpDbgValueSize;
begin
Result.Size := 0;
Result.BitSize := 0;
end;
function SizeVal(const ASize: Int64): TFpDbgValueSize;
begin
Result.Size := ASize;
Result.BitSize := 0;
end;
function SizeFromBits(const ABits: Int64): TFpDbgValueSize;
begin
Result.Size := ABits div 8;
if ABits < 0 then
Result.BitSize := -((-ABits) and 7)
else
Result.BitSize := ABits and 7;
end;
function IsZeroSize(const ASize: TFpDbgValueSize): Boolean;
begin
Result := (ASize.Size = 0) and (ASize.BitSize = 0);
end;
function IsByteSize(const ASize: TFpDbgValueSize): Boolean;
begin
Result := (ASize.BitSize = 0);
end;
function SizeToFullBytes(const ASize: TFpDbgValueSize): Int64;
begin
assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )');
Result := ASize.Size;
if ASize.BitSize = 0 then
exit
else
if ASize.BitSize > 0 then
inc(Result)
else
dec(Result);
end;
function SizeToBits(const ASize: TFpDbgValueSize): Int64;
begin
assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )');
Result := ASize.Size * 8 + ASize.BitSize;
end;
operator = (const a, b: TFpDbgValueSize): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )');
Result := (a.Size = b.Size) and (a.BitSize = b.BitSize);
end;
operator = (const a: TFpDbgValueSize; b: Int64): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
Result := (a.Size = b) and (a.BitSize = 0);
end;
operator>(const a: TFpDbgValueSize; b: Int64): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
Result := (a.Size > b) or
(a.Size = b) and (a.BitSize > 0);
end;
operator>=(const a: TFpDbgValueSize; b: Int64): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
Result := (a.Size > b) or
(a.Size = b) and (a.BitSize >= 0);
end;
operator<(const a: TFpDbgValueSize; b: Int64): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
Result := (a.Size < b) or
(a.Size = b) and (a.BitSize < 0);
end;
operator<=(const a: TFpDbgValueSize; b: Int64): Boolean;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
Result := (a.Size < b) or
(a.Size = b) and (a.BitSize <= 0);
end;
operator + (const a, b: TFpDbgValueSize): TFpDbgValueSize;
var
bits, low3bits: Int64;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )');
{$PUSH}{$R-}{$Q-}
bits := a.BitSize + b.BitSize;
Result.Size := a.Size + b.Size + bits div 8;
low3bits := bits and 7;
if low3bits = 0 then
Result.BitSize := 0
else
if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin
if (bits > 0) then // bits have wrong sign
Result.Size := Result.Size + 1;
Result.BitSize := low3bits - 8;
end
else begin
if (bits < 0) then // bits have wrong sign
Result.Size := Result.Size - 1;
Result.BitSize := low3bits;
end;
{$POP}
end;
operator - (const a, b: TFpDbgValueSize): TFpDbgValueSize;
var
bits, low3bits: Int64;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )');
{$PUSH}{$R-}{$Q-}
bits := a.BitSize - b.BitSize;
Result.Size := a.Size - b.Size + bits div 8;
low3bits := bits and 7;
if low3bits = 0 then
Result.BitSize := 0
else
if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin
if (bits > 0) then // bits have wrong sign
Result.Size := Result.Size + 1;
Result.BitSize := low3bits - 8;
end
else begin
if (bits < 0) then // bits have wrong sign
Result.Size := Result.Size - 1;
Result.BitSize := low3bits;
end;
{$POP}
end;
operator * (const a: TFpDbgValueSize; b: Int64): TFpDbgValueSize;
var
bits, low3bits: Int64;
begin
assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )');
{$PUSH}{$R-}{$Q-}
bits := a.BitSize * b;
Result.Size := a.Size * b + bits div 8;
low3bits := bits and 7;
if low3bits = 0 then
Result.BitSize := 0
else
if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin
if (bits > 0) then // bits have wrong sign
Result.Size := Result.Size + 1;
Result.BitSize := low3bits - 8;
end
else begin
if (bits < 0) then // bits have wrong sign
Result.Size := Result.Size - 1;
Result.BitSize := low3bits;
end;
{$POP}
end;
operator + (const AnAddr: TFpDbgMemLocation; ASize: TFpDbgValueSize
): TFpDbgMemLocation;
var
bits: Int64;
begin
assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )');
assert(AnAddr.MType in [mlfSelfMem, mlfTargetMem], '+: AnAddr.MType in [mlfSelfMem, mlfTargetMem]');
Result := AnAddr;
{$PUSH}{$R-}{$Q-}
bits := AnAddr.BitOffset + ASize.BitSize;
Result.Address := AnAddr.Address + ASize.Size + bits div 8;
if (bits < 0) and ((bits and 7) <> 0) then
Result.Address := Result.Address - 1; // Going to ADD some bits back
// E.g. bits=-1 means (bits and 7) = 7 and that means adding 7 bits, instead of substracting 1
Result.BitOffset := bits and 7;
{$POP}
end;
operator + (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation;
begin
Result := AnAddr;
{$PUSH}{$R-}{$Q-}
Result.Address := AnAddr.Address + AVal;
{$POP}
end;
operator - (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation;
begin
Result := AnAddr;
{$PUSH}{$R-}{$Q-}
Result.Address := AnAddr.Address - AVal;
{$POP}
end;
operator + (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation;
begin
Result := AnAddr;
{$PUSH}{$R-}{$Q-}
Result.Address := AnAddr.Address + AVal;
{$POP}
end;
operator - (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation;
begin
Result := AnAddr;
{$PUSH}{$R-}{$Q-}
Result.Address := AnAddr.Address - AVal;
{$POP}
end;
function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr;
begin
assert(ALocation.MType = mlfTargetMem, 'LocToAddr for other than mlfTargetMem');
Result := ALocation.Address;
end;
function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr;
begin
if (ALocation.MType = mlfTargetMem) then
Result := ALocation.Address
else
Result := 0;
end;
function SignExtend(ASrcVal: QWord; ASrcSize: TFpDbgValueSize): Int64;
var
SourceFullSize, SBit: Int64;
b: TBitSize;
begin
Result := Int64(ASrcVal);
SourceFullSize := SizeToFullBytes(ASrcSize);
if SourceFullSize = 0 then
exit;
b := ASrcSize.BitSize;
SBit := 8 * SourceFullSize;
if b > 0 then
SBit := SBit + b - 8;
if (ASrcVal and (1 shl (SBit-1)) ) <> 0 then
Result := Result or (int64(-1) shl SBit);
end;
//function {%H-}EmptyMemReadOpts: TFpDbgMemReadOptions;
//begin
// //
//end;
function dbgs(const ALocation: TFpDbgMemLocation): String;
begin
Result := '';
if not (ALocation.MType in [low(TFpDbgMemLocationType)..high(TFpDbgMemLocationType)]) then
Result := 'Location=out-of-range'
else
WriteStr(Result, 'Location=', ALocation.Address, ':', ALocation.BitOffset, ', ', ALocation.MType);
end;
function dbgs(const ASize: TFpDbgValueSize): String;
begin
WriteStr(Result, 'Size=', ASize.Size, ':', ASize.BitSize);
end;
function dbgs(const AReadDataType: TFpDbgMemReadDataType): String;
begin
WriteStr(Result, AReadDataType);
end;
{ TDbgRegisterValue }
function TDbgRegisterValue.GetStrFormatted(AFormat: TRegisterDisplayFormat): string;
begin
if FFormatter <> nil then
exit(FFormatter(Self, AFormat));
if FStrValue <> '' then
exit(FStrValue);
case AFormat of
rdDefault: Result := IntToStr(FNumValue);
rdHex: Result := '$'+Dec64ToNumb(FNumValue, 0, 16);
rdBinary: Result := '%'+Dec64ToNumb(FNumValue, 0, 2);
rdOctal: Result := '&'+Dec64ToNumb(FNumValue, 0, 8);
rdDecimal: Result := IntToStr(FNumValue);
rdRaw: Result := IntToStr(FNumValue);
end;
end;
function TDbgRegisterValue.GetStrValue: string;
begin
if (FStrValue = '') and (FFormatter <> nil) then
FStrValue := FFormatter(Self);
if (FStrValue = '') then
FStrValue := '?';
Result := FStrValue;
end;
constructor TDbgRegisterValue.Create(const AName: String);
begin
FName:=AName;
end;
destructor TDbgRegisterValue.Destroy;
begin
inherited Destroy;
Freemem(FMem);
end;
procedure TDbgRegisterValue.Assign(ASource: TDbgRegisterValue);
begin
FDwarfIdx := ASource.FDwarfIdx;
FName := ASource.FName;
FNumValue := ASource.FNumValue;
FSize := ASource.FSize;
FStrValue := ASource.FStrValue;
end;
function TDbgRegisterValue.HasEqualVal(AnOther: TDbgRegisterValue): Boolean;
begin
Result :=
(FNumValue = AnOther.FNumValue) and
(FSize = AnOther.FSize) and
(FStrValue = AnOther.FStrValue);
end;
procedure TDbgRegisterValue.SetValue(ANumValue: Integer; const AStrValue: string; ASize: byte;
ADwarfIdx: cardinal);
var
CNum: Cardinal absolute ANumValue;
begin
SetValue(TDBGPtr(CNum), AStrValue, ASize, ADwarfIdx);
end;
procedure TDbgRegisterValue.SetValue(ANumValue: Int64; const AStrValue: string; ASize: byte;
ADwarfIdx: cardinal);
begin
SetValue(TDBGPtr(ANumValue), AStrValue, ASize, ADwarfIdx);
end;
procedure TDbgRegisterValue.SetValue(ANumValue: Cardinal; const AStrValue: string; ASize: byte;
ADwarfIdx: cardinal);
begin
SetValue(TDBGPtr(ANumValue), AStrValue, ASize, ADwarfIdx);
end;
procedure TDbgRegisterValue.SetValue(ANumValue: TDBGPtr;
const AStrValue: string; ASize: byte; ADwarfIdx: cardinal);
begin
FStrValue:=AStrValue;
FNumValue:=ANumValue;
FSize:=ASize;
FDwarfIdx:=ADwarfIdx;
end;
procedure TDbgRegisterValue.SetValue(const AData: Pointer; ASize: byte; ADwarfIdx: cardinal;
AFormatter: TRegisterFormatterProc);
begin
FStrValue:='';
FNumValue:=0;
FSize := ASize;
FDwarfIdx:=ADwarfIdx;
FFormatter := AFormatter;
if FMem <> nil then
FMem := ReAllocMem(FMem, ASize)
else
FMem := AllocMem(ASize);
move(AData^, FMem^, ASize);
end;
procedure TDbgRegisterValue.Setx86EFlagsValue(ANumValue: TDBGPtr);
var
FlagS: string;
begin
FlagS := '';
if ANumValue and (1 shl 0) <> 0 then FlagS := FlagS + 'CF ';
if ANumValue and (1 shl 2) <> 0 then FlagS := FlagS + 'PF ';
if ANumValue and (1 shl 4) <> 0 then FlagS := FlagS + 'AF ';
if ANumValue and (1 shl 6) <> 0 then FlagS := FlagS + 'ZF ';
if ANumValue and (1 shl 7) <> 0 then FlagS := FlagS + 'SF ';
if ANumValue and (1 shl 8) <> 0 then FlagS := FlagS + 'TF ';
if ANumValue and (1 shl 9) <> 0 then FlagS := FlagS + 'IF ';
if ANumValue and (1 shl 10) <> 0 then FlagS := FlagS + 'DF ';
if ANumValue and (1 shl 11) <> 0 then FlagS := FlagS + 'OF ';
if (ANumValue shr 12) and 3 <> 0 then FlagS := FlagS + 'IOPL=' + IntToStr((ANumValue shr 12) and 3);
if ANumValue and (1 shl 14) <> 0 then FlagS := FlagS + 'NT ';
if ANumValue and (1 shl 16) <> 0 then FlagS := FlagS + 'RF ';
if ANumValue and (1 shl 17) <> 0 then FlagS := FlagS + 'VM ';
if ANumValue and (1 shl 18) <> 0 then FlagS := FlagS + 'AC ';
if ANumValue and (1 shl 19) <> 0 then FlagS := FlagS + 'VIF ';
if ANumValue and (1 shl 20) <> 0 then FlagS := FlagS + 'VIP ';
if ANumValue and (1 shl 21) <> 0 then FlagS := FlagS + 'ID ';
SetValue(ANumValue, trim(FlagS),4,Cardinal(-1));
end;
{ TFpDbgLocationContext }
function TFpDbgLocationContext.GetLastMemError: TFpError;
begin
Result := MemManager.LastError;
end;
function TFpDbgLocationContext.GetFrameBase: TDBGPtr;
begin
if FFrameBaseCallback <> nil then begin
FFrameBase := FFrameBaseCallback(Self, FFrameBaseError);
if (FFrameBase = 0) and not IsError(FFrameBaseError) then
FFrameBaseError := CreateError(fpErrAnyError, []);
FFrameBaseCallback := nil;
end;
Result := FFrameBase;
end;
function TFpDbgLocationContext.GetCfaFrameBase: TDBGPtr;
begin
if FCfaFrameBaseCallback <> nil then begin
FCfaFrameBase := FCfaFrameBaseCallback(Self, FCfaFrameBaseError);
if (FCfaFrameBase = 0) and not IsError(FCfaFrameBaseError) then
FCfaFrameBaseError := CreateError(fpErrAnyError, []);
FCfaFrameBaseCallback := nil;
end;
Result := FCfaFrameBase;
end;
function TFpDbgLocationContext.GetPartialReadResultLenght: QWord;
begin
Result := MemManager.PartialReadResultLenght;
end;
procedure TFpDbgLocationContext.SetFrameBaseCallback(ACallback: TGetFrameBaseCallback);
begin
FFrameBaseCallback := ACallback;
end;
procedure TFpDbgLocationContext.SetCfaFrameBaseCallback(ACallback: TGetFrameBaseCallback);
begin
FCfaFrameBaseCallback := ACallback;
end;
procedure TFpDbgLocationContext.ClearLastMemError;
begin
MemManager.ClearLastError;
end;
function TFpDbgLocationContext.ReadMemory(
const ASourceLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize;
const ADest: Pointer; const AFlags: TFpDbgMemManagerFlags): Boolean;
begin
Result := MemManager.ReadMemory(rdtRawRead, ASourceLocation, ASize, ADest, ASize.Size, Self, AFlags);
end;
function TFpDbgLocationContext.ReadMemoryEx(
const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: TFpDbgValueSize; ADest: Pointer): Boolean;
begin
Result := MemManager.ReadMemoryEx(ASourceLocation, AnAddressSpace, ASize, ADest, Self);
end;
function TFpDbgLocationContext.ReadRegister(ARegNum: Cardinal; out
AValue: TDbgPtr): Boolean;
begin
Result := MemManager.ReadRegister(ARegNum, AValue, Self);
end;
function TFpDbgLocationContext.ReadRegisterasAddress(ARegNum: Cardinal; out
AValue: TDbgPtr): Boolean;
begin
Result := MemManager.ReadRegisterAsAddress(ARegNum, AValue, Self);
end;
function TFpDbgLocationContext.WriteMemory(
const ADestLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize;
const ASource: Pointer; const AFlags: TFpDbgMemManagerFlags): Boolean;
begin
Result := MemManager.WriteMemory(rdtRawRead, ADestLocation, ASize, ASource, ASize.Size, Self, AFlags);
end;
function TFpDbgLocationContext.ReadAddress(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize): TFpDbgMemLocation;
begin
if MemManager.ReadMemory(rdtAddress, ALocation, ASize, @Result.Address, SizeOf(Result.Address), Self) then
Result := MemModel.AddressToTargetLocation(Result.Address)
else
Result := InvalidLoc;
end;
function TFpDbgLocationContext.ReadAddressEx(
const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: TFpDbgValueSize): TFpDbgMemLocation;
begin
Result := InvalidLoc;
end;
function TFpDbgLocationContext.ReadAddress(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AnAddress: TFpDbgMemLocation): Boolean;
begin
Result := MemManager.ReadMemory(rdtAddress, ALocation, ASize, @AnAddress.Address, (SizeOf(AnAddress.Address)), Self);
if Result then
AnAddress := MemModel.AddressToTargetLocation(AnAddress.Address)
else
AnAddress := InvalidLoc;
end;
function TFpDbgLocationContext.ReadUnsignedInt(
const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord
): Boolean;
begin
Result := MemManager.ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.WriteUnsignedInt(
const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: QWord): Boolean;
begin
Result := MemManager.WriteMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.ReadSignedInt(
const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: Int64
): Boolean;
begin
Result := MemManager.ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.WriteSignedInt(
const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
const AValue: Int64): Boolean;
begin
Result := MemManager.WriteMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.ReadEnum(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: QWord): Boolean;
begin
Result := MemManager.ReadMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.WriteEnum(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; const AValue: QWord): Boolean;
begin
Result := MemManager.WriteMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.ReadSet(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: TBytes): Boolean;
begin
System.SetLength(AValue, SizeToFullBytes(ASize));
Result := ASize > 0;
if Result then
Result := MemManager.ReadMemory(rdtSet, ALocation, ASize, @AValue[0], Length(AValue), Self);
end;
function TFpDbgLocationContext.WriteSet(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; const AValue: TBytes): Boolean;
begin
Result := MemManager.WriteMemory(rdtSet, ALocation, ASize, @AValue[0], Length(AValue), Self);
end;
function TFpDbgLocationContext.ReadSingle(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: Single): Boolean;
begin
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.ReadDouble(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: Double): Boolean;
begin
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
end;
function TFpDbgLocationContext.ReadExtended(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: TDbgExtended): Boolean;
begin
{$IF DBG_HAS_EXTENDED}
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), DBG_EXTENDED_SIZE), Self);
{$ELSE}
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), SizeOf(TDbgExtended)), Self);
{$ENDIF}
end;
function TFpDbgLocationContext.ReadFloat(const ALocation: TFpDbgMemLocation;
ASize: TFpDbgValueSize; out AValue: TDbgExtended): Boolean;
begin
{$IF DBG_HAS_EXTENDED}
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), DBG_EXTENDED_SIZE), Self);
{$ELSE}
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, Min(SizeOf(AValue), SizeOf(TDbgExtended)), Self);
{$ENDIF}
end;
function TFpDbgLocationContext.ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out
AValue: RawByteString; AnIgnoreMaxStringLen: boolean): Boolean;
begin
Result := False;
AValue := '';
if (not AnIgnoreMaxStringLen) and
(MemManager.MemLimits.MaxStringLen > 0) and
(ALen > MemManager.MemLimits.MaxStringLen)
then
ALen := MemManager.MemLimits.MaxStringLen;
if ALen = 0 then begin
Result := True;
exit;
end;
if not MemManager.SetLength(AValue, ALen) then
exit;
Result := ReadMemory(ALocation, SizeVal(Length(AValue)), @AValue[1]);
if not Result then
AValue := ''
end;
function TFpDbgLocationContext.ReadWString(const ALocation: TFpDbgMemLocation; ALen: Int64; out
AValue: WideString; AnIgnoreMaxStringLen: boolean): Boolean;
begin
Result := False;
AValue := '';
if (not AnIgnoreMaxStringLen) and
(MemManager.MemLimits.MaxStringLen > 0) and
(ALen > MemManager.MemLimits.MaxStringLen)
then
ALen := MemManager.MemLimits.MaxStringLen;
if ALen = 0 then begin
Result := True;
exit;
end;
if not MemManager.SetLength(AValue, ALen) then
exit;
Result := ReadMemory(ALocation, SizeVal(Length(AValue)*2), @AValue[1]);
if not Result then
AValue := ''
end;
function TFpDbgLocationContext.GetRegister(const ARegNum: Cardinal): TDbgRegisterValue;
begin
Result := MemManager.MemReader.GetRegister(ARegNum, Self);
end;
{ TFpDbgMemLimits }
procedure TFpDbgMemLimits.SetMaxMemReadSize(AValue: QWord);
begin
if (AValue <> 0) and (AValue < MINIMUM_MEMREAD_LIMIT) then
AValue := MINIMUM_MEMREAD_LIMIT;
if FMaxMemReadSize = AValue then Exit;
FMaxMemReadSize := AValue;
end;
constructor TFpDbgMemLimits.Create;
begin
FMaxMemReadSize := 512 * 1024 * 1024; // Do not try allocating more than 0.5 GB by default
FMaxArrayLen := 10000;
FMaxStringLen := 100 * 1024;
FMaxNullStringSearchLen := 20 * 1024;
end;
{ TFpDbgMemModel }
function TFpDbgMemModel.UpdateLocationToCodeAddress(const
ALocation: TFpDbgMemLocation): TFpDbgMemLocation;
begin
Result := ALocation;
end;
function TFpDbgMemModel.LocationToAddress(const
ALocation: TFpDbgMemLocation): TDBGPtr;
begin
Result := LocToAddr(ALocation);
end;
function TFpDbgMemModel.AddressToTargetLocation(const
AAddress: TDBGPtr): TFpDbgMemLocation;
begin
Result := TargetLoc(AAddress);
end;
function TFpDbgMemModel.IsReadableMemory(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := IsReadableMem(ALocation);
end;
function TFpDbgMemModel.IsReadableLocation(const
ALocation: TFpDbgMemLocation): Boolean;
begin
Result := IsReadableLoc(ALocation);
end;
{ TFpDbgMemReaderBase }
function TFpDbgMemReaderBase.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
ADest: Pointer; out ABytesRead: Cardinal): Boolean;
begin
Result := ReadMemoryPartial(AnAddress, ASize, ADest, ABytesRead);
end;
function TFpDbgMemReaderBase.ReadMemoryPartial(AnAddress: TDbgPtr;
ASize: Cardinal; ADest: Pointer; out ABytesRead: Cardinal): Boolean;
var
SizeRemaining, sz: Cardinal;
Offs: Integer;
Dummy: QWord;
begin
ABytesRead := ASize;
Result := ReadMemory(AnAddress, ASize, ADest);
if Result then
exit;
SizeRemaining := ASize;
Offs := 0;
ABytesRead := 0;
// check if the address is readable at all
Result := ReadMemory(AnAddress, 1, @Dummy);
if not Result then
exit;
while SizeRemaining > 0 do begin
Result := False;
sz := SizeRemaining;
while (not Result) and (sz > 1) do begin
sz := sz div 2;
Result := ReadMemory(AnAddress, sz, Pointer(PByte(ADest) + Offs));
end;
if not Result then
break;
ABytesRead := ABytesRead + sz;
Offs := Offs + sz;
AnAddress := AnAddress + sz;
SizeRemaining := SizeRemaining - sz;
end;
Result := ABytesRead > 0;
end;
{ TFpDbgMemConvertorLittleEndian }
function TFpDbgMemConvertorLittleEndian.PrepareTargetRead(
AReadDataType: TFpDbgMemReadDataType; var AConvData: TFpDbgMemConvData;
const ADest: Pointer): boolean;
begin
Result := AConvData.SourceFullSize <= AConvData.DestSize;
if not Result then
exit;
case AReadDataType of
rdtAddress, rdtSignedInt, rdtUnsignedInt,
rdtEnum, rdtSet: ;
rdtfloat:
Result := IsByteSize(AConvData.SourceSize) and
( (AConvData.SourceSize.Size = DBG_EXTENDED_SIZE) or
(AConvData.SourceSize.Size = SizeOf(Extended)) or
(AConvData.SourceSize.Size = SizeOf(Double)) or
(AConvData.SourceSize.Size = SizeOf(Single)) or
(AConvData.SourceSize.Size = SizeOf(real48))
);
rdtRawRead: ;
else begin
Assert(False, 'TFpDbgMemConvertorLittleEndian.PrepareTargetRead');
Result := False;
end;
end;
end;
function TFpDbgMemConvertorLittleEndian.FinishTargetRead(
AReadDataType: TFpDbgMemReadDataType;
const AConvData: TFpDbgMemConvData; const TmpData: Pointer;
const ADest: Pointer): boolean;
type
Preal48 = ^real48;
var
s: Boolean;
b: TBitAddr;
begin
Result := TmpData = ADest;
if not Result then
exit;
case AReadDataType of
rdtAddress, rdtUnsignedInt, rdtEnum, rdtSet: begin
if AConvData.SourceFullSize < AConvData.DestSize then
FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $00);
if AConvData.SourceSize.BitSize <> 0 then begin
assert(AConvData.SourceFullSize > 0, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: AConvData.SourceFullSize > 0');
PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ and
(Byte($FF) shr (8 - AConvData.SourceSize.BitSize)));
end;
end;
rdtSignedInt: begin
if AConvData.SourceFullSize < AConvData.DestSize then begin
b := AConvData.SourceSize.BitSize;
s := False;
if (AConvData.SourceFullSize > 0) then begin
if b = 0 then
s := ((PByte(ADest + AConvData.SourceFullSize - 1)^ and $80) <> 0)
else
s := ((PByte(ADest + AConvData.SourceFullSize - 1)^ and (1 shl (b-1)) ) <> 0);
end;
if s then
FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $FF)
else
FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $00);
if b <> 0 then begin
assert(AConvData.SourceFullSize > 0, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: AConvData.SourceFullSize > 0');
if s then
PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ or
(Byte($FF) shl b))
else
PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ and
(Byte($FF) shr (8 - b)));
end;
end;
end;
rdtfloat: begin
// Currently we have matching sizes, except for real48
if (AConvData.SourceFullSize = DBG_EXTENDED_SIZE) then begin
case AConvData.DestSize of
{$IF DBG_HAS_EXTENDED}
DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PDbgExtended(ADest)^;
{$ENDIF}
SizeOf(double): PDouble(ADest)^ := PDbgExtended(ADest)^;
SizeOf(Single): PSingle(ADest)^ := PDbgExtended(ADest)^;
else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching');
end;
end
else
if (AConvData.SourceFullSize = SizeOf(Extended)) then begin
case AConvData.DestSize of
{$IF DBG_HAS_EXTENDED}
DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PExtended(ADest)^;
{$ENDIF}
SizeOf(double): PDouble(ADest)^ := PExtended(ADest)^;
SizeOf(Single): PSingle(ADest)^ := PExtended(ADest)^;
else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching');
end;
end
else
if (AConvData.SourceFullSize = SizeOf(Double)) then begin
case AConvData.DestSize of
{$IF DBG_HAS_EXTENDED}
DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PDouble(ADest)^;
{$ENDIF}
SizeOf(double): PDouble(ADest)^ := PDouble(ADest)^;
SizeOf(Single): PSingle(ADest)^ := PDouble(ADest)^;
else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching');
end;
end
else
if (AConvData.SourceFullSize = SizeOf(Real48)) then begin
case AConvData.DestSize of
{$IF DBG_HAS_EXTENDED}
DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := double(Preal48(ADest)^);
{$ENDIF}
SizeOf(double): PDouble(ADest)^ := Preal48(ADest)^;
//SizeOf(Single): PSingle(ADest)^ := Preal48(ADest)^;
else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching');
end;
end
else
if (AConvData.SourceFullSize = SizeOf(Single)) then begin
case AConvData.DestSize of
{$IF DBG_HAS_EXTENDED}
DBG_EXTENDED_SIZE: PDbgExtended(ADest)^ := PSingle(ADest)^;
{$ENDIF}
SizeOf(double): PDouble(ADest)^ := PSingle(ADest)^;
SizeOf(Single): PSingle(ADest)^ := PSingle(ADest)^;
else assert(False, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: TargetSize not matching');
end;
end
else
Result := False;
end;
rdtRawRead: ; // TODO: cut bits?
else begin
Assert(False, 'TFpDbgMemConvertorLittleEndian.FailedTargetRead');
Result := False;
end;
end;
end;
procedure TFpDbgMemConvertorLittleEndian.FailedTargetRead(AConvertorData: TFpDbgMemConvData);
begin
//
end;
function TFpDbgMemConvertorLittleEndian.AdjustIntPointer(
var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean;
begin
Result := ANewSize <= ADataSize;
// 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.UnsignedExtend(ADataPointer: Pointer;
// ASourceSize, ADestSize: Cardinal);
//begin
// Assert(ASourceSize > 0, 'TFpDbgMemConvertorLittleEndian.SignExtend');
// if ASourceSize >= ADestSize then
// exit;
//
// FillByte((ADataPointer + ASourceSize)^, ADestSize-ASourceSize, $00)
//end;
{ TFpDbgMemCacheBase }
procedure TFpDbgMemCacheBase.Init;
begin
//
end;
{ TFpDbgMemCacheManagerBase }
procedure TFpDbgMemCacheManagerBase.InitalizeCache(ACache: TFpDbgMemCacheBase);
begin
ACache.FMemReader := FMemReader;
ACache.Init;
end;
function TFpDbgMemCacheManagerBase.AddCache(AnAddress: TDbgPtr; ASize: Cardinal
): TFpDbgMemCacheBase;
begin
Result := nil;
end;
function TFpDbgMemCacheManagerBase.AddCacheEx(AnAddress,
AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemCacheBase;
begin
Result := nil;
end;
procedure TFpDbgMemCacheManagerBase.RemoveCache(ACache: TFpDbgMemCacheBase);
begin
//
end;
function TFpDbgMemCacheManagerBase.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
ADest: Pointer): Boolean;
begin
Result := FMemReader.ReadMemory(AnAddress, ASize, ADest);
end;
function TFpDbgMemCacheManagerBase.ReadMemory(AnAddress: TDbgPtr;
ASize: Cardinal; ADest: Pointer; ABytesRead: Cardinal): Boolean;
begin
Result := FMemReader.ReadMemory(AnAddress, ASize, ADest, ABytesRead);
end;
function TFpDbgMemCacheManagerBase.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr;
ASize: Cardinal; ADest: Pointer): Boolean;
begin
Result := FMemReader.ReadMemoryEx(AnAddress, AnAddressSpace, ASize, ADest);
end;
{ TFpDbgMemCacheSimple }
constructor TFpDbgMemCacheSimple.Create(ACacheAddress: TDBGPtr;
ACacheSize: Cardinal);
begin
FCacheAddress := ACacheAddress;
FCacheSize := ACacheSize;
end;
function TFpDbgMemCacheSimple.ContainsMemory(AnAddress: TDbgPtr; ASize: Cardinal
): Boolean;
begin
Result := (ASize <= High(TDbgPtr) - AnAddress) and // not impossible memory range
(AnAddress >= FCacheAddress) and (AnAddress + ASize <= FCacheAddress + FCacheSize);
end;
function TFpDbgMemCacheSimple.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal;
ADest: Pointer): Boolean;
begin
Result := False;
if (ASize > High(TDbgPtr) - AnAddress) or // impossible memory range
(AnAddress < FCacheAddress) or (AnAddress + ASize > FCacheAddress + FCacheSize) or
FFailed
then
exit;
if FMem = nil then begin
SetLength(FMem, FCacheSize);
if not MemReader.ReadMemory(FCacheAddress, FCacheSize, @FMem[0]) then begin
FMem := nil;
FFailed := True;
exit;
end;
end;
Result := true;
move(FMem[AnAddress - FCacheAddress], PByte(ADest)^, ASize);
end;
{ TFpDbgMemCacheManagerSimple }
function CompareNodes(Item1, Item2: Pointer): Integer;
begin
if TFpDbgMemCacheSimple(Item1).CacheAddress > TFpDbgMemCacheSimple(Item2).CacheAddress
then Result := 1
else
if TFpDbgMemCacheSimple(Item1).CacheAddress < TFpDbgMemCacheSimple(Item2).CacheAddress
then Result := -1
else Result := 0;
end;
function CompareKey(Key, Item2: Pointer): Integer;
begin
If PDBGPtr(Key)^ > TFpDbgMemCacheSimple(Item2).CacheAddress
then Result := 1
else
If PDBGPtr(Key)^ < TFpDbgMemCacheSimple(Item2).CacheAddress
then Result := -1
else Result := 0;
end;
constructor TFpDbgMemCacheManagerSimple.Create;
begin
FCaches := TAVLTree.Create;
FCaches.OnCompare := @CompareNodes;
end;
destructor TFpDbgMemCacheManagerSimple.Destroy;
begin
inherited Destroy;
FCaches.Free;
end;
function TFpDbgMemCacheManagerSimple.HasMemory(AnAddress: TDbgPtr;
ASize: Cardinal): Boolean;
var
Node: TAVLTreeNode;
begin
Result := False;
if ASize > High(TDbgPtr) - AnAddress then // impossible memory range
exit;
Node := FCaches.FindNearestKey(@AnAddress, @CompareKey);
if Node = nil then
exit;
if TFpDbgMemCacheSimple(Node.Data).CacheAddress > AnAddress then
Node := Node.Precessor;;
if Node = nil then
exit;
Result := (AnAddress >= TFpDbgMemCacheSimple(Node.Data).CacheAddress) and
(AnAddress + ASize <= TFpDbgMemCacheSimple(Node.Data).CacheAddress +
TFpDbgMemCacheSimple(Node.Data).CacheSize);
end;
function TFpDbgMemCacheManagerSimple.ReadMemory(AnAddress: TDbgPtr;
ASize: Cardinal; ADest: Pointer): Boolean;
var
Node: TAVLTreeNode;
begin
Node := FCaches.FindNearestKey(@AnAddress, @CompareKey);
if Node = nil then
exit(inherited ReadMemory(AnAddress, ASize, ADest));
if TFpDbgMemCacheSimple(Node.Data).CacheAddress > AnAddress then
Node := Node.Precessor;;
if Node = nil then
exit(inherited ReadMemory(AnAddress, ASize, ADest));
if TFpDbgMemCacheSimple(Node.Data).ContainsMemory(AnAddress, ASize) then begin
Result := TFpDbgMemCacheSimple(Node.Data).ReadMemory(AnAddress, ASize, ADest);
exit;
end;
Result := inherited ReadMemory(AnAddress, ASize, ADest);
end;
function TFpDbgMemCacheManagerSimple.ReadMemory(AnAddress: TDbgPtr;
ASize: Cardinal; ADest: Pointer; ABytesRead: Cardinal): Boolean;
var
Node: TAVLTreeNode;
begin
Node := FCaches.FindNearestKey(@AnAddress, @CompareKey);
if Node = nil then
exit(inherited ReadMemory(AnAddress, ASize, ADest, ABytesRead));
if TFpDbgMemCacheSimple(Node.Data).CacheAddress > AnAddress then
Node := Node.Precessor;;
if Node = nil then
exit(inherited ReadMemory(AnAddress, ASize, ADest, ABytesRead));
// TODO: Allow to cache partial mem reads
if TFpDbgMemCacheSimple(Node.Data).ContainsMemory(AnAddress, ASize) then begin
ABytesRead := ASize;
Result := TFpDbgMemCacheSimple(Node.Data).ReadMemory(AnAddress, ASize, ADest);
exit;
end;
Result := inherited ReadMemory(AnAddress, ASize, ADest, ABytesRead);
end;
function TFpDbgMemCacheManagerSimple.AddCache(AnAddress: TDbgPtr;
ASize: Cardinal): TFpDbgMemCacheBase;
begin
Result := nil;
if HasMemory(AnAddress, ASize) then
exit;
Result := TFpDbgMemCacheSimple.Create(AnAddress, ASize);
InitalizeCache(Result);
FCaches.Add(Result);
end;
procedure TFpDbgMemCacheManagerSimple.RemoveCache(ACache: TFpDbgMemCacheBase);
begin
if ACache = nil then
exit;
FCaches.RemovePointer(ACache);
ACache.Free;
end;
{ TFpDbgMemLocation }
class operator TFpDbgMemLocation. = (a, b: TFpDbgMemLocation): boolean;
begin
Result := (a.Address = b.Address) and
(a.MType = b.MType) and (a.BitOffset = b.BitOffset) and
(a.AddressClass = b.AddressClass);
end;
class operator TFpDbgMemLocation.<(a, b: TFpDbgMemLocation): boolean;
begin
Result := (a.Address < b.Address) or
( (a.Address = b.Address) and
( (a.MType < b.MType) or
( (a.MType = b.MType) and
(a.BitOffset < b.BitOffset) or
( (a.BitOffset = b.BitOffset) and (a.AddressClass < b.AddressClass) )
)
) );
end;
class operator TFpDbgMemLocation.>(a, b: TFpDbgMemLocation): boolean;
begin
Result := (a.Address > b.Address) or
( (a.Address = b.Address) and
( (a.MType > b.MType) or
( (a.MType = b.MType) and
(a.BitOffset > b.BitOffset) or
( (a.BitOffset = b.BitOffset) and (a.AddressClass > b.AddressClass) )
)
) );
end;
{ TFpDbgMemManager }
function TFpDbgMemManager.GetCacheManager: TFpDbgMemCacheManagerBase;
begin
If FCacheManager = nil then
SetCacheManager(TFpDbgMemCacheManagerBase.Create);
Result := FCacheManager;
end;
procedure TFpDbgMemManager.BitShiftMem(ASrcMem, ADestMem: Pointer; ASrcSize,
ADestSize: cardinal; ABitCnt: Integer);
var
Next, Cur: Byte;
begin
Next := PByte(ASrcMem)^;
dec(ADestSize);
while ADestSize > 0 do begin
Cur := Next;
Next := PByte(ASrcMem + 1)^;
PByte(ADestMem)^ := Byte(( Cur shr ABitCnt) or ( Next shl (8 - ABitCnt) ));
ASrcMem := ASrcMem + 1;
ADestMem := ADestMem + 1;
dec(ADestSize);
end;
Cur := Next;
Next := 0;
if ASrcSize > ADestSize then
Next := PByte(ASrcMem + 1)^;
PByte(ADestMem)^ := Byte(( Cur shr ABitCnt) or ( Next shl (8 - ABitCnt) ));
end;
function TFpDbgMemManager.ReadMemory(AReadDataType: TFpDbgMemReadDataType;
const ASourceLocation: TFpDbgMemLocation; const ASourceSize: TFpDbgValueSize;
const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgLocationContext;
const AFlags: TFpDbgMemManagerFlags): Boolean;
var
ConvData: TFpDbgMemConvData;
ReadData, ReadData2: Pointer;
TmpVal: TDbgPtr;
BitOffset, SourceExtraSize: Integer;
SourceReadSize, SourceFullSize: QWord;
begin
Result := False;
FPartialReadResultLenght := SizeToFullBytes(ASourceSize);
DebugLn(FPDBG_VERBOSE_MEM, ['$ReadMem: ', dbgs(AReadDataType),' ', dbgs(ASourceLocation), ' ', dbgs(ASourceSize), ' Dest ', ADestSize]);
assert((AContext<>nil) or not(ASourceLocation.MType in [mlfTargetRegister]), 'TFpDbgMemManager.ReadMemory: (AContext<>nil) or not(ASourceLocation.MType in [mlfTargetRegister])');
// To late for an error, Dest-mem is already allocated
assert((FMemLimits.MaxMemReadSize = 0) or (SizeToFullBytes(ASourceSize) <= FMemLimits.MaxMemReadSize), 'TFpDbgMemManager.ReadMemory: (FMemLimits.MaxMemReadSize = 0) or (SizeToFullBytes(ASourceSize) <= FMemLimits.MaxMemReadSize)');
if (ASourceLocation.MType in [mlfInvalid, mlfUninitialized]) or
(ASourceSize <= 0)
then begin
FLastError := CreateError(fpInternalErrCanNotReadInvalidMem);
exit;
end;
FLastError := NoError;
ConvData.SourceLocation := ASourceLocation;
ConvData.SourceSize := ASourceSize; // ONLY valid for target/self-mem // Currently set equal to ADestSize;
ConvData.SourceFullSize := SizeToFullBytes(ASourceSize);
ConvData.DestSize := ADestSize;
if not TargetMemConvertor.PrepareTargetRead(AReadDataType, ConvData, ADest) then begin
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]);
exit;
end;
assert(ConvData.DestSize <= ADestSize, 'TFpDbgMemManager.ReadMemory: ConvData.DestSize <= ADestSize');
// SourceFullSize: excluding any size needed for BitOffset
SourceFullSize := ConvData.SourceFullSize;
if (SourceFullSize > TMP_MEM_SIZE) and (SourceFullSize > ConvData.DestSize) then begin
// The un-shifted (bit-offset) result must fully fit in either ADest or FTmpMem
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;
(* - If SourceFullSize does not fit into ADest,
then FinishTargetRead *MUST* copy the desired part
- If SourceFullSize is smaller than ADest,
then targetconverter *MUST* fill/zero/compute the missing data.
The read data will be alligned ot the first (smallest address) byte.
- targetconverter MUST treat FTmpMem as read-only
*)
BitOffset := ConvData.SourceLocation.BitOffset;
SourceExtraSize := (BitOffset + ConvData.SourceSize.BitSize + 7) div 8;
case ASourceLocation.MType of
mlfTargetMem, mlfSelfMem: begin
assert(BitOffset < 8, 'TFpDbgMemManager.ReadMemory: BitOffset < 8');
if QWord(ConvData.SourceSize.Size) > high(SourceReadSize) - SourceExtraSize then begin
// bigger than max read size
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]);
exit;
end;
SourceReadSize := ConvData.SourceSize.Size + SourceExtraSize;
// TODO: separate check for selfmem // requires selfmem to have a size field
if (SourceReadSize > High(TDbgPtr) - ConvData.SourceLocation.Address) or
( (SourceReadSize > ConvData.DestSize) and ((SourceReadSize - ConvData.DestSize) > TMP_MEM_SIZE) )
then begin
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]);
exit;
end;
case ASourceLocation.MType of
mlfTargetMem: begin
ReadData2 := nil;
if SourceReadSize <= ConvData.DestSize then begin
// full read to ADest
ReadData := ADest;
if mmfPartialRead in AFlags then
Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, SourceReadSize, ADest, FPartialReadResultLenght)
else
Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, SourceReadSize, ADest);
end
else
if SourceReadSize <= TMP_MEM_SIZE then begin
// full read to FTmpMem;
// This is the ONLY read that has ReadData <> ADest
// *** FinishTargetRead must copy the data ***
ReadData := @FTmpMem[0];
// TODO: partial reads for bit shifting?
Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, SourceReadSize, ReadData);
end
else begin
// SPLIT read to ADest/FTmpMem;
// BitOffset must be none zero, otherwise the data must fully fit in either ADest or FTmpMem
// *** BitShift will copy the date into ADest ***
assert(BitOffset <> 0, 'TFpDbgMemManager.ReadMemory: BitOffset <> 0');
ReadData := ADest;
ReadData2 := @FTmpMem[0];
// TODO: partial reads for bit shifting?
Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, ConvData.DestSize, ADest);
if Result then
Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address + ConvData.DestSize, SourceReadSize - ConvData.DestSize, ReadData2);
end;
if Result and (BitOffset <> 0) then begin
if (ReadData <> ADest) then begin
// Read to FTmpMem only
if (SourceFullSize <= ConvData.DestSize) then begin
BitShiftMem(ReadData, ADest, SourceReadSize, SourceFullSize, BitOffset);
ReadData := ADest;
end
else
BitShiftMem(ReadData, ReadData, SourceReadSize, SourceFullSize, BitOffset);
end
else
// Read to ADest or SPLIT
BitShiftMem(ReadData, ReadData, ConvData.DestSize, ConvData.DestSize, BitOffset);
if ReadData2 <> nil then begin
// SPLIT read; ReadData=ADest
// Since SourceReadSize can have max 1 extra byte => there can only be one byte; which must fit into ADest after shifting BitOffset
PByte(ADest+ConvData.DestSize-1)^ := Byte(PByte(ADest+ConvData.DestSize-1)^ or
(PByte(ReadData2)^ shl (8 - BitOffset) ));
end;
end;
// ReadData is now a pointer to the FULL data. Either in ADest or FTmpMem
end;
mlfSelfMem: begin // Can be cached TargetMem, or can be constant data from dwarf
try // accessinge SelfMem can fail, because there is on SelfmMem.Length that can be checked
Result := True;
if BitOffset <> 0 then begin
// BitShift will copy the data
if (SourceFullSize <= ConvData.DestSize) then
ReadData := @ConvData.SourceLocation.Address
else
ReadData := @FTmpMem[0];
BitShiftMem(@ConvData.SourceLocation.Address, ReadData, SourceReadSize, SourceFullSize, BitOffset)
end
else begin
// no BitShift
ReadData := ADest;
if SourceFullSize > ConvData.DestSize then
ReadData := @ConvData.SourceLocation.Address // ReadData has to be read-only // FinishTargetRead must copy the data
else
move(Pointer(ConvData.SourceLocation.Address)^, ADest^, SourceFullSize);
end;
except
Result := False;
end;
end;
end;
end;
mlfConstant, mlfConstantDeref, mlfTargetRegister:
begin
If (BitOffset <> 0) or (not IsByteSize(ConvData.SourceSize)) then begin
// Not yet supported
FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ConvData.SourceLocation.Address]);
Result := False;
exit;
end;
case ASourceLocation.MType of
mlfConstant, mlfConstantDeref: begin
TmpVal := ConvData.SourceLocation.Address;
SourceReadSize := SizeOf(ConvData.SourceLocation.Address);
end;
mlfTargetRegister: 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 begin
FLastError := CreateError(fpErrFailedReadRegister);
exit; // failed
end
end;
end;
if SourceReadSize < FPartialReadResultLenght then
FPartialReadResultLenght := SourceReadSize;
if SourceReadSize > ConvData.SourceSize.Size then
SourceReadSize := ConvData.SourceSize.Size
else
if SourceReadSize <= ConvData.SourceSize.Size then begin
ConvData.SourceSize := SizeVal(SourceReadSize);
ConvData.SourceFullSize := SourceReadSize;
end;
ReadData := @TmpVal;
if SizeOf(TmpVal) <> SourceReadSize then
// TODO: only needed if ADestSize > SourceReadSize ?
// Maybe do that after Move to ADest? // Maybe as part of FinishTargetRead ?
if not FSelfMemConvertor.AdjustIntPointer(ReadData, SizeOf(TmpVal), SourceReadSize) then begin
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;
if SourceReadSize <= ConvData.DestSize then begin
move(ReadData^, ADest^, Min(SizeOf(TmpVal), Int64(ConvData.DestSize))); // Little Endian only
ReadData := ADest;
end;
Result := True;
end;
end;
if Result then
Result := TargetMemConvertor.FinishTargetRead(AReadDataType, ConvData, ReadData, ADest)
else
TargetMemConvertor.FailedTargetRead(ConvData);
if (not Result) and (not IsError(FLastError)) then
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
TmpVal: TDbgPtr;
BitOffset: Integer;
DestWriteSize: QWord;
begin
Result := False;
DebugLn(FPDBG_VERBOSE_MEM, ['$WriteMem: ', dbgs(AReadDataType),' ', dbgs(ADestLocation), ' ', dbgs(ADestSize), ' Source ', ASource]);
assert(AContext<>nil, 'TFpDbgMemManager.WriteMemory: AContext<>nil');
if (ADestLocation.MType in [mlfInvalid, mlfUninitialized]) or
(ADestSize <= 0)
then begin
FLastError := CreateError(fpInternalErrCanNotWriteInvalidMem);
exit;
end;
FLastError := NoError;
// 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 (DestWriteSize < 8) and
(TmpVal and (QWord($ffffffffffffffff) << (DestWriteSize*8)) <> 0) and
( (AReadDataType <> rdtSignedInt) or
(TmpVal and (QWord($ffffffffffffffff) << (DestWriteSize*8)) <> (QWord($ffffffffffffffff) << (DestWriteSize*8)) )
)
then
exit; // failed
if not FMemReader.WriteRegister(Cardinal(ADestLocation.Address), TmpVal, AContext) then
exit; // failed
Result := True;
end;
mlfTargetMem:
begin
if (BitOffset = 0) and (ADestSize.BitSize = 0) and (ADestSize.Size > 0) then begin
FMemReader.WriteMemory(LocToAddr(ADestLocation), SizeToFullBytes(ADestSize), ASource);
end;
end;
mlfSelfMem:
begin
DestWriteSize := ADestSize.Size;
if (BitOffset = 0) and (ADestSize.BitSize = 0) and
(DestWriteSize > 0) and
(FStartWirteableSelfMem <> 0) and
(ADestLocation.Address >= FStartWirteableSelfMem) and
(ADestLocation.Address + DestWriteSize <= FStartWirteableSelfMem + FLenWirteableSelfMem)
then begin
if ASourceSize < DestWriteSize then
DestWriteSize := ASourceSize;
move(ASource^, Pointer(PtrUint(ADestLocation.Address))^, ADestSize.Size);
Result := True;
end;
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;
FCacheManager.Free;
FCacheManager := ACacheMgr;
if FCacheManager <> nil then
FCacheManager.FMemReader := FMemReader;
end;
constructor TFpDbgMemManager.Create(AMemReader: TFpDbgMemReaderBase;
AMemConvertor: TFpDbgMemConvertor; AMemModel: TFpDbgMemModel);
begin
FMemLimits := TFpDbgMemLimits.Create;
FMemReader := AMemReader;
FTargetMemConvertor := AMemConvertor;
FSelfMemConvertor := AMemConvertor;
FMemModel := AMemModel;
end;
constructor TFpDbgMemManager.Create(AMemReader: TFpDbgMemReaderBase; ATargenMemConvertor,
ASelfMemConvertor: TFpDbgMemConvertor; AMemModel: TFpDbgMemModel);
begin
FMemLimits := TFpDbgMemLimits.Create;
FMemReader := AMemReader;
FTargetMemConvertor := ATargenMemConvertor;
FSelfMemConvertor := ASelfMemConvertor;
FMemModel := AMemModel;
end;
destructor TFpDbgMemManager.Destroy;
begin
SetCacheManager(nil);
inherited Destroy;
FMemLimits.Free;
end;
procedure TFpDbgMemManager.ClearLastError;
begin
FLastError := NoError;
end;
procedure TFpDbgMemManager.SetWritableSeflMem(AStartWirteableSelfMem: TDBGPtr;
ALenWirteableSelfMem: Cardinal);
begin
FStartWirteableSelfMem := AStartWirteableSelfMem;
FLenWirteableSelfMem := ALenWirteableSelfMem;
end;
procedure TFpDbgMemManager.ClearWritableSeflMem;
begin
FStartWirteableSelfMem := 0;
FLenWirteableSelfMem := 0;
end;
function TFpDbgMemManager.RegisterSize(ARegNum: Cardinal): Integer;
begin
Result := FMemReader.RegisterSize(ARegNum);
end;
function TFpDbgMemManager.RegisterNumber(ARegName: String; out ARegNum: Cardinal
): Boolean;
begin
Result := FMemReader.RegisterNumber(ARegName, ARegNum);
end;
function TFpDbgMemManager.ReadMemoryEx(
const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr;
ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgLocationContext
): Boolean;
begin
assert(AContext<>nil, 'TFpDbgMemManager.ReadMemoryEx: AContext<>nil');
FLastError := NoError;
if (ASourceLocation.BitOffset <> 0) then begin
// Not supported to read at bit offset
FLastError := CreateError(fpInternalErrFailedReadMem);
Result := False;
exit;
end;
// AnAddressSpace is ignored, when not actually reading from target address
case ASourceLocation.MType of
mlfTargetMem: Result := FMemReader.ReadMemoryEx(ASourceLocation.Address, AnAddressSpace, SizeToFullBytes(ASize), ADest);
else
Result := ReadMemory(rdtRawRead, ASourceLocation, ASize, ADest, ASize.Size, AContext);
end;
if (not Result) and (not IsError(FLastError)) then
FLastError := CreateError(fpInternalErrFailedReadMem);
end;
function TFpDbgMemManager.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr;
AContext: TFpDbgLocationContext): Boolean;
begin
assert(AContext<>nil, 'TFpDbgMemManager.ReadRegister: AContext<>nil');
FLastError := NoError;
// TODO: If stackframe <> 0 then get the register internally (unroll stack)
Result := FMemReader.ReadRegister(ARegNum, AValue, AContext);
if not Result then
FLastError := CreateError(fpErrFailedReadRegister);
end;
function TFpDbgMemManager.ReadRegisterAsAddress(ARegNum: Cardinal; out
AValue: TDbgPtr; AContext: TFpDbgLocationContext): Boolean;
begin
Result := ReadRegister(ARegNum, AValue, AContext);
end;
function TFpDbgMemManager.SetLength(var ADest: TByteDynArray; ALength: Int64
): Boolean;
begin
Result := False;
if (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) then begin
FLastError := CreateError(fpErrReadMemSizeLimit);
exit;
end;
Result := True;
System.SetLength(ADest, ALength);
end;
function TFpDbgMemManager.SetLength(var ADest: RawByteString; ALength: Int64
): Boolean;
begin
Result := False;
if (ALength < 0) or
( (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) )
then begin
FLastError := CreateError(fpErrReadMemSizeLimit);
exit;
end;
Result := True;
System.SetLength(ADest, ALength);
end;
function TFpDbgMemManager.SetLength(var ADest: AnsiString; ALength: Int64
): Boolean;
begin
Result := False;
if (ALength < 0) or
( (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) )
then begin
FLastError := CreateError(fpErrReadMemSizeLimit);
exit;
end;
Result := True;
System.SetLength(ADest, ALength);
end;
function TFpDbgMemManager.SetLength(var ADest: WideString; ALength: Int64
): Boolean;
begin
Result := False;
if (ALength < 0) or
( (FMemLimits.MaxMemReadSize > 0) and (ALength * 2 > FMemLimits.MaxMemReadSize) )
then begin
FLastError := CreateError(fpErrReadMemSizeLimit);
exit;
end;
Result := True;
System.SetLength(ADest, ALength);
end;
function TFpDbgMemManager.CheckDataSize(ASize: Int64): Boolean;
begin
Result := False;
if (FMemLimits.MaxMemReadSize > 0) and (ASize > FMemLimits.MaxMemReadSize) then begin
FLastError := CreateError(fpErrReadMemSizeLimit);
exit;
end;
Result := True;
end;
function TFpDbgMemManager.ReadPChar(const ALocation: TFpDbgMemLocation;
AMaxChars: Int64; out AValue: AnsiString; NoTrimToZero: Boolean): Boolean;
var
i: QWord;
begin
Result := False;
if not MemModel.IsReadableLocation(ALocation) then begin
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;
if AMaxChars <= 0 then
AMaxChars := DEF_MAX_PCHAR_LEN;
i := MemLimits.MaxNullStringSearchLen;
if i = 0 then
i := MemLimits.MaxMemReadSize;
if (i > 0) and (AMaxChars > i) then
AMaxChars := i;
SetLength(AValue, AMaxChars);
if ReadMemory(rdtRawRead, ALocation, SizeVal(AMaxChars), @AValue[1], AMaxChars, nil, [mmfPartialRead]) then begin
Result := True;
i := PartialReadResultLenght;
SetLength(AValue, i);
if not NoTrimToZero then begin
i := pos(#0, AValue);
if i > 0 then
SetLength(AValue, i-1);
end;
exit;
end
end;
function TFpDbgMemManager.ReadPWChar(const ALocation: TFpDbgMemLocation;
AMaxChars: Int64; out AValue: WideString): Boolean;
var
i: QWord;
begin
Result := False;
if not MemModel.IsReadableLocation(ALocation) then begin
FLastError := CreateError(fpInternalErrFailedReadMem);
exit;
end;
if AMaxChars <= 0 then
AMaxChars := DEF_MAX_PCHAR_LEN;
i := MemLimits.MaxNullStringSearchLen;
if i = 0 then
i := MemLimits.MaxMemReadSize div 2;
if (i > 0) and (AMaxChars > i) then
AMaxChars := i;
SetLength(AValue, AMaxChars);
if ReadMemory(rdtRawRead, ALocation, SizeVal(AMaxChars*2), @AValue[1], AMaxChars*2, nil, [mmfPartialRead]) then begin
Result := True;
i := PartialReadResultLenght div 2;
SetLength(AValue, i);
i := pos(#0, AValue);
if i > 0 then
SetLength(AValue, i-1);
exit;
end
end;
initialization
FPDBG_VERBOSE_MEM := DebugLogger.FindOrRegisterLogGroup('FPDBG_VERBOSE_MEM' {$IFDEF FPDBG_VERBOSE_MEM} , True {$ENDIF} );
end.
Reference in New Issue View Git Blame Copy Permalink