mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 19:52:34 +02:00
5337 lines
173 KiB
ObjectPascal
5337 lines
173 KiB
ObjectPascal
unit IdeDebuggerWatchResult;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$ModeSwitch typehelpers}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Types,
|
|
// LazDebuggerIntf
|
|
LazDebuggerIntf, LazDebuggerIntfBaseTypes, LazDebuggerIntfFloatTypes,
|
|
// IdeIntf
|
|
IdeDebuggerWatchValueIntf,
|
|
// LclBase
|
|
LazUTF8, Laz2_XMLCfg, LazLoggerBase,
|
|
// IdeDebugger
|
|
IdeDebuggerUtils, LazDebuggerValueConverter;
|
|
|
|
type
|
|
|
|
TWatchResultData = class;
|
|
TWatchResultDataError = class;
|
|
TWatchResultStorage = class;
|
|
PWatchResultTypeStructFieldInfo = ^TWatchResultTypeStructFieldInfo;
|
|
TOverrideTemplateData = TWatchResultDataError;
|
|
|
|
{ TWatchResultValue }
|
|
|
|
TWatchResultValue = object
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline;
|
|
function GetAsString: RawByteString; inline;
|
|
function GetAsWideString: WideString; inline;
|
|
function GetAsQWord: QWord; inline;
|
|
function GetAsInt64: Int64; inline;
|
|
function GetAsSingle: Single; inline;
|
|
function GetAsDouble: Double; inline;
|
|
function GetAsExtended: TDbgExtended; inline;
|
|
function GetAsFloat: Extended; inline;
|
|
function GetByteSize: Integer; inline; // Int, Enum
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; inline;
|
|
function GetLowBound: Int64; inline; // static array
|
|
function GetCount: Integer; inline; // Set (Active Elements)
|
|
function GetLength: Integer; inline; // Array (Declared Len / Actual Len)
|
|
function GetElementName(AnIndex: integer): String; inline; // Set/Array
|
|
function GetDerefData: TWatchResultData; inline; // Ptr
|
|
function GetBoundType: TWatchResultData; inline; // Ptr
|
|
|
|
function GetEntryTemplate: TWatchResultData; inline; // NESTED TYPE FOR NESTED STORAGE
|
|
|
|
function GetDataAddress: TDBGPtr; inline;
|
|
|
|
// struct
|
|
function GetStructType: TLzDbgStructType; inline;
|
|
// function GetStructFlags: TLzDbgStructFlags; inline;
|
|
function GetAnchestor: TWatchResultData; inline; // TWatchResTypeStruct ;
|
|
function GetFieldCount: Integer; inline;
|
|
function GetField(AnIndex: Integer): TWatchResultData; inline;
|
|
function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline;
|
|
|
|
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueTextBase }
|
|
|
|
TWatchResultValueTextBase = object(TWatchResultValue)
|
|
private
|
|
FText: RawByteString;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline; // TODO: if the debugger introduces different len -limits depending on depth....
|
|
property GetAsString: RawByteString read FText;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueMemDump }
|
|
|
|
TWatchResultValueMemDump = object(TWatchResultValue)
|
|
private
|
|
FText: RawByteString;
|
|
FAddress: TDBGPtr;
|
|
protected const
|
|
VKind = rdkMemDump;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline; // TODO: if the debugger introduces different len -limits depending on depth....
|
|
property GetAsString: RawByteString read FText;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetDataAddress: TDBGPtr read FAddress;
|
|
end;
|
|
|
|
{ TWatchResultValuePrePrinted }
|
|
|
|
TWatchResultValuePrePrinted = object(TWatchResultValueTextBase)
|
|
protected const
|
|
VKind = rdkPrePrinted;
|
|
end;
|
|
|
|
{ TWatchResultValueString }
|
|
|
|
TWatchResultValueString = object(TWatchResultValueTextBase)
|
|
protected const
|
|
VKind = rdkString;
|
|
private
|
|
FAddress: TDBGPtr;
|
|
protected
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetDataAddress: TDBGPtr read FAddress;
|
|
end;
|
|
|
|
{ TWatchResultValueWideString }
|
|
|
|
TWatchResultValueWideString = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkWideString;
|
|
private
|
|
FWideText: WideString;
|
|
FAddress: TDBGPtr;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline; // TODO: if the debugger introduces different len -limits depending on depth....
|
|
property GetAsWideString: WideString read FWideText;
|
|
function GetAsString: RawByteString; inline;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetDataAddress: TDBGPtr read FAddress;
|
|
end;
|
|
|
|
{ TWatchResultValueOrdNumBase }
|
|
|
|
TWatchResultValueOrdNumBase = object(TWatchResultValue)
|
|
private
|
|
FNumValue: QWord;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline;
|
|
property GetAsQWord: QWord read FNumValue;
|
|
function GetAsInt64: Int64; inline;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultTypeOrdNum }
|
|
|
|
TWatchResultTypeOrdNum = object(TWatchResultValue)
|
|
private
|
|
FNumByteSize: Integer; // SmallInt
|
|
protected
|
|
property GetByteSize: Integer read FNumByteSize;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueSignedNum }
|
|
|
|
TWatchResultValueSignedNum = object(TWatchResultValueOrdNumBase)
|
|
protected const
|
|
VKind = rdkSignedNumVal;
|
|
protected
|
|
function GetAsString: RawByteString; inline;
|
|
end;
|
|
|
|
{ TWatchResultValueUnsignedNum }
|
|
|
|
TWatchResultValueUnsignedNum = object(TWatchResultValueOrdNumBase)
|
|
protected const
|
|
VKind = rdkUnsignedNumVal;
|
|
protected
|
|
function GetAsString: RawByteString; inline;
|
|
end;
|
|
|
|
{ TWatchResultValueChar }
|
|
|
|
TWatchResultValueChar = object(TWatchResultValueOrdNumBase)
|
|
protected const
|
|
VKind = rdkChar;
|
|
protected
|
|
function GetAsString: RawByteString; inline;
|
|
function GetAsWideString: WideString; inline;
|
|
end;
|
|
|
|
{ TWatchResultValuePointer }
|
|
|
|
TWatchResultValuePointer = object(TWatchResultValueOrdNumBase)
|
|
protected const
|
|
VKind = rdkPointerVal;
|
|
protected
|
|
//function GetIsDephtlessData: Boolean; inline; // Done in TWatchResultDataPointer
|
|
function GetAsString: RawByteString; inline;
|
|
property GetDataAddress: TDBGPtr read FNumValue;
|
|
end;
|
|
|
|
{ TWatchResultTypePointer }
|
|
|
|
TWatchResultTypePointer = object(TWatchResultValue)
|
|
private
|
|
FDerefData: TWatchResultData; // This may contain "Value"-Data. Will be stored in NestedStorage
|
|
protected
|
|
property GetDerefData: TWatchResultData read FDerefData;
|
|
property GetEntryTemplate: TWatchResultData read FDerefData;
|
|
function GetAsString: RawByteString; inline;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueFloat }
|
|
|
|
{ TWatchResultValueFloatBase }
|
|
|
|
{ TGenericWatchResultValueFloat }
|
|
|
|
generic TGenericWatchResultValueFloat<TFLOAT> = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkFloatVal;
|
|
private
|
|
FFloatValue: TFLOAT;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline;
|
|
function GetAsSingle: Single; inline;
|
|
function GetAsDouble: Double; inline;
|
|
function GetAsExtended: TDbgExtended; inline;
|
|
function GetAsFloat: Extended;
|
|
function GetAsString: RawByteString; inline;
|
|
procedure SetFromString(s: string); inline;
|
|
|
|
(* Once Saved/Loaded precission may be lowered *)
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueFloat }
|
|
|
|
TWatchResultValueFloat = specialize TGenericWatchResultValueFloat<Extended>;
|
|
|
|
{ TWatchResultValueSingle }
|
|
|
|
TWatchResultValueSingle = object(specialize TGenericWatchResultValueFloat<Single>)
|
|
protected
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; inline;
|
|
end;
|
|
|
|
{ TWatchResultValueDouble }
|
|
|
|
TWatchResultValueDouble = object(specialize TGenericWatchResultValueFloat<Double>)
|
|
protected
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; inline;
|
|
end;
|
|
|
|
{ TWatchResultValueExtended }
|
|
|
|
TWatchResultValueExtended = object(specialize TGenericWatchResultValueFloat<TDbgExtended>)
|
|
protected
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; inline;
|
|
end;
|
|
|
|
{ TWatchResultTypeFloat }
|
|
|
|
TWatchResultTypeFloat = object(TWatchResultValue)
|
|
private
|
|
FFloatPrecission: TLzDbgFloatPrecission;
|
|
protected
|
|
property GetFloatPrecission: TLzDbgFloatPrecission read FFloatPrecission;
|
|
function GetAsString: RawByteString; inline;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueBoolean }
|
|
|
|
TWatchResultValueBoolean = object(TWatchResultValueOrdNumBase)
|
|
protected const
|
|
VKind = rdkBool;
|
|
protected
|
|
function GetAsString: RawByteString; inline;
|
|
end;
|
|
|
|
{ TWatchResultValueEnumBase }
|
|
|
|
TWatchResultValueEnumBase = object(TWatchResultValueOrdNumBase)
|
|
private
|
|
FName: RawByteString;
|
|
protected
|
|
property GetAsString: RawByteString read FName;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueEnum }
|
|
|
|
TWatchResultValueEnum = object(TWatchResultValueEnumBase)
|
|
protected const
|
|
VKind = rdkEnum;
|
|
end;
|
|
|
|
{ TWatchResultValueEnumVal }
|
|
|
|
TWatchResultValueEnumVal = object(TWatchResultValueEnumBase)
|
|
protected const
|
|
VKind = rdkEnumVal;
|
|
end;
|
|
|
|
{ TWatchResultValueSet }
|
|
|
|
TWatchResultValueSet = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkSet;
|
|
private
|
|
FNames: Array of String;
|
|
protected
|
|
function GetIsDephtlessData: Boolean; inline;
|
|
function GetCount: Integer; inline;
|
|
function GetElementName(AnIndex: integer): String; inline;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueError }
|
|
|
|
TWatchResultValueError = object(TWatchResultValueTextBase)
|
|
protected const
|
|
VKind = rdkError;
|
|
end;
|
|
|
|
TWatchResultValueVariant = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkVariant;
|
|
private
|
|
FVariantData: TWatchResultData; // This may contain "Value"-Data. Will be stored in NestedStorage
|
|
FVisibility: TLzDbgFieldVisibility;
|
|
FName: RawByteString;
|
|
protected
|
|
property GetDerefData: TWatchResultData read FVariantData;
|
|
property GetAsString: RawByteString read FName;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueArrayBase }
|
|
|
|
TWatchResultValueArrayBase = object(TWatchResultValue)
|
|
private
|
|
FEntries: TWatchResultStorage;
|
|
protected
|
|
function GetCount: Integer;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultTypeArrayBase }
|
|
|
|
TWatchResultTypeArrayBase = object(TWatchResultValue)
|
|
private
|
|
FEntryTemplate: TWatchResultData;
|
|
protected
|
|
property GetEntryTemplate: TWatchResultData read FEntryTemplate;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValuePCharOrString }
|
|
|
|
TWatchResultValuePCharOrString = object(TWatchResultValueArrayBase)
|
|
protected const
|
|
VKind = rdkPCharOrString;
|
|
end;
|
|
|
|
{ TWatchResultValueArray }
|
|
|
|
TWatchResultValueArray = object(TWatchResultValueArrayBase)
|
|
protected const
|
|
VKind = rdkArray;
|
|
end;
|
|
|
|
{ TWatchResultValueUnknowArray }
|
|
|
|
TWatchResultValueUnknowArray = object(TWatchResultValueArray)
|
|
private
|
|
FLowBound: Int64;
|
|
FLength: Integer;
|
|
protected
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetLowBound: Int64 read FLowBound;
|
|
property GetLength: Integer read FLength;
|
|
end;
|
|
|
|
{ TWatchResultValueDynArray }
|
|
|
|
TWatchResultValueDynArray = object(TWatchResultValueArray)
|
|
private
|
|
FAddress: TDBGPtr;
|
|
FLength: Integer;
|
|
protected
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetDataAddress: TDBGPtr read FAddress;
|
|
property GetLength: Integer read FLength;
|
|
end;
|
|
|
|
{ TWatchResultValueStatArray }
|
|
|
|
TWatchResultValueStatArray = object(TWatchResultValueArray)
|
|
end;
|
|
|
|
{ TWatchResultTypeArray }
|
|
|
|
TWatchResultTypeArray = object(TWatchResultTypeArrayBase)
|
|
private
|
|
protected
|
|
end;
|
|
|
|
{ TWatchResultTypeStatArray }
|
|
|
|
TWatchResultTypeStatArray = object(TWatchResultTypeArrayBase)
|
|
private
|
|
FBoundType: TWatchResultData;
|
|
FLowBound: Int64;
|
|
FLength: Integer;
|
|
protected
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetLowBound: Int64 read FLowBound;
|
|
property GetLength: Integer read FLength;
|
|
end;
|
|
|
|
|
|
TWatchResultTypeStructFieldInfo = packed record
|
|
FieldName: String;
|
|
FieldVisibility: TLzDbgFieldVisibility;
|
|
FieldFlags: TLzDbgFieldFlags;
|
|
Field: TWatchResultData;
|
|
end;
|
|
|
|
|
|
|
|
// TLzDbgStructFlag = (dsfNil, dsfDummyAnchestor);
|
|
// TLzDbgStructFlags = set of TLzDbgStructFlag;
|
|
|
|
{ TWatchResultValueStruct }
|
|
|
|
TWatchResultValueStruct = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkStruct;
|
|
end;
|
|
|
|
{ TWatchResultValueStructWithRef }
|
|
|
|
TWatchResultValueStructWithRef = object(TWatchResultValueStruct)
|
|
private
|
|
FDataAddress: TDBGPtr;
|
|
public
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetDataAddress: TDBGPtr read FDataAddress;
|
|
end;
|
|
|
|
{ TWatchResultValueConverted }
|
|
|
|
TWatchResultValueConverted = object(TWatchResultValue)
|
|
protected const
|
|
VKind = rdkConvertRes;
|
|
end;
|
|
|
|
|
|
{ TWatchResultTypeStructBase }
|
|
|
|
TWatchResultTypeStructBase = object(TWatchResultValue)
|
|
private
|
|
FFieldData: packed array of TWatchResultTypeStructFieldInfo;
|
|
public
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
function GetFieldCount: Integer; inline;
|
|
function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure CopyFieldsProtoFrom(const ASource: TWatchResultTypeStructBase); inline;
|
|
procedure DoFree;
|
|
end;
|
|
|
|
{ TWatchResultTypeStruct }
|
|
|
|
TWatchResultTypeStruct = object(TWatchResultTypeStructBase)
|
|
private
|
|
FStructType: TLzDbgStructType;
|
|
// FStructFlags: TLzDbgStructFlags; // dsfDummyAnchestor
|
|
FAnchestor: TWatchResultData;
|
|
public
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
property GetStructType: TLzDbgStructType read FStructType;
|
|
// property GetStructFlags: TLzDbgStructFlags read FStructFlags;
|
|
property GetAnchestor: TWatchResultData read FAnchestor;
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
end;
|
|
|
|
{ TWatchResultTypeConverted }
|
|
|
|
TWatchResultTypeConverted = object(TWatchResultTypeStructBase)
|
|
private
|
|
FHandler: ILazDbgValueConverterIntf;
|
|
public
|
|
procedure AfterAssign(ATypeOnly: Boolean = False);
|
|
procedure DoFree;
|
|
end;
|
|
|
|
|
|
{ TWatchResultTypeProc }
|
|
|
|
TWatchResultTypeProc = object(TWatchResultValue)
|
|
private
|
|
FText: RawByteString;
|
|
protected
|
|
property GetAsString: RawByteString read FText;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultValueProcBase }
|
|
|
|
TWatchResultValueProcBase = object(TWatchResultValueOrdNumBase)
|
|
private
|
|
FLoc: String;
|
|
protected
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean);
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
end;
|
|
|
|
|
|
TWatchResultValueFunc = object(TWatchResultValueProcBase)
|
|
protected const
|
|
VKind = rdkFunction;
|
|
end;
|
|
|
|
TWatchResultValueProc = object(TWatchResultValueProcBase)
|
|
protected const
|
|
VKind = rdkProcedure;
|
|
end;
|
|
|
|
TWatchResultValueFuncRef = object(TWatchResultValueProcBase)
|
|
protected const
|
|
VKind = rdkFunctionRef;
|
|
end;
|
|
|
|
TWatchResultValueProcRef = object(TWatchResultValueProcBase)
|
|
protected const
|
|
VKind = rdkProcedureRef;
|
|
end;
|
|
|
|
|
|
|
|
{ TWatchResultStorageOverrides }
|
|
|
|
generic TWatchResultStorageOverrides<_OVERRIDE_DATA> = object
|
|
private type
|
|
TWatchResultStorageOverrideEntry = packed record
|
|
FIndex: integer;
|
|
FData: _OVERRIDE_DATA;
|
|
end;
|
|
TWatchResultStorageOverrideEntries = packed array of TWatchResultStorageOverrideEntry;
|
|
private
|
|
FOverrideEntries: TWatchResultStorageOverrideEntries;
|
|
FOverrideCount: Integer;
|
|
public
|
|
procedure Assign(ASource: TWatchResultStorageOverrides);
|
|
procedure Add(AnIndex: Integer; const AnOverrideData: _OVERRIDE_DATA); inline;
|
|
function Get(AnIndex: Integer; out AnOverrideData: _OVERRIDE_DATA): Boolean;
|
|
procedure Clear; // doesnt yet call afterFree for nested data
|
|
procedure AfterLastAdd;
|
|
end;
|
|
|
|
{ TWatchResultStorageOverridesWithData }
|
|
|
|
generic TWatchResultStorageOverridesWithData<_OVERRIDE_DATA, _ENTRY_DATA> = object(specialize TWatchResultStorageOverrides<_OVERRIDE_DATA>)
|
|
private type
|
|
TEntryDataArray = packed array of _ENTRY_DATA;
|
|
private const
|
|
DATA_OVERRIDE_MARK_B = $D2;
|
|
DATA_OVERRIDE_MARK_W = $D24B;
|
|
DATA_OVERRIDE_MARK_L = $D24B4BD2;
|
|
public
|
|
procedure Add(AnIndex: Integer; var AStoredData: _ENTRY_DATA; const AData: _OVERRIDE_DATA); reintroduce; // inline;
|
|
function Get(AnIndex: Integer; const AStoredData: _ENTRY_DATA; out AData: _OVERRIDE_DATA): Boolean; reintroduce; // inline;
|
|
procedure Clear(var AStoredData: TEntryDataArray; AFirst: Integer = 0); inline;
|
|
procedure Clear(AnIndex: Integer; var AStoredData: _ENTRY_DATA); // inline;
|
|
end;
|
|
|
|
|
|
{ TWatchResultStorage }
|
|
|
|
PWatchResultStorage = ^TWatchResultStorage;
|
|
|
|
TWatchResultStorage = class
|
|
public const
|
|
TAG_CNT = 'Cnt';
|
|
TAG_ERR = 'IsErr';
|
|
TAG_ALL_ERR = 'AllErrLvl';
|
|
protected
|
|
function GetCount: integer; virtual; abstract;
|
|
procedure SetCount(AValue: integer); virtual; abstract;
|
|
procedure SetNestedStorage(AValue: TWatchResultStorage); virtual;
|
|
function GetNestedStorage: TWatchResultStorage; virtual;
|
|
function GetNestedStoragePtr: PWatchResultStorage; virtual;
|
|
procedure Assign(ASource: TWatchResultStorage); virtual; abstract;
|
|
procedure ImportOverrides(ASource: TWatchResultStorage;
|
|
var AnOverrideTemplate: TOverrideTemplateData); virtual;
|
|
public
|
|
function CreateCopy: TWatchResultStorage; //virtual;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); virtual; abstract;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); virtual; abstract;
|
|
|
|
procedure SaveToIndex(AnIndex: Integer;
|
|
AData: TWatchResultData;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); virtual; abstract;
|
|
procedure LoadFromIndex(AnIndex: Integer;
|
|
out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); virtual; abstract;
|
|
property Count: integer read GetCount write SetCount;
|
|
property NestedStorage: TWatchResultStorage read GetNestedStorage write SetNestedStorage;
|
|
property NestedStoragePtr: PWatchResultStorage read GetNestedStoragePtr;
|
|
end;
|
|
TWatchResultStorageClass = class of TWatchResultStorage;
|
|
|
|
TWatchResultDataClassID = (
|
|
wdPrePrint, // TWatchResultDataPrePrinted
|
|
wdString, // TWatchResultDataString
|
|
wdWString, // TWatchResultDataWideString
|
|
wdChar, // TWatchResultDataChar
|
|
wdSNum, // TWatchResultDataSignedNum
|
|
wdUNum, // TWatchResultDataUnSignedNum
|
|
wdPtr, // TWatchResultDataPointer
|
|
wdFloat, // TWatchResultDataFloat
|
|
wdBool, // TWatchResultDataBoolean
|
|
wdEnum, // TWatchResultDataEnum
|
|
wdEnumVal, // TWatchResultDataEnumVal
|
|
wdSet, // TWatchResultDataSet
|
|
wdVar, // TWatchResultDataVariant
|
|
wdPChrStr, // TWatchResultDataPCharOrString
|
|
wdArray, // TWatchResultDataArray
|
|
wdDynA, // TWatchResultDataDynArray
|
|
wdStatA, // TWatchResultDataStatArray
|
|
wdStruct, // TWatchResultDataStruct
|
|
wdStructRef, // TWatchResultDataRefStruct
|
|
wdConverted, // TWatchResultDataConverted
|
|
wdFunc, // TWatchResultDataFunc,
|
|
wdProc, // TWatchResultDataProc,
|
|
wdFuncRef, // TWatchResultDataFuncRef,
|
|
wdProcRef, // TWatchResultDataProcRef,
|
|
wdMemDump, // TWatchResultDataMemDump
|
|
wdErr // TWatchResultDataError
|
|
);
|
|
|
|
//TWatchResultDataFlag = (wdfNoData);
|
|
//TWatchResultDataFlags = set of TWatchResultDataFlag;
|
|
|
|
TWatchResultDataFieldInfo = record
|
|
FieldName: String;
|
|
FieldVisibility: TLzDbgFieldVisibility;
|
|
FieldFlags: TLzDbgFieldFlags;
|
|
Field: TWatchResultData;
|
|
Owner: TWatchResultData; // defined in class
|
|
end;
|
|
|
|
{ TWatchResultDataEnumerator }
|
|
|
|
TWatchResultDataEnumerator = class
|
|
private
|
|
FSource: TWatchResultData;
|
|
FIndex: Integer;
|
|
function GetCurrent: TWatchResultDataFieldInfo; virtual;
|
|
public
|
|
constructor Create(ARes: TWatchResultData);
|
|
function MoveNext: Boolean; virtual;
|
|
property Current: TWatchResultDataFieldInfo read GetCurrent;
|
|
end;
|
|
|
|
//TWatchResultDataEnumerator = class
|
|
|
|
{ TWatchResultData }
|
|
|
|
TWatchResultData = class abstract(TObject, IWatchResultDataIntf)
|
|
private
|
|
FTypeName: String;
|
|
// FDataFlags: TWatchResultDataFlags;
|
|
// Addr: TDbgPtr;
|
|
// MemDump
|
|
function GetBackendValueHandler: ILazDbgValueConverterIntf; virtual;
|
|
function GetClassID: TWatchResultDataClassID; virtual; //abstract;
|
|
function GetInternalObject: TObject;
|
|
protected
|
|
class function GetStorageClass: TWatchResultStorageClass; virtual; abstract;
|
|
function CreateStorage: TWatchResultStorage; virtual; abstract;
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage;
|
|
ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False
|
|
): boolean; virtual; abstract;
|
|
|
|
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); virtual;
|
|
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); virtual;
|
|
procedure ClearData; virtual; abstract;
|
|
protected
|
|
function GetValueKind: TWatchResultDataKind; virtual; //abstract;
|
|
function GetTypeName: String; virtual;
|
|
function GetIsFullDephtEvaluated: Boolean; virtual;
|
|
|
|
function GetAsString: RawByteString; virtual; abstract;
|
|
function GetAsDesc: String; virtual; abstract;
|
|
function GetAsWideString: WideString; virtual; abstract;
|
|
function GetAsQWord: QWord; virtual; abstract;
|
|
function GetAsInt64: Int64; virtual; abstract;
|
|
function GetAsSingle: Single; virtual; abstract;
|
|
function GetAsDouble: Double; virtual; abstract;
|
|
function GetAsExtended: TDbgExtended; virtual; abstract;
|
|
function GetAsFloat: Extended; virtual; abstract; deprecated;
|
|
|
|
function GetByteSize: Integer; virtual; abstract;
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; virtual; abstract;
|
|
function GetCount: Integer; virtual; abstract;
|
|
function GetLength: Integer; virtual; abstract;
|
|
function GetElementName(AnIndex: integer): String; virtual; abstract;
|
|
function GetDerefData: TWatchResultData; virtual; abstract;
|
|
function GetDerefDataIntf: IWatchResultDataIntf;
|
|
function GetNestedType: TWatchResultData; virtual; abstract;
|
|
|
|
function GetArrayType: TLzDbgArrayType; virtual; abstract;
|
|
function GetBoundType: TWatchResultData; virtual; abstract;
|
|
function GetBoundTypeIntf: IWatchResultDataIntf;
|
|
function GetLowBound: Int64; virtual; abstract;
|
|
function GetSelectedEntry: TWatchResultData; virtual; abstract;
|
|
function GetSelectedEntryIntf: IWatchResultDataIntf;
|
|
function GetDataAddress: TDBGPtr; virtual; abstract;
|
|
function GetHasDataAddress: Boolean; virtual;
|
|
|
|
function GetStructType: TLzDbgStructType; virtual; abstract;
|
|
function GetAnchestor: TWatchResultData; virtual; abstract;
|
|
function GetAnchestorCount: Integer; virtual; abstract;
|
|
function GetAnchestors(AnIndex: Integer): TWatchResultData; virtual; abstract;
|
|
function GetAnchestorIntf: IWatchResultDataIntf;
|
|
function GetAnchestorsIntf(AnIndex: Integer): IWatchResultDataIntf;
|
|
function GetDirectFieldCount: Integer; virtual; abstract;
|
|
function GetFieldCount: Integer; virtual; abstract;
|
|
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; virtual; abstract;
|
|
function GetFieldsIntf(AnIndex: Integer): TWatchResultDataFieldInfoIntf;
|
|
function GetConvertedRes: TWatchResultData; virtual;
|
|
|
|
function GetFieldVisibility: TLzDbgFieldVisibility; virtual; abstract;
|
|
|
|
public
|
|
constructor CreateEmpty;
|
|
class function CreateFromXMLConfig(const AConfig: TXMLConfig; const APath: string): TWatchResultData; overload;
|
|
class function CreateFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean = False): TWatchResultData; overload;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean = False); virtual;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean = False); virtual;
|
|
procedure Assign(ASource: TWatchResultData; ATypeOnly: Boolean = False); virtual;
|
|
function CreateCopy(ATypeOnly: Boolean = False): TWatchResultData;
|
|
|
|
(* HandleExpressionSuffix
|
|
if a value other than "self" is returned, the caller is responsible to free it
|
|
*)
|
|
function HandleExpressionSuffix(ASuffix: String): TWatchResultData; virtual;
|
|
|
|
function GetEnumerator: TWatchResultDataEnumerator; virtual;
|
|
public
|
|
property ValueKind: TWatchResultDataKind read GetValueKind;
|
|
property TypeName: String read GetTypeName;
|
|
property IsFullDephtEvaluated: Boolean read GetIsFullDephtEvaluated;
|
|
|
|
property AsString: RawByteString read GetAsString;
|
|
property AsDesc: String read GetAsDesc;
|
|
property AsWideString: WideString read GetAsWideString;
|
|
property AsQWord: QWord read GetAsQWord;
|
|
property AsInt64: Int64 read GetAsInt64;
|
|
property AsSingle: Single read GetAsSingle;
|
|
property AsDouble: Double read GetAsDouble;
|
|
property AsExtended: TDbgExtended read GetAsExtended;
|
|
property AsFloat: Extended read GetAsFloat; deprecated;
|
|
|
|
property ByteSize: Integer read GetByteSize;
|
|
property FloatPrecission: TLzDbgFloatPrecission read GetFloatPrecission;
|
|
property DerefData: TWatchResultData read GetDerefData;
|
|
property NestedType: TWatchResultData read GetNestedType; // NESTED TYPE FOR NESTED STORAGE
|
|
|
|
property ElementName[AnIndex: Integer]: String read GetElementName;
|
|
property BackendValueHandler: ILazDbgValueConverterIntf read GetBackendValueHandler;
|
|
|
|
// Array
|
|
property ArrayType: TLzDbgArrayType read GetArrayType;
|
|
property LowBound: Int64 read GetLowBound;
|
|
property Count: Integer read GetCount; // Count of Entries evaluated
|
|
property ArrayLength: Integer read GetLength; // Declared Length
|
|
property BoundType: TWatchResultData read GetBoundType;
|
|
procedure SetSelectedIndex(AnIndex: Integer); virtual;
|
|
property SelectedEntry: TWatchResultData read GetSelectedEntry;
|
|
|
|
property DataAddress: TDBGPtr read GetDataAddress;
|
|
property HasDataAddress: Boolean read GetHasDataAddress;
|
|
|
|
// Struct
|
|
property StructType: TLzDbgStructType read GetStructType;
|
|
// property StructFlags: TLzDbgStructFlags read FStructFlags;
|
|
property Anchestor: TWatchResultData read GetAnchestor;
|
|
property AnchestorCount: Integer read GetAnchestorCount;
|
|
property Anchestors[AnIndex: Integer]: TWatchResultData read GetAnchestors;
|
|
|
|
property FieldCount: Integer read GetFieldCount;
|
|
property DirectFieldCount: Integer read GetDirectFieldCount; // without inherited fields
|
|
property Fields[AnIndex: Integer]: TWatchResultDataFieldInfo read GetFields;
|
|
|
|
property ConvertedRes: TWatchResultData read GetConvertedRes;
|
|
|
|
// variant
|
|
property FieldVisibility: TLzDbgFieldVisibility read GetFieldVisibility;
|
|
end;
|
|
TWatchResultDataClass = class of TWatchResultData;
|
|
|
|
{ TWatchResultDataEx - Declare Setters for TCurrentResData }
|
|
|
|
TWatchResultDataEx = class(TWatchResultData)
|
|
public
|
|
procedure SetTypeName(ATypeName: String);
|
|
procedure SetDerefData(ADerefData: TWatchResultData); virtual;
|
|
procedure SetDataAddress(AnAddr: TDbgPtr); virtual;
|
|
|
|
procedure SetEntryPrototype(AnEntry: TWatchResultData); virtual;
|
|
procedure WriteEntryToStorage(AnIndex: Integer); virtual;
|
|
procedure WriteValueToStorage(AnIndex: Integer; AValue: TWatchResultData); virtual;
|
|
procedure SetEntryCount(ACount: Integer); virtual;
|
|
|
|
procedure SetAnchestor(AnAnchestor: TWatchResultData); virtual;
|
|
procedure SetFieldCount(ACount: integer); virtual;
|
|
procedure SetField(AnIndex: Integer;
|
|
AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility;
|
|
AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData
|
|
); virtual;
|
|
function AddField(AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility;
|
|
AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData
|
|
): Integer;virtual;
|
|
procedure SetFieldData(AnIndex: Integer; AData: TWatchResultData); virtual;
|
|
end;
|
|
|
|
|
|
{ TGenericWatchResultData }
|
|
|
|
generic TGenericWatchResultData<_DATA> = class(TWatchResultDataEx)
|
|
protected type
|
|
{ TGenericBasicWatchResultStorage }
|
|
|
|
TGenericBasicWatchResultStorage = class(TWatchResultStorage)
|
|
strict private type
|
|
TDataArray = packed array of _DATA;
|
|
protected
|
|
FDataArray: TDataArray;
|
|
protected
|
|
function GetCount: integer; override;
|
|
procedure SetCount(AValue: integer); override;
|
|
procedure AssignDataArray(ASource: TWatchResultStorage); virtual;
|
|
procedure Assign(ASource: TWatchResultStorage); override;
|
|
procedure ImportOverrides(ASource: TWatchResultStorage;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
public
|
|
destructor Destroy; override; // DoFree() for items
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
|
|
|
|
procedure SaveToIndex(AnIndex: Integer;
|
|
AData: TWatchResultData;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
procedure LoadFromIndex(AnIndex: Integer;
|
|
out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
end;
|
|
|
|
{ TGenericWatchResultStorage }
|
|
|
|
TGenericWatchResultStorage = class(TGenericBasicWatchResultStorage)
|
|
private type
|
|
_ERROR_DATA = TWatchResultValueError;
|
|
_ERROR_CLASS = TWatchResultDataError;
|
|
TErrorStorage = specialize TWatchResultStorageOverridesWithData<_ERROR_DATA, _DATA>;
|
|
strict private
|
|
FErrorStore: TErrorStorage;
|
|
protected
|
|
procedure SetCount(AValue: integer); override;
|
|
procedure AssignDataArray(ASource: TWatchResultStorage); override;
|
|
procedure Assign(ASource: TWatchResultStorage); override;
|
|
procedure ImportOverrides(ASource: TWatchResultStorage;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
|
|
|
|
procedure SaveToIndex(AnIndex: Integer;
|
|
AData: TWatchResultData;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
procedure LoadFromIndex(AnIndex: Integer;
|
|
out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
end;
|
|
|
|
{ TGenericNestedWatchResultStorage }
|
|
|
|
TGenericNestedWatchResultStorage = class(TGenericWatchResultStorage)
|
|
private
|
|
FNestedStorage: TWatchResultStorage;
|
|
protected
|
|
procedure SetCount(AValue: integer); override;
|
|
function GetNestedStorage: TWatchResultStorage; override;
|
|
procedure SetNestedStorage(AValue: TWatchResultStorage); override;
|
|
function GetNestedStoragePtr: PWatchResultStorage; override;
|
|
procedure Assign(ASource: TWatchResultStorage); override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
|
|
end;
|
|
|
|
{ TGenericWatchResultData }
|
|
private
|
|
FData: _DATA;
|
|
protected
|
|
class function GetStorageClass: TWatchResultStorageClass; override;
|
|
function CreateStorage: TWatchResultStorage; override;
|
|
class procedure UpdateStorage(AStorage: PWatchResultStorage;
|
|
const AData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage;
|
|
ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False
|
|
): boolean; override;
|
|
procedure ClearData; override;
|
|
protected
|
|
function GetValueKind: TWatchResultDataKind; override;
|
|
function GetIsFullDephtEvaluated: Boolean; override;
|
|
|
|
function GetAsString: RawByteString; override;
|
|
function GetAsDesc: String; override;
|
|
function GetAsWideString: WideString; override;
|
|
function GetAsQWord: QWord; override;
|
|
function GetAsInt64: Int64; override;
|
|
function GetAsSingle: Single; override;
|
|
function GetAsDouble: Double; override;
|
|
function GetAsExtended: TDbgExtended; override;
|
|
function GetAsFloat: Extended; override; deprecated;
|
|
|
|
function GetByteSize: Integer; override;
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; override;
|
|
function GetCount: Integer; override;
|
|
function GetLength: Integer; override;
|
|
function GetElementName(AnIndex: integer): String; override;
|
|
function GetDerefData: TWatchResultData; override;
|
|
function GetNestedType: TWatchResultData; override;
|
|
|
|
function GetArrayType: TLzDbgArrayType; override;
|
|
function GetBoundType: TWatchResultData; override;
|
|
function GetLowBound: Int64; override;
|
|
function GetSelectedEntry: TWatchResultData; override;
|
|
function GetDataAddress: TDBGPtr; override;
|
|
|
|
function GetStructType: TLzDbgStructType; override;
|
|
function GetAnchestor: TWatchResultData; override; // TODO move to With_Type
|
|
function GetAnchestorCount: Integer; override;
|
|
function GetAnchestors(AnIndex: Integer): TWatchResultData; override;
|
|
function GetDirectFieldCount: Integer; override;
|
|
function GetFieldCount: Integer; override;
|
|
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; override;
|
|
|
|
function GetFieldVisibility: TLzDbgFieldVisibility; override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean = False); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean = False); override;
|
|
procedure Assign(ASource: TWatchResultData; ATypeOnly: Boolean = False); override;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataWithType }
|
|
|
|
generic TGenericWatchResultDataWithType<_DATA, _TYPE> = class(specialize TGenericWatchResultData<_DATA>)
|
|
private
|
|
FType: _TYPE;
|
|
protected
|
|
function GetByteSize: Integer; override;
|
|
function GetFloatPrecission: TLzDbgFloatPrecission; override;
|
|
|
|
function GetNestedType: TWatchResultData; override;
|
|
function GetBoundType: TWatchResultData; override;
|
|
function GetLowBound: Int64; override;
|
|
function GetSelectedEntry: TWatchResultData; override;
|
|
|
|
function GetStructType: TLzDbgStructType; override;
|
|
function GetAnchestor: TWatchResultData; override;
|
|
function GetDirectFieldCount: Integer; override;
|
|
function GetFieldCount: Integer; override;
|
|
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean = False); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean = False); override;
|
|
procedure Assign(ASource: TWatchResultData; ATypeOnly: Boolean = False); override;
|
|
end;
|
|
|
|
{ TWatchResultDataPrePrinted }
|
|
|
|
TWatchResultDataPrePrinted = class(specialize TGenericWatchResultData<TWatchResultValuePrePrinted>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(APrintedVal: String);
|
|
end;
|
|
|
|
{ TWatchResultDataMemDump }
|
|
|
|
TWatchResultDataMemDump = class(specialize TGenericWatchResultData<TWatchResultValueMemDump>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetHasDataAddress: Boolean; override;
|
|
function GetDataAddress: TDBGPtr; override;
|
|
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
|
public
|
|
constructor Create(APrintedVal: RawByteString);
|
|
end;
|
|
|
|
{ TWatchResultDataString }
|
|
|
|
TWatchResultDataString = class(specialize TGenericWatchResultData<TWatchResultValueString>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetHasDataAddress: Boolean; override;
|
|
function GetDataAddress: TDBGPtr; override;
|
|
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
|
public
|
|
constructor Create(AStringVal: String);
|
|
end;
|
|
|
|
{ TWatchResultDataWideString }
|
|
|
|
TWatchResultDataWideString = class(specialize TGenericWatchResultData<TWatchResultValueWideString>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetHasDataAddress: Boolean; override;
|
|
function GetDataAddress: TDBGPtr; override;
|
|
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
|
public
|
|
constructor Create(AStringVal: WideString);
|
|
end;
|
|
|
|
{ TGenericWatchResultDataSizedNum }
|
|
|
|
generic TGenericWatchResultDataSizedNum<_DATA> = class(specialize TGenericWatchResultDataWithType<_DATA, TWatchResultTypeOrdNum>)
|
|
protected
|
|
function GetAsQWord: QWord; override;
|
|
function GetAsInt64: Int64; override;
|
|
end;
|
|
|
|
{ TWatchResultDataChar }
|
|
|
|
TWatchResultDataChar = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueChar>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(ANumValue: QWord; AByteSize: Integer = 0);
|
|
end;
|
|
|
|
{ TWatchResultDataSignedNum }
|
|
|
|
TWatchResultDataSignedNum = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueSignedNum>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(ANumValue: Int64; AByteSize: Integer = 0);
|
|
end;
|
|
|
|
{ TWatchResultDataUnSignedNum }
|
|
|
|
TWatchResultDataUnSignedNum = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueUnsignedNum>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(ANumValue: QWord; AByteSize: Integer = 0);
|
|
end;
|
|
|
|
{ TWatchResultDataPointer }
|
|
|
|
TWatchResultDataPointer = class(specialize TGenericWatchResultDataWithType<TWatchResultValuePointer, TWatchResultTypePointer>)
|
|
private
|
|
FCurrentDerefData: TWatchResultData; // needed if this is an array element
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetIsFullDephtEvaluated: Boolean; override;
|
|
function GetHasDataAddress: Boolean; override;
|
|
function GetAsString: RawByteString; override;
|
|
function GetDerefData: TWatchResultData; override;
|
|
class function GetStorageClass: TWatchResultStorageClass; override;
|
|
function CreateStorage: TWatchResultStorage; override;
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage; ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False): boolean;
|
|
override;
|
|
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData
|
|
); override;
|
|
procedure ClearData; override;
|
|
public
|
|
procedure SetDerefData(ADerefData: TWatchResultData); override;
|
|
public
|
|
constructor Create(AnAddr: TDBGPtr);
|
|
end;
|
|
|
|
{ TWatchResultDataFloat }
|
|
|
|
TWatchResultDataFloat = class(specialize TGenericWatchResultDataWithType<TWatchResultValueFloat, TWatchResultTypeFloat>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission);
|
|
end;
|
|
|
|
{ TWatchResultDataFloatSized }
|
|
|
|
//generic TWatchResultDataFloatSized<TFLOAT> = class(specialize TGenericWatchResultData<specialize TGenericWatchResultValueFloat<TFLOAT> >)
|
|
generic TWatchResultDataFloatSized<_DATA> = class(specialize TGenericWatchResultData<_DATA>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
end;
|
|
|
|
{ TWatchResultDataSingle }
|
|
|
|
TWatchResultDataSingle = class(specialize TWatchResultDataFloatSized<TWatchResultValueSingle>)
|
|
public
|
|
constructor Create(AFloatValue: Single);
|
|
end;
|
|
|
|
{ TWatchResultDataDouble }
|
|
|
|
TWatchResultDataDouble = class(specialize TWatchResultDataFloatSized<TWatchResultValueDouble>)
|
|
public
|
|
constructor Create(AFloatValue: Double);
|
|
end;
|
|
|
|
{ TWatchResultDataExtended }
|
|
|
|
TWatchResultDataExtended = class(specialize TWatchResultDataFloatSized<TWatchResultValueExtended>)
|
|
public
|
|
constructor Create(AFloatValue: TDbgExtended);
|
|
end;
|
|
|
|
{ TWatchResultDataBoolean }
|
|
|
|
TWatchResultDataBoolean = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueBoolean>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(AnOrdBoolValue: QWord; AByteSize: Integer = 0);
|
|
constructor Create(ABoolValue: Boolean);
|
|
end;
|
|
|
|
{ TWatchResultDataEnum }
|
|
|
|
TWatchResultDataEnum = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueEnum>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(ANumValue: QWord; AName: String; AByteSize: Integer = 0);
|
|
end;
|
|
|
|
{ TWatchResultDataEnumVal }
|
|
|
|
TWatchResultDataEnumVal = class(specialize TGenericWatchResultDataSizedNum<TWatchResultValueEnumVal>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(ANumValue: QWord; AName: String; AByteSize: Integer = 0);
|
|
end;
|
|
|
|
{ TWatchResultDataSet }
|
|
|
|
TWatchResultDataSet = class(specialize TGenericWatchResultData<TWatchResultValueSet>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(const ANames: TStringDynArray);
|
|
end;
|
|
|
|
{ TWatchResultDataVariant }
|
|
|
|
TWatchResultDataVariant = class(specialize TGenericWatchResultData<TWatchResultValueVariant>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetFieldVisibility: TLzDbgFieldVisibility; override;
|
|
public
|
|
constructor Create(AName: String; AVisibility: TLzDbgFieldVisibility);
|
|
procedure SetDerefData(ADerefData: TWatchResultData); override;
|
|
end;
|
|
|
|
{ TWatchResultDataArrayBase }
|
|
|
|
generic TWatchResultDataArrayBase<_DATA, _TYPE> = class(specialize TGenericWatchResultDataWithType<_DATA, _TYPE>)
|
|
private
|
|
FCurrentElement: TWatchResultData;
|
|
FOverrideTemplateData: TOverrideTemplateData;
|
|
protected
|
|
function GetIsFullDephtEvaluated: Boolean; override;
|
|
public
|
|
procedure SetEntryPrototype(AnEntry: TWatchResultData); override;
|
|
procedure WriteValueToStorage(AnIndex: Integer; AValue: TWatchResultData); override;
|
|
procedure SetEntryCount(ACount: Integer); override;
|
|
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage; ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False): boolean;
|
|
override;
|
|
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage;
|
|
AnIndex: Integer; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure ClearData; override;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AnAsProto: Boolean = False); override;
|
|
procedure Assign(ASource: TWatchResultData; ATypeOnly: Boolean = False); override;
|
|
procedure SetSelectedIndex(AnIndex: Integer); override; // ReadEntryFromStorage
|
|
function GetSelectedEntry: TWatchResultData; override;
|
|
end;
|
|
|
|
{ TWatchResultDataPCharOrString }
|
|
|
|
TWatchResultDataPCharOrString = class(specialize TWatchResultDataArrayBase<TWatchResultValuePCharOrString, TWatchResultTypeArrayBase>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetIsFullDephtEvaluated: Boolean; override;
|
|
public
|
|
procedure SetEntryPrototype(AnEntry: TWatchResultData); override;
|
|
end;
|
|
|
|
{ TWatchResultDataArray }
|
|
|
|
TWatchResultDataArray = class(specialize TWatchResultDataArrayBase<TWatchResultValueUnknowArray, TWatchResultTypeArray>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetArrayType: TLzDbgArrayType; override;
|
|
function GetLowBound: Int64; override;
|
|
// ReadDataFromStorage should also procedure SetSelectedIndex(0) ???
|
|
public
|
|
constructor Create(ALength: Integer; ALowBound: Int64);
|
|
end;
|
|
|
|
{ TWatchResultDataDynArray }
|
|
|
|
TWatchResultDataDynArray = class(specialize TWatchResultDataArrayBase<TWatchResultValueDynArray, TWatchResultTypeArray>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetArrayType: TLzDbgArrayType; override;
|
|
function GetHasDataAddress: Boolean; override;
|
|
public
|
|
constructor Create(ALength: Integer);
|
|
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
|
end;
|
|
|
|
{ TWatchResultDataStatArray }
|
|
|
|
TWatchResultDataStatArray = class(specialize TWatchResultDataArrayBase<TWatchResultValueStatArray, TWatchResultTypeStatArray>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetArrayType: TLzDbgArrayType; override;
|
|
function GetDataAddress: TDBGPtr; override;
|
|
function GetLength: Integer; override;
|
|
public
|
|
constructor Create(ALength: Integer; ALowBound: Int64);
|
|
end;
|
|
|
|
|
|
|
|
{ TGenericWatchResultDataStruct }
|
|
|
|
generic TGenericWatchResultDataStruct<_DATA, _TYPE> = class(specialize TGenericWatchResultDataWithType<_DATA, _TYPE>)
|
|
private type
|
|
{ TWatchResultDataStructVariantEnumerator }
|
|
|
|
TWatchResultDataStructVariantEnumerator = class(TWatchResultDataEnumerator)
|
|
protected
|
|
function GetCurrent: TWatchResultDataFieldInfo; override;
|
|
public
|
|
constructor Create(ARes: TWatchResultData);
|
|
function MoveNext: Boolean; override;
|
|
end;
|
|
|
|
|
|
{ TWatchResultDataStructEnumerator }
|
|
|
|
TWatchResultDataStructEnumerator = class(TWatchResultDataEnumerator)
|
|
private
|
|
FSubEnumerator: TWatchResultDataStructVariantEnumerator;
|
|
FSubOwner: TWatchResultData;
|
|
protected
|
|
function GetCurrent: TWatchResultDataFieldInfo; override;
|
|
public
|
|
constructor Create(ARes: TWatchResultData);
|
|
function MoveNext: Boolean; override;
|
|
end;
|
|
|
|
{ TNestedFieldsWatchResultStorage }
|
|
|
|
TNestedFieldsWatchResultStorage = class(TGenericWatchResultStorage)
|
|
private
|
|
FFieldsStorage: array of TWatchResultStorage;
|
|
FOverrideTempl: array of TOverrideTemplateData;
|
|
function GetStoredFieldCount: Integer;
|
|
procedure SetStoredFieldCount(AValue: Integer);
|
|
protected
|
|
procedure SetCount(AValue: integer); override;
|
|
procedure Assign(ASource: TWatchResultStorage); override;
|
|
|
|
function GetNestedStorage(AnIndex: Integer): TWatchResultStorage; reintroduce;
|
|
function GetNestedStoragePtr(AnIndex: Integer): PWatchResultStorage; reintroduce;
|
|
procedure SetNestedStorage(AnIndex: Integer; AValue: TWatchResultStorage); reintroduce;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
|
|
|
|
property NestedStorage[AnIndex: Integer]: TWatchResultStorage read GetNestedStorage write SetNestedStorage;
|
|
property NestedStoragePtr[AnIndex: Integer]: PWatchResultStorage read GetNestedStoragePtr;
|
|
property StoredFieldCount: Integer read GetStoredFieldCount write SetStoredFieldCount;
|
|
end;
|
|
PNestedFieldsWatchResultStorage = ^TNestedFieldsWatchResultStorage;
|
|
|
|
private
|
|
FCurrentFields: array of TWatchResultData;
|
|
FHasFields: Boolean;
|
|
protected
|
|
class function GetStorageClass: TWatchResultStorageClass; override;
|
|
function CreateStorage: TWatchResultStorage; override;
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage; ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False): boolean;
|
|
override;
|
|
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage;
|
|
AnIndex: Integer; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure ClearData; override;
|
|
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; override;
|
|
public
|
|
function GetEnumerator: TWatchResultDataEnumerator; override;
|
|
|
|
procedure SetFieldCount(ACount: integer); override;
|
|
procedure SetField(AnIndex: Integer;
|
|
AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility;
|
|
AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData
|
|
); override;
|
|
function AddField(AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility;
|
|
AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData
|
|
): Integer; override;
|
|
procedure SetFieldData(AnIndex: Integer; AData: TWatchResultData); override;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStructWithAnchestor }
|
|
|
|
generic TGenericWatchResultDataStructWithAnchestor<_DATA, _TYPE> = class(specialize TGenericWatchResultDataStruct<_DATA, _TYPE>)
|
|
private type
|
|
|
|
{ TNestedFieldsAndAnchestorWatchResultStorage }
|
|
|
|
TNestedFieldsAndAnchestorWatchResultStorage = class(TNestedFieldsWatchResultStorage)
|
|
private
|
|
FAnchestorStorage: TWatchResultStorage;
|
|
protected
|
|
procedure SetCount(AValue: integer); override;
|
|
procedure Assign(ASource: TWatchResultStorage); override;
|
|
|
|
function GetNestedStorage(AnIndex: Integer): TWatchResultStorage; reintroduce;
|
|
function GetNestedStoragePtr(AnIndex: Integer): PWatchResultStorage; reintroduce;
|
|
procedure SetNestedStorage(AnIndex: Integer; AValue: TWatchResultStorage); reintroduce;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
ANestLvl: Integer=0); override;
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
|
|
|
|
property NestedStorage[AnIndex: Integer]: TWatchResultStorage read GetNestedStorage write SetNestedStorage;
|
|
property NestedStoragePtr[AnIndex: Integer]: PWatchResultStorage read GetNestedStoragePtr;
|
|
property StoredFieldCount: Integer read GetStoredFieldCount write SetStoredFieldCount;
|
|
end;
|
|
PNestedFieldsAndAnchestorWatchResultStorage = ^TNestedFieldsAndAnchestorWatchResultStorage;
|
|
|
|
private
|
|
FCurrentAnchestor: TWatchResultData;
|
|
protected
|
|
class function GetStorageClass: TWatchResultStorageClass; override;
|
|
function CreateStorage: TWatchResultStorage; override;
|
|
function MaybeUpdateProto(var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData;
|
|
AStorage: PWatchResultStorage; ARecurse: boolean = False;
|
|
ASkipStorage: boolean = False): boolean;
|
|
override;
|
|
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage;
|
|
AnIndex: Integer; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
procedure ClearData; override;
|
|
function GetAnchestor: TWatchResultData; override;
|
|
public
|
|
procedure SetAnchestor(AnAnchestor: TWatchResultData); override;
|
|
end;
|
|
|
|
{ TWatchResultDataStruct }
|
|
|
|
TWatchResultDataStruct = class(specialize TGenericWatchResultDataStructWithAnchestor<TWatchResultValueStruct, TWatchResultTypeStruct>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
public
|
|
constructor Create(AStructType: TLzDbgStructType);
|
|
end;
|
|
|
|
{ TWatchResultDataRefStruct }
|
|
|
|
TWatchResultDataRefStruct = class(specialize TGenericWatchResultDataStructWithAnchestor<TWatchResultValueStructWithRef, TWatchResultTypeStruct>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetHasDataAddress: Boolean; override;
|
|
public
|
|
constructor Create(AStructType: TLzDbgStructType;
|
|
ADataAddress: TDBGPtr
|
|
);
|
|
end;
|
|
|
|
{ TWatchResultDataConverted }
|
|
|
|
TWatchResultDataConverted = class(specialize TGenericWatchResultDataStruct<TWatchResultValueConverted, TWatchResultTypeConverted>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
function GetBackendValueHandler: ILazDbgValueConverterIntf; override;
|
|
function GetConvertedRes: TWatchResultData; override;
|
|
public
|
|
constructor Create(AHandler: ILazDbgValueConverterIntf);
|
|
end;
|
|
|
|
{ TGenericWatchResultDataProc }
|
|
|
|
generic TGenericWatchResultDataProc<_DATA> = class(specialize TGenericWatchResultDataWithType<_DATA, TWatchResultTypeProc>)
|
|
protected
|
|
function GetAsString: RawByteString; override; // TODO
|
|
function GetAsDesc: String; override;
|
|
public
|
|
constructor Create(AnAddr: QWord; ALoc, ADesc: String);
|
|
end;
|
|
|
|
{ TWatchResultDataFunc }
|
|
|
|
TWatchResultDataFunc = class(specialize TGenericWatchResultDataProc<TWatchResultValueFunc>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
end;
|
|
|
|
{ TWatchResultDataProc }
|
|
|
|
TWatchResultDataProc = class(specialize TGenericWatchResultDataProc<TWatchResultValueProc>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
end;
|
|
|
|
{ TWatchResultDataFuncRef }
|
|
|
|
TWatchResultDataFuncRef = class(specialize TGenericWatchResultDataProc<TWatchResultValueFuncRef>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
end;
|
|
|
|
{ TWatchResultDataProcRef }
|
|
|
|
TWatchResultDataProcRef = class(specialize TGenericWatchResultDataProc<TWatchResultValueProcRef>)
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{ TWatchResultDataError }
|
|
|
|
TWatchResultDataError = class(specialize TGenericWatchResultData<TWatchResultValueError>)
|
|
private type
|
|
|
|
{ TErrorDataStorage }
|
|
|
|
TErrorDataStorage = class(TGenericBasicWatchResultStorage)
|
|
public
|
|
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; ANestLvl: Integer = 0); override;
|
|
procedure LoadFromIndex(AnIndex: Integer; out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData); override;
|
|
end;
|
|
private
|
|
function GetClassID: TWatchResultDataClassID; override;
|
|
protected
|
|
class function GetStorageClass: TWatchResultStorageClass; override;
|
|
public
|
|
constructor Create(APrintedVal: String);
|
|
end;
|
|
|
|
function dbgs(AResKind: TWatchResultDataKind): String; overload;
|
|
|
|
|
|
function FloatToStr(Value: TDbgExtended; const FormatSettings: TFormatSettings): String; overload;
|
|
var
|
|
_TGenericWatchResultValueFloat_FPointSettings: TFormatSettings; // generics force this to be in interface
|
|
|
|
|
|
implementation
|
|
|
|
function dbgs(AResKind: TWatchResultDataKind): String;
|
|
begin
|
|
WriteStr(Result, AResKind);
|
|
end;
|
|
|
|
const
|
|
WatchResNameToClass: array [TWatchResultDataClassID] of TWatchResultDataClass = (
|
|
TWatchResultDataPrePrinted, // wdPrePrint
|
|
TWatchResultDataString, // wdString
|
|
TWatchResultDataWideString, // wdWString
|
|
TWatchResultDataChar, // wdChar
|
|
TWatchResultDataSignedNum, // wdSNum
|
|
TWatchResultDataUnSignedNum, // wdUNum
|
|
TWatchResultDataPointer, // wdPtr
|
|
TWatchResultDataFloat, // wdFloat
|
|
TWatchResultDataBoolean, // wdBool
|
|
TWatchResultDataEnum, // wdEnum
|
|
TWatchResultDataEnumVal, // wdEnumVal
|
|
TWatchResultDataSet, // wdSet
|
|
TWatchResultDataVariant, // wdVar
|
|
TWatchResultDataPCharOrString, // wdPChrStr
|
|
TWatchResultDataArray, // wdArray,
|
|
TWatchResultDataDynArray, // wdDynA,
|
|
TWatchResultDataStatArray, // wdStatA,
|
|
TWatchResultDataStruct, // wdStruct
|
|
TWatchResultDataRefStruct, // wdStructRef
|
|
TWatchResultDataConverted, // wdConverted
|
|
TWatchResultDataFunc, // wdFunc
|
|
TWatchResultDataProc, // wdProc
|
|
TWatchResultDataFuncRef, // wdFuncRef
|
|
TWatchResultDataProcRef, // wdProcRef
|
|
TWatchResultDataMemDump, // wdMemDump
|
|
TWatchResultDataError // wdErr
|
|
);
|
|
|
|
{ TWatchResultValue }
|
|
|
|
function TWatchResultValue.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsString: RawByteString;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsWideString: WideString;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsQWord: QWord;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsInt64: Int64;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsSingle: Single;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsDouble: Double;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsExtended: TDbgExtended;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAsFloat: Extended;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetByteSize: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := dfpSingle;
|
|
end;
|
|
|
|
function TWatchResultValue.GetLowBound: Int64;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetLength: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetElementName(AnIndex: integer): String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TWatchResultValue.GetDerefData: TWatchResultData;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchResultValue.GetBoundType: TWatchResultData;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchResultValue.GetEntryTemplate: TWatchResultData;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchResultValue.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetStructType: TLzDbgStructType;
|
|
begin
|
|
Result := dstUnknown;
|
|
end;
|
|
|
|
function TWatchResultValue.GetAnchestor: TWatchResultData;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchResultValue.GetFieldCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWatchResultValue.GetField(AnIndex: Integer): TWatchResultData;
|
|
begin
|
|
Result := Nil;
|
|
end;
|
|
|
|
function TWatchResultValue.GetFieldInfo(AnIndex: Integer
|
|
): PWatchResultTypeStructFieldInfo;
|
|
begin
|
|
Result := Nil;
|
|
end;
|
|
|
|
procedure TWatchResultValue.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultValue.DoFree;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultValue.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultValue.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
{ TWatchResultValueTextBase }
|
|
|
|
function TWatchResultValueTextBase.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TWatchResultValueTextBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FText := AConfig.GetValue(APath + 'Value', '');
|
|
end;
|
|
|
|
procedure TWatchResultValueTextBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Value', FText);
|
|
end;
|
|
|
|
{ TWatchResultDataMemDump }
|
|
|
|
function TWatchResultValueMemDump.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TWatchResultValueMemDump.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
var
|
|
t: RawByteString;
|
|
i, d: Integer;
|
|
c: Char;
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
|
|
t := AConfig.GetValue(APath + 'Value', '');
|
|
SetLength(FText, Length(t) div 2);
|
|
for i := 1 to Length(FText) do begin
|
|
c := t[i*2-1];
|
|
if c in ['0'..'9'] then d := ord(c) - ord('0')
|
|
else d := ord(c) - ord('A');
|
|
d := d * 16;
|
|
c := t[i*2];
|
|
if c in ['0'..'9'] then d := d + ord(c) - ord('0')
|
|
else d := d + ord(c) - ord('A');
|
|
FText[i] := char(d and 255);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultValueMemDump.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
const
|
|
HDIG = '0123456789ABCDEF';
|
|
var
|
|
t: RawByteString;
|
|
i: Integer;
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
SetLength(t, Length(FText)*2);
|
|
for i := 1 to Length(FText) do begin
|
|
t[i*2-1] := HDIG[(ord(FText[i]) div 16)+1];
|
|
t[i*2] := HDIG[(ord(FText[i]) and 15)+1];
|
|
end;
|
|
AConfig.SetValue(APath + 'Value', t);
|
|
end;
|
|
|
|
function TWatchResultDataMemDump.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdMemDump;
|
|
end;
|
|
|
|
function TWatchResultDataMemDump.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultDataMemDump.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := FData.GetDataAddress;
|
|
end;
|
|
|
|
procedure TWatchResultDataMemDump.SetDataAddress(AnAddr: TDbgPtr);
|
|
begin
|
|
FData.FAddress := AnAddr;
|
|
end;
|
|
|
|
constructor TWatchResultDataMemDump.Create(APrintedVal: RawByteString);
|
|
begin
|
|
inherited Create;
|
|
FData.FText := APrintedVal;
|
|
end;
|
|
|
|
{ TWatchResultValueString }
|
|
|
|
procedure TWatchResultValueString.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FAddress := TDBGPtr(AConfig.GetValue(APath + 'Addr', 0));
|
|
end;
|
|
|
|
procedure TWatchResultValueString.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Addr', Int64(FAddress), 0);
|
|
end;
|
|
|
|
{ TWatchResultValueWideString }
|
|
|
|
function TWatchResultValueWideString.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultValueWideString.GetAsString: RawByteString;
|
|
var
|
|
t: AnsiString;
|
|
begin
|
|
t := FWideText;
|
|
Result := t;
|
|
end;
|
|
|
|
procedure TWatchResultValueWideString.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FWideText := AConfig.GetValue(APath + 'Value', '');
|
|
FAddress := TDBGPtr(AConfig.GetValue(APath + 'Addr', 0));
|
|
end;
|
|
|
|
procedure TWatchResultValueWideString.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Value', FWideText);
|
|
AConfig.SetDeleteValue(APath + 'Addr', Int64(FAddress), 0);
|
|
end;
|
|
|
|
{ TWatchResultValueOrdNumBase }
|
|
|
|
function TWatchResultValueOrdNumBase.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultValueOrdNumBase.GetAsInt64: Int64;
|
|
begin
|
|
Result := Int64(FNumValue);
|
|
end;
|
|
|
|
procedure TWatchResultValueOrdNumBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FNumValue := QWord(AConfig.GetValue(APath + 'Value', int64(0)));
|
|
end;
|
|
|
|
procedure TWatchResultValueOrdNumBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Value', Int64(FNumValue));
|
|
end;
|
|
|
|
{ TWatchResultTypeOrdNum }
|
|
|
|
procedure TWatchResultTypeOrdNum.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
FNumByteSize := AConfig.GetValue(APath + 'BSize', 0);
|
|
end;
|
|
|
|
procedure TWatchResultTypeOrdNum.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'BSize', FNumByteSize, 0);
|
|
end;
|
|
|
|
{ TWatchResultValueSignedNum }
|
|
|
|
function TWatchResultValueSignedNum.GetAsString: RawByteString;
|
|
begin
|
|
Result := IntToStr(Int64(FNumValue));
|
|
end;
|
|
|
|
{ TWatchResultValueUnsignedNum }
|
|
|
|
function TWatchResultValueUnsignedNum.GetAsString: RawByteString;
|
|
begin
|
|
Result := IntToStr(QWord(FNumValue));
|
|
end;
|
|
|
|
{ TWatchResultValueChar }
|
|
|
|
function TWatchResultValueChar.GetAsString: RawByteString;
|
|
begin
|
|
Result := WideChar(FNumValue);
|
|
end;
|
|
|
|
function TWatchResultValueChar.GetAsWideString: WideString;
|
|
begin
|
|
Result := WideChar(FNumValue);
|
|
end;
|
|
|
|
{ TWatchResultValuePointer }
|
|
|
|
function TWatchResultValuePointer.GetAsString: RawByteString;
|
|
begin
|
|
Result := '$'+IntToHex(QWord(FNumValue), HexDigicCount(FNumValue, 0, True));
|
|
end;
|
|
|
|
{ TWatchResultTypePointer }
|
|
|
|
function TWatchResultTypePointer.GetAsString: RawByteString;
|
|
begin
|
|
if FDerefData = nil then
|
|
Result := ''
|
|
else
|
|
Result := '^: ' + FDerefData.AsString;
|
|
end;
|
|
|
|
procedure TWatchResultTypePointer.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
FDerefData := FDerefData.CreateCopy(ATypeOnly);
|
|
end;
|
|
|
|
procedure TWatchResultTypePointer.DoFree;
|
|
begin
|
|
FDerefData.Free;
|
|
end;
|
|
|
|
procedure TWatchResultTypePointer.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
var
|
|
deref: TWatchResultData;
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
if AConfig.HasPath(APath + 'Deref', False) then begin
|
|
deref := nil;
|
|
if AnEntryTemplate <> nil then begin
|
|
assert(AnEntryTemplate is TWatchResultDataPointer, 'TWatchResultTypePointer.LoadDataFromXMLConfig: AnEntryTemplate is TWatchResultDataPointer');
|
|
deref := TWatchResultDataPointer(AnEntryTemplate).FType.FDerefData;
|
|
end;
|
|
FDerefData := TWatchResultData.CreateFromXMLConfig(AConfig,
|
|
APath + 'Deref/',
|
|
deref,
|
|
AnOverrideTemplate,
|
|
AnAsProto);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultTypePointer.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
if FDerefData <> nil then
|
|
FDerefData.SaveDataToXMLConfig(AConfig, APath + 'Deref/', AnAsProto)
|
|
else
|
|
AConfig.DeletePath(APath + 'Deref');
|
|
end;
|
|
|
|
{ TGenericWatchResultValueFloat }
|
|
|
|
function FloatToStr(Value: TDbgExtended; const FormatSettings: TFormatSettings): String; overload;
|
|
begin
|
|
{$IF DBG_HAS_EXTENDED}
|
|
Result := SysUtils.FloatToStr(double(Value), FormatSettings);
|
|
{$ELSE}
|
|
Result := SysUtils.FloatToStr(Value, FormatSettings);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetAsSingle: Single;
|
|
begin
|
|
Result := FFloatValue;
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetAsDouble: Double;
|
|
begin
|
|
Result := FFloatValue;
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetAsExtended: TDbgExtended;
|
|
begin
|
|
Result := FFloatValue;
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetAsFloat: Extended;
|
|
begin
|
|
Result := FFloatValue;
|
|
end;
|
|
|
|
function TGenericWatchResultValueFloat.GetAsString: RawByteString;
|
|
begin
|
|
DisableFloatExceptions;
|
|
try
|
|
Result := FloatToStr(FFloatValue, _TGenericWatchResultValueFloat_FPointSettings);
|
|
finally
|
|
EnableFloatExceptions;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultValueFloat.SetFromString(s: string);
|
|
begin
|
|
FFloatValue := StrToFloatDef(s, 0, _TGenericWatchResultValueFloat_FPointSettings);
|
|
end;
|
|
|
|
procedure TGenericWatchResultValueFloat.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
SetFromString(AConfig.GetValue(APath + 'Value', '0'));
|
|
end;
|
|
|
|
procedure TGenericWatchResultValueFloat.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Value', GetAsString);
|
|
end;
|
|
|
|
{ TWatchResultValueSingle }
|
|
|
|
function TWatchResultValueSingle.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := dfpSingle; //, dfpDouble, dfpExtended
|
|
end;
|
|
|
|
{ TWatchResultValueDouble }
|
|
|
|
function TWatchResultValueDouble.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := dfpDouble;
|
|
end;
|
|
|
|
{ TWatchResultValueExtended }
|
|
|
|
function TWatchResultValueExtended.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := dfpExtended;
|
|
end;
|
|
|
|
{ TWatchResultTypeFloat }
|
|
|
|
function TWatchResultTypeFloat.GetAsString: RawByteString;
|
|
begin
|
|
WriteStr(Result, FFloatPrecission);
|
|
end;
|
|
|
|
procedure TWatchResultTypeFloat.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
AConfig.GetValue(APath + 'Prec', int64(ord(dfpSingle)), FFloatPrecission, TypeInfo(TLzDbgFloatPrecission));
|
|
end;
|
|
|
|
procedure TWatchResultTypeFloat.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Prec', FFloatPrecission, ord(dfpSingle), TypeInfo(TLzDbgFloatPrecission));
|
|
end;
|
|
|
|
{ TWatchResultValueBoolean }
|
|
|
|
function TWatchResultValueBoolean.GetAsString: RawByteString;
|
|
begin
|
|
if FNumValue <> 0 then
|
|
Result := 'True'
|
|
else
|
|
Result := 'False';
|
|
end;
|
|
|
|
{ TWatchResultValueEnumBase }
|
|
|
|
procedure TWatchResultValueEnumBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FName := AConfig.GetValue(APath + 'Value', '');
|
|
end;
|
|
|
|
procedure TWatchResultValueEnumBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Value', FName, '');
|
|
end;
|
|
|
|
{ TWatchResultValueSet }
|
|
|
|
function TWatchResultValueSet.GetIsDephtlessData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultValueSet.GetCount: Integer;
|
|
begin
|
|
Result := Length(FNames);
|
|
end;
|
|
|
|
function TWatchResultValueSet.GetElementName(AnIndex: integer): String;
|
|
begin
|
|
Result := FNames[AnIndex];
|
|
end;
|
|
|
|
procedure TWatchResultValueSet.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FNames := AConfig.GetValue(APath + 'Value', '').Split([',']);
|
|
end;
|
|
|
|
procedure TWatchResultValueSet.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Value', ''.Join(',', FNames), '');
|
|
end;
|
|
|
|
{ TWatchResultValueVariant }
|
|
|
|
procedure TWatchResultValueVariant.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
FVariantData := FVariantData.CreateCopy();
|
|
end;
|
|
|
|
procedure TWatchResultValueVariant.DoFree;
|
|
begin
|
|
FVariantData.Free;
|
|
end;
|
|
|
|
procedure TWatchResultValueVariant.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
var
|
|
p: String;
|
|
d: TOverrideTemplateData;
|
|
begin
|
|
if AnAsProto then
|
|
exit;
|
|
p := APath + 'var/';
|
|
d := nil;
|
|
if AConfig.HasPath(p, True) then
|
|
FVariantData := TWatchResultData.CreateFromXMLConfig(AConfig, p, nil,
|
|
d);
|
|
assert(d=nil, 'TWatchResultValueVariant.LoadDataFromXMLConfig: d=nil');
|
|
end;
|
|
|
|
procedure TWatchResultValueVariant.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
if FVariantData <> nil then
|
|
FVariantData.SaveDataToXMLConfig(AConfig, APath + 'var/', AnAsProto);
|
|
end;
|
|
|
|
{ TWatchResultValueArrayBase }
|
|
|
|
function TWatchResultValueArrayBase.GetCount: Integer;
|
|
begin
|
|
if FEntries = nil then
|
|
exit(0);
|
|
Result := FEntries.Count;
|
|
end;
|
|
|
|
procedure TWatchResultValueArrayBase.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
if FEntries <> nil then
|
|
FEntries := FEntries.CreateCopy;
|
|
end;
|
|
|
|
procedure TWatchResultValueArrayBase.DoFree;
|
|
begin
|
|
FEntries.Free;
|
|
end;
|
|
|
|
procedure TWatchResultValueArrayBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
var
|
|
p: String;
|
|
begin
|
|
if (AnEntryTemplate = nil) or (AnEntryTemplate.NestedType = nil) then
|
|
exit;
|
|
|
|
p := APath+'Entries/';
|
|
if FEntries = nil then begin
|
|
if (AConfig.GetValue(p+TWatchResultStorage.TAG_CNT, -1) > 0) then begin
|
|
if (AConfig.GetValue(p+TWatchResultStorage.TAG_ALL_ERR, -1) = 0) and
|
|
(AnEntryTemplate.NestedType.ValueKind <> rdkError)
|
|
then
|
|
FEntries := TWatchResultDataError.GetStorageClass.Create
|
|
else
|
|
FEntries := AnEntryTemplate.NestedType.CreateStorage; // (ErrStorageAtLevel)
|
|
end;
|
|
end;
|
|
|
|
if FEntries <> nil then begin
|
|
FEntries.LoadDataFromXMLConfig(AConfig,
|
|
p,
|
|
AnEntryTemplate.NestedType,
|
|
AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultValueArrayBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
if FEntries <> nil then
|
|
FEntries.SaveDataToXMLConfig(AConfig, APath+'Entries/'); //, AnAsProto);
|
|
end;
|
|
|
|
{ TWatchResultTypeArrayBase }
|
|
|
|
procedure TWatchResultTypeArrayBase.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
FEntryTemplate := FEntryTemplate.CreateCopy(ATypeOnly);
|
|
end;
|
|
|
|
procedure TWatchResultTypeArrayBase.DoFree;
|
|
begin
|
|
FreeAndNil(FEntryTemplate);
|
|
end;
|
|
|
|
procedure TWatchResultTypeArrayBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
if AConfig.HasPath(APath+'Proto/', True) then
|
|
FEntryTemplate := TWatchResultData.CreateFromXMLConfig(AConfig, APath+'Proto/', AnEntryTemplate, AnOverrideTemplate, True);
|
|
end;
|
|
|
|
procedure TWatchResultTypeArrayBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
if FEntryTemplate <> nil then
|
|
FEntryTemplate.SaveDataToXMLConfig(AConfig, APath+'Proto/', True);
|
|
end;
|
|
|
|
{ TWatchResultValueUnknowArray }
|
|
|
|
procedure TWatchResultValueUnknowArray.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FLength := AConfig.GetValue(APath + 'Len', 0);
|
|
FLowBound := AConfig.GetValue(APath + 'Low', 0);
|
|
end;
|
|
|
|
procedure TWatchResultValueUnknowArray.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Len', FLength, 0);
|
|
AConfig.SetDeleteValue(APath + 'Low', FLowBound, 0);
|
|
end;
|
|
|
|
{ TWatchResultValueDynArray }
|
|
|
|
procedure TWatchResultValueDynArray.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FLength := AConfig.GetValue(APath + 'Len', 0);
|
|
FAddress := TDBGPtr(AConfig.GetValue(APath + 'Addr', 0));
|
|
end;
|
|
|
|
procedure TWatchResultValueDynArray.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetDeleteValue(APath + 'Len', FLength, 0);
|
|
AConfig.SetDeleteValue(APath + 'Addr', Int64(FAddress), 0);
|
|
end;
|
|
|
|
{ TWatchResultTypeStatArray }
|
|
|
|
procedure TWatchResultTypeStatArray.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
if AConfig.HasPath(APath + 'Bound', False) then
|
|
FBoundType := twatchresultdata.CreateFromXMLConfig(AConfig, APath+''+'Bound/', AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
|
|
FLength := AConfig.GetValue(APath + 'Len', 0);
|
|
FLowBound := AConfig.GetValue(APath + 'Low', 0);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStatArray.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
if FBoundType <> nil then
|
|
FBoundType.SaveDataToXMLConfig(AConfig, APath+'Bound/', AnAsProto);
|
|
|
|
AConfig.SetDeleteValue(APath + 'Len', FLength, 0);
|
|
AConfig.SetDeleteValue(APath + 'Low', FLowBound, 0);
|
|
end;
|
|
|
|
{ TWatchResultValueStructWithRef }
|
|
|
|
procedure TWatchResultValueStructWithRef.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
//inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
|
|
FDataAddress := TDBGPtr(AConfig.GetValue(APath + 'Addr', 0));
|
|
end;
|
|
|
|
procedure TWatchResultValueStructWithRef.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
//inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
|
|
AConfig.SetDeleteValue(APath + 'Addr', Int64(FDataAddress), 0);
|
|
end;
|
|
|
|
{ TWatchResultTypeStructBase }
|
|
|
|
procedure TWatchResultTypeStructBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
const
|
|
Zero: array[0..3] of byte = (0,0,0,0);
|
|
var
|
|
DataCnt: integer;
|
|
i: Integer;
|
|
p: String;
|
|
begin
|
|
DataCnt := AConfig.GetValue(APath + 'Cnt', 0);
|
|
SetLength(FFieldData, DataCnt);
|
|
for i := 0 to DataCnt-1 do begin
|
|
p := APath+'F'+IntToStr(i)+'/';
|
|
FFieldData[i].FieldName := AConfig.GetValue(p + 'F-Name', '');
|
|
AConfig.GetValue(p + 'F-Vis', int64(ord(dfvUnknown)), FFieldData[i].FieldVisibility, TypeInfo(TLzDbgFieldVisibility));
|
|
AConfig.GetValue(p + 'F-Flg', Zero, FFieldData[i].FieldFlags, TypeInfo(TLzDbgFieldFlags));
|
|
if AConfig.GetValue(p+'Empty', 0) = 0 then
|
|
FFieldData[i].Field := TWatchResultData.CreateFromXMLConfig(AConfig, p);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultTypeStructBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
var
|
|
i: Integer;
|
|
p: String;
|
|
begin
|
|
AConfig.SetDeleteValue(APath + 'Cnt', Length(FFieldData), 0);
|
|
for i := 0 to Length(FFieldData)-1 do begin
|
|
p := APath+'F'+IntToStr(i)+'/';
|
|
AConfig.SetDeleteValue(p + 'F-Name', FFieldData[i].FieldName, '');
|
|
AConfig.SetDeleteValue(p + 'F-Vis', FFieldData[i].FieldVisibility, ord(dfvUnknown), TypeInfo(TLzDbgFieldVisibility));
|
|
AConfig.SetDeleteValue(p + 'F-Flg', FFieldData[i].FieldFlags, 0, TypeInfo(TLzDbgFieldFlags));
|
|
if FFieldData[i].Field <> nil then begin
|
|
FFieldData[i].Field.SaveDataToXMLConfig(AConfig, p, AnAsProto);
|
|
AConfig.DeleteValue(p+'Empty');
|
|
end
|
|
else
|
|
AConfig.SetValue(p+'Empty',1);
|
|
end;
|
|
end;
|
|
|
|
function TWatchResultTypeStructBase.GetFieldCount: Integer;
|
|
begin
|
|
Result := Length(FFieldData);
|
|
end;
|
|
|
|
function TWatchResultTypeStructBase.GetFieldInfo(AnIndex: Integer
|
|
): PWatchResultTypeStructFieldInfo;
|
|
begin
|
|
Result := @FFieldData[AnIndex];
|
|
end;
|
|
|
|
procedure TWatchResultTypeStructBase.AfterAssign(ATypeOnly: Boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(FFieldData, Length(FFieldData));
|
|
for i := 0 to Length(FFieldData) - 1 do
|
|
FFieldData[i].Field := FFieldData[i].Field.CreateCopy(ATypeOnly);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStructBase.CopyFieldsProtoFrom(
|
|
const ASource: TWatchResultTypeStructBase);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FFieldData := ASource.FFieldData;
|
|
SetLength(FFieldData, Length(FFieldData));
|
|
for i := 0 to Length(FFieldData) - 1 do
|
|
FFieldData[i].Field := ASource.FFieldData[i].Field.CreateCopy(True);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStructBase.DoFree;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Length(FFieldData) - 1 do
|
|
FFieldData[i].Field.Free;
|
|
FFieldData := nil;
|
|
end;
|
|
|
|
{ TWatchResultTypeStruct }
|
|
|
|
procedure TWatchResultTypeStruct.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
AConfig.GetValue(APath + 'SubID', int64(ord(dstUnknown)), FStructType, TypeInfo(TLzDbgStructType));
|
|
if AConfig.HasPath(APath+'Anch/', True) then begin
|
|
FAnchestor := TWatchResultData.CreateFromXMLConfig(AConfig, APath+'Anch/', AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
assert((FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct), 'TWatchResultTypeStruct.LoadDataFromXMLConfig: (FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct)');
|
|
if (FAnchestor <> nil) and (FAnchestor.ValueKind <> rdkStruct) then
|
|
FreeAndNil(FAnchestor);
|
|
end;
|
|
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStruct.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
AConfig.SetDeleteValue(APath + 'SubID', FStructType, ord(dstUnknown), TypeInfo(TLzDbgStructType));
|
|
if FAnchestor <> nil then
|
|
FAnchestor.SaveDataToXMLConfig(AConfig, APath+'Anch/', AnAsProto);
|
|
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStruct.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
FAnchestor := FAnchestor.CreateCopy(ATypeOnly);
|
|
inherited AfterAssign(ATypeOnly);
|
|
end;
|
|
|
|
procedure TWatchResultTypeStruct.DoFree;
|
|
begin
|
|
inherited DoFree;
|
|
FAnchestor.Free;
|
|
end;
|
|
|
|
{ TWatchResultTypeConverted }
|
|
|
|
procedure TWatchResultTypeConverted.AfterAssign(ATypeOnly: Boolean);
|
|
begin
|
|
inherited AfterAssign(ATypeOnly);
|
|
if FHandler <> nil then
|
|
FHandler.AddReference;
|
|
end;
|
|
|
|
procedure TWatchResultTypeConverted.DoFree;
|
|
begin
|
|
inherited DoFree;
|
|
if FHandler <> nil then
|
|
FHandler.ReleaseReference;
|
|
end;
|
|
|
|
{ TWatchResultTypeProc }
|
|
|
|
procedure TWatchResultTypeProc.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FText := AConfig.GetValue(APath + 'Desc', '');
|
|
|
|
end;
|
|
|
|
procedure TWatchResultTypeProc.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Desc', FText);
|
|
end;
|
|
|
|
{ TWatchResultValueProcBase }
|
|
|
|
procedure TWatchResultValueProcBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FLoc := AConfig.GetValue(APath + 'Loc', '');
|
|
end;
|
|
|
|
procedure TWatchResultValueProcBase.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
AConfig.SetValue(APath + 'Loc', FLoc);
|
|
end;
|
|
|
|
{ TWatchResultStorageOverrides }
|
|
|
|
procedure TWatchResultStorageOverrides.Assign(
|
|
ASource: TWatchResultStorageOverrides);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Self := ASource;
|
|
SetLength(FOverrideEntries, Length(FOverrideEntries));
|
|
if @_OVERRIDE_DATA.AfterAssign <> @TWatchResultValue.AfterAssign then begin
|
|
for i := 0 to FOverrideCount - 1 do begin
|
|
FOverrideEntries[i].FData.AfterAssign;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultStorageOverrides.Add(AnIndex: Integer;
|
|
const AnOverrideData: _OVERRIDE_DATA);
|
|
begin
|
|
if FOverrideCount >= Length(FOverrideEntries) then
|
|
SetLength(FOverrideEntries, FOverrideCount + 16);
|
|
assert((FOverrideCount = 0) or (FOverrideEntries[FOverrideCount-1].FIndex < AnIndex), 'TWatchResultStorageOverrides.Add: (FOverrideCount = 0) or (FOverrideEntries[FOverrideCount-1].FIndex < AnIndex)');
|
|
|
|
FOverrideEntries[FOverrideCount].FIndex := AnIndex;
|
|
FOverrideEntries[FOverrideCount].FData := AnOverrideData;
|
|
inc(FOverrideCount);
|
|
end;
|
|
|
|
function TWatchResultStorageOverrides.Get(AnIndex: Integer; out
|
|
AnOverrideData: _OVERRIDE_DATA): Boolean;
|
|
var
|
|
l, h, m: Integer;
|
|
begin
|
|
l := 0;
|
|
h := FOverrideCount-1;
|
|
while h > l do begin
|
|
m := (h+l) div 2;
|
|
if FOverrideEntries[m].FIndex < AnIndex then
|
|
l := m + 1
|
|
else
|
|
h := m;
|
|
end;
|
|
|
|
Result := l < FOverrideCount;
|
|
if not Result then
|
|
exit;
|
|
AnOverrideData := FOverrideEntries[l].FData;
|
|
Result := FOverrideEntries[l].FIndex = AnIndex;
|
|
end;
|
|
|
|
procedure TWatchResultStorageOverrides.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if @_OVERRIDE_DATA.DoFree <> @TWatchResultValue.DoFree then begin
|
|
for i := 0 to FOverrideCount - 1 do begin
|
|
FOverrideEntries[i].FData.DoFree;
|
|
end;
|
|
end;
|
|
FOverrideEntries := nil;
|
|
FOverrideCount := 0;
|
|
end;
|
|
|
|
procedure TWatchResultStorageOverrides.AfterLastAdd;
|
|
begin
|
|
SetLength(FOverrideEntries, FOverrideCount);
|
|
end;
|
|
|
|
{ TWatchResultStorageOverridesWithData }
|
|
|
|
procedure TWatchResultStorageOverridesWithData.Add(AnIndex: Integer;
|
|
var AStoredData: _ENTRY_DATA; const AData: _OVERRIDE_DATA);
|
|
var
|
|
AStoredDataByte: Byte absolute AStoredData;
|
|
AStoredDataWord: Word absolute AStoredData;
|
|
AStoredDataDWord: DWord absolute AStoredData;
|
|
begin
|
|
inherited Add(AnIndex, AData);
|
|
AStoredData := Default(_ENTRY_DATA);
|
|
case SizeOf(_ENTRY_DATA) of
|
|
0: ;
|
|
1: AStoredDataByte := DATA_OVERRIDE_MARK_B;
|
|
2,3: AStoredDataWord := DATA_OVERRIDE_MARK_W;
|
|
else AStoredDataDWord := DATA_OVERRIDE_MARK_L;
|
|
end;
|
|
end;
|
|
|
|
function TWatchResultStorageOverridesWithData.Get(AnIndex: Integer;
|
|
const AStoredData: _ENTRY_DATA; out AData: _OVERRIDE_DATA): Boolean;
|
|
var
|
|
AStoredDataByte: Byte absolute AStoredData;
|
|
AStoredDataWord: Word absolute AStoredData;
|
|
AStoredDataDWord: DWord absolute AStoredData;
|
|
begin
|
|
Result := False;
|
|
case SizeOf(_ENTRY_DATA) of
|
|
0: ;
|
|
1: if AStoredDataByte <> DATA_OVERRIDE_MARK_B then exit;
|
|
2,3: if AStoredDataWord <> DATA_OVERRIDE_MARK_W then exit;
|
|
else if AStoredDataDWord <> DATA_OVERRIDE_MARK_L then exit;
|
|
end;
|
|
|
|
Result := inherited Get(AnIndex, AData);
|
|
end;
|
|
|
|
procedure TWatchResultStorageOverridesWithData.Clear(
|
|
var AStoredData: TEntryDataArray; AFirst: Integer);
|
|
var
|
|
i, c: Integer;
|
|
begin
|
|
i := 0;
|
|
while (i < FOverrideCount) and (FOverrideEntries[i].FIndex < AFirst) do
|
|
inc(i);
|
|
if i >= FOverrideCount then
|
|
exit;
|
|
c := i;
|
|
while i < FOverrideCount do begin
|
|
case SizeOf(_ENTRY_DATA) of
|
|
0: ;
|
|
1: assert(PByte (@AStoredData[FOverrideEntries[i].FIndex])^ = DATA_OVERRIDE_MARK_B, 'TWatchResultStorageOverridesWithData.Clear: Mark is set');
|
|
2,3: assert(PWord (@AStoredData[FOverrideEntries[i].FIndex])^ = DATA_OVERRIDE_MARK_W, 'TWatchResultStorageOverridesWithData.Clear: Mark is set');
|
|
else assert(PDWord(@AStoredData[FOverrideEntries[i].FIndex])^ = DATA_OVERRIDE_MARK_L, 'TWatchResultStorageOverridesWithData.Clear: Mark is set');
|
|
end;
|
|
FillByte(AStoredData[FOverrideEntries[i].FIndex], SizeOf(_ENTRY_DATA), 0);
|
|
FOverrideEntries[i].FData.DoFree;
|
|
|
|
inc(i);
|
|
end;
|
|
FOverrideCount := c;
|
|
AfterLastAdd;
|
|
//inherited Clear;
|
|
end;
|
|
|
|
procedure TWatchResultStorageOverridesWithData.Clear(AnIndex: Integer;
|
|
var AStoredData: _ENTRY_DATA);
|
|
var
|
|
AStoredDataByte: Byte absolute AStoredData;
|
|
AStoredDataWord: Word absolute AStoredData;
|
|
AStoredDataDWord: DWord absolute AStoredData;
|
|
ADummy: _OVERRIDE_DATA;
|
|
begin
|
|
case SizeOf(_ENTRY_DATA) of
|
|
0: ;
|
|
1: if AStoredDataByte <> DATA_OVERRIDE_MARK_B then exit;
|
|
2,3: if AStoredDataWord <> DATA_OVERRIDE_MARK_W then exit;
|
|
else if AStoredDataDWord <> DATA_OVERRIDE_MARK_L then exit;
|
|
end;
|
|
|
|
if inherited Get(AnIndex, ADummy) then begin
|
|
case SizeOf(_ENTRY_DATA) of
|
|
0: ;
|
|
1: AStoredDataByte := 0;
|
|
2,3: AStoredDataWord := 0;
|
|
else AStoredDataDWord := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TWatchResultStorage }
|
|
|
|
function TWatchResultStorage.GetNestedStoragePtr: PWatchResultStorage;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TWatchResultStorage.ImportOverrides(ASource: TWatchResultStorage;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultStorage.SetNestedStorage(
|
|
AValue: TWatchResultStorage);
|
|
begin
|
|
assert(False, 'TWatchResultStorage.SetNestedStorage: False');
|
|
end;
|
|
|
|
function TWatchResultStorage.GetNestedStorage: TWatchResultStorage;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWatchResultStorage.CreateCopy: TWatchResultStorage;
|
|
begin
|
|
if Self = nil then
|
|
exit(nil);
|
|
Result := TWatchResultStorage(ClassType.Create);
|
|
Result.Assign(Self);
|
|
end;
|
|
|
|
{ TWatchResultDataEnumerator }
|
|
|
|
function TWatchResultDataEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
|
begin
|
|
Result := FSource.Fields[FIndex];
|
|
end;
|
|
|
|
constructor TWatchResultDataEnumerator.Create(ARes: TWatchResultData);
|
|
begin
|
|
FSource := ARes;
|
|
FIndex := -1;
|
|
end;
|
|
|
|
function TWatchResultDataEnumerator.MoveNext: Boolean;
|
|
begin
|
|
inc(FIndex);
|
|
Result := FIndex < FSource.FieldCount;
|
|
end;
|
|
|
|
{ TWatchResultData }
|
|
|
|
function TWatchResultData.GetValueKind: TWatchResultDataKind;
|
|
begin
|
|
Result := rdkUnknown;
|
|
end;
|
|
|
|
function TWatchResultData.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TWatchResultData.GetAnchestorIntf: IWatchResultDataIntf;
|
|
begin
|
|
Result := GetAnchestor;
|
|
end;
|
|
|
|
function TWatchResultData.GetAnchestorsIntf(AnIndex: Integer
|
|
): IWatchResultDataIntf;
|
|
begin
|
|
Result := GetAnchestors(AnIndex);
|
|
end;
|
|
|
|
function TWatchResultData.GetFieldsIntf(AnIndex: Integer
|
|
): TWatchResultDataFieldInfoIntf;
|
|
var
|
|
R: TWatchResultDataFieldInfo;
|
|
begin
|
|
R := GetFields(AnIndex);
|
|
Result.FieldName := R.FieldName;
|
|
Result.FieldVisibility := R.FieldVisibility;
|
|
Result.FieldFlags := R.FieldFlags;
|
|
Result.Field := R.Field;
|
|
Result.Owner := R.Owner;
|
|
end;
|
|
|
|
constructor TWatchResultData.CreateEmpty;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
class function TWatchResultData.CreateFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string): TWatchResultData;
|
|
var
|
|
d1: TWatchResultData;
|
|
d2: TOverrideTemplateData;
|
|
begin
|
|
d1 := nil;
|
|
d2 := nil;
|
|
Result := CreateFromXMLConfig(AConfig, APath, d1, d2, False);
|
|
end;
|
|
|
|
class function TWatchResultData.CreateFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean
|
|
): TWatchResultData;
|
|
var
|
|
AnId: TWatchResultDataClassID;
|
|
begin
|
|
Result := nil;
|
|
try
|
|
AConfig.GetValue(APath + 'CID', Int64(ord(wdPrePrint)), AnId, TypeInfo(TWatchResultDataClassID));
|
|
Result := WatchResNameToClass[AnId].Create;
|
|
Result.LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
except
|
|
Result := TWatchResultDataError.Create('Error: Failed to load from XML'); // TODO: create a class, that will not overwrite the broken xml
|
|
end;
|
|
end;
|
|
|
|
function TWatchResultData.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdPrePrint;
|
|
end;
|
|
|
|
function TWatchResultData.GetInternalObject: TObject;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchResultData.GetConvertedRes: TWatchResultData;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TWatchResultData.GetTypeName: String;
|
|
begin
|
|
Result := FTypeName;
|
|
end;
|
|
|
|
function TWatchResultData.GetIsFullDephtEvaluated: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TWatchResultData.GetDerefDataIntf: IWatchResultDataIntf;
|
|
begin
|
|
Result := GetDerefData;
|
|
end;
|
|
|
|
function TWatchResultData.GetBoundTypeIntf: IWatchResultDataIntf;
|
|
begin
|
|
Result := GetBoundType;
|
|
end;
|
|
|
|
function TWatchResultData.GetSelectedEntryIntf: IWatchResultDataIntf;
|
|
begin
|
|
Result := GetSelectedEntry;
|
|
end;
|
|
|
|
function TWatchResultData.GetBackendValueHandler: ILazDbgValueConverterIntf;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TWatchResultData.AfterSaveToIndex(AStorage: TWatchResultStorage;
|
|
AnIndex: Integer; var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultData.AfterLoadFromIndex(AStorage: TWatchResultStorage;
|
|
AnIndex: Integer; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TWatchResultData.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
FTypeName := AConfig.GetValue(APath + 'TypeName', '');
|
|
end;
|
|
|
|
procedure TWatchResultData.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
|
const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
AConfig.SetDeleteValue(APath + 'CID', GetClassID, int64(ord(wdPrePrint)), TypeInfo(TWatchResultDataClassID));
|
|
AConfig.SetDeleteValue(APath + 'TypeName', FTypeName, '');
|
|
end;
|
|
|
|
procedure TWatchResultData.Assign(ASource: TWatchResultData; ATypeOnly: Boolean
|
|
);
|
|
begin
|
|
FTypeName := ASource.FTypeName;
|
|
end;
|
|
|
|
function TWatchResultData.CreateCopy(ATypeOnly: Boolean): TWatchResultData;
|
|
begin
|
|
if Self = nil then
|
|
exit(nil);
|
|
Result := TWatchResultData(ClassType.Create);
|
|
Result.Assign(Self, ATypeOnly);
|
|
end;
|
|
|
|
function TWatchResultData.HandleExpressionSuffix(ASuffix: String
|
|
): TWatchResultData;
|
|
begin
|
|
Result := Self;
|
|
if ASuffix <> '' then
|
|
Result := TWatchResultDataError.Create('Can''t evaluate: ' + ASuffix);
|
|
end;
|
|
|
|
function TWatchResultData.GetEnumerator: TWatchResultDataEnumerator;
|
|
begin
|
|
Result := TWatchResultDataEnumerator.Create(Self);
|
|
end;
|
|
|
|
procedure TWatchResultData.SetSelectedIndex(AnIndex: Integer);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
{ TWatchResultDataEx }
|
|
|
|
procedure TWatchResultDataEx.SetTypeName(ATypeName: String);
|
|
begin
|
|
FTypeName := ATypeName;
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetDerefData(ADerefData: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetDerefData: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetDataAddress(AnAddr: TDbgPtr);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetDataAddress: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetEntryPrototype(AnEntry: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetEntryPrototype: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.WriteEntryToStorage(AnIndex: Integer);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.WriteEntryToStorage: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.WriteValueToStorage(AnIndex: Integer;
|
|
AValue: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.WriteValueToStorage: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetEntryCount(ACount: Integer);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetEntryCount: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetAnchestor(AnAnchestor: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultData.SetAnchestor: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetFieldCount(ACount: integer);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetFieldCount: False');
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetField(AnIndex: Integer; AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility; AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultDataEx.SetField: False');
|
|
end;
|
|
|
|
function TWatchResultDataEx.AddField(AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility; AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData): Integer;
|
|
begin
|
|
assert(False, 'TWatchResultData.AddField: False');
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TWatchResultDataEx.SetFieldData(AnIndex: Integer; AData: TWatchResultData);
|
|
begin
|
|
assert(False, 'TWatchResultData.SetFieldData: False');
|
|
end;
|
|
|
|
{ TGenericWatchResultData.TGenericBasicWatchResultStorage }
|
|
|
|
function TGenericWatchResultData.TGenericBasicWatchResultStorage.GetCount: integer;
|
|
begin
|
|
Result := Length(FDataArray);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.SetCount(
|
|
AValue: integer);
|
|
var
|
|
i: SizeInt;
|
|
begin
|
|
if @_DATA.DoFree <> @TWatchResultValue.DoFree then begin
|
|
for i := AValue to Length(FDataArray) - 1 do
|
|
FDataArray[i].DoFree;
|
|
end;
|
|
SetLength(FDataArray, AValue);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.AssignDataArray
|
|
(ASource: TWatchResultStorage);
|
|
var
|
|
Src: TGenericBasicWatchResultStorage absolute ASource;
|
|
i: Integer;
|
|
begin
|
|
FDataArray := Src.FDataArray;
|
|
SetLength(FDataArray, Length(FDataArray));
|
|
if @_DATA.AfterAssign <> @TWatchResultValue.AfterAssign then begin
|
|
for i := 0 to Length(FDataArray) - 1 do
|
|
FDataArray[i].AfterAssign;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.Assign(
|
|
ASource: TWatchResultStorage);
|
|
begin
|
|
assert(ASource.ClassType = ClassType, 'TGenericWatchResultDataArrayStorageHelper.Assign: ASource.ClassType = ClassType');
|
|
if not (ASource is TGenericBasicWatchResultStorage) then
|
|
exit;
|
|
|
|
AssignDataArray(ASource);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.ImportOverrides
|
|
(ASource: TWatchResultStorage; var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
assert(False, 'TGenericWatchResultData.TGenericBasicWatchResultStorage.ImportOverrides: False');
|
|
end;
|
|
|
|
destructor TGenericWatchResultData.TGenericBasicWatchResultStorage.Destroy;
|
|
begin
|
|
Count := 0;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.LoadDataFromXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
|
|
var
|
|
l: Int64;
|
|
i: Integer;
|
|
PathNst: String;
|
|
begin
|
|
PathNst := '';
|
|
if ANestLvl > 0 then PathNst := 'N'+IntToStr(ANestLvl);
|
|
|
|
l := AConfig.GetValue(APath+TAG_CNT+PathNst, 0);
|
|
SetLength(FDataArray, l);
|
|
|
|
if ANestLvl > 0 then PathNst := PathNst+'/';
|
|
for i := 0 to Length(FDataArray) - 1 do
|
|
FDataArray[i].LoadDataFromXMLConfig(AConfig, APath+'E'+IntToStr(i)+'/'+PathNst, AnEntryTemplate, AnOverrideTemplate, False);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.SaveDataToXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
var
|
|
i: Integer;
|
|
PathNst: String;
|
|
begin
|
|
PathNst := '';
|
|
if ANestLvl > 0 then PathNst := 'N'+IntToStr(ANestLvl);
|
|
|
|
AConfig.SetDeleteValue(APath+TAG_CNT+PathNst, Length(FDataArray), 0);
|
|
|
|
if ANestLvl > 0 then PathNst := PathNst+'/';
|
|
for i := 0 to Length(FDataArray) - 1 do
|
|
FDataArray[i].SaveDataToXMLConfig(AConfig, APath+'E'+IntToStr(i)+'/'+PathNst, False);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.SaveToIndex(
|
|
AnIndex: Integer; AData: TWatchResultData;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
assert(AData.GetStorageClass = ClassType, 'TGenericWatchResultData.TGenericBasicWatchResultStorage.SaveToIndex: AData.GetStorageClass = ClassType');
|
|
assert(AData is TGenericWatchResultData);
|
|
|
|
FDataArray[AnIndex] := TGenericWatchResultData(AData).FData;
|
|
AData.AfterSaveToIndex(Self, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
TGenericWatchResultData(AData).FData := Default(_DATA);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericBasicWatchResultStorage.LoadFromIndex(
|
|
AnIndex: Integer; out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
assert(AnEntryTemplate <> nil);
|
|
assert(AnEntryTemplate is TGenericWatchResultData, 'TGenericWatchResultData.TGenericBasicWatchResultStorage.LoadFromIndex: AnEntryTemplate is _DATA');
|
|
TGenericWatchResultData(AnEntryTemplate).FData := FDataArray[AnIndex];
|
|
AData := AnEntryTemplate;
|
|
AData.AfterLoadFromIndex(Self, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
end;
|
|
|
|
{ TGenericWatchResultData.TGenericWatchResultStorage }
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.SetCount( AValue: integer);
|
|
begin
|
|
if AValue < Count then
|
|
FErrorStore.Clear(FDataArray, AValue);
|
|
inherited SetCount(AValue);
|
|
FErrorStore.AfterLastAdd; // TODO: TRIM, once only finished // TODO maybe only explicit
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.AssignDataArray(
|
|
ASource: TWatchResultStorage);
|
|
var
|
|
Src: TGenericWatchResultStorage absolute ASource;
|
|
DoAfter: Boolean;
|
|
i: Integer;
|
|
e: _ERROR_DATA;
|
|
begin
|
|
assert(ASource is TGenericWatchResultStorage, 'TGenericWatchResultData.TGenericWatchResultStorage.AssignDataArray: ASource is TGenericWatchResultStorage');
|
|
SetLength(FDataArray, Length(Src.FDataArray));
|
|
DoAfter := @_DATA.AfterAssign <> @TWatchResultValue.AfterAssign;
|
|
for i := 0 to Length(FDataArray) - 1 do begin
|
|
if not Src.FErrorStore.Get(i, Src.FDataArray[i], e) then begin
|
|
FDataArray[i] := Src.FDataArray[i];
|
|
if DoAfter then
|
|
FDataArray[i].AfterAssign;
|
|
end
|
|
else
|
|
case SizeOf(_DATA) of
|
|
0: ;
|
|
1: PByte (@FDataArray[i])^ := PByte (@Src.FDataArray[i])^;
|
|
2,3: PWord (@FDataArray[i])^ := PWord (@Src.FDataArray[i])^;
|
|
else PDWord(@FDataArray[i])^ := PDWord(@Src.FDataArray[i])^;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.Assign(
|
|
ASource: TWatchResultStorage);
|
|
var
|
|
Src: TGenericWatchResultStorage absolute ASource;
|
|
begin
|
|
if (ASource is TGenericWatchResultStorage) then
|
|
FErrorStore.Assign(Src.FErrorStore);
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.ImportOverrides(
|
|
ASource: TWatchResultStorage; var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AnErrSource: TWatchResultDataError.TErrorDataStorage absolute ASource;
|
|
i: Integer;
|
|
begin
|
|
assert(ASource.ClassType = TWatchResultDataError.TErrorDataStorage, 'TGenericWatchResultData.TGenericWatchResultStorage.ImportOverrides: ASource.ClassInfo = TWatchResultDataError.TErrorDataStorage');
|
|
Count := ASource.Count;
|
|
|
|
for i := 0 to Count - 1 do begin
|
|
if _ERROR_DATA(AnErrSource.FDataArray[i]).FText <> '' then // TODO: support for not-assigned entries
|
|
FErrorStore.Add(i, FDataArray[i], AnErrSource.FDataArray[i]);
|
|
AnErrSource.FDataArray[i] := Default(_ERROR_DATA);
|
|
end;
|
|
|
|
assert(AnOverrideTemplate = nil, 'TGenericWatchResultData.TGenericWatchResultStorage.ImportOverrides: AnOverrideTemplate = nil');
|
|
//if AnOverrideTemplate = nil then
|
|
AnOverrideTemplate := _ERROR_CLASS.CreateEmpty;
|
|
end;
|
|
|
|
destructor TGenericWatchResultData.TGenericWatchResultStorage.Destroy;
|
|
begin
|
|
FErrorStore.Clear(FDataArray);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.LoadDataFromXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
|
|
var
|
|
l: Int64;
|
|
i: Integer;
|
|
e: _ERROR_DATA;
|
|
PathNst, p: String;
|
|
AllErr: Boolean;
|
|
begin
|
|
PathNst := '';
|
|
if ANestLvl > 0 then PathNst := 'N'+IntToStr(ANestLvl);
|
|
|
|
AllErr := (AConfig.GetValue(APath+TWatchResultStorage.TAG_ALL_ERR, -1) = 0) and
|
|
(AnEntryTemplate.ValueKind <> rdkError);
|
|
|
|
l := AConfig.GetValue(APath+TAG_CNT+PathNst, 0);
|
|
SetLength(FDataArray, l);
|
|
|
|
if ANestLvl > 0 then PathNst := PathNst+'/';
|
|
for i := 0 to Length(FDataArray) - 1 do begin
|
|
p := APath+'E'+IntToStr(i)+'/'+PathNst;
|
|
|
|
if AllErr or (AConfig.GetValue(p+TAG_ERR, 0) = 1) then begin
|
|
e := Default(_ERROR_DATA);
|
|
e.LoadDataFromXMLConfig(AConfig, p, AnEntryTemplate, AnOverrideTemplate, False);
|
|
FErrorStore.Add(i, FDataArray[i], e);
|
|
if AnOverrideTemplate = nil then
|
|
AnOverrideTemplate := _ERROR_CLASS.CreateEmpty;
|
|
end
|
|
else
|
|
FDataArray[i].LoadDataFromXMLConfig(AConfig, p, AnEntryTemplate, AnOverrideTemplate, False);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.SaveDataToXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
var
|
|
i: Integer;
|
|
e: _ERROR_DATA;
|
|
PathNst, p: String;
|
|
begin
|
|
PathNst := '';
|
|
if ANestLvl > 0 then PathNst := 'N'+IntToStr(ANestLvl);
|
|
|
|
AConfig.SetDeleteValue(APath+TAG_CNT+PathNst, Length(FDataArray), 0);
|
|
|
|
if ANestLvl > 0 then PathNst := PathNst+'/';
|
|
for i := 0 to Length(FDataArray) - 1 do begin
|
|
p := APath+'E'+IntToStr(i)+'/'+PathNst;
|
|
|
|
if FErrorStore.Get(i, FDataArray[i], e) then begin
|
|
AConfig.SetValue(p+TAG_ERR, 1);
|
|
e.SaveDataToXMLConfig(AConfig, p, False);
|
|
end
|
|
else begin
|
|
AConfig.DeleteValue(p+TAG_ERR);
|
|
FDataArray[i].SaveDataToXMLConfig(AConfig, p, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.SaveToIndex(
|
|
AnIndex: Integer; AData: TWatchResultData;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
if AData.ValueKind = rdkError then begin
|
|
assert(AData is _ERROR_CLASS, '');
|
|
if AnOverrideTemplate = nil then
|
|
AnOverrideTemplate := _ERROR_CLASS.CreateEmpty;
|
|
FErrorStore.Add(AnIndex, FDataArray[AnIndex], _ERROR_CLASS(AData).FData);
|
|
AData.AfterSaveToIndex(Self, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
_ERROR_CLASS(AData).FData := Default(_ERROR_DATA);
|
|
exit;
|
|
end;
|
|
|
|
inherited SaveToIndex(AnIndex, AData, AnEntryTemplate, AnOverrideTemplate);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericWatchResultStorage.LoadFromIndex(
|
|
AnIndex: Integer; out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
if AnOverrideTemplate <> nil then begin
|
|
assert(AnOverrideTemplate is _ERROR_CLASS, 'TGenericWatchResultData.TGenericWatchResultStorage.LoadFromIndex: AnOverrideTemplate is _ERROR_DATA');
|
|
if FErrorStore.Get(AnIndex, FDataArray[AnIndex], _ERROR_CLASS(AnOverrideTemplate).FData) then begin
|
|
AData := AnOverrideTemplate;
|
|
AData.AfterLoadFromIndex(Self, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
inherited LoadFromIndex(AnIndex, AData, AnEntryTemplate, AnOverrideTemplate);
|
|
end;
|
|
|
|
{ TGenericWatchResultData.TGenericNestedWatchResultStorage }
|
|
|
|
procedure TGenericWatchResultData.TGenericNestedWatchResultStorage.SetCount(
|
|
AValue: integer);
|
|
begin
|
|
inherited SetCount(AValue);
|
|
if FNestedStorage <> nil then
|
|
FNestedStorage.Count := AValue;
|
|
end;
|
|
|
|
function TGenericWatchResultData.TGenericNestedWatchResultStorage.GetNestedStorage: TWatchResultStorage;
|
|
begin
|
|
Result := FNestedStorage;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericNestedWatchResultStorage.SetNestedStorage
|
|
(AValue: TWatchResultStorage);
|
|
begin
|
|
FNestedStorage := AValue;
|
|
if FNestedStorage <> nil then
|
|
FNestedStorage.Count := Count;
|
|
end;
|
|
|
|
function TGenericWatchResultData.TGenericNestedWatchResultStorage.GetNestedStoragePtr: PWatchResultStorage;
|
|
begin
|
|
Result := @FNestedStorage;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericNestedWatchResultStorage.Assign(
|
|
ASource: TWatchResultStorage);
|
|
begin
|
|
inherited Assign(ASource);
|
|
FNestedStorage := ASource.NestedStorage.CreateCopy;
|
|
end;
|
|
|
|
destructor TGenericWatchResultData.TGenericNestedWatchResultStorage.Destroy;
|
|
begin
|
|
FreeAndNil(FNestedStorage);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericNestedWatchResultStorage.LoadDataFromXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
|
|
var
|
|
t: TWatchResultData;
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, ANestLvl);
|
|
if FNestedStorage <> nil then begin
|
|
|
|
if (AConfig.GetValue(APath+TAG_ALL_ERR, -1) = ANestLvl+1) and
|
|
(AnEntryTemplate.ValueKind<> rdkError)
|
|
then begin
|
|
FNestedStorage.Free;
|
|
FNestedStorage := TWatchResultDataError.GetStorageClass.Create;
|
|
end;
|
|
|
|
t := AnEntryTemplate;
|
|
if t <> nil then
|
|
t := t.NestedType;
|
|
FNestedStorage.LoadDataFromXMLConfig(AConfig, APath, t, AnOverrideTemplate, ANestLvl+1);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.TGenericNestedWatchResultStorage.SaveDataToXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
|
|
if FNestedStorage <> nil then
|
|
FNestedStorage.SaveDataToXMLConfig(AConfig, APath, ANestLvl+1);
|
|
end;
|
|
|
|
{ TGenericWatchResultData }
|
|
|
|
class function TGenericWatchResultData.GetStorageClass: TWatchResultStorageClass;
|
|
begin
|
|
Result := TGenericWatchResultStorage;
|
|
end;
|
|
|
|
function TGenericWatchResultData.CreateStorage: TWatchResultStorage;
|
|
begin
|
|
Result := GetStorageClass.Create;
|
|
end;
|
|
|
|
class procedure TGenericWatchResultData.UpdateStorage(
|
|
AStorage: PWatchResultStorage; const AData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
OldStorage: TWatchResultStorage;
|
|
begin
|
|
OldStorage := AStorage^;
|
|
AStorage^ := AData.CreateStorage;
|
|
AStorage^.ImportOverrides(OldStorage, AnOverrideTemplate);
|
|
OldStorage.Free;
|
|
end;
|
|
|
|
function TGenericWatchResultData.MaybeUpdateProto(
|
|
var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
|
|
ARecurse: boolean; ASkipStorage: boolean): boolean;
|
|
begin
|
|
Result := (Self <> nil) and
|
|
( (AProtoData = nil) or
|
|
( (AProtoData.ValueKind = rdkError) and
|
|
(Self.ValueKind <> rdkError)
|
|
) );
|
|
|
|
if Result then begin
|
|
if (AProtoData <> nil) then begin
|
|
AProtoData.Free;
|
|
end;
|
|
AProtoData := Self.CreateCopy(True);
|
|
|
|
if not ASkipStorage and (AStorage <> nil) and (AStorage^ <> nil) then
|
|
UpdateStorage(AStorage, Self, AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.ClearData;
|
|
begin
|
|
FData := Default(_DATA);
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetValueKind: TWatchResultDataKind;
|
|
begin
|
|
Result := FData.VKind;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetIsFullDephtEvaluated: Boolean;
|
|
begin
|
|
Result := FData.GetIsDephtlessData;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsString: RawByteString;
|
|
begin
|
|
Result := FData.GetAsString;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsDesc: String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsWideString: WideString;
|
|
begin
|
|
Result := FData.GetAsWideString;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsQWord: QWord;
|
|
begin
|
|
Result := FData.GetAsQWord;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsInt64: Int64;
|
|
begin
|
|
Result := FData.GetAsInt64;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsSingle: Single;
|
|
begin
|
|
Result := FData.GetAsSingle;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsDouble: Double;
|
|
begin
|
|
Result := FData.GetAsDouble;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsExtended: TDbgExtended;
|
|
begin
|
|
Result := FData.GetAsExtended;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAsFloat: Extended;
|
|
begin
|
|
Result := FData.GetAsFloat;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetCount: Integer;
|
|
begin
|
|
Result := FData.GetCount;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetLength: Integer;
|
|
begin
|
|
Result := FData.GetLength;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetElementName(AnIndex: integer): String;
|
|
begin
|
|
Result := FData.GetElementName(AnIndex);
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetDerefData: TWatchResultData;
|
|
begin
|
|
Result := FData.GetDerefData;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetNestedType: TWatchResultData;
|
|
begin
|
|
Result := FData.GetEntryTemplate;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetArrayType: TLzDbgArrayType;
|
|
begin
|
|
Result := datUnknown;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetBoundType: TWatchResultData;
|
|
begin
|
|
Result := FData.GetBoundType;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetLowBound: Int64;
|
|
begin
|
|
Result := FData.GetLowBound;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetByteSize: Integer;
|
|
begin
|
|
Result := FData.GetByteSize;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := FData.GetFloatPrecission;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetSelectedEntry: TWatchResultData;
|
|
begin
|
|
Result := FData.GetEntryTemplate;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := FData.GetDataAddress;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetStructType: TLzDbgStructType;
|
|
begin
|
|
Result := dstUnknown;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAnchestor: TWatchResultData;
|
|
begin
|
|
Result := Nil;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAnchestorCount: Integer;
|
|
var
|
|
a: TWatchResultData;
|
|
begin
|
|
Result := 0;
|
|
a := GetAnchestor;
|
|
while a <> nil do begin
|
|
inc(Result);
|
|
a := a.GetAnchestor;
|
|
end;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetAnchestors(AnIndex: Integer): TWatchResultData;
|
|
begin
|
|
Result := GetAnchestor;
|
|
if (AnIndex > 0) and (Result <> nil) then
|
|
Result := Result.Anchestors[AnIndex - 1];
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetDirectFieldCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetFieldCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetFields(AnIndex: Integer
|
|
): TWatchResultDataFieldInfo;
|
|
begin
|
|
Result := Default(TWatchResultDataFieldInfo);
|
|
end;
|
|
|
|
function TGenericWatchResultData.GetFieldVisibility: TLzDbgFieldVisibility;
|
|
begin
|
|
Result := dfvUnknown;
|
|
end;
|
|
|
|
destructor TGenericWatchResultData.Destroy;
|
|
begin
|
|
FData.DoFree;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
if not AnAsProto then
|
|
FData.LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
if not AnAsProto then
|
|
FData.SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
end;
|
|
|
|
procedure TGenericWatchResultData.Assign(ASource: TWatchResultData;
|
|
ATypeOnly: Boolean);
|
|
var
|
|
Src: TGenericWatchResultData absolute ASource;
|
|
begin
|
|
inherited Assign(ASource, ATypeOnly);
|
|
if ATypeOnly or (not (ASource is TGenericWatchResultData)) then
|
|
exit;
|
|
|
|
FData := Src.FData;
|
|
FData.AfterAssign;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataWithType }
|
|
|
|
function TGenericWatchResultDataWithType.GetByteSize: Integer;
|
|
begin
|
|
Result := FType.GetByteSize;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetFloatPrecission: TLzDbgFloatPrecission;
|
|
begin
|
|
Result := FType.GetFloatPrecission;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetNestedType: TWatchResultData;
|
|
begin
|
|
Result := FType.GetEntryTemplate;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetBoundType: TWatchResultData;
|
|
begin
|
|
Result := FType.GetBoundType;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetLowBound: Int64;
|
|
begin
|
|
Result := FType.GetLowBound;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetSelectedEntry: TWatchResultData;
|
|
begin
|
|
Result := FType.GetEntryTemplate;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetStructType: TLzDbgStructType;
|
|
begin
|
|
Result := FType.GetStructType;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetAnchestor: TWatchResultData;
|
|
begin
|
|
Result := FType.GetAnchestor;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetDirectFieldCount: Integer;
|
|
begin
|
|
Result := FType.GetFieldCount;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetFieldCount: Integer;
|
|
var
|
|
a: TWatchResultData;
|
|
begin
|
|
Result := FType.GetFieldCount;
|
|
a := Anchestor;
|
|
while a <> nil do begin
|
|
Result := Result + a .GetDirectFieldCount;
|
|
a := a.Anchestor;
|
|
end;
|
|
end;
|
|
|
|
function TGenericWatchResultDataWithType.GetFields(AnIndex: Integer): TWatchResultDataFieldInfo;
|
|
var
|
|
AnAnchestor: TWatchResultData;
|
|
AnAnchestorIdx: Integer;
|
|
inf: PWatchResultTypeStructFieldInfo;
|
|
begin
|
|
if AnIndex < FType.GetFieldCount then begin
|
|
inf := FType.GetFieldInfo(AnIndex);
|
|
Result.FieldName := inf^.FieldName;
|
|
Result.FieldVisibility := inf^.FieldVisibility;
|
|
Result.FieldFlags := inf^.FieldFlags;
|
|
Result.Field := inf^.Field;
|
|
Result.Owner := Self;
|
|
exit;
|
|
end;
|
|
|
|
AnAnchestorIdx := AnIndex;
|
|
AnAnchestor := Self;
|
|
repeat
|
|
AnAnchestorIdx := AnAnchestorIdx - AnAnchestor.GetDirectFieldCount;
|
|
AnAnchestor := AnAnchestor.Anchestor;
|
|
until (AnAnchestor = nil) or (AnAnchestorIdx < AnAnchestor.GetDirectFieldCount);
|
|
|
|
if Anchestor = nil then begin
|
|
Result := Default(TWatchResultDataFieldInfo);
|
|
exit;
|
|
end;
|
|
|
|
Result := AnAnchestor.GetFields(AnAnchestorIdx);
|
|
end;
|
|
|
|
destructor TGenericWatchResultDataWithType.Destroy;
|
|
begin
|
|
FType.DoFree;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataWithType.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
FType.LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataWithType.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
FType.SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataWithType.Assign(ASource: TWatchResultData;
|
|
ATypeOnly: Boolean);
|
|
var
|
|
Src: TGenericWatchResultDataWithType absolute ASource;
|
|
begin
|
|
inherited Assign(ASource, ATypeOnly);
|
|
if not (ASource is TGenericWatchResultDataWithType) then
|
|
exit;
|
|
FType := Src.FType;
|
|
FType.AfterAssign(ATypeOnly);
|
|
end;
|
|
|
|
{ TWatchResultDataPrePrinted }
|
|
|
|
function TWatchResultDataPrePrinted.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdPrePrint;
|
|
end;
|
|
|
|
constructor TWatchResultDataPrePrinted.Create(APrintedVal: String);
|
|
begin
|
|
inherited Create;
|
|
FData.FText := APrintedVal;
|
|
end;
|
|
|
|
{ TWatchResultDataString }
|
|
|
|
function TWatchResultDataString.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdString;
|
|
end;
|
|
|
|
function TWatchResultDataString.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultDataString.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := FData.GetDataAddress;
|
|
end;
|
|
|
|
procedure TWatchResultDataString.SetDataAddress(AnAddr: TDbgPtr);
|
|
begin
|
|
FData.FAddress := AnAddr;
|
|
end;
|
|
|
|
constructor TWatchResultDataString.Create(AStringVal: String);
|
|
begin
|
|
inherited Create;
|
|
FData.FText := AStringVal;
|
|
end;
|
|
|
|
{ TWatchResultDataWideString }
|
|
|
|
function TWatchResultDataWideString.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdWString;
|
|
end;
|
|
|
|
function TWatchResultDataWideString.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultDataWideString.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := FData.FAddress;
|
|
end;
|
|
|
|
procedure TWatchResultDataWideString.SetDataAddress(AnAddr: TDbgPtr);
|
|
begin
|
|
FData.FAddress := AnAddr;
|
|
end;
|
|
|
|
constructor TWatchResultDataWideString.Create(AStringVal: WideString);
|
|
begin
|
|
inherited Create;
|
|
FData.FWideText := AStringVal;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataSizedNum }
|
|
|
|
function TGenericWatchResultDataSizedNum.GetAsQWord: QWord;
|
|
begin
|
|
Result := FData.GetAsQWord;
|
|
if (FType.GetByteSize > 0) and (FType.GetByteSize < 8) then
|
|
Result := Result and not(QWord(-1) << (FType.GetByteSize<<3));
|
|
end;
|
|
|
|
function TGenericWatchResultDataSizedNum.GetAsInt64: Int64;
|
|
begin
|
|
Result := FData.GetAsInt64;
|
|
if (FType.GetByteSize > 0) and (FType.GetByteSize < 8) then begin
|
|
if Result and (1 << ((FType.GetByteSize<<3) - 1)) <> 0 then
|
|
Result := Result or (Int64(-1) << (FType.GetByteSize<<3))
|
|
else
|
|
Result := Result and not(Int64(-1) << (FType.GetByteSize<<3));
|
|
end;
|
|
end;
|
|
|
|
{ TWatchResultDataChar }
|
|
|
|
function TWatchResultDataChar.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdChar;
|
|
end;
|
|
|
|
constructor TWatchResultDataChar.Create(ANumValue: QWord; AByteSize: Integer);
|
|
begin
|
|
inherited Create();
|
|
FData.FNumValue := QWord(ANumValue);
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
{ TWatchResultDataSignedNum }
|
|
|
|
function TWatchResultDataSignedNum.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdSNum;
|
|
end;
|
|
|
|
constructor TWatchResultDataSignedNum.Create(ANumValue: Int64;
|
|
AByteSize: Integer);
|
|
begin
|
|
inherited Create();
|
|
FData.FNumValue := QWord(ANumValue);
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
{ TWatchResultDataUnSignedNum }
|
|
|
|
function TWatchResultDataUnSignedNum.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdUNum;
|
|
end;
|
|
|
|
constructor TWatchResultDataUnSignedNum.Create(ANumValue: QWord;
|
|
AByteSize: Integer);
|
|
begin
|
|
inherited Create();
|
|
FData.FNumValue := QWord(ANumValue);
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
{ TWatchResultDataPointer }
|
|
|
|
function TWatchResultDataPointer.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdPtr;
|
|
end;
|
|
|
|
function TWatchResultDataPointer.GetIsFullDephtEvaluated: Boolean;
|
|
begin
|
|
Result := (DerefData <> nil) and (DerefData.IsFullDephtEvaluated);
|
|
end;
|
|
|
|
function TWatchResultDataPointer.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TWatchResultDataPointer.GetAsString: RawByteString;
|
|
begin
|
|
Result := FData.GetAsString + FType.GetAsString;
|
|
end;
|
|
|
|
function TWatchResultDataPointer.GetDerefData: TWatchResultData;
|
|
begin
|
|
if FCurrentDerefData <> nil then
|
|
Result := FCurrentDerefData
|
|
else
|
|
Result := FType.GetDerefData;
|
|
end;
|
|
|
|
class function TWatchResultDataPointer.GetStorageClass: TWatchResultStorageClass;
|
|
begin
|
|
Result := TGenericNestedWatchResultStorage;
|
|
end;
|
|
|
|
function TWatchResultDataPointer.CreateStorage: TWatchResultStorage;
|
|
begin
|
|
Result := inherited CreateStorage;
|
|
if FType.FDerefData <> nil then
|
|
TGenericNestedWatchResultStorage(Result).FNestedStorage := FType.FDerefData.CreateStorage;
|
|
end;
|
|
|
|
function TWatchResultDataPointer.MaybeUpdateProto(
|
|
var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
|
|
ARecurse: boolean; ASkipStorage: boolean): boolean;
|
|
var
|
|
APtrProtoData: TWatchResultDataPointer absolute AProtoData;
|
|
Store: PWatchResultStorage;
|
|
begin
|
|
Result := inherited MaybeUpdateProto(AProtoData, AnOverrideTemplate, AStorage, ARecurse, ASkipStorage);
|
|
if (not Result) and (AProtoData is TWatchResultDataPointer) and
|
|
ARecurse and (FType.FDerefData <> nil)
|
|
then begin
|
|
Store := AStorage;
|
|
if (Store <> nil) and (Store^ <> nil) then
|
|
Store := Store^.NestedStoragePtr;
|
|
Result := FType.FDerefData.MaybeUpdateProto(APtrProtoData.FType.FDerefData, AnOverrideTemplate,
|
|
Store, ARecurse, ASkipStorage);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultDataPointer.AfterSaveToIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
APtrEntryTemplate: TWatchResultDataPointer absolute AnEntryTemplate;
|
|
begin
|
|
(* SELF is part of TWatchResultDataArrayBase.FCurrentElement
|
|
SELF and AnEntryTemplate can be the same
|
|
-> if they are no update of FDerefData will happen
|
|
*)
|
|
assert(AStorage is TGenericNestedWatchResultStorage, 'TWatchResultDataPointer.AfterSaveToIndex: is TGenericNestedWatchResultStorage');
|
|
|
|
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
|
|
if (FType.FDerefData <> nil) then begin
|
|
assert(AnEntryTemplate is TWatchResultDataPointer, 'TWatchResultDataPointer.AfterSaveToIndex: AnEntryTemplate is TWatchResultDataPointer');
|
|
|
|
FType.FDerefData.MaybeUpdateProto(
|
|
APtrEntryTemplate.FType.FDerefData,
|
|
AnOverrideTemplate,
|
|
AStorage.NestedStoragePtr
|
|
);
|
|
|
|
if (AStorage.NestedStorage = nil) then
|
|
AStorage.NestedStorage := FType.FDerefData.CreateStorage;
|
|
|
|
AStorage.NestedStorage.SaveToIndex(AnIndex,
|
|
FType.FDerefData,
|
|
APtrEntryTemplate.FType.FDerefData,
|
|
AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultDataPointer.AfterLoadFromIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
assert(AStorage is TGenericNestedWatchResultStorage, 'TWatchResultDataPointer.AfterLoadFromIndex: is TGenericNestedWatchResultStorage');
|
|
|
|
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
|
|
if (FType.FDerefData <> nil) then begin
|
|
if (AStorage.NestedStorage <> nil) then
|
|
AStorage.NestedStorage.LoadFromIndex(AnIndex, FCurrentDerefData, FType.FDerefData, AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultDataPointer.ClearData;
|
|
begin
|
|
if (FType.FDerefData <> nil) then
|
|
FType.FDerefData.ClearData;
|
|
|
|
inherited ClearData;
|
|
end;
|
|
|
|
procedure TWatchResultDataPointer.SetDerefData(ADerefData: TWatchResultData);
|
|
begin
|
|
FType.FDerefData := ADerefData;
|
|
end;
|
|
|
|
constructor TWatchResultDataPointer.Create(AnAddr: TDBGPtr);
|
|
begin
|
|
inherited Create();
|
|
FData.FNumValue := QWord(AnAddr);
|
|
end;
|
|
|
|
{ TWatchResultDataFloat }
|
|
|
|
function TWatchResultDataFloat.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdFloat;
|
|
end;
|
|
|
|
constructor TWatchResultDataFloat.Create(AFloatValue: Extended;
|
|
APrecission: TLzDbgFloatPrecission);
|
|
begin
|
|
inherited Create;
|
|
FData.FFloatValue := AFloatValue;
|
|
FType.FFloatPrecission := APrecission;
|
|
end;
|
|
|
|
{ TWatchResultDataFloatSized }
|
|
|
|
function TWatchResultDataFloatSized.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdFloat;
|
|
end;
|
|
|
|
{ TWatchResultDataSingle }
|
|
|
|
constructor TWatchResultDataSingle.Create(AFloatValue: Single);
|
|
begin
|
|
FData.FFloatValue := AFloatValue;
|
|
end;
|
|
|
|
{ TWatchResultDataDouble }
|
|
|
|
constructor TWatchResultDataDouble.Create(AFloatValue: Double);
|
|
begin
|
|
FData.FFloatValue := AFloatValue;
|
|
end;
|
|
|
|
{ TWatchResultDataExtended }
|
|
|
|
constructor TWatchResultDataExtended.Create(AFloatValue: TDbgExtended);
|
|
begin
|
|
FData.FFloatValue := AFloatValue;
|
|
end;
|
|
|
|
{ TWatchResultDataBoolean }
|
|
|
|
function TWatchResultDataBoolean.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdBool;
|
|
end;
|
|
|
|
constructor TWatchResultDataBoolean.Create(AnOrdBoolValue: QWord;
|
|
AByteSize: Integer);
|
|
begin
|
|
inherited Create;
|
|
FData.FNumValue := AnOrdBoolValue;
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
constructor TWatchResultDataBoolean.Create(ABoolValue: Boolean);
|
|
begin
|
|
inherited Create;
|
|
if ABoolValue then
|
|
FData.FNumValue := 1
|
|
else
|
|
FData.FNumValue := 0;
|
|
FType.FNumByteSize := 0;
|
|
end;
|
|
|
|
{ TWatchResultDataEnum }
|
|
|
|
function TWatchResultDataEnum.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdEnum;
|
|
end;
|
|
|
|
constructor TWatchResultDataEnum.Create(ANumValue: QWord; AName: String;
|
|
AByteSize: Integer);
|
|
begin
|
|
inherited Create;
|
|
FData.FNumValue := ANumValue;
|
|
FData.FName := AName;
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
{ TWatchResultDataEnumVal }
|
|
|
|
function TWatchResultDataEnumVal.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdEnumVal;
|
|
end;
|
|
|
|
constructor TWatchResultDataEnumVal.Create(ANumValue: QWord; AName: String;
|
|
AByteSize: Integer);
|
|
begin
|
|
inherited Create;
|
|
FData.FNumValue := ANumValue;
|
|
FData.FName := AName;
|
|
FType.FNumByteSize := AByteSize;
|
|
end;
|
|
|
|
{ TWatchResultDataSet }
|
|
|
|
function TWatchResultDataSet.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdSet;
|
|
end;
|
|
|
|
constructor TWatchResultDataSet.Create(const ANames: TStringDynArray);
|
|
begin
|
|
inherited Create;
|
|
FData.FNames := ANames;
|
|
end;
|
|
|
|
{ TWatchResultDataVariant }
|
|
|
|
function TWatchResultDataVariant.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdVar;
|
|
end;
|
|
|
|
function TWatchResultDataVariant.GetFieldVisibility: TLzDbgFieldVisibility;
|
|
begin
|
|
Result := FData.FVisibility;
|
|
end;
|
|
|
|
constructor TWatchResultDataVariant.Create(AName: String;
|
|
AVisibility: TLzDbgFieldVisibility);
|
|
begin
|
|
inherited Create;
|
|
FData.FName := AName;
|
|
FData.FVisibility := AVisibility;
|
|
end;
|
|
|
|
procedure TWatchResultDataVariant.SetDerefData(ADerefData: TWatchResultData);
|
|
begin
|
|
FData.FVariantData := ADerefData;
|
|
end;
|
|
|
|
{ TWatchResultDataArrayBase }
|
|
|
|
function TWatchResultDataArrayBase.GetIsFullDephtEvaluated: Boolean;
|
|
begin
|
|
Result := FData.GetIsDephtlessData and // No partly elevated elements
|
|
(Count = ArrayLength); // all elements present
|
|
// TODO: if not GetIsDephtlessData => iterate all elements
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.SetEntryPrototype(AnEntry: TWatchResultData);
|
|
begin
|
|
assert(FType.FEntryTemplate=nil, 'TWatchResultDataArrayBase.SetEntryPrototype: FType.FEntryTemplate=nil');
|
|
|
|
if FType.FEntryTemplate = nil then // never reached => done above
|
|
FType.FEntryTemplate := AnEntry.CreateCopy(True);
|
|
|
|
FCurrentElement := FType.FEntryTemplate; // Reference without ownership
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.WriteValueToStorage(AnIndex: Integer; AValue: TWatchResultData);
|
|
begin
|
|
assert(AValue <> nil, 'TWatchResultDataArrayBase.WriteValueToStorage: AValue <> nil');
|
|
|
|
if AValue.MaybeUpdateProto(
|
|
FType.FEntryTemplate,
|
|
FOverrideTemplateData,
|
|
@FData.FEntries
|
|
)
|
|
then begin
|
|
FCurrentElement := FType.FEntryTemplate;
|
|
end;
|
|
|
|
assert(FData.FEntries <> nil, 'TWatchResultDataArrayBase.WriteValueToStorage: FData.FEntries <> nil');
|
|
assert(AnIndex<FData.FEntries.Count, 'TWatchResultDataArrayBase.WriteValueToStorage: AnIndex<FData.FEntries.Count');
|
|
FData.FEntries.SaveToIndex(AnIndex, AValue, FType.FEntryTemplate, FOverrideTemplateData);
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.SetEntryCount(ACount: Integer);
|
|
begin
|
|
assert((ACount=0) or (FType.FEntryTemplate<>nil), 'TWatchResultDataArrayBase.SetEntryCount: (ACount=0) or (FType.FEntryTemplate<>nil)');
|
|
if ACount = 0 then begin
|
|
FreeAndNil(FData.FEntries);
|
|
exit;
|
|
end;
|
|
|
|
if FData.FEntries = nil then
|
|
FData.FEntries := FType.FEntryTemplate.CreateStorage;
|
|
FData.FEntries.Count := ACount;
|
|
end;
|
|
|
|
function TWatchResultDataArrayBase.MaybeUpdateProto(
|
|
var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
|
|
ARecurse: boolean; ASkipStorage: boolean): boolean;
|
|
var
|
|
AnArrayProtoData: TWatchResultDataArrayBase absolute AProtoData;
|
|
Store: PWatchResultStorage;
|
|
begin
|
|
Result := inherited MaybeUpdateProto(AProtoData, AnOverrideTemplate,
|
|
AStorage, ARecurse, ASkipStorage);
|
|
if (not Result) and (AProtoData is TWatchResultDataArrayBase) and
|
|
ARecurse and (FType.FEntryTemplate <> nil)
|
|
then begin
|
|
Store := AStorage;
|
|
if (Store <> nil) and (Store^ <> nil) then
|
|
Store := Store^.NestedStoragePtr;
|
|
Result := FType.FEntryTemplate.MaybeUpdateProto(AnArrayProtoData.FType.FEntryTemplate, AnOverrideTemplate,
|
|
Store, ARecurse, ASkipStorage);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.AfterSaveToIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AnArrayEntryTemplate: TWatchResultDataArrayBase absolute AnEntryTemplate;
|
|
begin
|
|
assert(AnEntryTemplate is TWatchResultDataArrayBase, 'TWatchResultDataArrayBase.AfterSaveToIndex: AnEntryTemplate is TWatchResultDataArrayBase');
|
|
(* SELF is part of TWatchResultDataArrayBase.FCurrentElement
|
|
SELF and AnEntryTemplate can be the same
|
|
-> if they are no update of FEntryTemplate will happen
|
|
*)
|
|
|
|
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
|
|
if (FType.FEntryTemplate <> nil) then begin
|
|
FType.FEntryTemplate.MaybeUpdateProto(
|
|
AnArrayEntryTemplate.FType.FEntryTemplate,
|
|
AnOverrideTemplate,
|
|
@FData.FEntries,
|
|
True,
|
|
True
|
|
);
|
|
end;
|
|
|
|
if (AnOverrideTemplate = nil) and (FOverrideTemplateData <> nil) then
|
|
AnOverrideTemplate := TGenericWatchResultStorage._ERROR_CLASS.CreateEmpty;
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.AfterLoadFromIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
|
|
if FOverrideTemplateData = nil then
|
|
FOverrideTemplateData := TOverrideTemplateData(AnOverrideTemplate.CreateCopy(True));
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.ClearData;
|
|
begin
|
|
if (FType.FEntryTemplate <> nil) then
|
|
FType.FEntryTemplate.ClearData;
|
|
|
|
inherited ClearData;
|
|
end;
|
|
|
|
destructor TWatchResultDataArrayBase.Destroy;
|
|
begin
|
|
FCurrentElement := Nil;
|
|
if (FType.FEntryTemplate <> nil) and (FData.FEntries <> nil) then
|
|
FType.FEntryTemplate.ClearData;
|
|
|
|
if FOverrideTemplateData <> nil then begin
|
|
assert(FOverrideTemplateData is TWatchResultDataError, 'TWatchResultDataArrayBase.Destroy: FOverrideTemplateData is TWatchResultDataError');
|
|
//FOverrideTemplateData.ClearData;
|
|
FreeAndNil(FOverrideTemplateData);
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.LoadDataFromXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, True);
|
|
if not AnAsProto then begin
|
|
FData.LoadDataFromXMLConfig(AConfig, APath, Self, FOverrideTemplateData, False);
|
|
end;
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.Assign(ASource: TWatchResultData;
|
|
ATypeOnly: Boolean);
|
|
var
|
|
Src: TWatchResultDataArrayBase absolute ASource;
|
|
begin
|
|
if ASource is TWatchResultDataArrayBase then begin
|
|
if Src.FOverrideTemplateData <> nil then
|
|
FOverrideTemplateData := TOverrideTemplateData.CreateEmpty;
|
|
end;
|
|
|
|
// Do not copy _DATA from nested FEntryTemplate
|
|
// Copy our own FData, since it's blocked by AProtoOnly
|
|
if not ATypeOnly then begin
|
|
FData := Src.FData;
|
|
FData.AfterAssign(True);
|
|
end;
|
|
inherited Assign(ASource, True);
|
|
end;
|
|
|
|
procedure TWatchResultDataArrayBase.SetSelectedIndex(AnIndex: Integer);
|
|
begin
|
|
assert((FData.FEntries<>nil) or (AnIndex=0), 'TWatchResultDataArrayBase.SetSelectedIndex: (FData.FEntries<>nil) or (AnIndex=0)');
|
|
if FData.FEntries <> nil then
|
|
FData.FEntries.LoadFromIndex(AnIndex, FCurrentElement, FType.FEntryTemplate, FOverrideTemplateData);
|
|
end;
|
|
|
|
function TWatchResultDataArrayBase.GetSelectedEntry: TWatchResultData;
|
|
begin
|
|
Result := FCurrentElement;
|
|
end;
|
|
|
|
{ TWatchResultDataPCharOrString }
|
|
|
|
function TWatchResultDataPCharOrString.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdPChrStr;
|
|
end;
|
|
|
|
function TWatchResultDataPCharOrString.GetIsFullDephtEvaluated: Boolean;
|
|
begin
|
|
Result := False; // TODO
|
|
end;
|
|
|
|
{ TWatchResultDataArray }
|
|
|
|
function TWatchResultDataArray.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdArray;
|
|
end;
|
|
|
|
procedure TWatchResultDataPCharOrString.SetEntryPrototype(
|
|
AnEntry: TWatchResultData);
|
|
begin
|
|
inherited SetEntryPrototype(AnEntry);
|
|
FTypeName := AnEntry.FTypeName;
|
|
end;
|
|
|
|
function TWatchResultDataArray.GetArrayType: TLzDbgArrayType;
|
|
begin
|
|
Result := datUnknown;
|
|
end;
|
|
|
|
function TWatchResultDataArray.GetLowBound: Int64;
|
|
begin
|
|
Result := FData.GetLowBound;
|
|
end;
|
|
|
|
constructor TWatchResultDataArray.Create(ALength: Integer; ALowBound: Int64);
|
|
begin
|
|
inherited Create;
|
|
FData.FLength := ALength;
|
|
FData.FLowBound := ALowBound;
|
|
end;
|
|
|
|
{ TWatchResultDataDynArray }
|
|
|
|
function TWatchResultDataDynArray.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdDynA;
|
|
end;
|
|
|
|
function TWatchResultDataDynArray.GetArrayType: TLzDbgArrayType;
|
|
begin
|
|
Result := datDynArray;
|
|
end;
|
|
|
|
function TWatchResultDataDynArray.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
constructor TWatchResultDataDynArray.Create(ALength: Integer);
|
|
begin
|
|
inherited Create;
|
|
FData.FLength := ALength;
|
|
end;
|
|
|
|
procedure TWatchResultDataDynArray.SetDataAddress(AnAddr: TDbgPtr);
|
|
begin
|
|
FData.FAddress := AnAddr;
|
|
end;
|
|
|
|
{ TWatchResultDataStatArray }
|
|
|
|
function TWatchResultDataStatArray.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdStatA;
|
|
end;
|
|
|
|
function TWatchResultDataStatArray.GetArrayType: TLzDbgArrayType;
|
|
begin
|
|
Result := datStatArray;
|
|
end;
|
|
|
|
function TWatchResultDataStatArray.GetDataAddress: TDBGPtr;
|
|
begin
|
|
Result := FData.GetDataAddress;
|
|
end;
|
|
|
|
function TWatchResultDataStatArray.GetLength: Integer;
|
|
begin
|
|
Result := FType.GetLength;
|
|
end;
|
|
|
|
constructor TWatchResultDataStatArray.Create(ALength: Integer; ALowBound: Int64
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FType.FLength := ALength;
|
|
FType.FLowBound := ALowBound;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator }
|
|
|
|
function TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
|
begin
|
|
FSource.SetSelectedIndex(FIndex);
|
|
Result := Default(TWatchResultDataFieldInfo);
|
|
Result.Field := FSource.SelectedEntry.DerefData;
|
|
Result.FieldName := FSource.SelectedEntry.AsString;
|
|
Result.FieldVisibility := FSource.SelectedEntry.FieldVisibility;
|
|
end;
|
|
|
|
constructor TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.Create
|
|
(ARes: TWatchResultData);
|
|
begin
|
|
inherited Create(ARes);
|
|
FIndex := -1;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.MoveNext: Boolean;
|
|
begin
|
|
inc(FIndex);
|
|
Result := FIndex < FSource.Count;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator }
|
|
|
|
function TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
|
begin
|
|
if FSubEnumerator <> nil then begin
|
|
Result := FSubEnumerator.Current;
|
|
Result.Owner := FSubOwner;
|
|
end
|
|
else
|
|
Result := FSource.Fields[FIndex];
|
|
end;
|
|
|
|
constructor TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.Create
|
|
(ARes: TWatchResultData);
|
|
begin
|
|
inherited Create(ARes);
|
|
FIndex := -1;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.MoveNext: Boolean;
|
|
begin
|
|
if FSubEnumerator <> nil then begin
|
|
Result := FSubEnumerator.MoveNext;
|
|
if Result then
|
|
exit
|
|
else
|
|
FreeAndNil(FSubEnumerator);
|
|
end;
|
|
|
|
repeat
|
|
inc(FIndex);
|
|
Result := FIndex < FSource.FieldCount;
|
|
|
|
if Result and (dffVariant in FSource.Fields[FIndex].FieldFlags) then begin
|
|
FSubOwner := FSource.Fields[FIndex].Owner;
|
|
FSubEnumerator := TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.Create(
|
|
FSource.Fields[FIndex].Field
|
|
);
|
|
if not FSubEnumerator.MoveNext then begin
|
|
FreeAndNil(FSubEnumerator);
|
|
Continue;
|
|
end;
|
|
end;
|
|
|
|
break;
|
|
until True;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage }
|
|
|
|
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetStoredFieldCount: Integer;
|
|
begin
|
|
Result := Length(FFieldsStorage);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetStoredFieldCount
|
|
(AValue: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AValue = Length(FFieldsStorage) then
|
|
exit;
|
|
|
|
for i := AValue to Length(FFieldsStorage) - 1 do
|
|
FreeAndNil(FFieldsStorage[i]);
|
|
SetLength(FFieldsStorage, AValue);
|
|
|
|
for i := AValue to Length(FOverrideTempl) - 1 do
|
|
FreeAndNil(FOverrideTempl[i]);
|
|
SetLength(FOverrideTempl, AValue);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetCount
|
|
(AValue: integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited SetCount(AValue);
|
|
for i := 0 to Length(FFieldsStorage) - 1 do
|
|
if FFieldsStorage[i] <> nil then
|
|
FFieldsStorage[i].SetCount(AValue);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.Assign(
|
|
ASource: TWatchResultStorage);
|
|
var
|
|
Src: TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage absolute ASource;
|
|
i: Integer;
|
|
begin
|
|
inherited Assign(ASource);
|
|
|
|
if ASource is TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage then begin
|
|
SetLength(FFieldsStorage, Length(Src.FFieldsStorage));
|
|
for i := 0 to Length(FFieldsStorage) - 1 do
|
|
FFieldsStorage[i] := Src.FFieldsStorage[i].CreateCopy;
|
|
|
|
SetLength(FOverrideTempl, Length(Src.FOverrideTempl));
|
|
for i := 0 to Length(FOverrideTempl) - 1 do
|
|
FOverrideTempl[i] := TOverrideTemplateData(Src.FOverrideTempl[i].CreateCopy);
|
|
end;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetNestedStorage
|
|
(AnIndex: Integer): TWatchResultStorage;
|
|
begin
|
|
Result := FFieldsStorage[AnIndex];
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetNestedStoragePtr
|
|
(AnIndex: Integer): PWatchResultStorage;
|
|
begin
|
|
Result := @FFieldsStorage[AnIndex];
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage
|
|
(AnIndex: Integer; AValue: TWatchResultStorage);
|
|
begin
|
|
assert((FFieldsStorage[AnIndex]=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FFieldsStorage[AnIndex]=nil) or (AValue=nil)');
|
|
FFieldsStorage[AnIndex] := AValue;
|
|
|
|
if AValue <> nil then
|
|
AValue.Count := Count;
|
|
end;
|
|
|
|
destructor TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.Destroy;
|
|
begin
|
|
StoredFieldCount := 0;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.LoadDataFromXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
|
|
var
|
|
t: TWatchResultData;
|
|
i: Integer;
|
|
begin
|
|
assert((AnEntryTemplate=nil) or (AnEntryTemplate is TGenericWatchResultDataStruct), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.LoadDataFromXMLConfig: (AnEntryTemplate=nil) or (AnEntryTemplate is TGenericWatchResultDataStruct)');
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate,
|
|
AnOverrideTemplate, ANestLvl);
|
|
|
|
for i := 0 to Length(FFieldsStorage) - 1 do begin
|
|
if FFieldsStorage[i] <> nil then begin
|
|
t := AnEntryTemplate;
|
|
if t <> nil then
|
|
t := TGenericWatchResultDataStruct(t).FType.FFieldData[i].Field;
|
|
FFieldsStorage[i].LoadDataFromXMLConfig(AConfig, APath+'F'+IntToStr(i)+'/', t, FOverrideTempl[i], ANestLvl);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SaveDataToXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
|
|
|
|
for i := 0 to Length(FFieldsStorage) - 1 do
|
|
if FFieldsStorage[i] <> nil then
|
|
FFieldsStorage[i].SaveDataToXMLConfig(AConfig, APath+'F'+IntToStr(i)+'/', ANestLvl);
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStruct }
|
|
|
|
class function TGenericWatchResultDataStruct.GetStorageClass: TWatchResultStorageClass;
|
|
begin
|
|
Result := TNestedFieldsWatchResultStorage;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.CreateStorage: TWatchResultStorage;
|
|
var
|
|
Store: TNestedFieldsWatchResultStorage absolute Result;
|
|
i: Integer;
|
|
begin
|
|
Result := inherited CreateStorage;
|
|
|
|
Store.StoredFieldCount := Length(FType.FFieldData);
|
|
for i := 0 to Length(FType.FFieldData) - 1 do
|
|
if FType.FFieldData[i].Field <> nil then
|
|
Store.NestedStorage[i] := FType.FFieldData[i].Field.CreateStorage;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.MaybeUpdateProto(
|
|
var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
|
|
ARecurse: boolean; ASkipStorage: boolean): boolean;
|
|
var
|
|
AStructProtoData: TGenericWatchResultDataStruct absolute AProtoData;
|
|
FieldStore: PNestedFieldsWatchResultStorage absolute AStorage;
|
|
dummy: TOverrideTemplateData;
|
|
i: Integer;
|
|
begin
|
|
Result := inherited MaybeUpdateProto(AProtoData, AnOverrideTemplate, AStorage, ARecurse, ASkipStorage);
|
|
if Result or not ARecurse then
|
|
exit;
|
|
|
|
if (Length(AStructProtoData.FType.FFieldData) = 0) and
|
|
(Length(FType.FFieldData) > 0)
|
|
then
|
|
AStructProtoData.FType.CopyFieldsProtoFrom(FType);
|
|
assert((Length(FType.FFieldData)=0) or (Length(FType.FFieldData)=Length(AStructProtoData.FType.FFieldData)), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (Length(FType.FFieldData)=0) or (Length(FType.FFieldData)=Length(AStructProtoData.FType.FFieldData))');
|
|
|
|
|
|
assert((AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage)');
|
|
if (AStorage = nil) or (AStorage^ = nil)
|
|
then begin
|
|
if (ARecurse) then begin // or "if not ASkipStorage and " ??
|
|
dummy := nil;
|
|
for i := 0 to Length(FType.FFieldData) - 1 do begin
|
|
if FType.FFieldData[i].Field <> nil then begin
|
|
FType.FFieldData[i].Field.MaybeUpdateProto(AStructProtoData.FType.FFieldData[i].Field,
|
|
dummy, nil, ARecurse, ASkipStorage);
|
|
assert(dummy = nil, 'TGenericWatchResultDataStruct.MaybeUpdateProto: dummy = nil');
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
|
|
else begin
|
|
if (FieldStore^.StoredFieldCount = 0) then
|
|
FieldStore^.StoredFieldCount := Length(FType.FFieldData);
|
|
assert((length(FType.FFieldData)=0) or (FieldStore^.StoredFieldCount = Length(FType.FFieldData)), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (length(FType.FFieldData)=0) or (FieldStore^.StoredFieldCount = Length(FType.FFieldData))');
|
|
|
|
for i := 0 to Length(FType.FFieldData) - 1 do begin
|
|
if FType.FFieldData[i].Field <> nil then begin
|
|
FType.FFieldData[i].Field.MaybeUpdateProto(AStructProtoData.FType.FFieldData[i].Field,
|
|
FieldStore^.FOverrideTempl[i], FieldStore^.NestedStoragePtr[i], ARecurse, ASkipStorage);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.AfterSaveToIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AStructEntryTemplate: TGenericWatchResultDataStruct absolute AnEntryTemplate;
|
|
AStore: TNestedFieldsWatchResultStorage absolute AStorage;
|
|
i: Integer;
|
|
begin
|
|
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
|
|
if not FHasFields then
|
|
exit;
|
|
|
|
if Length(FType.FFieldData) > AStore.StoredFieldCount then begin
|
|
assert(AStore.StoredFieldCount=0, 'TGenericWatchResultDataStruct.AfterSaveToIndex: AStore.StoredFieldCount=0');
|
|
AStore.StoredFieldCount := Length(FType.FFieldData);
|
|
assert(length(AStructEntryTemplate.FType.FFieldData) = 0, 'TGenericWatchResultDataStruct.AfterSaveToIndex: length(AStructEntryTemplate.FType.FFieldData) = 0');
|
|
AStructEntryTemplate.FType.FFieldData := FType.FFieldData;
|
|
SetLength(AStructEntryTemplate.FType.FFieldData, Length(AStructEntryTemplate.FType.FFieldData));
|
|
for i := 0 to Length(AStructEntryTemplate.FType.FFieldData) - 1 do
|
|
AStructEntryTemplate.FType.FFieldData[i].Field := nil;
|
|
end;
|
|
for i := 0 to Length(FType.FFieldData) - 1 do begin
|
|
if FType.FFieldData[i].Field <> nil then begin
|
|
FType.FFieldData[i].Field.MaybeUpdateProto(
|
|
AStructEntryTemplate.FType.FFieldData[i].Field,
|
|
AStore.FOverrideTempl[i],
|
|
AStore.NestedStoragePtr[i]
|
|
);
|
|
|
|
if (AStore.NestedStorage[i] = nil) then
|
|
AStore.NestedStorage[i] := FType.FFieldData[i].Field.CreateStorage;
|
|
|
|
AStore.NestedStorage[i].SaveToIndex(AnIndex,
|
|
FType.FFieldData[i].Field,
|
|
AStructEntryTemplate.FType.FFieldData[i].Field,
|
|
AStore.FOverrideTempl[i]);
|
|
end;
|
|
end;
|
|
FHasFields := False;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.AfterLoadFromIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AStore: TNestedFieldsWatchResultStorage absolute AStorage;
|
|
i: Integer;
|
|
begin
|
|
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate,
|
|
AnOverrideTemplate);
|
|
|
|
if AStore.StoredFieldCount = 0 then begin
|
|
SetLength(FCurrentFields, 0);
|
|
end
|
|
else begin
|
|
assert(AStore.StoredFieldCount = Length(FType.FFieldData), 'TGenericWatchResultDataStruct.AfterLoadFromIndex: AStore.StoredFieldCount = Length(FType.FFieldData)');
|
|
SetLength(FCurrentFields, Length(FType.FFieldData));
|
|
if (AStore.NestedStorage[0] = nil) or (AStore.NestedStorage[0].Count = 0) then begin
|
|
for i := 0 to Length(FCurrentFields) - 1 do
|
|
FCurrentFields[i] := nil;
|
|
end
|
|
else begin
|
|
for i := 0 to Length(FType.FFieldData) - 1 do begin
|
|
if (AStore.NestedStorage[i] <> nil) then begin
|
|
AStore.NestedStorage[i].LoadFromIndex(AnIndex, FCurrentFields[i], FType.FFieldData[i].Field, AStore.FOverrideTempl[i]);
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.ClearData;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited ClearData;
|
|
|
|
FHasFields := False;
|
|
for i := 0 to Length(FType.FFieldData) - 1 do
|
|
if (FType.FFieldData[i].Field <> nil) then
|
|
FType.FFieldData[i].Field.ClearData;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.GetFields(AnIndex: Integer
|
|
): TWatchResultDataFieldInfo;
|
|
begin
|
|
Result := inherited GetFields(AnIndex);
|
|
if (AnIndex < Length(FCurrentFields)) and (FCurrentFields[AnIndex] <> nil) then
|
|
Result.Field := FCurrentFields[AnIndex];
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.GetEnumerator: TWatchResultDataEnumerator;
|
|
begin
|
|
Result := TWatchResultDataStructEnumerator.Create(Self);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.SetFieldCount(ACount: integer);
|
|
begin
|
|
SetLength(FType.FFieldData, ACount);
|
|
// DoFree for unused fields
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.SetField(AnIndex: Integer;
|
|
AFieldName: String; AVisibility: TLzDbgFieldVisibility;
|
|
AFlags: TLzDbgFieldFlags; AData: TWatchResultData);
|
|
begin
|
|
FHasFields := True;
|
|
FType.FFieldData[AnIndex].FieldName := AFieldName;
|
|
FType.FFieldData[AnIndex].FieldVisibility := AVisibility;
|
|
FType.FFieldData[AnIndex].FieldFlags := AFlags;
|
|
FType.FFieldData[AnIndex].Field := AData;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStruct.AddField(AFieldName: String;
|
|
AVisibility: TLzDbgFieldVisibility; AFlags: TLzDbgFieldFlags;
|
|
AData: TWatchResultData): Integer;
|
|
begin
|
|
FHasFields := True;
|
|
Result := Length(FType.FFieldData);
|
|
SetLength(FType.FFieldData, Result + 1);
|
|
FType.FFieldData[Result].FieldName := AFieldName;
|
|
FType.FFieldData[Result].FieldVisibility := AVisibility;
|
|
FType.FFieldData[Result].FieldFlags := AFlags;
|
|
FType.FFieldData[Result].Field := AData;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStruct.SetFieldData(AnIndex: Integer;
|
|
AData: TWatchResultData);
|
|
begin
|
|
FHasFields := True;
|
|
if AnIndex >= Length(FType.FFieldData) then
|
|
SetLength(FType.FFieldData, AnIndex+1);
|
|
FType.FFieldData[AnIndex].Field := AData;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage }
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SetCount
|
|
(AValue: integer);
|
|
begin
|
|
inherited SetCount(AValue);
|
|
if FAnchestorStorage <> nil then
|
|
FAnchestorStorage.SetCount(AValue);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.Assign
|
|
(ASource: TWatchResultStorage);
|
|
var
|
|
Src: TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage absolute ASource;
|
|
begin
|
|
inherited Assign(ASource);
|
|
|
|
if ASource is TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage then begin
|
|
FAnchestorStorage := Src.FAnchestorStorage.CreateCopy;
|
|
end;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.GetNestedStorage
|
|
(AnIndex: Integer): TWatchResultStorage;
|
|
begin
|
|
if AnIndex < 0 then
|
|
Result := FAnchestorStorage
|
|
else
|
|
Result := inherited GetNestedStorage(AnIndex);
|
|
end;
|
|
|
|
function TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.GetNestedStoragePtr
|
|
(AnIndex: Integer): PWatchResultStorage;
|
|
begin
|
|
if AnIndex < 0 then
|
|
Result := @FAnchestorStorage
|
|
else
|
|
Result := inherited GetNestedStoragePtr(AnIndex);
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SetNestedStorage
|
|
(AnIndex: Integer; AValue: TWatchResultStorage);
|
|
begin
|
|
if AnIndex < 0 then begin
|
|
assert((FAnchestorStorage=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FAnchestorStorage=nil) or (AValue=nil)');
|
|
FAnchestorStorage := AValue;
|
|
|
|
if AValue <> nil then
|
|
AValue.Count := Count;
|
|
end
|
|
else
|
|
inherited SetNestedStorage(AnIndex, AValue);
|
|
end;
|
|
|
|
destructor TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.Destroy;
|
|
begin
|
|
FreeAndNil(FAnchestorStorage);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.LoadDataFromXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
|
|
var
|
|
t: TWatchResultData;
|
|
begin
|
|
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate,
|
|
AnOverrideTemplate, ANestLvl);
|
|
|
|
if FAnchestorStorage <> nil then begin
|
|
t := AnEntryTemplate;
|
|
if t <> nil then
|
|
t := TGenericWatchResultDataStructWithAnchestor(t).FType.FAnchestor;
|
|
|
|
FAnchestorStorage.LoadDataFromXMLConfig(AConfig, APath+'Anch/', t, AnOverrideTemplate, ANestLvl);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SaveDataToXMLConfig
|
|
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
|
|
|
|
if FAnchestorStorage <> nil then
|
|
FAnchestorStorage.SaveDataToXMLConfig(AConfig, APath+'Anch/', ANestLvl);
|
|
end;
|
|
|
|
{ TGenericWatchResultDataStructWithAnchestor }
|
|
|
|
class function TGenericWatchResultDataStructWithAnchestor.GetStorageClass: TWatchResultStorageClass;
|
|
begin
|
|
Result := TNestedFieldsAndAnchestorWatchResultStorage;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStructWithAnchestor.CreateStorage: TWatchResultStorage;
|
|
var
|
|
Store: TNestedFieldsAndAnchestorWatchResultStorage absolute Result;
|
|
begin
|
|
Result := inherited CreateStorage;
|
|
|
|
if FType.FAnchestor <> nil then
|
|
Store.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStructWithAnchestor.MaybeUpdateProto(
|
|
var AProtoData: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
|
|
ARecurse: boolean; ASkipStorage: boolean): boolean;
|
|
var
|
|
AStructProtoData: TGenericWatchResultDataStructWithAnchestor absolute AProtoData;
|
|
FieldStore: PNestedFieldsAndAnchestorWatchResultStorage absolute AStorage;
|
|
dummy: TOverrideTemplateData;
|
|
begin
|
|
Result := inherited MaybeUpdateProto(AProtoData, AnOverrideTemplate, AStorage, ARecurse, ASkipStorage);
|
|
if Result or not ARecurse then
|
|
exit;
|
|
|
|
if (AStructProtoData.FType.FAnchestor = nil) and
|
|
(FType.FAnchestor <> nil)
|
|
then
|
|
AStructProtoData.FType.FAnchestor := FType.FAnchestor.CreateCopy(True);
|
|
|
|
|
|
assert((AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsAndAnchestorWatchResultStorage), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage)');
|
|
if (AStorage = nil) or (AStorage^ = nil)
|
|
then begin
|
|
if (ARecurse) then begin // or "if not ASkipStorage and " ??
|
|
dummy := nil;
|
|
if FType.FAnchestor <> nil then begin
|
|
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, dummy,
|
|
nil, ARecurse, ASkipStorage);
|
|
assert(dummy = nil, 'TGenericWatchResultDataStructWithAnchestor.MaybeUpdateProto: dummy = nil');
|
|
end;
|
|
end;
|
|
end
|
|
|
|
else begin
|
|
if FType.FAnchestor <> nil then begin
|
|
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, AnOverrideTemplate,
|
|
FieldStore^.NestedStoragePtr[-1], ARecurse, ASkipStorage);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.AfterSaveToIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
var AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AStructEntryTemplate: TGenericWatchResultDataStructWithAnchestor absolute AnEntryTemplate;
|
|
AStore: TNestedFieldsAndAnchestorWatchResultStorage absolute AStorage;
|
|
begin
|
|
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate,
|
|
AnOverrideTemplate);
|
|
|
|
if (FType.FAnchestor <> nil) then begin
|
|
assert(AnEntryTemplate is TGenericWatchResultDataStructWithAnchestor, 'TGenericWatchResultDataStructWithAnchestor.AfterSaveToIndex: AnEntryTemplate is TGenericWatchResultDataStruct');
|
|
|
|
FType.FAnchestor.MaybeUpdateProto(
|
|
AStructEntryTemplate.FType.FAnchestor,
|
|
AnOverrideTemplate,
|
|
AStore.NestedStoragePtr[-1]
|
|
);
|
|
|
|
if (AStore.NestedStorage[-1] = nil) then
|
|
AStore.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
|
|
|
|
AStore.NestedStorage[-1].SaveToIndex(AnIndex,
|
|
FType.FAnchestor,
|
|
AStructEntryTemplate.FType.FAnchestor,
|
|
AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.AfterLoadFromIndex(
|
|
AStorage: TWatchResultStorage; AnIndex: Integer;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
var
|
|
AStore: TNestedFieldsAndAnchestorWatchResultStorage absolute AStorage;
|
|
begin
|
|
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate,
|
|
AnOverrideTemplate);
|
|
|
|
if (FType.FAnchestor <> nil) then begin
|
|
if (AStore.NestedStorage[-1] <> nil) then
|
|
AStore.NestedStorage[-1].LoadFromIndex(AnIndex, FCurrentAnchestor, FType.FAnchestor, AnOverrideTemplate);
|
|
end;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.ClearData;
|
|
begin
|
|
inherited ClearData;
|
|
|
|
if FType.FAnchestor <> nil then
|
|
FType.FAnchestor.ClearData;
|
|
end;
|
|
|
|
function TGenericWatchResultDataStructWithAnchestor.GetAnchestor: TWatchResultData;
|
|
begin
|
|
if FCurrentAnchestor <> nil then
|
|
Result := FCurrentAnchestor
|
|
else
|
|
Result := inherited GetAnchestor;
|
|
end;
|
|
|
|
procedure TGenericWatchResultDataStructWithAnchestor.SetAnchestor(
|
|
AnAnchestor: TWatchResultData);
|
|
begin
|
|
FType.FAnchestor := AnAnchestor;
|
|
end;
|
|
|
|
{ TWatchResultDataStruct }
|
|
|
|
function TWatchResultDataStruct.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdStruct;
|
|
end;
|
|
|
|
constructor TWatchResultDataStruct.Create(AStructType: TLzDbgStructType);
|
|
begin
|
|
FType.FStructType := AStructType;
|
|
FHasFields := False;
|
|
end;
|
|
|
|
{ TWatchResultDataRefStruct }
|
|
|
|
function TWatchResultDataRefStruct.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdStructRef;
|
|
end;
|
|
|
|
function TWatchResultDataRefStruct.GetHasDataAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
constructor TWatchResultDataRefStruct.Create(AStructType: TLzDbgStructType;
|
|
ADataAddress: TDBGPtr);
|
|
begin
|
|
FData.FDataAddress := ADataAddress;
|
|
FType.FStructType := AStructType;
|
|
FHasFields := False;
|
|
end;
|
|
|
|
{ TWatchResultDataConverted }
|
|
|
|
function TWatchResultDataConverted.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdConverted;
|
|
end;
|
|
|
|
function TWatchResultDataConverted.GetBackendValueHandler: ILazDbgValueConverterIntf;
|
|
begin
|
|
Result := FType.FHandler;
|
|
end;
|
|
|
|
function TWatchResultDataConverted.GetConvertedRes: TWatchResultData;
|
|
begin
|
|
if (FieldCount > 0) then
|
|
Result := Fields[0].Field;
|
|
|
|
if (FieldCount > 1) and
|
|
( (Fields[0].Field = nil) or
|
|
(Fields[0].Field.ValueKind = rdkError)
|
|
)
|
|
then
|
|
Result := Fields[1].Field;
|
|
end;
|
|
|
|
constructor TWatchResultDataConverted.Create(
|
|
AHandler: ILazDbgValueConverterIntf);
|
|
begin
|
|
assert((FType.FHandler=nil) or (FType.FHandler=AHandler) or (AHandler=nil), 'TWatchResultDataConverted.Create: (FType.FHandler=nil) or (FType.FHandler=AHandler) or (AHandler=nil)');
|
|
if (AHandler <> FType.FHandler) and (AHandler <> nil) then begin
|
|
if FType.FHandler <> nil then
|
|
FType.FHandler.ReleaseReference;
|
|
FType.FHandler := AHandler;
|
|
if AHandler <> nil then
|
|
AHandler.AddReference;
|
|
end;
|
|
FHasFields := False;
|
|
end;
|
|
|
|
{ TGenericWatchResultDataProc }
|
|
|
|
function TGenericWatchResultDataProc.GetAsString: RawByteString;
|
|
begin
|
|
Result := FData.FLoc;
|
|
end;
|
|
|
|
function TGenericWatchResultDataProc.GetAsDesc: String;
|
|
begin
|
|
Result := FType.FText;
|
|
end;
|
|
|
|
constructor TGenericWatchResultDataProc.Create(AnAddr: QWord; ALoc,
|
|
ADesc: String);
|
|
begin
|
|
FType.FText := ADesc;
|
|
FData.FLoc := ALoc;
|
|
FData.FNumValue := AnAddr;
|
|
inherited Create();
|
|
end;
|
|
|
|
{ TWatchResultDataFunc }
|
|
|
|
function TWatchResultDataFunc.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdFunc;
|
|
end;
|
|
|
|
{ TWatchResultDataProc }
|
|
|
|
function TWatchResultDataProc.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdProc;
|
|
end;
|
|
|
|
{ TWatchResultDataFuncRef }
|
|
|
|
function TWatchResultDataFuncRef.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdFuncRef;
|
|
end;
|
|
|
|
{ TWatchResultDataProcRef }
|
|
|
|
function TWatchResultDataProcRef.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdProcRef;
|
|
end;
|
|
|
|
{ TWatchResultDataError.TErrorDataStorage }
|
|
|
|
procedure TWatchResultDataError.TErrorDataStorage.SaveDataToXMLConfig(
|
|
const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
|
begin
|
|
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
|
|
AConfig.SetDeleteValue(APath+TAG_ALL_ERR, ANestLvl, -1);
|
|
end;
|
|
|
|
procedure TWatchResultDataError.TErrorDataStorage.LoadFromIndex(
|
|
AnIndex: Integer; out AData: TWatchResultData;
|
|
const AnEntryTemplate: TWatchResultData;
|
|
var AnOverrideTemplate: TOverrideTemplateData);
|
|
begin
|
|
if AnEntryTemplate.ClassType <> TWatchResultDataError then begin
|
|
if AnOverrideTemplate = nil then
|
|
AnOverrideTemplate := TGenericWatchResultStorage._ERROR_CLASS.CreateEmpty;
|
|
inherited LoadFromIndex(AnIndex, AData, AnOverrideTemplate, AnOverrideTemplate)
|
|
end
|
|
else
|
|
inherited LoadFromIndex(AnIndex, AData, AnEntryTemplate, AnOverrideTemplate);
|
|
end;
|
|
|
|
{ TWatchResultDataError }
|
|
|
|
function TWatchResultDataError.GetClassID: TWatchResultDataClassID;
|
|
begin
|
|
Result := wdErr;
|
|
end;
|
|
|
|
class function TWatchResultDataError.GetStorageClass: TWatchResultStorageClass;
|
|
begin
|
|
Result := TErrorDataStorage;
|
|
end;
|
|
|
|
constructor TWatchResultDataError.Create(APrintedVal: String);
|
|
begin
|
|
inherited Create;
|
|
FData.FText := APrintedVal;
|
|
end;
|
|
|
|
initialization
|
|
_TGenericWatchResultValueFloat_FPointSettings := DefaultFormatSettings;
|
|
_TGenericWatchResultValueFloat_FPointSettings.DecimalSeparator := '.';
|
|
_TGenericWatchResultValueFloat_FPointSettings.ThousandSeparator := ',';
|
|
|
|
end.
|
|
|