mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 16:43:43 +02:00
c53e775af5
with the ability to deal with Dwarf-debug info. Added the ability to read the Dwarf-debug info from the object files and to map the corresponding addresses to their position in the final executable. git-svn-id: trunk@48864 -
4763 lines
142 KiB
ObjectPascal
4763 lines
142 KiB
ObjectPascal
{
|
|
---------------------------------------------------------------------------
|
|
fpdbgdwarf.pas - Native Freepascal debugger - Dwarf symbol processing
|
|
---------------------------------------------------------------------------
|
|
|
|
This unit contains helper classes for handling and evaluating of debuggee data
|
|
described by DWARF debug symbols
|
|
|
|
---------------------------------------------------------------------------
|
|
|
|
@created(Mon Aug 1st WET 2006)
|
|
@lastmod($Date$)
|
|
@author(Marc Weustink <marc@@dommelstein.nl>)
|
|
@author(Martin Friebe)
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit FpDbgDwarf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{off $INLINE OFF}
|
|
|
|
(* Notes:
|
|
|
|
* FpDbgDwarfValues and Context
|
|
The Values do not add a reference to the Context. Yet they require the Context.
|
|
It is the users responsibility to keep the context, as long as any value exists.
|
|
|
|
*)
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, types, math, FpDbgInfo, FpDbgDwarfDataClasses, FpdMemoryTools, FpErrorMessages,
|
|
FpDbgUtil, FpDbgDwarfConst, DbgIntfBaseTypes, LazUTF8, LazLoggerBase, LazClasses;
|
|
|
|
type
|
|
TFpDwarfInfo = FpDbgDwarfDataClasses.TFpDwarfInfo;
|
|
|
|
{ TFpDwarfDefaultSymbolClassMap }
|
|
|
|
TFpDwarfDefaultSymbolClassMap = class(TFpDwarfSymbolClassMap)
|
|
public
|
|
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
|
|
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
|
class function CreateContext(AThreadId, AStackFrame: Integer; AnAddress:
|
|
TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext; override;
|
|
class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
|
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
|
|
end;
|
|
|
|
{ TFpDwarfInfoAddressContext }
|
|
|
|
TFpDwarfInfoAddressContext = class(TFpDbgInfoContext)
|
|
private
|
|
FSymbol: TFpDbgSymbol;
|
|
FAddress: TDBGPtr;
|
|
FThreadId, FStackFrame: Integer;
|
|
FDwarf: TFpDwarfInfo;
|
|
FlastResult: TFpDbgValue;
|
|
protected
|
|
function GetSymbolAtAddress: TFpDbgSymbol; override;
|
|
function GetProcedureAtAddress: TFpDbgValue; override;
|
|
function GetAddress: TDbgPtr; override;
|
|
function GetThreadId: Integer; override;
|
|
function GetStackFrame: Integer; override;
|
|
function GetSizeOfAddress: Integer; override;
|
|
function GetMemManager: TFpDbgMemManager; override;
|
|
|
|
property Symbol: TFpDbgSymbol read FSymbol;
|
|
property Dwarf: TFpDwarfInfo read FDwarf;
|
|
property Address: TDBGPtr read FAddress write FAddress;
|
|
property ThreadId: Integer read FThreadId write FThreadId;
|
|
property StackFrame: Integer read FStackFrame write FStackFrame;
|
|
|
|
function ApplyContext(AVal: TFpDbgValue): TFpDbgValue; inline;
|
|
function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline;
|
|
procedure AddRefToVal(AVal: TFpDbgValue); inline;
|
|
function GetSelfParameter: TFpDbgValue; virtual;
|
|
|
|
function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar;
|
|
SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean; inline;
|
|
function FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar;
|
|
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; inline;
|
|
// FindLocalSymbol: for the subroutine itself
|
|
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
|
|
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; virtual;
|
|
public
|
|
constructor Create(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo);
|
|
destructor Destroy; override;
|
|
function FindSymbol(const AName: String): TFpDbgValue; override;
|
|
end;
|
|
|
|
TFpDwarfSymbol = class;
|
|
TFpDwarfSymbolType = class;
|
|
TFpDwarfSymbolValue = class;
|
|
TFpDwarfSymbolValueClass = class of TFpDwarfSymbolValue;
|
|
TFpDwarfSymbolTypeClass = class of TFpDwarfSymbolType;
|
|
|
|
{%region Value objects }
|
|
|
|
{ TFpDwarfValueBase }
|
|
|
|
TFpDwarfValueBase = class(TFpDbgValue)
|
|
private
|
|
FContext: TFpDbgInfoContext;
|
|
public
|
|
property Context: TFpDbgInfoContext read FContext;
|
|
end;
|
|
|
|
{ TFpDwarfValueTypeDefinition }
|
|
|
|
TFpDwarfValueTypeDefinition = class(TFpDwarfValueBase)
|
|
private
|
|
FSymbol: TFpDbgSymbol; // stType
|
|
protected
|
|
function GetKind: TDbgSymbolKind; override;
|
|
function GetDbgSymbol: TFpDbgSymbol; override;
|
|
public
|
|
constructor Create(ASymbol: TFpDbgSymbol); // Only for stType
|
|
destructor Destroy; override;
|
|
function GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue; override;
|
|
end;
|
|
|
|
{ TFpDwarfValue }
|
|
|
|
TFpDwarfValue = class(TFpDwarfValueBase)
|
|
private
|
|
FOwner: TFpDwarfSymbolType; // the creator, usually the type
|
|
FValueSymbol: TFpDwarfSymbolValue;
|
|
FTypeCastTargetType: TFpDwarfSymbolType;
|
|
FTypeCastSourceValue: TFpDbgValue;
|
|
|
|
FDataAddressCache: array of TFpDbgMemLocation;
|
|
FStructureValue: TFpDwarfValue;
|
|
FLastMember: TFpDwarfValue;
|
|
FLastError: TFpError;
|
|
function GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation;
|
|
function MemManager: TFpDbgMemManager; inline;
|
|
function AddressSize: Byte; inline;
|
|
procedure SetDataAddressCache(AIndex: Integer; AValue: TFpDbgMemLocation);
|
|
procedure SetStructureValue(AValue: TFpDwarfValue);
|
|
protected
|
|
procedure DoReferenceAdded; override;
|
|
procedure DoReferenceReleased; override;
|
|
procedure CircleBackRefActiveChanged(NewActive: Boolean); override;
|
|
procedure SetLastMember(ALastMember: TFpDwarfValue);
|
|
function GetLastError: TFpError; override;
|
|
|
|
// Address of the symbol (not followed any type deref, or location)
|
|
function GetAddress: TFpDbgMemLocation; override;
|
|
function OrdOrAddress: TFpDbgMemLocation;
|
|
// Address of the data (followed type deref, location, ...)
|
|
function DataAddr: TFpDbgMemLocation;
|
|
function OrdOrDataAddr: TFpDbgMemLocation;
|
|
function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType = nil): Boolean;
|
|
function GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType = nil): Boolean;
|
|
function HasDwarfDataAddress: Boolean; // TODO: is this just HasAddress?
|
|
|
|
procedure Reset; virtual; // keeps lastmember and structureninfo
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function HasTypeCastInfo: Boolean;
|
|
function IsValidTypeCast: Boolean; virtual;
|
|
function GetKind: TDbgSymbolKind; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgValue; override;
|
|
function GetMember(AIndex: Int64): TFpDbgValue; override;
|
|
function GetDbgSymbol: TFpDbgSymbol; override;
|
|
function GetTypeInfo: TFpDbgSymbol; override;
|
|
function GetContextTypeInfo: TFpDbgSymbol; override;
|
|
public
|
|
constructor Create(AOwner: TFpDwarfSymbolType);
|
|
destructor Destroy; override;
|
|
procedure SetValueSymbol(AValueSymbol: TFpDwarfSymbolValue);
|
|
function SetTypeCastInfo(AStructure: TFpDwarfSymbolType;
|
|
ASource: TFpDbgValue): Boolean; // Used for Typecast
|
|
// StructureValue: Any Value returned via GetMember points to its structure
|
|
property StructureValue: TFpDwarfValue read FStructureValue write SetStructureValue;
|
|
// DataAddressCache[0]: ValueAddress // DataAddressCache[1..n]: DataAddress
|
|
property DataAddressCache[AIndex: Integer]: TFpDbgMemLocation read GetDataAddressCache write SetDataAddressCache;
|
|
end;
|
|
|
|
{ TFpDwarfValueSized }
|
|
|
|
TFpDwarfValueSized = class(TFpDwarfValue)
|
|
private
|
|
FSize: Integer;
|
|
protected
|
|
function CanUseTypeCastAddress: Boolean;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetSize: Integer; override;
|
|
public
|
|
constructor Create(AOwner: TFpDwarfSymbolType; ASize: Integer);
|
|
end;
|
|
|
|
{ TFpDwarfValueNumeric }
|
|
|
|
TFpDwarfValueNumeric = class(TFpDwarfValueSized)
|
|
protected
|
|
FEvaluated: set of (doneUInt, doneInt, doneAddr, doneFloat);
|
|
protected
|
|
procedure Reset; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override; // svfOrdinal
|
|
function IsValidTypeCast: Boolean; override;
|
|
public
|
|
constructor Create(AOwner: TFpDwarfSymbolType; ASize: Integer);
|
|
end;
|
|
|
|
{ TFpDwarfValueInteger }
|
|
|
|
TFpDwarfValueInteger = class(TFpDwarfValueNumeric)
|
|
private
|
|
FIntValue: Int64;
|
|
protected
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetAsInteger: Int64; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueCardinal }
|
|
|
|
TFpDwarfValueCardinal = class(TFpDwarfValueNumeric)
|
|
private
|
|
FValue: QWord;
|
|
protected
|
|
function GetAsCardinal: QWord; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueFloat }
|
|
|
|
TFpDwarfValueFloat = class(TFpDwarfValueNumeric) // TDbgDwarfSymbolValue
|
|
// TODO: typecasts to int should convert
|
|
private
|
|
FValue: Extended;
|
|
protected
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsFloat: Extended; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueBoolean }
|
|
|
|
TFpDwarfValueBoolean = class(TFpDwarfValueCardinal)
|
|
protected
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsBool: Boolean; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueChar }
|
|
|
|
TFpDwarfValueChar = class(TFpDwarfValueCardinal)
|
|
protected
|
|
// returns single char(byte) / widechar
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsString: AnsiString; override;
|
|
function GetAsWideString: WideString; override;
|
|
end;
|
|
|
|
{ TFpDwarfValuePointer }
|
|
|
|
TFpDwarfValuePointer = class(TFpDwarfValueNumeric)
|
|
private
|
|
FLastAddrMember: TFpDbgValue;
|
|
FPointetToAddr: TFpDbgMemLocation;
|
|
protected
|
|
function GetAsCardinal: QWord; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetDataAddress: TFpDbgMemLocation; override;
|
|
function GetAsString: AnsiString; override;
|
|
function GetMember(AIndex: Int64): TFpDbgValue; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueEnum }
|
|
|
|
TFpDwarfValueEnum = class(TFpDwarfValueNumeric)
|
|
private
|
|
FValue: QWord;
|
|
FMemberIndex: Integer;
|
|
FMemberValueDone: Boolean;
|
|
procedure InitMemberIndex;
|
|
protected
|
|
procedure Reset; override;
|
|
//function IsValidTypeCast: Boolean; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetAsString: AnsiString; override;
|
|
// Has exactly 0 (if the ordinal value is out of range) or 1 member (the current value's enum)
|
|
function GetMemberCount: Integer; override;
|
|
function GetMember({%H-}AIndex: Int64): TFpDbgValue; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueEnumMember }
|
|
|
|
TFpDwarfValueEnumMember = class(TFpDwarfValue)
|
|
private
|
|
FOwnerVal: TFpDwarfSymbolValue;
|
|
protected
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetAsString: AnsiString; override;
|
|
function IsValidTypeCast: Boolean; override;
|
|
public
|
|
constructor Create(AOwner: TFpDwarfSymbolValue);
|
|
end;
|
|
|
|
{ TFpDwarfValueConstNumber }
|
|
|
|
TFpDwarfValueConstNumber = class(TFpDbgValueConstNumber)
|
|
protected
|
|
procedure Update(AValue: QWord; ASigned: Boolean);
|
|
end;
|
|
|
|
{ TFpDwarfValueSet }
|
|
|
|
TFpDwarfValueSet = class(TFpDwarfValueSized)
|
|
private
|
|
FMem: array of Byte;
|
|
FMemberCount: Integer;
|
|
FMemberMap: array of Integer;
|
|
FNumValue: TFpDwarfValueConstNumber;
|
|
FTypedNumValue: TFpDbgValue;
|
|
procedure InitMap;
|
|
protected
|
|
procedure Reset; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetMember(AIndex: Int64): TFpDbgValue; override;
|
|
function GetAsCardinal: QWord; override; // only up to qmord
|
|
function IsValidTypeCast: Boolean; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueStruct }
|
|
|
|
TFpDwarfValueStruct = class(TFpDwarfValue)
|
|
private
|
|
FDataAddress: TFpDbgMemLocation;
|
|
FDataAddressDone: Boolean;
|
|
protected
|
|
procedure Reset; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetDataAddress: TFpDbgMemLocation; override;
|
|
function GetDataSize: Integer; override;
|
|
function GetSize: Integer; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueStructTypeCast }
|
|
|
|
TFpDwarfValueStructTypeCast = class(TFpDwarfValue)
|
|
private
|
|
FMembers: TFpDbgCircularRefCntObjList;
|
|
FDataAddress: TFpDbgMemLocation;
|
|
FDataAddressDone: Boolean;
|
|
protected
|
|
procedure Reset; override;
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetKind: TDbgSymbolKind; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetSize: Integer; override;
|
|
function GetDataSize: Integer; override;
|
|
function GetDataAddress: TFpDbgMemLocation; override;
|
|
function IsValidTypeCast: Boolean; override;
|
|
public
|
|
destructor Destroy; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgValue; override;
|
|
function GetMember(AIndex: Int64): TFpDbgValue; override;
|
|
function GetMemberCount: Integer; override;
|
|
end;
|
|
|
|
{ TFpDwarfValueConstAddress }
|
|
|
|
TFpDwarfValueConstAddress = class(TFpDbgValueConstAddress)
|
|
protected
|
|
procedure Update(AnAddress: TFpDbgMemLocation);
|
|
end;
|
|
|
|
{ TFpDwarfValueArray }
|
|
|
|
TFpDwarfValueArray = class(TFpDwarfValue)
|
|
private
|
|
FAddrObj: TFpDwarfValueConstAddress;
|
|
protected
|
|
function GetFieldFlags: TFpDbgValueFieldFlags; override;
|
|
function GetKind: TDbgSymbolKind; override;
|
|
function GetAsCardinal: QWord; override;
|
|
function GetDataAddress: TFpDbgMemLocation; override;
|
|
function GetMember(AIndex: Int64): TFpDbgValue; override;
|
|
function GetMemberEx(AIndex: array of Int64): TFpDbgValue; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetMemberCountEx(AIndex: array of Int64): Integer; override;
|
|
function GetIndexType(AIndex: Integer): TFpDbgSymbol; override;
|
|
function GetIndexTypeCount: Integer; override;
|
|
function IsValidTypeCast: Boolean; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
{%endregion Value objects }
|
|
|
|
{%region Symbol objects }
|
|
|
|
TInitLocParserData = record
|
|
(* DW_AT_data_member_location: Is always pushed on stack
|
|
DW_AT_data_location: Is avalibale for DW_OP_push_object_address
|
|
*)
|
|
ObjectDataAddress: TFpDbgMemLocation;
|
|
ObjectDataAddrPush: Boolean; // always push ObjectDataAddress on stack: DW_AT_data_member_location
|
|
end;
|
|
PInitLocParserData = ^TInitLocParserData;
|
|
|
|
{ TDbgDwarfIdentifier }
|
|
|
|
{ TFpDwarfSymbol }
|
|
|
|
TFpDwarfSymbol = class(TDbgDwarfSymbolBase)
|
|
private
|
|
FNestedTypeInfo: TFpDwarfSymbolType;
|
|
FParentTypeInfo: TFpDwarfSymbol;
|
|
FDwarfReadFlags: set of (didtNameRead, didtTypeRead, didtArtificialRead, didtIsArtifical);
|
|
function GetNestedTypeInfo: TFpDwarfSymbolType;
|
|
protected
|
|
(* There will be a circular reference between parenttype and self
|
|
"self" will only set its reference to parenttype, if self has other references. *)
|
|
procedure DoReferenceAdded; override;
|
|
procedure DoReferenceReleased; override;
|
|
procedure CircleBackRefActiveChanged(ANewActive: Boolean); override;
|
|
procedure SetParentTypeInfo(AValue: TFpDwarfSymbol); virtual;
|
|
|
|
function DoGetNestedTypeInfo: TFpDwarfSymbolType; virtual;
|
|
function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
|
|
function IsArtificial: Boolean; // usud by formal param and subprogram
|
|
procedure NameNeeded; override;
|
|
procedure TypeInfoNeeded; override;
|
|
property NestedTypeInfo: TFpDwarfSymbolType read GetNestedTypeInfo;
|
|
|
|
// OwnerTypeInfo: reverse of "NestedTypeInfo" (variable that is of this type)
|
|
// property OwnerTypeInfo: TDbgDwarfIdentifier read FOwnerTypeInfo; // write SetOwnerTypeInfo;
|
|
// ParentTypeInfo: funtion for local var / class for member
|
|
property ParentTypeInfo: TFpDwarfSymbol read FParentTypeInfo write SetParentTypeInfo;
|
|
|
|
function DataSize: Integer; virtual;
|
|
protected
|
|
function InitLocationParser(const {%H-}ALocationParser: TDwarfLocationExpression;
|
|
AnInitLocParserData: PInitLocParserData = nil): Boolean; virtual;
|
|
function LocationFromTag(ATag: Cardinal; AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; // kept, if tag does not exist
|
|
AnInitLocParserData: PInitLocParserData = nil;
|
|
AnInformationEntry: TDwarfInformationEntry = nil;
|
|
ASucessOnMissingTag: Boolean = False
|
|
): Boolean;
|
|
// GetDataAddress: data of a class, or string
|
|
function GetDataAddress(AValueObj: TFpDwarfValue; var AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType; ATargetCacheIndex: Integer): Boolean;
|
|
function GetDataAddressNext(AValueObj: TFpDwarfValue; var AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType; ATargetCacheIndex: Integer): Boolean; virtual;
|
|
function HasAddress: Boolean; virtual;
|
|
|
|
procedure Init; override;
|
|
public
|
|
class function CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbol;
|
|
destructor Destroy; override;
|
|
function StartScope: TDbgPtr; // return 0, if none. 0 includes all anyway
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValue }
|
|
|
|
TFpDwarfSymbolValue = class(TFpDwarfSymbol) // var, const, member, ...
|
|
protected
|
|
FValueObject: TFpDwarfValue;
|
|
FMembers: TFpDbgCircularRefCntObjList;
|
|
|
|
function GetValueAddress({%H-}AValueObj: TFpDwarfValue;{%H-} out AnAddress: TFpDbgMemLocation): Boolean; virtual;
|
|
function GetValueDataAddress(AValueObj: TFpDwarfValue; out AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType = nil): Boolean;
|
|
procedure KindNeeded; override;
|
|
procedure MemberVisibilityNeeded; override;
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
|
|
procedure Init; override;
|
|
public
|
|
destructor Destroy; override;
|
|
class function CreateValueSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbolValue;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueWithLocation }
|
|
|
|
TFpDwarfSymbolValueWithLocation = class(TFpDwarfSymbolValue)
|
|
private
|
|
procedure FrameBaseNeeded(ASender: TObject); // Sender = TDwarfLocationExpression
|
|
protected
|
|
function GetValueObject: TFpDbgValue; override;
|
|
function InitLocationParser(const ALocationParser: TDwarfLocationExpression;
|
|
AnInitLocParserData: PInitLocParserData): Boolean; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolType }
|
|
|
|
(* Types and allowed tags in dwarf 2
|
|
|
|
DW_TAG_enumeration_type, DW_TAG_subroutine_type, DW_TAG_union_type,
|
|
DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type,
|
|
DW_TAG_thrown_type
|
|
|
|
DW_TAG_base_type
|
|
DW_AT_encoding Y
|
|
DW_AT_bit_offset Y
|
|
DW_AT_bit_size Y
|
|
|
|
DW_TAG_base_type
|
|
| DW_TAG_typedef
|
|
| | DW_TAG_string_type
|
|
| | | DW_TAG_array_type
|
|
| | | |
|
|
| | | | DW_TAG_class_type
|
|
| | | | | DW_TAG_structure_type
|
|
| | | | | |
|
|
| | | | | | DW_TAG_enumeration_type
|
|
| | | | | | | DW_TAG_set_type
|
|
| | | | | | | | DW_TAG_enumerator
|
|
| | | | | | | | | DW_TAG_subrange_type
|
|
DW_AT_name Y Y Y Y Y Y Y Y Y Y
|
|
DW_AT_sibling Y Y Y Y Y Y Y Y Y Y
|
|
DECL Y Y Y Y Y Y Y Y Y
|
|
DW_AT_byte_size Y Y Y Y Y Y Y Y
|
|
DW_AT_abstract_origin Y Y Y Y Y Y Y Y
|
|
DW_AT_accessibility Y Y Y Y Y Y Y Y
|
|
DW_AT_declaration Y Y Y Y Y Y Y Y
|
|
DW_AT_start_scope Y Y Y Y Y Y Y
|
|
DW_AT_visibility Y Y Y Y Y Y Y Y
|
|
DW_AT_type Y Y Y Y
|
|
DW_AT_segment Y DW_TAG_string_type
|
|
DW_AT_string_length Y
|
|
DW_AT_ordering Y DW_TAG_array_type
|
|
DW_AT_stride_size Y
|
|
DW_AT_const_value Y DW_TAG_enumerator
|
|
DW_AT_count Y DW_TAG_subrange_type
|
|
DW_AT_lower_bound Y
|
|
DW_AT_upper_bound Y
|
|
|
|
DW_TAG_pointer_type
|
|
| DW_TAG_reference_type
|
|
| | DW_TAG_packed_type
|
|
| | | DW_TAG_const_type
|
|
| | | | DW_TAG_volatile_type
|
|
DW_AT_address_class Y Y
|
|
DW_AT_sibling Y Y Y Y Y
|
|
DW_AT_type Y Y Y Y Y
|
|
|
|
DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
|
*)
|
|
|
|
TFpDwarfSymbolType = class(TFpDwarfSymbol)
|
|
protected
|
|
procedure Init; override;
|
|
procedure MemberVisibilityNeeded; override;
|
|
procedure SizeNeeded; override;
|
|
function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDwarfValue; virtual; // returns refcount=1 for caller, no cached copy kept
|
|
public
|
|
class function CreateTypeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbolType;
|
|
function TypeCastValue(AValue: TFpDbgValue): TFpDbgValue; override;
|
|
// TODO: flag bounds as cardinal if needed
|
|
function GetValueBounds({%H-}AValueObj: TFpDwarfValue; out ALowBound, AHighBound: Int64): Boolean; virtual;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeBasic }
|
|
|
|
TFpDwarfSymbolTypeBasic = class(TFpDwarfSymbolType)
|
|
//function DoGetNestedTypeInfo: TFpDwarfSymbolType; // return nil
|
|
protected
|
|
procedure KindNeeded; override;
|
|
procedure TypeInfoNeeded; override;
|
|
function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDwarfValue; override;
|
|
function GetHasBounds: Boolean; override;
|
|
function GetOrdHighBound: Int64; override;
|
|
function GetOrdLowBound: Int64; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeModifier }
|
|
|
|
TFpDwarfSymbolTypeModifier = class(TFpDwarfSymbolType)
|
|
protected
|
|
procedure TypeInfoNeeded; override;
|
|
procedure ForwardToSymbolNeeded; override;
|
|
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeRef }
|
|
|
|
TFpDwarfSymbolTypeRef = class(TFpDwarfSymbolTypeModifier)
|
|
protected
|
|
function GetFlags: TDbgSymbolFlags; override;
|
|
function GetDataAddressNext(AValueObj: TFpDwarfValue; var AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType; ATargetCacheIndex: Integer): Boolean; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeDeclaration }
|
|
|
|
TFpDwarfSymbolTypeDeclaration = class(TFpDwarfSymbolTypeModifier)
|
|
protected
|
|
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
|
|
// typedef > pointer > srtuct
|
|
// while a pointer to class/object: pointer > typedef > ....
|
|
function DoGetNestedTypeInfo: TFpDwarfSymbolType; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeSubRange }
|
|
TFpDwarfSubRangeBoundReadState = (rfNotRead, rfNotFound, rfConst, rfValue);
|
|
|
|
TFpDwarfSymbolTypeSubRange = class(TFpDwarfSymbolTypeModifier)
|
|
// TODO not a modifier, maybe have a forwarder base class
|
|
private
|
|
FLowBoundConst: Int64;
|
|
FLowBoundValue: TFpDwarfSymbolValue;
|
|
FLowBoundState: TFpDwarfSubRangeBoundReadState;
|
|
FHighBoundConst: Int64;
|
|
FHighBoundValue: TFpDwarfSymbolValue;
|
|
FHighBoundState: TFpDwarfSubRangeBoundReadState;
|
|
FCountConst: Int64;
|
|
FCountValue: TFpDwarfSymbolValue;
|
|
FCountState: TFpDwarfSubRangeBoundReadState;
|
|
FLowEnumIdx, FHighEnumIdx: Integer;
|
|
FEnumIdxValid: Boolean;
|
|
procedure InitEnumIdx;
|
|
procedure ReadBounds(AValueObj: TFpDwarfValue);
|
|
protected
|
|
function DoGetNestedTypeInfo: TFpDwarfSymbolType;override;
|
|
function GetHasBounds: Boolean; override;
|
|
function GetOrdHighBound: Int64; override;
|
|
function GetOrdLowBound: Int64; override;
|
|
|
|
procedure NameNeeded; override;
|
|
procedure KindNeeded; override;
|
|
procedure SizeNeeded; override;
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetFlags: TDbgSymbolFlags; override;
|
|
procedure Init; override;
|
|
public
|
|
function GetValueBounds(AValueObj: TFpDwarfValue; out ALowBound,
|
|
AHighBound: Int64): Boolean; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypePointer }
|
|
|
|
TFpDwarfSymbolTypePointer = class(TFpDwarfSymbolType)
|
|
private
|
|
FIsInternalPointer: Boolean;
|
|
function GetIsInternalPointer: Boolean; inline;
|
|
function IsInternalDynArrayPointer: Boolean; inline;
|
|
protected
|
|
procedure TypeInfoNeeded; override;
|
|
procedure KindNeeded; override;
|
|
procedure SizeNeeded; override;
|
|
procedure ForwardToSymbolNeeded; override;
|
|
function GetDataAddressNext(AValueObj: TFpDwarfValue; var AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType; ATargetCacheIndex: Integer): Boolean; override;
|
|
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override;
|
|
function DataSize: Integer; override;
|
|
public
|
|
property IsInternalPointer: Boolean read GetIsInternalPointer write FIsInternalPointer; // Class (also DynArray, but DynArray is handled without this)
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueEnumMember }
|
|
|
|
TFpDwarfSymbolValueEnumMember = class(TFpDwarfSymbolValue)
|
|
FOrdinalValue: Int64;
|
|
FOrdinalValueRead, FHasOrdinalValue: Boolean;
|
|
procedure ReadOrdinalValue;
|
|
protected
|
|
procedure KindNeeded; override;
|
|
function GetHasOrdinalValue: Boolean; override;
|
|
function GetOrdinalValue: Int64; override;
|
|
procedure Init; override;
|
|
function GetValueObject: TFpDbgValue; override;
|
|
end;
|
|
|
|
|
|
{ TFpDwarfSymbolTypeEnum }
|
|
|
|
TFpDwarfSymbolTypeEnum = class(TFpDwarfSymbolType)
|
|
private
|
|
FMembers: TFpDbgCircularRefCntObjList;
|
|
procedure CreateMembers;
|
|
protected
|
|
function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDwarfValue; override;
|
|
procedure KindNeeded; override;
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
|
|
function GetHasBounds: Boolean; override;
|
|
function GetOrdHighBound: Int64; override;
|
|
function GetOrdLowBound: Int64; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
{ TFpDwarfSymbolTypeSet }
|
|
|
|
TFpDwarfSymbolTypeSet = class(TFpDwarfSymbolType)
|
|
protected
|
|
procedure KindNeeded; override;
|
|
function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDwarfValue; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
end;
|
|
|
|
(*
|
|
If not specified
|
|
.NestedTypeInfo --> copy of TypeInfo
|
|
.ParentTypeInfo --> nil
|
|
|
|
ParentTypeInfo: has a weak RefCount (only AddRef, if self has other refs)
|
|
|
|
|
|
AnObject = TFpDwarfSymbolValueVariable
|
|
|-- .TypeInfo --> TBar = TFpDwarfSymbolTypeStructure [*1]
|
|
|-- .ParentTypeInfo --> may point to subroutine, if param or local var // TODO
|
|
|
|
TBar = TFpDwarfSymbolTypeStructure
|
|
|-- .TypeInfo --> TBarBase = TFpDwarfSymbolTypeStructure
|
|
|
|
TBarBase = TFpDwarfSymbolTypeStructure
|
|
|-- .TypeInfo --> TOBject = TFpDwarfSymbolTypeStructure
|
|
|
|
TObject = TFpDwarfSymbolTypeStructure
|
|
|-- .TypeInfo --> nil
|
|
|
|
|
|
FField = TFpDwarfSymbolValueMember (declared in TBarBase)
|
|
|-- .TypeInfo --> Integer = TFpDwarfSymbolTypeBasic [*1]
|
|
|-- .ParentTypeInfo --> TBarBase
|
|
|
|
[*1] May have TFpDwarfSymbolTypeDeclaration or others
|
|
*)
|
|
|
|
{ TFpDwarfSymbolValueMember }
|
|
|
|
TFpDwarfSymbolValueMember = class(TFpDwarfSymbolValueWithLocation)
|
|
protected
|
|
function GetValueAddress(AValueObj: TFpDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override;
|
|
function HasAddress: Boolean; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeStructure }
|
|
|
|
TFpDwarfSymbolTypeStructure = class(TFpDwarfSymbolType)
|
|
// record or class
|
|
private
|
|
FMembers: TFpDbgCircularRefCntObjList;
|
|
FLastChildByName: TFpDwarfSymbol;
|
|
FInheritanceInfo: TDwarfInformationEntry;
|
|
procedure CreateMembers;
|
|
procedure InitInheritanceInfo; inline;
|
|
protected
|
|
function DoGetNestedTypeInfo: TFpDwarfSymbolType; override;
|
|
procedure KindNeeded; override;
|
|
function GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue; override;
|
|
|
|
// GetMember, if AIndex > Count then parent
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
|
|
function GetDataAddressNext(AValueObj: TFpDwarfValue; var AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType; ATargetCacheIndex: Integer): Boolean; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeArray }
|
|
|
|
TFpDwarfSymbolTypeArray = class(TFpDwarfSymbolType)
|
|
private
|
|
FMembers: TFpDbgCircularRefCntObjList;
|
|
FRowMajor: Boolean;
|
|
FStrideInBits: Int64;
|
|
FDwarfArrayReadFlags: set of (didtStrideRead, didtOrdering);
|
|
procedure CreateMembers;
|
|
procedure ReadStride;
|
|
procedure ReadOrdering;
|
|
protected
|
|
procedure KindNeeded; override;
|
|
function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDwarfValue; override;
|
|
|
|
function GetFlags: TDbgSymbolFlags; override;
|
|
// GetMember: returns the TYPE/range of each index. NOT the data
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberByName({%H-}AIndex: String): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
function GetMemberAddress(AValObject: TFpDwarfValue; AIndex: Array of Int64): TFpDbgMemLocation;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueProc }
|
|
|
|
TFpDwarfSymbolValueProc = class(TFpDwarfSymbolValue)
|
|
private
|
|
//FCU: TDwarfCompilationUnit;
|
|
FProcMembers: TRefCntObjList; // Locals
|
|
FLastMember: TFpDbgSymbol;
|
|
FAddress: TDbgPtr;
|
|
FAddressInfo: PDwarfAddressInfo;
|
|
FStateMachine: TDwarfLineInfoStateMachine;
|
|
FFrameBaseParser: TDwarfLocationExpression;
|
|
FSelfParameter: TFpDwarfValue;
|
|
function StateMachineValid: Boolean;
|
|
function ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
|
|
procedure CreateMembers;
|
|
protected
|
|
function GetMember(AIndex: Int64): TFpDbgSymbol; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
|
|
function GetMemberCount: Integer; override;
|
|
|
|
function GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
|
|
procedure KindNeeded; override;
|
|
procedure SizeNeeded; override;
|
|
function GetFlags: TDbgSymbolFlags; override;
|
|
|
|
function GetColumn: Cardinal; override;
|
|
function GetFile: String; override;
|
|
// function GetFlags: TDbgSymbolFlags; override;
|
|
function GetLine: Cardinal; override;
|
|
function GetValueObject: TFpDbgValue; override;
|
|
public
|
|
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); overload;
|
|
destructor Destroy; override;
|
|
// TODO members = locals ?
|
|
function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpDwarfValue;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueVariable }
|
|
|
|
TFpDwarfSymbolValueVariable = class(TFpDwarfSymbolValueWithLocation)
|
|
protected
|
|
function GetValueAddress(AValueObj: TFpDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override;
|
|
function HasAddress: Boolean; override;
|
|
public
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueParameter }
|
|
|
|
TFpDwarfSymbolValueParameter = class(TFpDwarfSymbolValueWithLocation)
|
|
protected
|
|
function GetValueAddress(AValueObj: TFpDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override;
|
|
function HasAddress: Boolean; override;
|
|
public
|
|
end;
|
|
|
|
{ TFpDwarfSymbolUnit }
|
|
|
|
TFpDwarfSymbolUnit = class(TFpDwarfSymbol)
|
|
private
|
|
FLastChildByName: TFpDbgSymbol;
|
|
protected
|
|
procedure Init; override;
|
|
function GetMemberByName(AIndex: String): TFpDbgSymbol; override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
{%endregion Symbol objects }
|
|
|
|
implementation
|
|
|
|
var
|
|
FPDBG_DWARF_VERBOSE, FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_DATA_WARNINGS: PLazLoggerLogGroup;
|
|
|
|
{ TFpDwarfDefaultSymbolClassMap }
|
|
|
|
class function TFpDwarfDefaultSymbolClassMap.HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
class function TFpDwarfDefaultSymbolClassMap.GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass;
|
|
begin
|
|
case ATag of
|
|
// TODO:
|
|
DW_TAG_constant:
|
|
Result := TFpDwarfSymbolValue;
|
|
DW_TAG_string_type,
|
|
DW_TAG_union_type, DW_TAG_ptr_to_member_type,
|
|
DW_TAG_file_type,
|
|
DW_TAG_thrown_type, DW_TAG_subroutine_type:
|
|
Result := TFpDwarfSymbolType;
|
|
|
|
// Type types
|
|
DW_TAG_packed_type,
|
|
DW_TAG_const_type,
|
|
DW_TAG_volatile_type: Result := TFpDwarfSymbolTypeModifier;
|
|
DW_TAG_reference_type: Result := TFpDwarfSymbolTypeRef;
|
|
DW_TAG_typedef: Result := TFpDwarfSymbolTypeDeclaration;
|
|
DW_TAG_pointer_type: Result := TFpDwarfSymbolTypePointer;
|
|
|
|
DW_TAG_base_type: Result := TFpDwarfSymbolTypeBasic;
|
|
DW_TAG_subrange_type: Result := TFpDwarfSymbolTypeSubRange;
|
|
DW_TAG_enumeration_type: Result := TFpDwarfSymbolTypeEnum;
|
|
DW_TAG_enumerator: Result := TFpDwarfSymbolValueEnumMember;
|
|
DW_TAG_set_type: Result := TFpDwarfSymbolTypeSet;
|
|
DW_TAG_structure_type,
|
|
DW_TAG_class_type: Result := TFpDwarfSymbolTypeStructure;
|
|
DW_TAG_array_type: Result := TFpDwarfSymbolTypeArray;
|
|
// Value types
|
|
DW_TAG_variable: Result := TFpDwarfSymbolValueVariable;
|
|
DW_TAG_formal_parameter: Result := TFpDwarfSymbolValueParameter;
|
|
DW_TAG_member: Result := TFpDwarfSymbolValueMember;
|
|
DW_TAG_subprogram: Result := TFpDwarfSymbolValueProc;
|
|
//
|
|
DW_TAG_compile_unit: Result := TFpDwarfSymbolUnit;
|
|
|
|
else
|
|
Result := TFpDwarfSymbol;
|
|
end;
|
|
end;
|
|
|
|
class function TFpDwarfDefaultSymbolClassMap.CreateContext(AThreadId, AStackFrame: Integer;
|
|
AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo): TFpDbgInfoContext;
|
|
begin
|
|
Result := TFpDwarfInfoAddressContext.Create(AThreadId, AStackFrame, AnAddress, ASymbol, ADwarf);
|
|
end;
|
|
|
|
class function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
|
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase;
|
|
begin
|
|
Result := TFpDwarfSymbolValueProc.Create(ACompilationUnit, AInfo, AAddress);
|
|
end;
|
|
|
|
{ TDbgDwarfInfoAddressContext }
|
|
|
|
function TFpDwarfInfoAddressContext.GetSymbolAtAddress: TFpDbgSymbol;
|
|
begin
|
|
Result := FSymbol;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetProcedureAtAddress: TFpDbgValue;
|
|
begin
|
|
Result := inherited GetProcedureAtAddress;
|
|
ApplyContext(Result);
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetAddress: TDbgPtr;
|
|
begin
|
|
Result := FAddress;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetThreadId: Integer;
|
|
begin
|
|
Result := FThreadId;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetStackFrame: Integer;
|
|
begin
|
|
Result := FStackFrame;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetSizeOfAddress: Integer;
|
|
begin
|
|
assert(FSymbol is TFpDwarfSymbol, 'TDbgDwarfInfoAddressContext.GetSizeOfAddress');
|
|
Result := TFpDwarfSymbol(FSymbol).CompilationUnit.AddressSize;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetMemManager: TFpDbgMemManager;
|
|
begin
|
|
Result := FDwarf.MemManager;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.ApplyContext(AVal: TFpDbgValue): TFpDbgValue;
|
|
begin
|
|
if (AVal <> nil) and (TFpDwarfValueBase(AVal).FContext = nil) then
|
|
TFpDwarfValueBase(AVal).FContext := Self;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue;
|
|
begin
|
|
if ASym = nil then begin
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
|
|
if ASym.SymbolType = stValue then begin
|
|
Result := ASym.Value;
|
|
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
end
|
|
else begin
|
|
Result := TFpDwarfValueTypeDefinition.Create(ASym);
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
end;
|
|
ASym.ReleaseReference;
|
|
end;
|
|
|
|
procedure TFpDwarfInfoAddressContext.AddRefToVal(AVal: TFpDbgValue);
|
|
begin
|
|
AVal.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.GetSelfParameter: TFpDbgValue;
|
|
begin
|
|
Result := TFpDwarfSymbolValueProc(FSymbol).GetSelfParameter(FAddress);
|
|
if (Result <> nil) and (TFpDwarfValueBase(Result).FContext = nil) then
|
|
TFpDwarfValueBase(Result).FContext := Self;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper,
|
|
PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean;
|
|
var
|
|
i, ExtVal: Integer;
|
|
CU: TDwarfCompilationUnit;
|
|
InfoEntry, FoundInfoEntry: TDwarfInformationEntry;
|
|
s: String;
|
|
begin
|
|
Result := False;
|
|
ADbgValue := nil;
|
|
InfoEntry := nil;
|
|
FoundInfoEntry := nil;
|
|
i := FDwarf.CompilationUnitsCount;
|
|
while i > 0 do begin
|
|
dec(i);
|
|
CU := FDwarf.CompilationUnits[i];
|
|
if CU = SkipCompUnit then
|
|
continue;
|
|
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier search UNIT Name=', CU.FileName]);
|
|
|
|
InfoEntry.ReleaseReference;
|
|
InfoEntry := TDwarfInformationEntry.Create(CU, nil);
|
|
InfoEntry.ScopeIndex := CU.FirstScope.Index;
|
|
|
|
if not InfoEntry.AbbrevTag = DW_TAG_compile_unit then
|
|
continue;
|
|
// compile_unit can not have startscope
|
|
|
|
s := CU.UnitName;
|
|
if (s <> '') and (CompareUtf8BothCase(PNameUpper, PNameLower, @s[1])) then begin
|
|
ReleaseRefAndNil(FoundInfoEntry);
|
|
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
break;
|
|
end;
|
|
|
|
CU.ScanAllEntries;
|
|
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
|
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
|
// only variables are marked "external", but types not / so we may need all top level
|
|
FoundInfoEntry.ReleaseReference;
|
|
FoundInfoEntry := InfoEntry.Clone;
|
|
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier MAYBE FOUND Name=', CU.FileName]);
|
|
|
|
// DW_AT_visibility ?
|
|
if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
|
|
if ExtVal <> 0 then
|
|
break;
|
|
// Search for better ADbgValue
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FoundInfoEntry <> nil then begin;
|
|
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, FoundInfoEntry));
|
|
FoundInfoEntry.ReleaseReference;
|
|
end;
|
|
|
|
InfoEntry.ReleaseReference;
|
|
Result := ADbgValue <> nil;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.FindSymbolInStructure(const AName: String; PNameUpper,
|
|
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
|
|
var
|
|
InfoEntryInheritance: TDwarfInformationEntry;
|
|
FwdInfoPtr: Pointer;
|
|
FwdCompUint: TDwarfCompilationUnit;
|
|
SelfParam: TFpDbgValue;
|
|
begin
|
|
Result := False;
|
|
ADbgValue := nil;
|
|
InfoEntry.AddReference;
|
|
|
|
while True do begin
|
|
if not InfoEntry.IsAddressInStartScope(FAddress) then
|
|
break;
|
|
|
|
InfoEntryInheritance := InfoEntry.FindChildByTag(DW_TAG_inheritance);
|
|
|
|
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
|
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
|
SelfParam := GetSelfParameter;
|
|
if (SelfParam <> nil) then begin
|
|
// TODO: only valid, as long as context is valid, because if context is freed, then self is lost too
|
|
ADbgValue := SelfParam.MemberByName[AName];
|
|
assert(ADbgValue <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
|
if ADbgValue <> nil then
|
|
ADbgValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
end
|
|
else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
|
|
;
|
|
if ADbgValue = nil then begin // Todo: abort the searh /SetError
|
|
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
end;
|
|
InfoEntry.ReleaseReference;
|
|
InfoEntryInheritance.ReleaseReference;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
if not( (InfoEntryInheritance <> nil) and
|
|
(InfoEntryInheritance.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)) )
|
|
then
|
|
break;
|
|
InfoEntry.ReleaseReference;
|
|
InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
InfoEntryInheritance.ReleaseReference;
|
|
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier PARENT ', dbgs(InfoEntry, FwdCompUint) ]);
|
|
end;
|
|
|
|
InfoEntry.ReleaseReference;
|
|
Result := ADbgValue <> nil;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
|
|
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
|
|
begin
|
|
Result := False;
|
|
ADbgValue := nil;
|
|
if not InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then
|
|
exit;
|
|
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
|
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
|
|
end;
|
|
Result := ADbgValue <> nil;
|
|
end;
|
|
|
|
constructor TFpDwarfInfoAddressContext.Create(AThreadId, AStackFrame: Integer;
|
|
AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo);
|
|
begin
|
|
inherited Create;
|
|
AddReference;
|
|
FAddress := AnAddress;
|
|
FThreadId := AThreadId;
|
|
FStackFrame := AStackFrame;
|
|
FDwarf := ADwarf;
|
|
FSymbol := ASymbol;
|
|
FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF};
|
|
end;
|
|
|
|
destructor TFpDwarfInfoAddressContext.Destroy;
|
|
begin
|
|
FlastResult.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF};
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFpDwarfInfoAddressContext.FindSymbol(const AName: String): TFpDbgValue;
|
|
var
|
|
SubRoutine: TFpDwarfSymbolValueProc; // TDbgSymbol;
|
|
CU: TDwarfCompilationUnit;
|
|
//Scope,
|
|
StartScopeIdx: Integer;
|
|
InfoEntry: TDwarfInformationEntry;
|
|
NameUpper, NameLower: String;
|
|
InfoName: PChar;
|
|
tg: Cardinal;
|
|
PNameUpper, PNameLower: PChar;
|
|
begin
|
|
Result := nil;
|
|
if (FSymbol = nil) or not(FSymbol is TFpDwarfSymbolValueProc) or (AName = '') then
|
|
exit;
|
|
|
|
SubRoutine := TFpDwarfSymbolValueProc(FSymbol);
|
|
NameUpper := UTF8UpperCase(AName);
|
|
NameLower := UTF8LowerCase(AName);
|
|
PNameUpper := @NameUpper[1];
|
|
PNameLower := @NameLower[1];
|
|
|
|
try
|
|
CU := SubRoutine.CompilationUnit;
|
|
InfoEntry := SubRoutine.InformationEntry.Clone;
|
|
|
|
while InfoEntry.HasValidScope do begin
|
|
//debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]);
|
|
StartScopeIdx := InfoEntry.ScopeIndex;
|
|
|
|
//if InfoEntry.Abbrev = nil then
|
|
// exit;
|
|
|
|
if not InfoEntry.IsAddressInStartScope(FAddress) // StartScope = first valid address
|
|
then begin
|
|
// CONTINUE: Search parent(s)
|
|
//InfoEntry.ScopeIndex := StartScopeIdx;
|
|
InfoEntry.GoParent;
|
|
Continue;
|
|
end;
|
|
|
|
if InfoEntry.ReadName(InfoName) and not InfoEntry.IsArtificial
|
|
then begin
|
|
if (CompareUtf8BothCase(PNameUpper, PNameLower, InfoName)) then begin
|
|
// TODO: this is a pascal sperific search order? Or not?
|
|
// If this is a type with a pointer or ref, need to find the pointer or ref.
|
|
InfoEntry.GoParent;
|
|
if InfoEntry.HasValidScope and
|
|
InfoEntry.GoNamedChildEx(PNameUpper, PNameLower)
|
|
then begin
|
|
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
|
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
InfoEntry.ScopeIndex := StartScopeIdx;
|
|
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
tg := InfoEntry.AbbrevTag;
|
|
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
|
|
if FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry, Result) then
|
|
exit; // TODO: check error
|
|
//InfoEntry.ScopeIndex := StartScopeIdx;
|
|
end
|
|
|
|
else
|
|
if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine
|
|
if FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry, Result) then
|
|
exit; // TODO: check error
|
|
//InfoEntry.ScopeIndex := StartScopeIdx;
|
|
end
|
|
// TODO: nested subroutine
|
|
|
|
else
|
|
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
|
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
|
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// Search parent(s)
|
|
InfoEntry.ScopeIndex := StartScopeIdx;
|
|
InfoEntry.GoParent;
|
|
end;
|
|
|
|
FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU, Result);
|
|
|
|
finally
|
|
if (Result = nil) or (InfoEntry = nil)
|
|
then DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier NOT found Name=', AName])
|
|
else DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier(',AName,') found Scope=', TFpDwarfSymbol(Result.DbgSymbol).InformationEntry.ScopeDebugText, ' ResultSymbol=', DbgSName(Result.DbgSymbol), ' ', Result.DbgSymbol.Name, ' in ', TFpDwarfSymbol(Result.DbgSymbol).CompilationUnit.FileName]);
|
|
ReleaseRefAndNil(InfoEntry);
|
|
|
|
FlastResult.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
|
FlastResult := Result;
|
|
|
|
assert((Result = nil) or (Result is TFpDwarfValueBase), 'TDbgDwarfInfoAddressContext.FindSymbol: (Result = nil) or (Result is TFpDwarfValueBase)');
|
|
ApplyContext(Result);
|
|
end;
|
|
end;
|
|
|
|
{ TFpDwarfValueTypeDefinition }
|
|
|
|
function TFpDwarfValueTypeDefinition.GetKind: TDbgSymbolKind;
|
|
begin
|
|
Result := skNone;
|
|
end;
|
|
|
|
function TFpDwarfValueTypeDefinition.GetDbgSymbol: TFpDbgSymbol;
|
|
begin
|
|
Result := FSymbol;
|
|
end;
|
|
|
|
constructor TFpDwarfValueTypeDefinition.Create(ASymbol: TFpDbgSymbol);
|
|
begin
|
|
inherited Create;
|
|
FSymbol := ASymbol;
|
|
FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDwarfValueTypeDefinition'){$ENDIF};
|
|
end;
|
|
|
|
destructor TFpDwarfValueTypeDefinition.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDwarfValueTypeDefinition'){$ENDIF};
|
|
end;
|
|
|
|
function TFpDwarfValueTypeDefinition.GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue;
|
|
begin
|
|
Result := FSymbol.TypeCastValue(ADataVal);
|
|
assert((Result = nil) or (Result is TFpDwarfValue), 'TFpDwarfValueTypeDefinition.GetTypeCastedValue: (Result = nil) or (Result is TFpDwarfValue)');
|
|
if (Result <> nil) and (TFpDwarfValue(Result).FContext = nil) then
|
|
TFpDwarfValue(Result).FContext := FContext;
|
|
end;
|
|
|
|
{ TFpDwarfValue }
|
|
|
|
function TFpDwarfValue.MemManager: TFpDbgMemManager;
|
|
begin
|
|
Result := nil;
|
|
if FContext <> nil then
|
|
Result := FContext.MemManager;
|
|
|
|
if Result = nil then begin
|
|
// Either a typecast, or a member gotten from a typecast,...
|
|
assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil) and (FOwner.CompilationUnit.Owner <> nil), 'TDbgDwarfSymbolValue.MemManager');
|
|
Result := FOwner.CompilationUnit.Owner.MemManager;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation;
|
|
begin
|
|
if AIndex < Length(FDataAddressCache) then
|
|
Result := FDataAddressCache[AIndex]
|
|
else
|
|
Result := UnInitializedLoc;
|
|
end;
|
|
|
|
function TFpDwarfValue.AddressSize: Byte;
|
|
begin
|
|
assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil), 'TDbgDwarfSymbolValue.AddressSize');
|
|
Result := FOwner.CompilationUnit.AddressSize;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.SetDataAddressCache(AIndex: Integer; AValue: TFpDbgMemLocation);
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
i := length(FDataAddressCache);
|
|
if AIndex >= i then begin
|
|
SetLength(FDataAddressCache, AIndex + 1 + 8);
|
|
// todo: Fillbyte 0
|
|
for j := i to Length(FDataAddressCache) - 1 do
|
|
FDataAddressCache[j] := UnInitializedLoc;
|
|
end;
|
|
FDataAddressCache[AIndex] := AValue;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.SetStructureValue(AValue: TFpDwarfValue);
|
|
begin
|
|
if FStructureValue <> nil then
|
|
Reset;
|
|
|
|
if FStructureValue = AValue then
|
|
exit;
|
|
|
|
if CircleBackRefsActive and (FStructureValue <> nil) then
|
|
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
FStructureValue := AValue;
|
|
if CircleBackRefsActive and (FStructureValue <> nil) then
|
|
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
end;
|
|
|
|
function TFpDwarfValue.GetLastError: TFpError;
|
|
begin
|
|
Result := FLastError;
|
|
end;
|
|
|
|
function TFpDwarfValue.DataAddr: TFpDbgMemLocation;
|
|
begin
|
|
// GetDwarfDataAddress(???); What about FTypeCastSourceValue.AsCardinal ?
|
|
if FValueSymbol <> nil then begin
|
|
//FValueSymbol.GetValueAddress(Self, Result);
|
|
FValueSymbol.GetValueDataAddress(Self, Result, FOwner);
|
|
if IsError(FValueSymbol.LastError) then
|
|
FLastError := FValueSymbol.LastError;
|
|
end
|
|
else
|
|
if HasTypeCastInfo then begin
|
|
Result := FTypeCastSourceValue.Address;
|
|
if IsError(FTypeCastSourceValue.LastError) then
|
|
FLastError := FTypeCastSourceValue.LastError;
|
|
|
|
if IsReadableLoc(Result) then begin
|
|
if not FTypeCastTargetType.GetDataAddress(Self, Result, FOwner, 1) then
|
|
Result := InvalidLoc;
|
|
if IsError(FTypeCastTargetType.LastError) then
|
|
FLastError := FTypeCastTargetType.LastError;
|
|
end;
|
|
end
|
|
else
|
|
Result := InvalidLoc;
|
|
end;
|
|
|
|
function TFpDwarfValue.OrdOrDataAddr: TFpDbgMemLocation;
|
|
begin
|
|
if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
|
|
Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
|
|
else
|
|
Result := DataAddr;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType): Boolean;
|
|
var
|
|
fields: TFpDbgValueFieldFlags;
|
|
begin
|
|
if FValueSymbol <> nil then begin
|
|
Assert(FValueSymbol is TFpDwarfSymbolValue, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
|
|
Assert(TypeInfo is TFpDwarfSymbolType, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
|
|
Assert(not HasTypeCastInfo, 'TDbgDwarfSymbolValue.GetDwarfDataAddress not HasTypeCastInfo');
|
|
Result := FValueSymbol.GetValueDataAddress(Self, AnAddress, ATargetType);
|
|
if IsError(FValueSymbol.LastError) then
|
|
FLastError := FValueSymbol.LastError;
|
|
end
|
|
|
|
else
|
|
begin
|
|
// TODO: cache own address
|
|
// try typecast
|
|
Result := HasTypeCastInfo;
|
|
if not Result then
|
|
exit;
|
|
fields := FTypeCastSourceValue.FieldFlags;
|
|
AnAddress := InvalidLoc;
|
|
if svfOrdinal in fields then
|
|
AnAddress := ConstLoc(FTypeCastSourceValue.AsCardinal)
|
|
else
|
|
if svfAddress in fields then
|
|
AnAddress := FTypeCastSourceValue.Address;
|
|
|
|
Result := IsReadableLoc(AnAddress);
|
|
if not Result then
|
|
exit;
|
|
|
|
Result := FTypeCastTargetType.GetDataAddress(Self, AnAddress, ATargetType, 1);
|
|
if IsError(FTypeCastTargetType.LastError) then
|
|
FLastError := FTypeCastTargetType.LastError;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
|
|
ATargetType: TFpDwarfSymbolType): Boolean;
|
|
begin
|
|
AnAddress := InvalidLoc;
|
|
Result := StructureValue <> nil;
|
|
if Result then
|
|
Result := StructureValue.GetDwarfDataAddress(AnAddress, ATargetType);
|
|
end;
|
|
|
|
function TFpDwarfValue.HasDwarfDataAddress: Boolean;
|
|
begin
|
|
if FValueSymbol <> nil then begin
|
|
Assert(FValueSymbol is TFpDwarfSymbolValue, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
|
|
Assert(TypeInfo is TFpDwarfSymbolType, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
|
|
Assert(not HasTypeCastInfo, 'TDbgDwarfSymbolValue.GetDwarfDataAddress not HasTypeCastInfo');
|
|
Result := FValueSymbol.HasAddress;
|
|
end
|
|
else
|
|
begin
|
|
// try typecast
|
|
Result := HasTypeCastInfo;
|
|
if not Result then
|
|
exit;
|
|
Result := FTypeCastSourceValue.FieldFlags * [svfAddress, svfOrdinal] <> [];
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.Reset;
|
|
begin
|
|
FDataAddressCache := nil;
|
|
FLastError := NoError;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
if FValueSymbol <> nil then begin
|
|
if FValueSymbol.HasAddress then Result := Result + [svfAddress];
|
|
end
|
|
else
|
|
if HasTypeCastInfo then begin
|
|
Result := Result + FTypeCastSourceValue.FieldFlags * [svfAddress];
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValue.HasTypeCastInfo: Boolean;
|
|
begin
|
|
Result := (FTypeCastTargetType <> nil) and (FTypeCastSourceValue <> nil);
|
|
end;
|
|
|
|
function TFpDwarfValue.IsValidTypeCast: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.DoReferenceAdded;
|
|
begin
|
|
inherited DoReferenceAdded;
|
|
DoPlainReferenceAdded;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.DoReferenceReleased;
|
|
begin
|
|
inherited DoReferenceReleased;
|
|
DoPlainReferenceReleased;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.CircleBackRefActiveChanged(NewActive: Boolean);
|
|
begin
|
|
inherited CircleBackRefActiveChanged(NewActive);
|
|
if NewActive then;
|
|
if CircleBackRefsActive then begin
|
|
if FValueSymbol <> nil then
|
|
FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
if FStructureValue <> nil then
|
|
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
end
|
|
else begin
|
|
if FValueSymbol <> nil then
|
|
FValueSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
if FStructureValue <> nil then
|
|
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.SetLastMember(ALastMember: TFpDwarfValue);
|
|
begin
|
|
if FLastMember <> nil then
|
|
FLastMember.ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
|
|
FLastMember := ALastMember;
|
|
|
|
if (FLastMember <> nil) then begin
|
|
FLastMember.SetStructureValue(Self);
|
|
FLastMember.AddCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
if (FLastMember.FContext = nil) then
|
|
FLastMember.FContext := FContext;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetKind: TDbgSymbolKind;
|
|
begin
|
|
if FValueSymbol <> nil then
|
|
Result := FValueSymbol.Kind
|
|
else
|
|
if HasTypeCastInfo then
|
|
Result := FTypeCastTargetType.Kind
|
|
else
|
|
Result := inherited GetKind;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetAddress: TFpDbgMemLocation;
|
|
begin
|
|
if FValueSymbol <> nil then
|
|
FValueSymbol.GetValueAddress(Self, Result)
|
|
else
|
|
if HasTypeCastInfo then
|
|
Result := FTypeCastSourceValue.Address
|
|
else
|
|
Result := inherited GetAddress;
|
|
end;
|
|
|
|
function TFpDwarfValue.OrdOrAddress: TFpDbgMemLocation;
|
|
begin
|
|
if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then
|
|
Result := ConstLoc(FTypeCastSourceValue.AsCardinal)
|
|
else
|
|
Result := Address;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetMemberCount: Integer;
|
|
begin
|
|
if FValueSymbol <> nil then
|
|
Result := FValueSymbol.MemberCount
|
|
else
|
|
Result := inherited GetMemberCount;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetMemberByName(AIndex: String): TFpDbgValue;
|
|
var
|
|
m: TFpDbgSymbol;
|
|
begin
|
|
Result := nil;
|
|
if FValueSymbol <> nil then begin
|
|
m := FValueSymbol.MemberByName[AIndex];
|
|
if m <> nil then
|
|
Result := m.Value;
|
|
end;
|
|
SetLastMember(TFpDwarfValue(Result));
|
|
end;
|
|
|
|
function TFpDwarfValue.GetMember(AIndex: Int64): TFpDbgValue;
|
|
var
|
|
m: TFpDbgSymbol;
|
|
begin
|
|
Result := nil;
|
|
if FValueSymbol <> nil then begin
|
|
m := FValueSymbol.Member[AIndex];
|
|
if m <> nil then
|
|
Result := m.Value;
|
|
end;
|
|
SetLastMember(TFpDwarfValue(Result));
|
|
end;
|
|
|
|
function TFpDwarfValue.GetDbgSymbol: TFpDbgSymbol;
|
|
begin
|
|
Result := FValueSymbol;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetTypeInfo: TFpDbgSymbol;
|
|
begin
|
|
if HasTypeCastInfo then
|
|
Result := FTypeCastTargetType
|
|
else
|
|
Result := inherited GetTypeInfo;
|
|
end;
|
|
|
|
function TFpDwarfValue.GetContextTypeInfo: TFpDbgSymbol;
|
|
begin
|
|
if (FValueSymbol <> nil) and (FValueSymbol.ParentTypeInfo <> nil) then
|
|
Result := FValueSymbol.ParentTypeInfo
|
|
else
|
|
Result := nil; // internal error
|
|
end;
|
|
|
|
constructor TFpDwarfValue.Create(AOwner: TFpDwarfSymbolType);
|
|
begin
|
|
FOwner := AOwner;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TFpDwarfValue.Destroy;
|
|
begin
|
|
FTypeCastTargetType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
|
|
FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
|
|
SetLastMember(nil);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFpDwarfValue.SetValueSymbol(AValueSymbol: TFpDwarfSymbolValue);
|
|
begin
|
|
if FValueSymbol = AValueSymbol then
|
|
exit;
|
|
|
|
if CircleBackRefsActive and (FValueSymbol <> nil) then
|
|
FValueSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
FValueSymbol := AValueSymbol;
|
|
if CircleBackRefsActive and (FValueSymbol <> nil) then
|
|
FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
|
|
end;
|
|
|
|
function TFpDwarfValue.SetTypeCastInfo(AStructure: TFpDwarfSymbolType;
|
|
ASource: TFpDbgValue): Boolean;
|
|
begin
|
|
Reset;
|
|
|
|
if FTypeCastSourceValue <> ASource then begin
|
|
if FTypeCastSourceValue <> nil then
|
|
FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
|
|
FTypeCastSourceValue := ASource;
|
|
if FTypeCastSourceValue <> nil then
|
|
FTypeCastSourceValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
|
|
end;
|
|
|
|
if FTypeCastTargetType <> AStructure then begin
|
|
if FTypeCastTargetType <> nil then
|
|
FTypeCastTargetType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
|
|
FTypeCastTargetType := AStructure;
|
|
if FTypeCastTargetType <> nil then
|
|
FTypeCastTargetType.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
|
|
end;
|
|
|
|
Result := IsValidTypeCast;
|
|
end;
|
|
|
|
{ TFpDwarfValueSized }
|
|
|
|
function TFpDwarfValueSized.CanUseTypeCastAddress: Boolean;
|
|
begin
|
|
Result := True;
|
|
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
|
|
exit
|
|
else
|
|
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
|
(FTypeCastSourceValue.Size = FSize) and (FSize > 0)
|
|
then
|
|
exit;
|
|
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and
|
|
not ( (FTypeCastTargetType.Kind = skPointer) //or
|
|
//(FSize = AddressSize xxxxxxx)
|
|
)
|
|
then
|
|
exit;
|
|
Result := False;
|
|
end;
|
|
|
|
function TFpDwarfValueSized.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfSize];
|
|
end;
|
|
|
|
function TFpDwarfValueSized.GetSize: Integer;
|
|
begin
|
|
Result := FSize;
|
|
end;
|
|
|
|
constructor TFpDwarfValueSized.Create(AOwner: TFpDwarfSymbolType; ASize: Integer);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSize := ASize;
|
|
end;
|
|
|
|
{ TFpDwarfValueNumeric }
|
|
|
|
procedure TFpDwarfValueNumeric.Reset;
|
|
begin
|
|
inherited Reset;
|
|
FEvaluated := [];
|
|
end;
|
|
|
|
function TFpDwarfValueNumeric.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfOrdinal];
|
|
end;
|
|
|
|
function TFpDwarfValueNumeric.IsValidTypeCast: Boolean;
|
|
begin
|
|
Result := HasTypeCastInfo;
|
|
If not Result then
|
|
exit;
|
|
if (svfOrdinal in FTypeCastSourceValue.FieldFlags) or CanUseTypeCastAddress then
|
|
exit;
|
|
Result := False;
|
|
end;
|
|
|
|
constructor TFpDwarfValueNumeric.Create(AOwner: TFpDwarfSymbolType; ASize: Integer);
|
|
begin
|
|
inherited Create(AOwner, ASize);
|
|
FEvaluated := [];
|
|
end;
|
|
|
|
{ TFpDwarfValueInteger }
|
|
|
|
function TFpDwarfValueInteger.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfInteger];
|
|
end;
|
|
|
|
function TFpDwarfValueInteger.GetAsCardinal: QWord;
|
|
begin
|
|
Result := QWord(GetAsInteger); // include sign extension
|
|
end;
|
|
|
|
function TFpDwarfValueInteger.GetAsInteger: Int64;
|
|
begin
|
|
if doneInt in FEvaluated then begin
|
|
Result := FIntValue;
|
|
exit;
|
|
end;
|
|
Include(FEvaluated, doneInt);
|
|
|
|
if (FSize <= 0) or (FSize > SizeOf(Result)) then
|
|
Result := inherited GetAsInteger
|
|
else
|
|
if not MemManager.ReadSignedInt(OrdOrDataAddr, FSize, Result) then begin
|
|
Result := 0; // TODO: error
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
|
|
FIntValue := Result;
|
|
end;
|
|
|
|
{ TDbgDwarfCardinalSymbolValue }
|
|
|
|
function TFpDwarfValueCardinal.GetAsCardinal: QWord;
|
|
begin
|
|
if doneUInt in FEvaluated then begin
|
|
Result := FValue;
|
|
exit;
|
|
end;
|
|
Include(FEvaluated, doneUInt);
|
|
|
|
if (FSize <= 0) or (FSize > SizeOf(Result)) then
|
|
Result := inherited GetAsCardinal
|
|
else
|
|
if not MemManager.ReadUnsignedInt(OrdOrDataAddr, FSize, Result) then begin
|
|
Result := 0; // TODO: error
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
|
|
FValue := Result;
|
|
end;
|
|
|
|
function TFpDwarfValueCardinal.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfCardinal];
|
|
end;
|
|
|
|
{ TFpDwarfValueFloat }
|
|
|
|
function TFpDwarfValueFloat.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfFloat] - [svfOrdinal];
|
|
end;
|
|
|
|
function TFpDwarfValueFloat.GetAsFloat: Extended;
|
|
begin
|
|
if doneFloat in FEvaluated then begin
|
|
Result := FValue;
|
|
exit;
|
|
end;
|
|
Include(FEvaluated, doneUInt);
|
|
|
|
if (FSize <= 0) or (FSize > SizeOf(Result)) then
|
|
Result := inherited GetAsCardinal
|
|
else
|
|
if not MemManager.ReadFloat(OrdOrDataAddr, FSize, Result) then begin
|
|
Result := 0; // TODO: error
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
|
|
FValue := Result;
|
|
end;
|
|
|
|
{ TFpDwarfValueBoolean }
|
|
|
|
function TFpDwarfValueBoolean.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfBoolean];
|
|
end;
|
|
|
|
function TFpDwarfValueBoolean.GetAsBool: Boolean;
|
|
begin
|
|
Result := QWord(GetAsCardinal) <> 0;
|
|
end;
|
|
|
|
{ TFpDwarfValueChar }
|
|
|
|
function TFpDwarfValueChar.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
case FSize of
|
|
1: Result := Result + [svfString];
|
|
2: Result := Result + [svfWideString];
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValueChar.GetAsString: AnsiString;
|
|
begin
|
|
// Can typecast, because of FSize = 1, GetAsCardinal only read one byte
|
|
if FSize <> 1 then
|
|
Result := inherited GetAsString
|
|
else
|
|
Result := SysToUTF8(char(byte(GetAsCardinal)));
|
|
end;
|
|
|
|
function TFpDwarfValueChar.GetAsWideString: WideString;
|
|
begin
|
|
if FSize > 2 then
|
|
Result := inherited GetAsString
|
|
else
|
|
Result := WideChar(Word(GetAsCardinal));
|
|
end;
|
|
|
|
{ TFpDwarfValuePointer }
|
|
|
|
function TFpDwarfValuePointer.GetAsCardinal: QWord;
|
|
var
|
|
a: TFpDbgMemLocation;
|
|
begin
|
|
a := GetDataAddress;
|
|
if IsTargetAddr(a) then
|
|
Result := LocToAddr(a)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TFpDwarfValuePointer.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
|
|
Result := Result + [svfCardinal, svfOrdinal, svfSizeOfPointer, svfDataAddress] - [svfSize]; // data address
|
|
|
|
t := TypeInfo;
|
|
if (t <> nil) then t := t.TypeInfo;
|
|
if (t <> nil) and (t.Kind = skChar) and IsReadableMem(DataAddress) then // pchar
|
|
Result := Result + [svfString]; // data address
|
|
end;
|
|
|
|
function TFpDwarfValuePointer.GetDataAddress: TFpDbgMemLocation;
|
|
begin
|
|
if doneAddr in FEvaluated then begin
|
|
Result := FPointetToAddr;
|
|
exit;
|
|
end;
|
|
Include(FEvaluated, doneAddr);
|
|
|
|
if (FSize <= 0) then
|
|
Result := InvalidLoc
|
|
else
|
|
begin
|
|
if not MemManager.ReadAddress(OrdOrDataAddr, FSize, Result) then
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
|
|
FPointetToAddr := Result;
|
|
end;
|
|
|
|
function TFpDwarfValuePointer.GetAsString: AnsiString;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
i: Integer;
|
|
begin
|
|
t := TypeInfo;
|
|
if (t <> nil) then t := t.TypeInfo;
|
|
if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(DataAddress) then begin // pchar
|
|
SetLength(Result, 2000);
|
|
i := 2000;
|
|
while (i > 0) and (not MemManager.ReadMemory(DataAddress, 2000, @Result[1])) do
|
|
i := i div 2;
|
|
SetLength(Result,i);
|
|
i := pos(#0, Result);
|
|
if i > 0 then
|
|
SetLength(Result,i-1);
|
|
exit;
|
|
end;
|
|
|
|
Result := inherited GetAsString;
|
|
end;
|
|
|
|
function TFpDwarfValuePointer.GetMember(AIndex: Int64): TFpDbgValue;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
addr: TFpDbgMemLocation;
|
|
Tmp: TFpDwarfValueConstAddress;
|
|
begin
|
|
//TODO: ?? if no TypeInfo.TypeInfo;, then return TFpDwarfValueConstAddress.Create(addr); (for mem dump)
|
|
Result := nil;
|
|
ReleaseRefAndNil(FLastAddrMember);
|
|
if (TypeInfo = nil) then begin // TODO dedicanted error code
|
|
FLastError := CreateError(fpErrAnyError, ['Can not dereference an untyped pointer']);
|
|
exit;
|
|
end;
|
|
|
|
// TODO re-use last member
|
|
|
|
ti := TypeInfo.TypeInfo;
|
|
{$PUSH}{$R-}{$Q-} // TODO: check overflow
|
|
if ti <> nil then
|
|
AIndex := AIndex * ti.Size;
|
|
addr := DataAddress;
|
|
if not IsTargetAddr(addr) then begin
|
|
FLastError := CreateError(fpErrAnyError, ['Internal dereference error']);
|
|
exit;
|
|
end;
|
|
addr.Address := addr.Address + AIndex;
|
|
{$POP}
|
|
|
|
Tmp := TFpDwarfValueConstAddress.Create(addr);
|
|
if ti <> nil then begin
|
|
Result := ti.TypeCastValue(Tmp);
|
|
Tmp.ReleaseReference;
|
|
SetLastMember(TFpDwarfValue(Result));
|
|
Result.ReleaseReference;
|
|
end
|
|
else begin
|
|
Result := Tmp;
|
|
FLastAddrMember := Result;
|
|
end;
|
|
end;
|
|
|
|
destructor TFpDwarfValuePointer.Destroy;
|
|
begin
|
|
FLastAddrMember.ReleaseReference;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TFpDwarfValueEnum }
|
|
|
|
procedure TFpDwarfValueEnum.InitMemberIndex;
|
|
var
|
|
v: QWord;
|
|
i: Integer;
|
|
begin
|
|
// TODO: if TypeInfo is a subrange, check against the bounds, then bypass it, and scan all members (avoid subrange scanning members)
|
|
if FMemberValueDone then exit;
|
|
// FTypeCastTargetType (if not nil) must be same as FOwner. It may have wrappers like declaration.
|
|
v := GetAsCardinal;
|
|
i := FOwner.MemberCount - 1;
|
|
while i >= 0 do begin
|
|
if FOwner.Member[i].OrdinalValue = v then break;
|
|
dec(i);
|
|
end;
|
|
FMemberIndex := i;
|
|
FMemberValueDone := True;
|
|
end;
|
|
|
|
procedure TFpDwarfValueEnum.Reset;
|
|
begin
|
|
inherited Reset;
|
|
FMemberValueDone := False;
|
|
end;
|
|
|
|
function TFpDwarfValueEnum.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfOrdinal, svfMembers, svfIdentifier];
|
|
end;
|
|
|
|
function TFpDwarfValueEnum.GetAsCardinal: QWord;
|
|
begin
|
|
if doneUInt in FEvaluated then begin
|
|
Result := FValue;
|
|
exit;
|
|
end;
|
|
Include(FEvaluated, doneUInt);
|
|
|
|
if (FSize <= 0) or (FSize > SizeOf(Result)) then
|
|
Result := inherited GetAsCardinal
|
|
else
|
|
if not MemManager.ReadEnum(OrdOrDataAddr, FSize, Result) then begin
|
|
FLastError := MemManager.LastError;
|
|
Result := 0; // TODO: error
|
|
end;
|
|
|
|
FValue := Result;
|
|
end;
|
|
|
|
function TFpDwarfValueEnum.GetAsString: AnsiString;
|
|
begin
|
|
InitMemberIndex;
|
|
if FMemberIndex >= 0 then
|
|
Result := FOwner.Member[FMemberIndex].Name
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TFpDwarfValueEnum.GetMemberCount: Integer;
|
|
begin
|
|
InitMemberIndex;
|
|
if FMemberIndex < 0 then
|
|
Result := 0
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
function TFpDwarfValueEnum.GetMember(AIndex: Int64): TFpDbgValue;
|
|
begin
|
|
InitMemberIndex;
|
|
if (FMemberIndex >= 0) and (AIndex = 0) then
|
|
Result := FOwner.Member[FMemberIndex].Value
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
{ TFpDwarfValueEnumMember }
|
|
|
|
function TFpDwarfValueEnumMember.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfOrdinal, svfIdentifier];
|
|
end;
|
|
|
|
function TFpDwarfValueEnumMember.GetAsCardinal: QWord;
|
|
begin
|
|
Result := FOwnerVal.OrdinalValue;
|
|
end;
|
|
|
|
function TFpDwarfValueEnumMember.GetAsString: AnsiString;
|
|
begin
|
|
Result := FOwnerVal.Name;
|
|
end;
|
|
|
|
function TFpDwarfValueEnumMember.IsValidTypeCast: Boolean;
|
|
begin
|
|
assert(False, 'TDbgDwarfEnumMemberSymbolValue.IsValidTypeCast can not be returned for typecast');
|
|
Result := False;
|
|
end;
|
|
|
|
constructor TFpDwarfValueEnumMember.Create(AOwner: TFpDwarfSymbolValue);
|
|
begin
|
|
FOwnerVal := AOwner;
|
|
inherited Create(nil);
|
|
end;
|
|
|
|
{ TFpDwarfValueConstNumber }
|
|
|
|
procedure TFpDwarfValueConstNumber.Update(AValue: QWord; ASigned: Boolean);
|
|
begin
|
|
Signed := ASigned;
|
|
Value := AValue;
|
|
end;
|
|
|
|
{ TFpDwarfValueSet }
|
|
|
|
procedure TFpDwarfValueSet.InitMap;
|
|
const
|
|
BitCount: array[0..15] of byte = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
|
|
var
|
|
i, i2, v, MemIdx, Bit, Cnt: Integer;
|
|
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
if (length(FMem) > 0) or (FSize <= 0) then
|
|
exit;
|
|
t := TypeInfo;
|
|
if t = nil then exit;
|
|
t := t.TypeInfo;
|
|
if t = nil then exit;
|
|
|
|
if not MemManager.ReadSet(DataAddr, FSize, FMem) then begin
|
|
FLastError := MemManager.LastError;
|
|
exit; // TODO: error
|
|
end;
|
|
|
|
Cnt := 0;
|
|
for i := 0 to FSize - 1 do
|
|
Cnt := Cnt + (BitCount[FMem[i] and 15]) + (BitCount[(FMem[i] div 16) and 15]);
|
|
FMemberCount := Cnt;
|
|
|
|
if (Cnt = 0) then exit;
|
|
SetLength(FMemberMap, Cnt);
|
|
|
|
if (t.Kind = skEnum) then begin
|
|
i2 := 0;
|
|
for i := 0 to t.MemberCount - 1 do
|
|
begin
|
|
v := t.Member[i].OrdinalValue;
|
|
MemIdx := v shr 3;
|
|
Bit := 1 shl (v and 7);
|
|
if (FMem[MemIdx] and Bit) <> 0 then begin
|
|
assert(i2 < Cnt, 'TDbgDwarfSetSymbolValue.InitMap too many members');
|
|
if i2 = Cnt then break;
|
|
FMemberMap[i2] := i;
|
|
inc(i2);
|
|
end;
|
|
end;
|
|
|
|
if i2 < Cnt then begin
|
|
FMemberCount := i2;
|
|
debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
|
|
end;
|
|
end
|
|
else begin
|
|
i2 := 0;
|
|
MemIdx := 0;
|
|
Bit := 1;
|
|
v := t.OrdLowBound;
|
|
for i := v to t.OrdHighBound do
|
|
begin
|
|
if (FMem[MemIdx] and Bit) <> 0 then begin
|
|
assert(i2 < Cnt, 'TDbgDwarfSetSymbolValue.InitMap too many members');
|
|
if i2 = Cnt then break;
|
|
FMemberMap[i2] := i - v; // offset from low-bound
|
|
inc(i2);
|
|
end;
|
|
if Bit = 128 then begin
|
|
Bit := 1;
|
|
inc(MemIdx);
|
|
end
|
|
else
|
|
Bit := Bit shl 1;
|
|
end;
|
|
|
|
if i2 < Cnt then begin
|
|
FMemberCount := i2;
|
|
debugln(FPDBG_DWARF_DATA_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TFpDwarfValueSet.Reset;
|
|
begin
|
|
inherited Reset;
|
|
SetLength(FMem, 0);
|
|
end;
|
|
|
|
function TFpDwarfValueSet.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfMembers];
|
|
if FSize <= 8 then
|
|
Result := Result + [svfOrdinal];
|
|
end;
|
|
|
|
function TFpDwarfValueSet.GetMemberCount: Integer;
|
|
begin
|
|
InitMap;
|
|
Result := FMemberCount;
|
|
end;
|
|
|
|
function TFpDwarfValueSet.GetMember(AIndex: Int64): TFpDbgValue;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
Result := nil;
|
|
InitMap;
|
|
t := TypeInfo;
|
|
if t = nil then exit;
|
|
t := t.TypeInfo;
|
|
if t = nil then exit;
|
|
assert(t is TFpDwarfSymbolType, 'TDbgDwarfSetSymbolValue.GetMember t');
|
|
|
|
if t.Kind = skEnum then begin
|
|
Result := t.Member[FMemberMap[AIndex]].Value;
|
|
end
|
|
else begin
|
|
if (FNumValue = nil) or (FNumValue.RefCount > 1) then // refcount 1 by FTypedNumValue
|
|
FNumValue := TFpDwarfValueConstNumber.Create(FMemberMap[AIndex] + t.OrdLowBound, t.Kind = skInteger)
|
|
else
|
|
begin
|
|
FNumValue.Update(FMemberMap[AIndex] + t.OrdLowBound, t.Kind = skInteger);
|
|
FNumValue.AddReference;
|
|
end;
|
|
|
|
if (FTypedNumValue = nil) or (FTypedNumValue.RefCount > 1) then begin
|
|
FTypedNumValue.ReleaseReference;
|
|
FTypedNumValue := t.TypeCastValue(FNumValue)
|
|
end
|
|
else
|
|
TFpDwarfValue(FTypedNumValue).SetTypeCastInfo(TFpDwarfSymbolType(t), FNumValue); // update
|
|
FNumValue.ReleaseReference;
|
|
Assert((FTypedNumValue <> nil) and (TFpDwarfValue(FTypedNumValue).IsValidTypeCast), 'TDbgDwarfSetSymbolValue.GetMember FTypedNumValue');
|
|
Assert((FNumValue <> nil) and (FNumValue.RefCount > 0), 'TDbgDwarfSetSymbolValue.GetMember FNumValue');
|
|
Result := FTypedNumValue;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValueSet.GetAsCardinal: QWord;
|
|
begin
|
|
Result := 0;
|
|
if (FSize <= SizeOf(Result)) and (length(FMem) > 0) then
|
|
move(FMem[0], Result, FSize);
|
|
end;
|
|
|
|
function TFpDwarfValueSet.IsValidTypeCast: Boolean;
|
|
var
|
|
f: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := HasTypeCastInfo;
|
|
If not Result then
|
|
exit;
|
|
|
|
assert(FTypeCastTargetType.Kind = skSet, 'TFpDwarfValueSet.IsValidTypeCast: FTypeCastTargetType.Kind = skSet');
|
|
|
|
if (FTypeCastSourceValue.TypeInfo = FTypeCastTargetType)
|
|
then
|
|
exit; // pointer deref
|
|
|
|
f := FTypeCastSourceValue.FieldFlags;
|
|
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
|
|
exit;
|
|
|
|
if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
|
(FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
|
|
then
|
|
exit;
|
|
|
|
Result := False;
|
|
end;
|
|
|
|
destructor TFpDwarfValueSet.Destroy;
|
|
begin
|
|
FTypedNumValue.ReleaseReference;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TFpDwarfValueStruct }
|
|
|
|
procedure TFpDwarfValueStruct.Reset;
|
|
begin
|
|
inherited Reset;
|
|
FDataAddressDone := False;
|
|
end;
|
|
|
|
function TFpDwarfValueStruct.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfMembers];
|
|
|
|
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
|
|
if Kind in [skClass] then begin
|
|
Result := Result + [svfOrdinal, svfDataAddress, svfDataSize]; // svfDataSize
|
|
if (FValueSymbol <> nil) and FValueSymbol.HasAddress then
|
|
Result := Result + [svfSizeOfPointer];
|
|
end
|
|
else begin
|
|
Result := Result + [svfSize];
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValueStruct.GetAsCardinal: QWord;
|
|
begin
|
|
Result := QWord(LocToAddrOrNil(DataAddress));
|
|
end;
|
|
|
|
function TFpDwarfValueStruct.GetDataAddress: TFpDbgMemLocation;
|
|
var
|
|
t: TFpDbgMemLocation;
|
|
begin
|
|
if FValueSymbol <> nil then begin
|
|
if not FDataAddressDone then begin
|
|
FDataAddress := InvalidLoc;
|
|
FValueSymbol.GetValueAddress(Self, t);
|
|
assert(SizeOf(FDataAddress) >= AddressSize, 'TDbgDwarfStructSymbolValue.GetDataAddress');
|
|
if (MemManager <> nil) then begin
|
|
FDataAddress := MemManager.ReadAddress(t, AddressSize);
|
|
if not IsValidLoc(FDataAddress) then
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
FDataAddressDone := True;
|
|
end;
|
|
Result := FDataAddress;
|
|
end
|
|
else
|
|
Result := inherited GetDataAddress;
|
|
end;
|
|
|
|
function TFpDwarfValueStruct.GetDataSize: Integer;
|
|
begin
|
|
Assert((FValueSymbol = nil) or (FValueSymbol.TypeInfo is TFpDwarfSymbol));
|
|
if (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then
|
|
if FValueSymbol.TypeInfo.Kind = skClass then
|
|
Result := TFpDwarfSymbol(FValueSymbol.TypeInfo).DataSize
|
|
else
|
|
Result := FValueSymbol.TypeInfo.Size
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TFpDwarfValueStruct.GetSize: Integer;
|
|
begin
|
|
if (Kind <> skClass) and (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then
|
|
Result := FValueSymbol.TypeInfo.Size
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
{ TFpDwarfValueStructTypeCast }
|
|
|
|
procedure TFpDwarfValueStructTypeCast.Reset;
|
|
begin
|
|
inherited Reset;
|
|
FDataAddressDone := False;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfMembers];
|
|
if kind = skClass then // todo detect hidden pointer
|
|
Result := Result + [svfDataSize]
|
|
else
|
|
Result := Result + [svfSize];
|
|
|
|
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
|
|
if Kind in [skClass] then
|
|
Result := Result + [svfOrdinal, svfDataAddress, svfSizeOfPointer]; // svfDataSize
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetKind: TDbgSymbolKind;
|
|
begin
|
|
if HasTypeCastInfo then
|
|
Result := FTypeCastTargetType.Kind
|
|
else
|
|
Result := inherited GetKind;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetAsCardinal: QWord;
|
|
begin
|
|
Result := QWord(LocToAddrOrNil(DataAddress));
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetSize: Integer;
|
|
begin
|
|
if (Kind <> skClass) and (FTypeCastTargetType <> nil) then
|
|
Result := FTypeCastTargetType.Size
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetDataSize: Integer;
|
|
begin
|
|
Assert((FTypeCastTargetType = nil) or (FTypeCastTargetType is TFpDwarfSymbol));
|
|
if FTypeCastTargetType <> nil then
|
|
if FTypeCastTargetType.Kind = skClass then
|
|
Result := TFpDwarfSymbol(FTypeCastTargetType).DataSize
|
|
else
|
|
Result := FTypeCastTargetType.Size
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetDataAddress: TFpDbgMemLocation;
|
|
var
|
|
fields: TFpDbgValueFieldFlags;
|
|
t: TFpDbgMemLocation;
|
|
begin
|
|
if HasTypeCastInfo then begin
|
|
if not FDataAddressDone then begin
|
|
// TODO: wrong for records // use GetDwarfDataAddress
|
|
fields := FTypeCastSourceValue.FieldFlags;
|
|
if svfOrdinal in fields then
|
|
FDataAddress := TargetLoc(TDbgPtr(FTypeCastSourceValue.AsCardinal))
|
|
else
|
|
if svfAddress in fields then begin
|
|
FDataAddress := InvalidLoc;
|
|
t := FTypeCastSourceValue.Address;
|
|
assert(SizeOf(FDataAddress) >= AddressSize, 'TDbgDwarfStructSymbolValue.GetDataAddress');
|
|
if (MemManager <> nil) then begin
|
|
FDataAddress := MemManager.ReadAddress(t, AddressSize);
|
|
if not IsValidLoc(FDataAddress) then
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
end;
|
|
FDataAddressDone := True;
|
|
end;
|
|
Result := FDataAddress;
|
|
end
|
|
else
|
|
Result := inherited GetDataAddress;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.IsValidTypeCast: Boolean;
|
|
var
|
|
f: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := HasTypeCastInfo;
|
|
if not Result then
|
|
exit;
|
|
|
|
if FTypeCastTargetType.Kind = skClass then begin
|
|
f := FTypeCastSourceValue.FieldFlags;
|
|
Result := (svfOrdinal in f); // ordinal is prefered in GetDataAddress
|
|
if Result then
|
|
exit;
|
|
Result := (svfAddress in f) and
|
|
( ( not(svfSize in f) ) or // either svfSizeOfPointer or a void type, e.g. pointer(1)^
|
|
( (svfSize in f) and (FTypeCastSourceValue.Size = AddressSize) )
|
|
);
|
|
end
|
|
else begin
|
|
f := FTypeCastSourceValue.FieldFlags;
|
|
if (f * [{svfOrdinal, }svfAddress] = [svfAddress]) then begin
|
|
if (f * [svfSize, svfSizeOfPointer]) = [svfSize] then
|
|
Result := Result and (FTypeCastTargetType.Size = FTypeCastSourceValue.Size)
|
|
else
|
|
if (f * [svfSize, svfSizeOfPointer]) = [svfSizeOfPointer] then
|
|
Result := Result and (FTypeCastTargetType.Size = AddressSize)
|
|
else
|
|
Result := (f * [svfSize, svfSizeOfPointer]) = []; // source is a void type, e.g. pointer(1)^
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
destructor TFpDwarfValueStructTypeCast.Destroy;
|
|
begin
|
|
FreeAndNil(FMembers);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetMemberByName(AIndex: String): TFpDbgValue;
|
|
var
|
|
tmp: TFpDbgSymbol;
|
|
begin
|
|
Result := nil;
|
|
if not HasTypeCastInfo then
|
|
exit;
|
|
|
|
tmp := FTypeCastTargetType.MemberByName[AIndex];
|
|
if (tmp <> nil) then begin
|
|
assert((tmp is TFpDwarfSymbolValue), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp));
|
|
if FMembers = nil then
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
FMembers.Add(tmp);
|
|
|
|
Result := tmp.Value;
|
|
end;
|
|
SetLastMember(TFpDwarfValue(Result));
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetMember(AIndex: Int64): TFpDbgValue;
|
|
var
|
|
tmp: TFpDbgSymbol;
|
|
begin
|
|
Result := nil;
|
|
if not HasTypeCastInfo then
|
|
exit;
|
|
|
|
// TODO: Why store them all in list? They are hold by the type
|
|
tmp := FTypeCastTargetType.Member[AIndex];
|
|
if (tmp <> nil) then begin
|
|
assert((tmp is TFpDwarfSymbolValue), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp));
|
|
if FMembers = nil then
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
FMembers.Add(tmp);
|
|
|
|
Result := tmp.Value;
|
|
end;
|
|
SetLastMember(TFpDwarfValue(Result));
|
|
end;
|
|
|
|
function TFpDwarfValueStructTypeCast.GetMemberCount: Integer;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
Result := 0;
|
|
if not HasTypeCastInfo then
|
|
exit;
|
|
|
|
Result := FTypeCastTargetType.MemberCount;
|
|
|
|
ti := FTypeCastTargetType;
|
|
//TODO: cache result
|
|
if ti.Kind in [skClass, skObject] then
|
|
while ti.TypeInfo <> nil do begin
|
|
ti := ti.TypeInfo;
|
|
Result := Result + ti.MemberCount;
|
|
end;
|
|
end;
|
|
|
|
{ TFpDwarfValueConstAddress }
|
|
|
|
procedure TFpDwarfValueConstAddress.Update(AnAddress: TFpDbgMemLocation);
|
|
begin
|
|
Address := AnAddress;
|
|
end;
|
|
|
|
{ TFpDwarfValueArray }
|
|
|
|
function TFpDwarfValueArray.GetFieldFlags: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := inherited GetFieldFlags;
|
|
Result := Result + [svfMembers];
|
|
if (TypeInfo <> nil) and (sfDynArray in TypeInfo.Flags) then
|
|
Result := Result + [svfOrdinal, svfDataAddress];
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetKind: TDbgSymbolKind;
|
|
begin
|
|
Result := skArray;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetAsCardinal: QWord;
|
|
begin
|
|
// TODO cache
|
|
if not MemManager.ReadUnsignedInt(OrdOrAddress, AddressSize, Result) then begin
|
|
FLastError := MemManager.LastError;
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetDataAddress: TFpDbgMemLocation;
|
|
begin
|
|
Result := OrdOrDataAddr;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetMember(AIndex: Int64): TFpDbgValue;
|
|
begin
|
|
Result := GetMemberEx([AIndex]);
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetMemberEx(AIndex: array of Int64): TFpDbgValue;
|
|
var
|
|
Addr: TFpDbgMemLocation;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
assert((FOwner is TFpDwarfSymbolTypeArray) and (FOwner.Kind = skArray));
|
|
Addr := TFpDwarfSymbolTypeArray(FOwner).GetMemberAddress(Self, AIndex);
|
|
if not IsReadableLoc(Addr) then exit;
|
|
|
|
// FAddrObj.RefCount: hold by self
|
|
i := 1;
|
|
// FAddrObj.RefCount: hold by FLastMember (ignore only, if FLastMember is not hold by others)
|
|
if (FLastMember <> nil) and (FLastMember.RefCount = 1) then
|
|
i := 2;
|
|
if (FAddrObj = nil) or (FAddrObj.RefCount > i) then begin
|
|
FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
|
|
FAddrObj := TFpDwarfValueConstAddress.Create(Addr);
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FAddrObj.DbgRenameReference(@FAddrObj, 'TDbgDwarfArraySymbolValue');{$ENDIF}
|
|
end
|
|
else begin
|
|
FAddrObj.Update(Addr);
|
|
end;
|
|
|
|
if (FLastMember = nil) or (FLastMember.RefCount > 1) then begin
|
|
SetLastMember(TFpDwarfValue(FOwner.TypeInfo.TypeCastValue(FAddrObj)));
|
|
FLastMember.ReleaseReference;
|
|
end
|
|
else begin
|
|
TFpDwarfValue(FLastMember).SetTypeCastInfo(TFpDwarfSymbolType(FOwner.TypeInfo), FAddrObj);
|
|
end;
|
|
|
|
Result := FLastMember;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetMemberCount: Integer;
|
|
var
|
|
t, t2: TFpDbgSymbol;
|
|
Addr: TFpDbgMemLocation;
|
|
LowBound, HighBound: int64;
|
|
i: Int64;
|
|
begin
|
|
Result := 0;
|
|
t := TypeInfo;
|
|
if t.MemberCount < 1 then // IndexTypeCount;
|
|
exit;
|
|
t2 := t.Member[0]; // IndexType[0];
|
|
if not ((t2 is TFpDwarfSymbolType) and (TFpDwarfSymbolType(t2).GetValueBounds(self, LowBound, HighBound))) and
|
|
not t2.HasBounds then begin
|
|
if (sfDynArray in t.Flags) and (AsCardinal <> 0) and
|
|
GetDwarfDataAddress(Addr, TFpDwarfSymbolType(FOwner))
|
|
then begin
|
|
if not (IsReadableMem(Addr) and (LocToAddr(Addr) > 4)) then
|
|
exit;
|
|
Addr.Address := Addr.Address - AddressSize;
|
|
if MemManager.ReadSignedInt(Addr, 4, i) then begin
|
|
Result := Integer(i)+1;
|
|
exit;
|
|
end
|
|
else
|
|
FLastError := MemManager.LastError;
|
|
end;
|
|
exit;
|
|
end;
|
|
Result := t2.OrdHighBound - t2.OrdLowBound + 1;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetMemberCountEx(AIndex: array of Int64): Integer;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
Result := 0;
|
|
t := TypeInfo;
|
|
if length(AIndex) >= t.MemberCount then
|
|
exit;
|
|
t := t.Member[length(AIndex)];
|
|
if not t.HasBounds then
|
|
exit;
|
|
Result := t.OrdHighBound - t.OrdLowBound + 1;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetIndexType(AIndex: Integer): TFpDbgSymbol;
|
|
begin
|
|
Result := TypeInfo.Member[AIndex];
|
|
end;
|
|
|
|
function TFpDwarfValueArray.GetIndexTypeCount: Integer;
|
|
begin
|
|
Result := TypeInfo.MemberCount;
|
|
end;
|
|
|
|
function TFpDwarfValueArray.IsValidTypeCast: Boolean;
|
|
var
|
|
f: TFpDbgValueFieldFlags;
|
|
begin
|
|
Result := HasTypeCastInfo;
|
|
If not Result then
|
|
exit;
|
|
|
|
assert(FTypeCastTargetType.Kind = skArray, 'TFpDwarfValueArray.IsValidTypeCast: FTypeCastTargetType.Kind = skArray');
|
|
//TODO: shortcut, if FTypeCastTargetType = FTypeCastSourceValue.TypeInfo ?
|
|
|
|
f := FTypeCastSourceValue.FieldFlags;
|
|
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
|
|
exit;
|
|
|
|
if sfDynArray in FTypeCastTargetType.Flags then begin
|
|
// dyn array
|
|
if (svfOrdinal in f)then
|
|
exit;
|
|
if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
|
(FTypeCastSourceValue.Size = FOwner.CompilationUnit.AddressSize)
|
|
then
|
|
exit;
|
|
if (f * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) then
|
|
exit;
|
|
end
|
|
else begin
|
|
// stat array
|
|
if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
|
(FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
|
|
then
|
|
exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
destructor TFpDwarfValueArray.Destroy;
|
|
begin
|
|
FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TDbgDwarfIdentifier }
|
|
|
|
function TFpDwarfSymbol.GetNestedTypeInfo: TFpDwarfSymbolType;
|
|
begin
|
|
// TODO DW_AT_start_scope;
|
|
Result := FNestedTypeInfo;
|
|
if (Result <> nil) or (didtTypeRead in FDwarfReadFlags) then
|
|
exit;
|
|
|
|
include(FDwarfReadFlags, didtTypeRead);
|
|
FNestedTypeInfo := DoGetNestedTypeInfo;
|
|
Result := FNestedTypeInfo;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.SetParentTypeInfo(AValue: TFpDwarfSymbol);
|
|
begin
|
|
if FParentTypeInfo = AValue then exit;
|
|
|
|
if (FParentTypeInfo <> nil) and CircleBackRefsActive then
|
|
FParentTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FParentTypeInfo, 'FParentTypeInfo'){$ENDIF};
|
|
|
|
FParentTypeInfo := AValue;
|
|
|
|
if (FParentTypeInfo <> nil) and CircleBackRefsActive then
|
|
FParentTypeInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FParentTypeInfo, 'FParentTypeInfo'){$ENDIF};
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.DoReferenceAdded;
|
|
begin
|
|
inherited DoReferenceAdded;
|
|
DoPlainReferenceAdded;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.DoReferenceReleased;
|
|
begin
|
|
inherited DoReferenceReleased;
|
|
DoPlainReferenceReleased;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.CircleBackRefActiveChanged(ANewActive: Boolean);
|
|
begin
|
|
if (FParentTypeInfo = nil) then
|
|
exit;
|
|
if ANewActive then
|
|
FParentTypeInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FParentTypeInfo, 'FParentTypeInfo'){$ENDIF}
|
|
else
|
|
FParentTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FParentTypeInfo, 'FParentTypeInfo'){$ENDIF};
|
|
end;
|
|
|
|
function TFpDwarfSymbol.DoGetNestedTypeInfo: TFpDwarfSymbolType;
|
|
var
|
|
FwdInfoPtr: Pointer;
|
|
FwdCompUint: TDwarfCompilationUnit;
|
|
InfoEntry: TDwarfInformationEntry;
|
|
begin // Do not access anything that may need forwardSymbol
|
|
if InformationEntry.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint) then begin
|
|
InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
Result := TFpDwarfSymbolType.CreateTypeSubClass('', InfoEntry);
|
|
ReleaseRefAndNil(InfoEntry);
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.ReadMemberVisibility(out
|
|
AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
|
|
var
|
|
Val: Integer;
|
|
begin
|
|
Result := InformationEntry.ReadValue(DW_AT_external, Val);
|
|
if Result and (Val <> 0) then begin
|
|
AMemberVisibility := svPublic;
|
|
exit;
|
|
end;
|
|
|
|
Result := InformationEntry.ReadValue(DW_AT_accessibility, Val);
|
|
if not Result then exit;
|
|
case Val of
|
|
DW_ACCESS_private: AMemberVisibility := svPrivate;
|
|
DW_ACCESS_protected: AMemberVisibility := svProtected;
|
|
DW_ACCESS_public: AMemberVisibility := svPublic;
|
|
else AMemberVisibility := svPrivate;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.IsArtificial: Boolean;
|
|
begin
|
|
if not(didtArtificialRead in FDwarfReadFlags) then begin
|
|
if InformationEntry.IsArtificial then
|
|
Include(FDwarfReadFlags, didtIsArtifical);
|
|
Include(FDwarfReadFlags, didtArtificialRead);
|
|
end;
|
|
Result := didtIsArtifical in FDwarfReadFlags;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.NameNeeded;
|
|
var
|
|
AName: String;
|
|
begin
|
|
if InformationEntry.ReadName(AName) then
|
|
SetName(AName)
|
|
else
|
|
inherited NameNeeded;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.TypeInfoNeeded;
|
|
begin
|
|
SetTypeInfo(NestedTypeInfo);
|
|
end;
|
|
|
|
function TFpDwarfSymbol.DataSize: Integer;
|
|
var
|
|
t: TFpDwarfSymbolType;
|
|
begin
|
|
t := NestedTypeInfo;
|
|
if t <> nil then
|
|
Result := t.DataSize
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
|
|
AnInitLocParserData: PInitLocParserData): Boolean;
|
|
begin
|
|
if (AnInitLocParserData <> nil) and IsValidLoc(AnInitLocParserData^.ObjectDataAddress)
|
|
then begin
|
|
if AnInitLocParserData^.ObjectDataAddrPush then begin
|
|
debugln(FPDBG_DWARF_VERBOSE, ['TFpDwarfSymbol.InitLocationParser Push=', dbgs(AnInitLocParserData^.ObjectDataAddress)]);
|
|
ALocationParser.Push(AnInitLocParserData^.ObjectDataAddress, lseValue);
|
|
end
|
|
else begin
|
|
debugln(FPDBG_DWARF_VERBOSE, ['TFpDwarfSymbol.InitLocationParser CurrentObjectAddress=', dbgs(AnInitLocParserData^.ObjectDataAddress)]);
|
|
ALocationParser.CurrentObjectAddress := AnInitLocParserData^.ObjectDataAddress;
|
|
end;
|
|
end;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.LocationFromTag(ATag: Cardinal; AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; AnInitLocParserData: PInitLocParserData;
|
|
AnInformationEntry: TDwarfInformationEntry; ASucessOnMissingTag: Boolean): Boolean;
|
|
var
|
|
Val: TByteDynArray;
|
|
LocationParser: TDwarfLocationExpression;
|
|
begin
|
|
//debugln(['TDbgDwarfIdentifier.LocationFromTag', ClassName, ' ',Name, ' ', DwarfAttributeToString(ATag)]);
|
|
|
|
Result := False;
|
|
if AnInformationEntry = nil then
|
|
AnInformationEntry := InformationEntry;
|
|
|
|
//TODO: avoid copying data
|
|
// DW_AT_data_member_location in members [ block or const]
|
|
// DW_AT_location [block or reference] todo: const
|
|
if not AnInformationEntry.ReadValue(ATag, Val) then begin
|
|
Result := ASucessOnMissingTag;
|
|
if not Result then
|
|
AnAddress := InvalidLoc;
|
|
if not Result then
|
|
DebugLn(['LocationFromTag: failed to read DW_AT_location / ASucessOnMissingTag=', dbgs(ASucessOnMissingTag)]);
|
|
exit;
|
|
end;
|
|
|
|
AnAddress := InvalidLoc;
|
|
if Length(Val) = 0 then begin
|
|
DebugLn('LocationFromTag: Warning DW_AT_location empty');
|
|
//exit;
|
|
end;
|
|
|
|
LocationParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit,
|
|
AValueObj.MemManager, AValueObj.Context);
|
|
InitLocationParser(LocationParser, AnInitLocParserData);
|
|
LocationParser.Evaluate;
|
|
|
|
if IsError(LocationParser.LastError) then
|
|
SetLastError(LocationParser.LastError);
|
|
|
|
if LocationParser.ResultKind in [lseValue] then begin
|
|
AnAddress := TargetLoc(LocationParser.ResultData);
|
|
if ATag=DW_AT_location then
|
|
AnAddress.Address :=CompilationUnit.MapAddressToNewValue(AnAddress.Address);
|
|
Result := True;
|
|
end
|
|
else
|
|
if LocationParser.ResultKind in [lseRegister] then begin
|
|
AnAddress := ConstLoc(LocationParser.ResultData);
|
|
Result := True;
|
|
end
|
|
else
|
|
debugln(['TDbgDwarfIdentifier.LocationFromTag FAILED']); // TODO
|
|
|
|
LocationParser.Free;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.GetDataAddress(AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType;
|
|
ATargetCacheIndex: Integer): Boolean;
|
|
var
|
|
ti: TFpDwarfSymbolType;
|
|
InitLocParserData: TInitLocParserData;
|
|
begin
|
|
InitLocParserData.ObjectDataAddress := AnAddress;
|
|
InitLocParserData.ObjectDataAddrPush := False;
|
|
Result := LocationFromTag(DW_AT_data_location, AValueObj, AnAddress, @InitLocParserData, nil, True);
|
|
if not Result then
|
|
exit;
|
|
|
|
|
|
if ATargetType = Self then begin
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
|
|
//TODO: Handle AValueObj.DataAddressCache[ATargetCacheIndex];
|
|
Result := GetDataAddressNext(AValueObj, AnAddress, ATargetType, ATargetCacheIndex);
|
|
if not Result then
|
|
exit;
|
|
|
|
ti := NestedTypeInfo;
|
|
if ti <> nil then
|
|
Result := ti.GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex+1)
|
|
else
|
|
Result := ATargetType = nil; // end of type chain
|
|
end;
|
|
|
|
function TFpDwarfSymbol.GetDataAddressNext(AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType;
|
|
ATargetCacheIndex: Integer): Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TFpDwarfSymbol.HasAddress: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbol.Init;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
class function TFpDwarfSymbol.CreateSubClass(AName: String;
|
|
AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbol;
|
|
var
|
|
c: TDbgDwarfSymbolBaseClass;
|
|
begin
|
|
c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
|
|
Result := TFpDwarfSymbol(c.Create(AName, AnInformationEntry));
|
|
end;
|
|
|
|
destructor TFpDwarfSymbol.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
ReleaseRefAndNil(FNestedTypeInfo);
|
|
Assert(not CircleBackRefsActive, 'CircleBackRefsActive can not be is destructor');
|
|
// FParentTypeInfo := nil
|
|
end;
|
|
|
|
function TFpDwarfSymbol.StartScope: TDbgPtr;
|
|
begin
|
|
if not InformationEntry.ReadStartScope(Result) then
|
|
Result := 0;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValue }
|
|
|
|
function TFpDwarfSymbolValue.GetValueAddress(AValueObj: TFpDwarfValue; out
|
|
AnAddress: TFpDbgMemLocation): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValue.GetValueDataAddress(AValueObj: TFpDwarfValue; out
|
|
AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType): Boolean;
|
|
begin
|
|
Result := TypeInfo <> nil;
|
|
if not Result then
|
|
exit;
|
|
|
|
Assert((TypeInfo is TFpDwarfSymbol) and (TypeInfo.SymbolType = stType), 'TFpDwarfSymbolValue.GetDataAddress');
|
|
Result := GetValueAddress(AValueObj, AnAddress);
|
|
Result := Result and IsReadableLoc(AnAddress);
|
|
if Result then begin
|
|
Result := TFpDwarfSymbolType(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1);
|
|
if not Result then SetLastError(TypeInfo.LastError);
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValue.KindNeeded;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
t := TypeInfo;
|
|
if t = nil then
|
|
inherited KindNeeded
|
|
else
|
|
SetKind(t.Kind);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValue.MemberVisibilityNeeded;
|
|
var
|
|
Val: TDbgSymbolMemberVisibility;
|
|
begin
|
|
if ReadMemberVisibility(Val) then
|
|
SetMemberVisibility(Val)
|
|
else
|
|
if TypeInfo <> nil then
|
|
SetMemberVisibility(TypeInfo.MemberVisibility)
|
|
else
|
|
inherited MemberVisibilityNeeded;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValue.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
k: TDbgSymbolKind;
|
|
begin
|
|
ti := TypeInfo;
|
|
if ti = nil then begin
|
|
Result := inherited GetMember(AIndex);
|
|
exit;
|
|
end;
|
|
|
|
k := ti.Kind;
|
|
// while holding result, until refcount added, do not call any function
|
|
Result := ti.Member[AIndex];
|
|
assert((Result = nil) or (Result is TFpDwarfSymbolValue), 'TFpDwarfSymbolValue.GetMember is Value');
|
|
|
|
if (k in [skClass, skObject, skRecord {, skArray}]) and
|
|
(Result <> nil) and (Result is TFpDwarfSymbolValue)
|
|
then begin
|
|
if FMembers = nil then
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
FMembers.Add(Result); //TODO: last member only?
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValue.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
k: TDbgSymbolKind;
|
|
begin
|
|
ti := TypeInfo;
|
|
if ti = nil then begin
|
|
Result := inherited GetMemberByName(AIndex);
|
|
exit;
|
|
end;
|
|
|
|
k := ti.Kind;
|
|
|
|
// while holding result, until refcount added, do not call any function
|
|
Result := ti.MemberByName[AIndex];
|
|
assert((Result = nil) or (Result is TFpDwarfSymbolValue), 'TFpDwarfSymbolValue.GetMember is Value');
|
|
|
|
if (k in [skClass, skObject, skRecord {, skArray}]) and
|
|
(Result <> nil) and (Result is TFpDwarfSymbolValue)
|
|
then begin
|
|
if FMembers = nil then
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
FMembers.Add(Result);
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValue.GetMemberCount: Integer;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
ti := TypeInfo;
|
|
if ti <> nil then begin
|
|
Result := ti.MemberCount;
|
|
//TODO: cache result
|
|
if ti.Kind in [skClass, skObject] then
|
|
while ti.TypeInfo <> nil do begin
|
|
ti := ti.TypeInfo;
|
|
Result := Result + ti.MemberCount;
|
|
end;
|
|
end
|
|
else
|
|
Result := inherited GetMemberCount;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValue.Init;
|
|
begin
|
|
inherited Init;
|
|
SetSymbolType(stValue);
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolValue.Destroy;
|
|
begin
|
|
Assert(not CircleBackRefsActive, 'CircleBackRefsActive can not be is ddestructor');
|
|
|
|
FreeAndNil(FMembers);
|
|
if FValueObject <> nil then begin
|
|
FValueObject.SetValueSymbol(nil);
|
|
FValueObject.ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueObject, ClassName+'.FValueObject'){$ENDIF};
|
|
FValueObject := nil;
|
|
end;
|
|
ParentTypeInfo := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
class function TFpDwarfSymbolValue.CreateValueSubClass(AName: String;
|
|
AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbolValue;
|
|
var
|
|
c: TDbgDwarfSymbolBaseClass;
|
|
begin
|
|
c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
|
|
|
|
if c.InheritsFrom(TFpDwarfSymbolValue) then
|
|
Result := TFpDwarfSymbolValueClass(c).Create(AName, AnInformationEntry)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueWithLocation }
|
|
|
|
function TFpDwarfSymbolValueWithLocation.InitLocationParser(const ALocationParser: TDwarfLocationExpression;
|
|
AnInitLocParserData: PInitLocParserData): Boolean;
|
|
begin
|
|
Result := inherited InitLocationParser(ALocationParser, AnInitLocParserData);
|
|
ALocationParser.OnFrameBaseNeeded := @FrameBaseNeeded;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueWithLocation.FrameBaseNeeded(ASender: TObject);
|
|
var
|
|
p: TFpDwarfSymbol;
|
|
fb: TDBGPtr;
|
|
begin
|
|
debugln(FPDBG_DWARF_SEARCH, ['TFpDwarfSymbolValueVariable.FrameBaseNeeded ']);
|
|
p := ParentTypeInfo;
|
|
// TODO: what if parent is declaration?
|
|
if (p <> nil) and (p is TFpDwarfSymbolValueProc) then begin
|
|
fb := TFpDwarfSymbolValueProc(p).GetFrameBase(ASender as TDwarfLocationExpression);
|
|
(ASender as TDwarfLocationExpression).FrameBase := fb;
|
|
if fb = 0 then begin
|
|
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpDwarfSymbolValueWithLocation.FrameBaseNeeded result is 0']);
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
{$warning TODO}
|
|
//else
|
|
//if OwnerTypeInfo <> nil then
|
|
// OwnerTypeInfo.fr;
|
|
// TODO: check owner
|
|
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpDwarfSymbolValueWithLocation.FrameBaseNeeded no parent type info']);
|
|
(ASender as TDwarfLocationExpression).FrameBase := 0;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueWithLocation.GetValueObject: TFpDbgValue;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
Result := FValueObject;
|
|
if Result <> nil then exit;
|
|
|
|
ti := TypeInfo;
|
|
if (ti = nil) or not (ti.SymbolType = stType) then exit;
|
|
|
|
FValueObject := TFpDwarfSymbolType(ti).GetTypedValueObject(False);
|
|
if FValueObject <> nil then begin
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FValueObject.DbgRenameReference(@FValueObject, ClassName+'.FValueObject');{$ENDIF}
|
|
FValueObject.MakePlainRefToCirclular;
|
|
FValueObject.SetValueSymbol(self);
|
|
end;
|
|
|
|
Result := FValueObject;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolType }
|
|
|
|
procedure TFpDwarfSymbolType.Init;
|
|
begin
|
|
inherited Init;
|
|
SetSymbolType(stType);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolType.MemberVisibilityNeeded;
|
|
var
|
|
Val: TDbgSymbolMemberVisibility;
|
|
begin
|
|
if ReadMemberVisibility(Val) then
|
|
SetMemberVisibility(Val)
|
|
else
|
|
inherited MemberVisibilityNeeded;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolType.SizeNeeded;
|
|
var
|
|
ByteSize: Integer;
|
|
begin
|
|
if InformationEntry.ReadValue(DW_AT_byte_size, ByteSize) then
|
|
SetSize(ByteSize)
|
|
else
|
|
inherited SizeNeeded;
|
|
end;
|
|
|
|
function TFpDwarfSymbolType.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFpDwarfSymbolType.GetValueBounds(AValueObj: TFpDwarfValue; out ALowBound,
|
|
AHighBound: Int64): Boolean;
|
|
begin
|
|
Result := HasBounds;
|
|
ALowBound := OrdLowBound;
|
|
AHighBound := OrdHighBound;
|
|
end;
|
|
|
|
class function TFpDwarfSymbolType.CreateTypeSubClass(AName: String;
|
|
AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbolType;
|
|
var
|
|
c: TDbgDwarfSymbolBaseClass;
|
|
begin
|
|
c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag);
|
|
|
|
if c.InheritsFrom(TFpDwarfSymbolType) then
|
|
Result := TFpDwarfSymbolTypeClass(c).Create(AName, AnInformationEntry)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFpDwarfSymbolType.TypeCastValue(AValue: TFpDbgValue): TFpDbgValue;
|
|
begin
|
|
Result := GetTypedValueObject(True);
|
|
If Result = nil then
|
|
exit;
|
|
assert(Result is TFpDwarfValue);
|
|
if not TFpDwarfValue(Result).SetTypeCastInfo(self, AValue) then
|
|
ReleaseRefAndNil(Result);
|
|
end;
|
|
|
|
{ TDbgDwarfBaseTypeIdentifier }
|
|
|
|
procedure TFpDwarfSymbolTypeBasic.KindNeeded;
|
|
var
|
|
Encoding, ByteSize: Integer;
|
|
begin
|
|
if not InformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin
|
|
DebugLn(FPDBG_DWARF_WARNINGS, ['TFpDwarfSymbolTypeBasic.KindNeeded: Failed reading encoding for ', DwarfTagToString(InformationEntry.AbbrevTag)]);
|
|
inherited KindNeeded;
|
|
exit;
|
|
end;
|
|
|
|
if InformationEntry.ReadValue(DW_AT_byte_size, ByteSize) then
|
|
SetSize(ByteSize);
|
|
|
|
case Encoding of
|
|
DW_ATE_address : SetKind(skPointer);
|
|
DW_ATE_boolean: SetKind(skBoolean);
|
|
//DW_ATE_complex_float:
|
|
DW_ATE_float: SetKind(skFloat);
|
|
DW_ATE_signed: SetKind(skInteger);
|
|
DW_ATE_signed_char: SetKind(skChar);
|
|
DW_ATE_unsigned: SetKind(skCardinal);
|
|
DW_ATE_unsigned_char: SetKind(skChar);
|
|
else
|
|
begin
|
|
DebugLn(FPDBG_DWARF_WARNINGS, ['TFpDwarfSymbolTypeBasic.KindNeeded: Unknown encoding ', DwarfBaseTypeEncodingToString(Encoding), ' for ', DwarfTagToString(InformationEntry.AbbrevTag)]);
|
|
inherited KindNeeded;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeBasic.TypeInfoNeeded;
|
|
begin
|
|
SetTypeInfo(nil);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeBasic.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
case Kind of
|
|
skPointer: Result := TFpDwarfValuePointer.Create(Self, Size);
|
|
skInteger: Result := TFpDwarfValueInteger.Create(Self, Size);
|
|
skCardinal: Result := TFpDwarfValueCardinal.Create(Self, Size);
|
|
skBoolean: Result := TFpDwarfValueBoolean.Create(Self, Size);
|
|
skChar: Result := TFpDwarfValueChar.Create(Self, Size);
|
|
skFloat: Result := TFpDwarfValueFloat.Create(Self, Size);
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeBasic.GetHasBounds: Boolean;
|
|
begin
|
|
Result := (kind = skInteger) or (kind = skCardinal);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeBasic.GetOrdHighBound: Int64;
|
|
begin
|
|
case Kind of
|
|
skInteger: Result := int64( high(int64) shr (64 - Min(Size, 8) * 8));
|
|
skCardinal: Result := int64( high(qword) shr (64 - Min(Size, 8) * 8));
|
|
else
|
|
Result := inherited GetOrdHighBound;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeBasic.GetOrdLowBound: Int64;
|
|
begin
|
|
case Kind of
|
|
skInteger: Result := -(int64( high(int64) shr (64 - Min(Size, 8) * 8)))-1;
|
|
skCardinal: Result := 0;
|
|
else
|
|
Result := inherited GetOrdHighBound;
|
|
end;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeModifier }
|
|
|
|
procedure TFpDwarfSymbolTypeModifier.TypeInfoNeeded;
|
|
var
|
|
p: TFpDwarfSymbolType;
|
|
begin
|
|
p := NestedTypeInfo;
|
|
if p <> nil then
|
|
SetTypeInfo(p.TypeInfo)
|
|
else
|
|
SetTypeInfo(nil);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeModifier.ForwardToSymbolNeeded;
|
|
begin
|
|
SetForwardToSymbol(NestedTypeInfo)
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeModifier.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
var
|
|
ti: TFpDwarfSymbolType;
|
|
begin
|
|
ti := NestedTypeInfo;
|
|
if ti <> nil then
|
|
Result := ti.GetTypedValueObject(ATypeCast)
|
|
else
|
|
Result := inherited;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeRef }
|
|
|
|
function TFpDwarfSymbolTypeRef.GetFlags: TDbgSymbolFlags;
|
|
begin
|
|
Result := (inherited GetFlags) + [sfInternalRef];
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeRef.GetDataAddressNext(AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType;
|
|
ATargetCacheIndex: Integer): Boolean;
|
|
var
|
|
t: TFpDbgMemLocation;
|
|
begin
|
|
t := AValueObj.DataAddressCache[ATargetCacheIndex];
|
|
if IsInitializedLoc(t) then begin
|
|
AnAddress := t;
|
|
end
|
|
else begin
|
|
Result := AValueObj.MemManager <> nil;
|
|
if not Result then
|
|
exit;
|
|
AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
|
|
AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress;
|
|
end;
|
|
Result := IsValidLoc(AnAddress);
|
|
|
|
if Result then
|
|
Result := inherited GetDataAddressNext(AValueObj, AnAddress, ATargetType, ATargetCacheIndex)
|
|
else
|
|
if IsError(AValueObj.MemManager.LastError) then
|
|
SetLastError(AValueObj.MemManager.LastError);
|
|
// Todo: other error
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeDeclaration }
|
|
|
|
function TFpDwarfSymbolTypeDeclaration.DoGetNestedTypeInfo: TFpDwarfSymbolType;
|
|
var
|
|
ti: TFpDwarfSymbolType;
|
|
ti2: TFpDbgSymbol;
|
|
begin
|
|
Result := inherited DoGetNestedTypeInfo;
|
|
|
|
// Is internal class pointer?
|
|
// Do not trigged any cached property of the pointer
|
|
if (Result = nil) then
|
|
exit;
|
|
|
|
ti := Result;
|
|
if (ti is TFpDwarfSymbolTypeModifier) then begin
|
|
ti := TFpDwarfSymbolType(ti.TypeInfo);
|
|
if (Result = nil) then
|
|
exit;
|
|
end;
|
|
if not (ti is TFpDwarfSymbolTypePointer) then
|
|
exit;
|
|
|
|
ti2 := ti.NestedTypeInfo;
|
|
// only if it is NOT a declaration
|
|
if (ti2 <> nil) and (ti2 is TFpDwarfSymbolTypeStructure) then begin
|
|
TFpDwarfSymbolTypePointer(ti).IsInternalPointer := True;
|
|
// TODO: Flag the structure as class (save teme in KindNeeded)
|
|
end;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeSubRange }
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.InitEnumIdx;
|
|
var
|
|
t: TFpDwarfSymbolType;
|
|
i: Integer;
|
|
h, l: Int64;
|
|
begin
|
|
if FEnumIdxValid then
|
|
exit;
|
|
FEnumIdxValid := True;
|
|
|
|
t := NestedTypeInfo;
|
|
i := t.MemberCount - 1;
|
|
h := OrdHighBound;
|
|
l := OrdLowBound;
|
|
|
|
while (i >= 0) and (t.Member[i].OrdinalValue > h) do
|
|
dec(i);
|
|
FHighEnumIdx := i;
|
|
|
|
while (i >= 0) and (t.Member[i].OrdinalValue >= l) do
|
|
dec(i);
|
|
FLowEnumIdx := i + 1;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.ReadBounds(AValueObj: TFpDwarfValue);
|
|
var
|
|
FwdInfoPtr: Pointer;
|
|
FwdCompUint: TDwarfCompilationUnit;
|
|
NewInfo: TDwarfInformationEntry;
|
|
var
|
|
AnAddress: TFpDbgMemLocation;
|
|
InitLocParserData: TInitLocParserData;
|
|
begin
|
|
if FLowBoundState <> rfNotRead then exit;
|
|
|
|
// Todo: search attrib-IDX only once
|
|
if InformationEntry.ReadReference(DW_AT_lower_bound, FwdInfoPtr, FwdCompUint) then begin
|
|
NewInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
FLowBoundValue := TFpDwarfSymbolValue.CreateValueSubClass('', NewInfo);
|
|
NewInfo.ReleaseReference;
|
|
if FLowBoundValue = nil then begin
|
|
FLowBoundState := rfNotFound;
|
|
exit;
|
|
end
|
|
else
|
|
FLowBoundState := rfValue;
|
|
end
|
|
else
|
|
if InformationEntry.ReadValue(DW_AT_lower_bound, FLowBoundConst) then begin
|
|
FLowBoundState := rfConst;
|
|
end
|
|
else
|
|
begin
|
|
//FLowBoundConst := 0; // the default
|
|
//FLowBoundState := rfConst;
|
|
FLowBoundState := rfNotFound;
|
|
exit; // incomplete type
|
|
end;
|
|
|
|
|
|
if InformationEntry.ReadReference(DW_AT_upper_bound, FwdInfoPtr, FwdCompUint) then begin
|
|
NewInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
FHighBoundValue := TFpDwarfSymbolValue.CreateValueSubClass('', NewInfo);
|
|
NewInfo.ReleaseReference;
|
|
if FHighBoundValue = nil then begin
|
|
FHighBoundState := rfNotFound;
|
|
exit;
|
|
end
|
|
else
|
|
FHighBoundState := rfValue;
|
|
end
|
|
else
|
|
if InformationEntry.ReadValue(DW_AT_upper_bound, FHighBoundConst) then begin
|
|
FHighBoundState := rfConst;
|
|
end
|
|
else
|
|
begin
|
|
if assigned(AValueObj) then
|
|
InitLocParserData.ObjectDataAddress := AValueObj.Address;
|
|
InitLocParserData.ObjectDataAddrPush := False;
|
|
if assigned(AValueObj) and LocationFromTag(DW_AT_upper_bound, AValueObj, AnAddress, @InitLocParserData, InformationEntry, True) then begin
|
|
FHighBoundState := rfConst;
|
|
FHighBoundConst := AnAddress.Address;
|
|
end
|
|
else
|
|
begin
|
|
FHighBoundState := rfNotFound;
|
|
|
|
if InformationEntry.ReadReference(DW_AT_count, FwdInfoPtr, FwdCompUint) then begin
|
|
NewInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
FCountValue := TFpDwarfSymbolValue.CreateValueSubClass('', NewInfo);
|
|
NewInfo.ReleaseReference;
|
|
if FCountValue = nil then begin
|
|
FCountState := rfNotFound;
|
|
exit;
|
|
end
|
|
else
|
|
FCountState := rfValue;
|
|
end
|
|
else
|
|
if InformationEntry.ReadValue(DW_AT_count, FCountConst) then begin
|
|
FCountState := rfConst;
|
|
end
|
|
else
|
|
FCountState := rfNotFound;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.DoGetNestedTypeInfo: TFpDwarfSymbolType;
|
|
begin
|
|
Result := inherited DoGetNestedTypeInfo;
|
|
if Result <> nil then
|
|
exit;
|
|
|
|
if FLowBoundState = rfValue then
|
|
Result := FLowBoundValue.TypeInfo as TFpDwarfSymbolType
|
|
else
|
|
if FHighBoundState = rfValue then
|
|
Result := FHighBoundValue.TypeInfo as TFpDwarfSymbolType
|
|
else
|
|
if FCountState = rfValue then
|
|
Result := FCountValue.TypeInfo as TFpDwarfSymbolType;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetHasBounds: Boolean;
|
|
begin
|
|
ReadBounds(nil);
|
|
// TODO: currently limited to const.
|
|
// not standard, but upper may be missing?
|
|
Result := (FLowBoundState in [rfConst]) and
|
|
( (FHighBoundState in [rfConst]) or
|
|
(FCountState in [rfConst]) );
|
|
|
|
(*
|
|
Result := (FLowBoundState in [rfValue, rfConst]) and
|
|
( (FHighBoundState in [rfValue, rfConst]) or
|
|
(FCountState in [rfValue, rfConst]) );
|
|
*)
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetOrdHighBound: Int64;
|
|
begin
|
|
// Todo range check off.
|
|
//if FHighBoundState = rfValue then
|
|
// Result := FHighBoundValue.VALUE // TODO
|
|
//else
|
|
if FHighBoundState = rfConst then
|
|
Result := FHighBoundConst
|
|
else
|
|
//if FCountState = rfValue then
|
|
// Result := GetOrdLowBound + FCountValue.VALUE - 1 // TODO
|
|
//else
|
|
if FHighBoundState = rfConst then
|
|
Result := GetOrdLowBound + FCountConst - 1;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetOrdLowBound: Int64;
|
|
begin
|
|
//if FLowBoundState = rfValue then
|
|
// Result := FLowBoundValue.VALUE // TODO
|
|
//else
|
|
Result := FLowBoundConst;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.NameNeeded;
|
|
var
|
|
AName: String;
|
|
begin
|
|
if InformationEntry.ReadName(AName) then
|
|
SetName(AName)
|
|
else
|
|
SetName('');
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.KindNeeded;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
// TODO: limit to ordinal types
|
|
if not HasBounds then begin // does ReadBounds;
|
|
SetKind(skNone); // incomplete type
|
|
end;
|
|
|
|
t := NestedTypeInfo;
|
|
if t = nil then begin
|
|
SetKind(skInteger);
|
|
SetSize(CompilationUnit.AddressSize);
|
|
end
|
|
else
|
|
SetKind(t.Kind);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.SizeNeeded;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
begin
|
|
t := NestedTypeInfo;
|
|
if t = nil then begin
|
|
SetKind(skInteger);
|
|
SetSize(CompilationUnit.AddressSize);
|
|
end
|
|
else
|
|
SetSize(t.Size);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
begin
|
|
if Kind = skEnum then begin
|
|
if not FEnumIdxValid then
|
|
InitEnumIdx;
|
|
Result := NestedTypeInfo.Member[AIndex - FLowEnumIdx];
|
|
end
|
|
else
|
|
Result := inherited GetMember(AIndex);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetMemberCount: Integer;
|
|
begin
|
|
if Kind = skEnum then begin
|
|
if not FEnumIdxValid then
|
|
InitEnumIdx;
|
|
Result := FHighEnumIdx - FLowEnumIdx + 1;
|
|
end
|
|
else
|
|
Result := inherited GetMemberCount;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetFlags: TDbgSymbolFlags;
|
|
begin
|
|
Result := (inherited GetFlags) + [sfSubRange];
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSubRange.GetValueBounds(AValueObj: TFpDwarfValue; out
|
|
ALowBound, AHighBound: Int64): Boolean;
|
|
begin
|
|
ReadBounds(AValueObj);
|
|
Result := inherited GetValueBounds(AValueObj, ALowBound, AHighBound);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeSubRange.Init;
|
|
begin
|
|
FLowBoundState := rfNotRead;
|
|
FHighBoundState := rfNotRead;
|
|
FCountState := rfNotRead;
|
|
inherited Init;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypePointer }
|
|
|
|
function TFpDwarfSymbolTypePointer.IsInternalDynArrayPointer: Boolean;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
Result := False;
|
|
ti := NestedTypeInfo; // Same as TypeInfo, but does not try to be forwarded
|
|
Result := (ti <> nil) and (ti is TFpDwarfSymbolTypeArray);
|
|
if Result then
|
|
Result := (sfDynArray in ti.Flags);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypePointer.TypeInfoNeeded;
|
|
var
|
|
p: TFpDwarfSymbolType;
|
|
begin
|
|
p := NestedTypeInfo;
|
|
if IsInternalPointer and (p <> nil) then begin
|
|
SetTypeInfo(p.TypeInfo);
|
|
exit;
|
|
end;
|
|
SetTypeInfo(p);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypePointer.GetIsInternalPointer: Boolean;
|
|
begin
|
|
Result := FIsInternalPointer or IsInternalDynArrayPointer;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypePointer.KindNeeded;
|
|
var
|
|
k: TDbgSymbolKind;
|
|
begin
|
|
if IsInternalPointer then begin
|
|
k := NestedTypeInfo.Kind;
|
|
if k = skObject then
|
|
SetKind(skClass)
|
|
else
|
|
SetKind(k);
|
|
end
|
|
else
|
|
SetKind(skPointer);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypePointer.SizeNeeded;
|
|
begin
|
|
SetSize(CompilationUnit.AddressSize);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypePointer.ForwardToSymbolNeeded;
|
|
begin
|
|
if IsInternalPointer then
|
|
SetForwardToSymbol(NestedTypeInfo) // Same as TypeInfo, but does not try to be forwarded
|
|
else
|
|
SetForwardToSymbol(nil); // inherited ForwardToSymbolNeeded;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypePointer.GetDataAddressNext(AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType;
|
|
ATargetCacheIndex: Integer): Boolean;
|
|
var
|
|
t: TFpDbgMemLocation;
|
|
begin
|
|
t := AValueObj.DataAddressCache[ATargetCacheIndex];
|
|
if IsInitializedLoc(t) then begin
|
|
AnAddress := t;
|
|
end
|
|
else begin
|
|
Result := AValueObj.MemManager <> nil;
|
|
if not Result then
|
|
exit;
|
|
AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
|
|
AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress;
|
|
end;
|
|
Result := IsValidLoc(AnAddress);
|
|
|
|
if Result then
|
|
Result := inherited GetDataAddressNext(AValueObj, AnAddress, ATargetType, ATargetCacheIndex)
|
|
else
|
|
if IsError(AValueObj.MemManager.LastError) then
|
|
SetLastError(AValueObj.MemManager.LastError);
|
|
// Todo: other error
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypePointer.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
if IsInternalPointer then
|
|
Result := NestedTypeInfo.GetTypedValueObject(ATypeCast)
|
|
else
|
|
Result := TFpDwarfValuePointer.Create(Self, CompilationUnit.AddressSize);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypePointer.DataSize: Integer;
|
|
begin
|
|
if Kind = skClass then
|
|
Result := NestedTypeInfo.Size
|
|
else
|
|
Result := inherited DataSize;
|
|
end;
|
|
|
|
{ TDbgDwarfIdentifierEnumElement }
|
|
|
|
procedure TFpDwarfSymbolValueEnumMember.ReadOrdinalValue;
|
|
begin
|
|
if FOrdinalValueRead then exit;
|
|
FOrdinalValueRead := True;
|
|
FHasOrdinalValue := InformationEntry.ReadValue(DW_AT_const_value, FOrdinalValue);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueEnumMember.KindNeeded;
|
|
begin
|
|
SetKind(skEnumValue);
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueEnumMember.GetHasOrdinalValue: Boolean;
|
|
begin
|
|
ReadOrdinalValue;
|
|
Result := FHasOrdinalValue;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueEnumMember.GetOrdinalValue: Int64;
|
|
begin
|
|
ReadOrdinalValue;
|
|
Result := FOrdinalValue;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueEnumMember.Init;
|
|
begin
|
|
FOrdinalValueRead := False;
|
|
inherited Init;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueEnumMember.GetValueObject: TFpDbgValue;
|
|
begin
|
|
Result := FValueObject;
|
|
if Result <> nil then exit;
|
|
|
|
FValueObject := TFpDwarfValueEnumMember.Create(Self);
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FValueObject.DbgRenameReference(@FValueObject, ClassName+'.FValueObject');{$ENDIF}
|
|
FValueObject.MakePlainRefToCirclular;
|
|
FValueObject.SetValueSymbol(self);
|
|
|
|
Result := FValueObject;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeEnum }
|
|
|
|
procedure TFpDwarfSymbolTypeEnum.CreateMembers;
|
|
var
|
|
Info, Info2: TDwarfInformationEntry;
|
|
sym: TFpDwarfSymbol;
|
|
begin
|
|
if FMembers <> nil then
|
|
exit;
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
Info := InformationEntry.FirstChild;
|
|
if Info = nil then exit;
|
|
|
|
while Info.HasValidScope do begin
|
|
if (Info.AbbrevTag = DW_TAG_enumerator) then begin
|
|
Info2 := Info.Clone;
|
|
sym := TFpDwarfSymbol.CreateSubClass('', Info2);
|
|
FMembers.Add(sym);
|
|
sym.ReleaseReference;
|
|
sym.ParentTypeInfo := self;
|
|
Info2.ReleaseReference;
|
|
end;
|
|
Info.GoNext;
|
|
end;
|
|
|
|
Info.ReleaseReference;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
Result := TFpDwarfValueEnum.Create(Self, Size);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeEnum.KindNeeded;
|
|
begin
|
|
SetKind(skEnum);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
begin
|
|
CreateMembers;
|
|
Result := TFpDbgSymbol(FMembers[AIndex]);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
var
|
|
i: Integer;
|
|
s, s1, s2: String;
|
|
begin
|
|
if AIndex = '' then
|
|
s1 := UTF8UpperCase(AIndex);
|
|
s2 := UTF8LowerCase(AIndex);
|
|
CreateMembers;
|
|
i := FMembers.Count - 1;
|
|
while i >= 0 do begin
|
|
Result := TFpDbgSymbol(FMembers[i]);
|
|
s := Result.Name;
|
|
if (s <> '') and CompareUtf8BothCase(@s1[1], @s2[1], @s[1]) then
|
|
exit;
|
|
dec(i);
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetMemberCount: Integer;
|
|
begin
|
|
CreateMembers;
|
|
Result := FMembers.Count;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetHasBounds: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetOrdHighBound: Int64;
|
|
var
|
|
c: Integer;
|
|
begin
|
|
c := MemberCount;
|
|
if c > 0 then
|
|
Result := Member[c-1].OrdinalValue
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeEnum.GetOrdLowBound: Int64;
|
|
var
|
|
c: Integer;
|
|
begin
|
|
c := MemberCount;
|
|
if c > 0 then
|
|
Result := Member[0].OrdinalValue
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolTypeEnum.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FMembers <> nil then
|
|
for i := 0 to FMembers.Count - 1 do
|
|
TFpDwarfSymbol(FMembers[i]).ParentTypeInfo := nil;
|
|
FreeAndNil(FMembers);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeSet }
|
|
|
|
procedure TFpDwarfSymbolTypeSet.KindNeeded;
|
|
begin
|
|
SetKind(skSet);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSet.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
Result := TFpDwarfValueSet.Create(Self, Size);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSet.GetMemberCount: Integer;
|
|
begin
|
|
if TypeInfo.Kind = skEnum then
|
|
Result := TypeInfo.MemberCount
|
|
else
|
|
Result := inherited GetMemberCount;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeSet.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
begin
|
|
if TypeInfo.Kind = skEnum then
|
|
Result := TypeInfo.Member[AIndex]
|
|
else
|
|
Result := inherited GetMember(AIndex);
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueMember }
|
|
|
|
function TFpDwarfSymbolValueMember.GetValueAddress(AValueObj: TFpDwarfValue; out
|
|
AnAddress: TFpDbgMemLocation): Boolean;
|
|
var
|
|
BaseAddr: TFpDbgMemLocation;
|
|
InitLocParserData: TInitLocParserData;
|
|
begin
|
|
AnAddress := AValueObj.DataAddressCache[0];
|
|
Result := IsValidLoc(AnAddress);
|
|
if IsInitializedLoc(AnAddress) then
|
|
exit;
|
|
|
|
if AValueObj = nil then debugln(['TFpDwarfSymbolValueMember.InitLocationParser: NO VAl Obj !!!!!!!!!!!!!!!'])
|
|
else if AValueObj.StructureValue = nil then debugln(['TFpDwarfSymbolValueMember.InitLocationParser: NO STRUCT Obj !!!!!!!!!!!!!!!']);
|
|
|
|
if (AValueObj = nil) or (AValueObj.StructureValue = nil) or (ParentTypeInfo = nil)
|
|
then begin
|
|
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpDwarfSymbolValueMember.InitLocationParser Error: ',ErrorCode(LastError),' ValueObject=', DbgSName(FValueObject)]);
|
|
Result := False;
|
|
if not IsError(LastError) then
|
|
SetLastError(CreateError(fpErrLocationParserInit)); // TODO: error message?
|
|
exit;
|
|
end;
|
|
Assert((ParentTypeInfo is TFpDwarfSymbol) and (ParentTypeInfo.SymbolType = stType), '');
|
|
if not AValueObj.GetStructureDwarfDataAddress(BaseAddr, TFpDwarfSymbolType(ParentTypeInfo)) then begin
|
|
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpDwarfSymbolValueMember.InitLocationParser Error: ',ErrorCode(LastError),' ValueObject=', DbgSName(FValueObject)]);
|
|
Result := False;
|
|
if not IsError(LastError) then
|
|
SetLastError(CreateError(fpErrLocationParserInit)); // TODO: error message?
|
|
exit;
|
|
end;
|
|
//TODO: AValueObj.StructureValue.LastError
|
|
|
|
InitLocParserData.ObjectDataAddress := BaseAddr;
|
|
InitLocParserData.ObjectDataAddrPush := True;
|
|
Result := LocationFromTag(DW_AT_data_member_location, AValueObj, AnAddress, @InitLocParserData);
|
|
|
|
AValueObj.DataAddressCache[0] := AnAddress;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueMember.HasAddress: Boolean;
|
|
begin
|
|
Result := (InformationEntry.HasAttrib(DW_AT_data_member_location));
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeStructure }
|
|
|
|
function TFpDwarfSymbolTypeStructure.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
var
|
|
Ident: TDwarfInformationEntry;
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
// Todo, maybe create all children?
|
|
if FLastChildByName <> nil then begin
|
|
FLastChildByName.ReleaseCirclularReference;
|
|
FLastChildByName := nil;
|
|
end;
|
|
Result := nil;
|
|
|
|
Ident := InformationEntry.FindNamedChild(AIndex);
|
|
if Ident <> nil then begin
|
|
FLastChildByName := TFpDwarfSymbol.CreateSubClass('', Ident);
|
|
FLastChildByName.MakePlainRefToCirclular;
|
|
FLastChildByName.ParentTypeInfo := self;
|
|
//assert is member ?
|
|
ReleaseRefAndNil(Ident);
|
|
Result := FLastChildByName;
|
|
|
|
exit;
|
|
end;
|
|
|
|
ti := TypeInfo; // Parent
|
|
if ti <> nil then
|
|
Result := ti.MemberByName[AIndex];
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeStructure.GetMemberCount: Integer;
|
|
begin
|
|
CreateMembers;
|
|
Result := FMembers.Count;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeStructure.GetDataAddressNext(AValueObj: TFpDwarfValue;
|
|
var AnAddress: TFpDbgMemLocation; ATargetType: TFpDwarfSymbolType;
|
|
ATargetCacheIndex: Integer): Boolean;
|
|
var
|
|
t: TFpDbgMemLocation;
|
|
InitLocParserData: TInitLocParserData;
|
|
begin
|
|
t := AValueObj.DataAddressCache[ATargetCacheIndex];
|
|
if IsInitializedLoc(t) then begin
|
|
AnAddress := t;
|
|
Result := IsValidLoc(AnAddress);
|
|
end
|
|
else begin
|
|
InitInheritanceInfo;
|
|
//TODO: may be a constant // offset
|
|
InitLocParserData.ObjectDataAddress := AnAddress;
|
|
InitLocParserData.ObjectDataAddrPush := True;
|
|
Result := LocationFromTag(DW_AT_data_member_location, AValueObj, t, @InitLocParserData, FInheritanceInfo);
|
|
if not Result then
|
|
exit;
|
|
AnAddress := t;
|
|
AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress;
|
|
|
|
if IsError(AValueObj.MemManager.LastError) then
|
|
SetLastError(AValueObj.MemManager.LastError);
|
|
end;
|
|
|
|
Result := inherited GetDataAddressNext(AValueObj, AnAddress, ATargetType, ATargetCacheIndex);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeStructure.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
var
|
|
ti: TFpDbgSymbol;
|
|
begin
|
|
CreateMembers;
|
|
if AIndex >= FMembers.Count then begin
|
|
ti := TypeInfo;
|
|
if ti <> nil then
|
|
Result := ti.Member[AIndex - FMembers.Count];
|
|
end
|
|
else
|
|
Result := TFpDbgSymbol(FMembers[AIndex]);
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolTypeStructure.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
ReleaseRefAndNil(FInheritanceInfo);
|
|
if FMembers <> nil then begin
|
|
for i := 0 to FMembers.Count - 1 do
|
|
TFpDwarfSymbol(FMembers[i]).ParentTypeInfo := nil;
|
|
FreeAndNil(FMembers);
|
|
end;
|
|
if FLastChildByName <> nil then begin
|
|
FLastChildByName.ParentTypeInfo := nil;
|
|
FLastChildByName.ReleaseCirclularReference;
|
|
FLastChildByName := nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeStructure.CreateMembers;
|
|
var
|
|
Info: TDwarfInformationEntry;
|
|
Info2: TDwarfInformationEntry;
|
|
sym: TFpDwarfSymbol;
|
|
begin
|
|
if FMembers <> nil then
|
|
exit;
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
Info := InformationEntry.Clone;
|
|
Info.GoChild;
|
|
|
|
while Info.HasValidScope do begin
|
|
if (Info.AbbrevTag = DW_TAG_member) or (Info.AbbrevTag = DW_TAG_subprogram) then begin
|
|
Info2 := Info.Clone;
|
|
sym := TFpDwarfSymbol.CreateSubClass('', Info2);
|
|
FMembers.Add(sym);
|
|
sym.ReleaseReference;
|
|
sym.ParentTypeInfo := self;
|
|
Info2.ReleaseReference;
|
|
end;
|
|
Info.GoNext;
|
|
end;
|
|
|
|
Info.ReleaseReference;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeStructure.InitInheritanceInfo;
|
|
begin
|
|
if FInheritanceInfo = nil then
|
|
FInheritanceInfo := InformationEntry.FindChildByTag(DW_TAG_inheritance);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeStructure.DoGetNestedTypeInfo: TFpDwarfSymbolType;
|
|
var
|
|
FwdInfoPtr: Pointer;
|
|
FwdCompUint: TDwarfCompilationUnit;
|
|
ParentInfo: TDwarfInformationEntry;
|
|
begin
|
|
Result:= nil;
|
|
InitInheritanceInfo;
|
|
if (FInheritanceInfo <> nil) and
|
|
FInheritanceInfo.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)
|
|
then begin
|
|
ParentInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
|
//DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ParentInfo.FInformationEntry, FwdCompUint) ]);
|
|
Result := TFpDwarfSymbolType.CreateTypeSubClass('', ParentInfo);
|
|
ParentInfo.ReleaseReference;
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeStructure.KindNeeded;
|
|
begin
|
|
if (InformationEntry.AbbrevTag = DW_TAG_class_type) then
|
|
SetKind(skClass)
|
|
else
|
|
begin
|
|
if TypeInfo <> nil then // inheritance
|
|
SetKind(skObject) // skClass
|
|
else
|
|
if MemberByName['_vptr$TOBJECT'] <> nil then
|
|
SetKind(skObject) // skClass
|
|
else
|
|
if MemberByName['_vptr$'+Name] <> nil then
|
|
SetKind(skObject)
|
|
else
|
|
SetKind(skRecord);
|
|
end;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeStructure.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
if ATypeCast then
|
|
Result := TFpDwarfValueStructTypeCast.Create(Self)
|
|
else
|
|
Result := TFpDwarfValueStruct.Create(Self);
|
|
end;
|
|
|
|
{ TFpDwarfSymbolTypeArray }
|
|
|
|
procedure TFpDwarfSymbolTypeArray.CreateMembers;
|
|
var
|
|
Info, Info2: TDwarfInformationEntry;
|
|
t: Cardinal;
|
|
sym: TFpDwarfSymbol;
|
|
begin
|
|
if FMembers <> nil then
|
|
exit;
|
|
FMembers := TFpDbgCircularRefCntObjList.Create;
|
|
|
|
Info := InformationEntry.FirstChild;
|
|
if Info = nil then exit;
|
|
|
|
while Info.HasValidScope do begin
|
|
t := Info.AbbrevTag;
|
|
if (t = DW_TAG_enumeration_type) or (t = DW_TAG_subrange_type) then begin
|
|
Info2 := Info.Clone;
|
|
sym := TFpDwarfSymbol.CreateSubClass('', Info2);
|
|
FMembers.Add(sym);
|
|
sym.ReleaseReference;
|
|
sym.ParentTypeInfo := self;
|
|
Info2.ReleaseReference;
|
|
end;
|
|
Info.GoNext;
|
|
end;
|
|
|
|
Info.ReleaseReference;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeArray.ReadStride;
|
|
var
|
|
t: TFpDwarfSymbolType;
|
|
begin
|
|
if didtStrideRead in FDwarfArrayReadFlags then
|
|
exit;
|
|
Include(FDwarfArrayReadFlags, didtStrideRead);
|
|
if InformationEntry.ReadValue(DW_AT_bit_stride, FStrideInBits) then
|
|
exit;
|
|
|
|
CreateMembers;
|
|
if (FMembers.Count > 0) and // TODO: stride for diff member
|
|
(TDbgDwarfSymbolBase(FMembers[0]).InformationEntry.ReadValue(DW_AT_byte_stride, FStrideInBits))
|
|
then begin
|
|
FStrideInBits := FStrideInBits * 8;
|
|
exit;
|
|
end;
|
|
|
|
t := NestedTypeInfo;
|
|
if t = nil then
|
|
FStrideInBits := 0 // TODO error
|
|
else
|
|
FStrideInBits := t.Size * 8;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeArray.ReadOrdering;
|
|
var
|
|
AVal: Integer;
|
|
begin
|
|
if didtOrdering in FDwarfArrayReadFlags then
|
|
exit;
|
|
Include(FDwarfArrayReadFlags, didtOrdering);
|
|
if InformationEntry.ReadValue(DW_AT_ordering, AVal) then
|
|
FRowMajor := AVal = DW_ORD_row_major
|
|
else
|
|
FRowMajor := True; // default (at least in pas)
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolTypeArray.KindNeeded;
|
|
begin
|
|
SetKind(skArray); // Todo: static/dynamic?
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetTypedValueObject(ATypeCast: Boolean): TFpDwarfValue;
|
|
begin
|
|
Result := TFpDwarfValueArray.Create(Self);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetFlags: TDbgSymbolFlags;
|
|
function IsDynSubRange(m: TFpDwarfSymbol): Boolean;
|
|
begin
|
|
Result := sfSubRange in m.Flags;
|
|
if not Result then exit;
|
|
while (m <> nil) and not(m is TFpDwarfSymbolTypeSubRange) do
|
|
m := m.NestedTypeInfo;
|
|
Result := m <> nil;
|
|
if not Result then exit; // TODO: should not happen, handle error
|
|
Result := TFpDwarfSymbolTypeSubRange(m).FHighBoundState = rfValue; // dynamic high bound
|
|
end;
|
|
var
|
|
m: TFpDbgSymbol;
|
|
begin
|
|
Result := inherited GetFlags;
|
|
if (MemberCount = 1) then begin
|
|
m := Member[0];
|
|
if (not m.HasBounds) or // e.g. Subrange with missing upper bound
|
|
(m.OrdHighBound < m.OrdLowBound) or
|
|
(IsDynSubRange(TFpDwarfSymbol(m)))
|
|
then
|
|
Result := Result + [sfDynArray]
|
|
else
|
|
Result := Result + [sfStatArray];
|
|
end
|
|
else
|
|
Result := Result + [sfStatArray];
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
begin
|
|
CreateMembers;
|
|
Result := TFpDbgSymbol(FMembers[AIndex]);
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
begin
|
|
Result := nil; // no named members
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetMemberCount: Integer;
|
|
begin
|
|
CreateMembers;
|
|
Result := FMembers.Count;
|
|
end;
|
|
|
|
function TFpDwarfSymbolTypeArray.GetMemberAddress(AValObject: TFpDwarfValue;
|
|
AIndex: array of Int64): TFpDbgMemLocation;
|
|
var
|
|
Idx, Offs, Factor: Int64;
|
|
LowBound, HighBound: int64;
|
|
i: Integer;
|
|
bsize: Integer;
|
|
m: TFpDwarfSymbol;
|
|
begin
|
|
assert((AValObject is TFpDwarfValueArray), 'TFpDwarfSymbolTypeArray.GetMemberAddress AValObject');
|
|
ReadOrdering;
|
|
ReadStride; // TODO Stride per member (member = dimension/index)
|
|
Result := InvalidLoc;
|
|
if (FStrideInBits <= 0) or (FStrideInBits mod 8 <> 0) then
|
|
exit;
|
|
|
|
CreateMembers;
|
|
if Length(AIndex) > FMembers.Count then
|
|
exit;
|
|
|
|
if AValObject is TFpDwarfValueArray then begin
|
|
if not TFpDwarfValueArray(AValObject).GetDwarfDataAddress(Result, Self) then begin
|
|
Result := InvalidLoc;
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
exit; // TODO error
|
|
|
|
Offs := 0;
|
|
Factor := 1;
|
|
|
|
{$PUSH}{$R-}{$Q-} // TODO: check range of index
|
|
bsize := FStrideInBits div 8;
|
|
if FRowMajor then begin
|
|
for i := Length(AIndex) - 1 downto 0 do begin
|
|
Idx := AIndex[i];
|
|
m := TFpDwarfSymbol(FMembers[i]);
|
|
if ((m is TFpDwarfSymbolType) and (TFpDwarfSymbolType(m).GetValueBounds(AValObject, LowBound, HighBound))) or
|
|
m.HasBounds then begin
|
|
Idx := Idx - m.OrdLowBound;
|
|
end;
|
|
Offs := Offs + Idx * bsize * Factor;
|
|
if i > 0 then begin
|
|
if not m.HasBounds then begin
|
|
Result := InvalidLoc;
|
|
exit;
|
|
end;
|
|
// TODO range check
|
|
Factor := Factor * (m.OrdHighBound - m.OrdLowBound + 1);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
for i := 0 to Length(AIndex) - 1 do begin
|
|
Idx := AIndex[i];
|
|
m := TFpDwarfSymbol(FMembers[i]);
|
|
if m.HasBounds then begin
|
|
Idx := Idx - m.OrdLowBound;
|
|
end;
|
|
Offs := Offs + Idx * bsize * Factor;
|
|
if i < Length(AIndex) - 1 then begin
|
|
if not m.HasBounds then begin
|
|
Result := InvalidLoc;
|
|
exit;
|
|
end;
|
|
Factor := Factor * (m.OrdHighBound - m.OrdLowBound + 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
assert(IsTargetAddr(Result), 'DwarfArray MemberAddress');
|
|
Result.Address := Result.Address + Offs;
|
|
{$POP}
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolTypeArray.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FMembers <> nil then begin
|
|
for i := 0 to FMembers.Count - 1 do
|
|
TFpDwarfSymbol(FMembers[i]).ParentTypeInfo := nil;
|
|
FreeAndNil(FMembers);
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TDbgDwarfSymbol }
|
|
|
|
constructor TFpDwarfSymbolValueProc.Create(ACompilationUnit: TDwarfCompilationUnit;
|
|
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr);
|
|
var
|
|
InfoEntry: TDwarfInformationEntry;
|
|
begin
|
|
FAddress := AAddress;
|
|
FAddressInfo := AInfo;
|
|
|
|
InfoEntry := TDwarfInformationEntry.Create(ACompilationUnit, nil);
|
|
InfoEntry.ScopeIndex := AInfo^.ScopeIndex;
|
|
|
|
inherited Create(
|
|
String(FAddressInfo^.Name),
|
|
InfoEntry
|
|
);
|
|
|
|
SetAddress(TargetLoc(FAddressInfo^.StartPC));
|
|
|
|
InfoEntry.ReleaseReference;
|
|
//BuildLineInfo(
|
|
|
|
// AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil);
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolValueProc.Destroy;
|
|
begin
|
|
FreeAndNil(FProcMembers);
|
|
FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember'){$ENDIF};
|
|
FreeAndNil(FStateMachine);
|
|
if FSelfParameter <> nil then begin
|
|
//TDbgDwarfIdentifier(FSelfParameter.DbgSymbol).ParentTypeInfo := nil;
|
|
FSelfParameter.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSelfParameter, 'FSelfParameter'){$ENDIF};
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetColumn: Cardinal;
|
|
begin
|
|
if StateMachineValid
|
|
then Result := FStateMachine.Column
|
|
else Result := inherited GetColumn;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetFile: String;
|
|
begin
|
|
if StateMachineValid
|
|
then Result := FStateMachine.FileName
|
|
else Result := inherited GetFile;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetLine: Cardinal;
|
|
begin
|
|
if StateMachineValid
|
|
then Result := FStateMachine.Line
|
|
else Result := inherited GetLine;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetValueObject: TFpDbgValue;
|
|
begin
|
|
Result := FValueObject;
|
|
if Result <> nil then exit;
|
|
|
|
FValueObject := TFpDwarfValue.Create(nil);
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FValueObject.DbgRenameReference(@FValueObject, ClassName+'.FValueObject');{$ENDIF}
|
|
FValueObject.MakePlainRefToCirclular;
|
|
FValueObject.SetValueSymbol(self);
|
|
|
|
Result := FValueObject;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.StateMachineValid: Boolean;
|
|
var
|
|
SM1, SM2: TDwarfLineInfoStateMachine;
|
|
begin
|
|
Result := FStateMachine <> nil;
|
|
if Result then Exit;
|
|
|
|
if FAddressInfo^.StateMachine = nil
|
|
then begin
|
|
CompilationUnit.BuildLineInfo(FAddressInfo, False);
|
|
if FAddressInfo^.StateMachine = nil then Exit;
|
|
end;
|
|
|
|
// we cannot restore a statemachine to its current state
|
|
// so we shouldn't modify FAddressInfo^.StateMachine
|
|
// so use clones to navigate
|
|
SM1 := FAddressInfo^.StateMachine.Clone;
|
|
if FAddress < SM1.Address
|
|
then begin
|
|
// The address we want to find is before the start of this symbol ??
|
|
SM1.Free;
|
|
Exit;
|
|
end;
|
|
SM2 := FAddressInfo^.StateMachine.Clone;
|
|
|
|
repeat
|
|
if (FAddress = SM1.Address)
|
|
or not SM2.NextLine
|
|
or (FAddress < SM2.Address)
|
|
then begin
|
|
// found
|
|
FStateMachine := SM1;
|
|
SM2.Free;
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
until not SM1.NextLine;
|
|
|
|
//if all went well we shouldn't come here
|
|
SM1.Free;
|
|
SM2.Free;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
|
|
var
|
|
Val: Integer;
|
|
begin
|
|
AFlags := [];
|
|
Result := InformationEntry.ReadValue(DW_AT_virtuality, Val);
|
|
if not Result then exit;
|
|
case Val of
|
|
DW_VIRTUALITY_none: ;
|
|
DW_VIRTUALITY_virtual: AFlags := [sfVirtual];
|
|
DW_VIRTUALITY_pure_virtual: AFlags := [sfVirtual];
|
|
end;
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueProc.CreateMembers;
|
|
var
|
|
Info: TDwarfInformationEntry;
|
|
Info2: TDwarfInformationEntry;
|
|
begin
|
|
if FProcMembers <> nil then
|
|
exit;
|
|
FProcMembers := TRefCntObjList.Create;
|
|
Info := InformationEntry.Clone;
|
|
Info.GoChild;
|
|
|
|
while Info.HasValidScope do begin
|
|
if ((Info.AbbrevTag = DW_TAG_formal_parameter) or (Info.AbbrevTag = DW_TAG_variable)) //and
|
|
//not(Info.IsArtificial)
|
|
then begin
|
|
Info2 := Info.Clone;
|
|
FProcMembers.Add(Info2);
|
|
Info2.ReleaseReference;
|
|
end;
|
|
Info.GoNext;
|
|
end;
|
|
|
|
Info.ReleaseReference;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetMember(AIndex: Int64): TFpDbgSymbol;
|
|
begin
|
|
CreateMembers;
|
|
FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember'){$ENDIF};
|
|
FLastMember := TFpDwarfSymbol.CreateSubClass('', TDwarfInformationEntry(FProcMembers[AIndex]));
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');{$ENDIF}
|
|
Result := FLastMember;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
var
|
|
Info: TDwarfInformationEntry;
|
|
s, s2: String;
|
|
i: Integer;
|
|
begin
|
|
CreateMembers;
|
|
s2 := LowerCase(AIndex);
|
|
FLastMember.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember'){$ENDIF};
|
|
FLastMember := nil;;
|
|
for i := 0 to FProcMembers.Count - 1 do begin
|
|
Info := TDwarfInformationEntry(FProcMembers[i]);
|
|
if Info.ReadName(s) and (LowerCase(s) = s2) then begin
|
|
FLastMember := TFpDwarfSymbol.CreateSubClass('', Info);
|
|
{$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpDwarfSymbolValueProc.FLastMember');{$ENDIF}
|
|
break;
|
|
end;
|
|
end;
|
|
Result := FLastMember;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetMemberCount: Integer;
|
|
begin
|
|
CreateMembers;
|
|
Result := FProcMembers.Count;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
|
|
var
|
|
Val: TByteDynArray;
|
|
begin
|
|
Result := 0;
|
|
if FFrameBaseParser = nil then begin
|
|
//TODO: avoid copying data
|
|
if not InformationEntry.ReadValue(DW_AT_frame_base, Val) then begin
|
|
// error
|
|
debugln(FPDBG_DWARF_ERRORS, ['TFpDwarfSymbolValueProc.GetFrameBase failed to read DW_AT_frame_base']);
|
|
exit;
|
|
end;
|
|
if Length(Val) = 0 then begin
|
|
// error
|
|
debugln(FPDBG_DWARF_ERRORS, ['TFpDwarfSymbolValueProc.GetFrameBase failed to read DW_AT_location']);
|
|
exit;
|
|
end;
|
|
|
|
FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit,
|
|
ASender.MemManager, ASender.Context);
|
|
FFrameBaseParser.Evaluate;
|
|
end;
|
|
|
|
if FFrameBaseParser.ResultKind in [lseValue] then
|
|
Result := FFrameBaseParser.ResultData;
|
|
|
|
if IsError(FFrameBaseParser.LastError) then begin
|
|
SetLastError(FFrameBaseParser.LastError);
|
|
debugln(FPDBG_DWARF_ERRORS, ['TFpDwarfSymbolValueProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(LastError)]);
|
|
end
|
|
else
|
|
if Result = 0 then begin
|
|
debugln(FPDBG_DWARF_ERRORS, ['TFpDwarfSymbolValueProc.GetFrameBase location parser failed. result is 0']);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueProc.KindNeeded;
|
|
begin
|
|
if TypeInfo <> nil then
|
|
SetKind(skFunction)
|
|
else
|
|
SetKind(skProcedure);
|
|
end;
|
|
|
|
procedure TFpDwarfSymbolValueProc.SizeNeeded;
|
|
begin
|
|
SetSize(FAddressInfo^.EndPC - FAddressInfo^.StartPC);
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetFlags: TDbgSymbolFlags;
|
|
var
|
|
flg: TDbgSymbolFlags;
|
|
begin
|
|
Result := inherited GetFlags;
|
|
if ReadVirtuality(flg) then
|
|
Result := Result + flg;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueProc.GetSelfParameter(AnAddress: TDbgPtr): TFpDwarfValue;
|
|
const
|
|
this1: string = 'THIS';
|
|
this2: string = 'this';
|
|
self1: string = '$SELF';
|
|
self2: string = '$self';
|
|
var
|
|
InfoEntry: TDwarfInformationEntry;
|
|
tg: Cardinal;
|
|
found: Boolean;
|
|
begin
|
|
// special: search "self"
|
|
// Todo nested procs
|
|
Result := FSelfParameter;
|
|
if Result <> nil then exit;
|
|
|
|
InfoEntry := InformationEntry.Clone;
|
|
//StartScopeIdx := InfoEntry.ScopeIndex;
|
|
InfoEntry.GoParent;
|
|
tg := InfoEntry.AbbrevTag;
|
|
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
|
|
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
|
|
found := InfoEntry.GoNamedChildEx(@this1[1], @this2[1]);
|
|
if not found then begin
|
|
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
|
|
found := InfoEntry.GoNamedChildEx(@self1[1], @self2[1]);
|
|
end;
|
|
if found then begin
|
|
if ((AnAddress = 0) or InfoEntry.IsAddressInStartScope(AnAddress)) and
|
|
InfoEntry.IsArtificial
|
|
then begin
|
|
Result := TFpDwarfValue(TFpDwarfSymbolValue.CreateValueSubClass('self', InfoEntry).Value);
|
|
FSelfParameter := Result;
|
|
FSelfParameter.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSelfParameter, 'FSelfParameter'){$ENDIF};
|
|
FSelfParameter.DbgSymbol.ReleaseReference;
|
|
//FSelfParameter.DbgSymbol.ParentTypeInfo := Self;
|
|
debugln(FPDBG_DWARF_SEARCH, ['TFpDwarfSymbolValueProc.GetSelfParameter ', InfoEntry.ScopeDebugText, DbgSName(Result)]);
|
|
end;
|
|
end;
|
|
end;
|
|
InfoEntry.ReleaseReference;
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueVariable }
|
|
|
|
function TFpDwarfSymbolValueVariable.GetValueAddress(AValueObj: TFpDwarfValue; out
|
|
AnAddress: TFpDbgMemLocation): Boolean;
|
|
begin
|
|
AnAddress := AValueObj.DataAddressCache[0];
|
|
Result := IsValidLoc(AnAddress);
|
|
if IsInitializedLoc(AnAddress) then
|
|
exit;
|
|
Result := LocationFromTag(DW_AT_location, AValueObj, AnAddress);
|
|
AValueObj.DataAddressCache[0] := AnAddress;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueVariable.HasAddress: Boolean;
|
|
begin
|
|
Result := InformationEntry.HasAttrib(DW_AT_location);
|
|
end;
|
|
|
|
{ TFpDwarfSymbolValueParameter }
|
|
|
|
function TFpDwarfSymbolValueParameter.GetValueAddress(AValueObj: TFpDwarfValue; out
|
|
AnAddress: TFpDbgMemLocation): Boolean;
|
|
begin
|
|
AnAddress := AValueObj.DataAddressCache[0];
|
|
Result := IsValidLoc(AnAddress);
|
|
if IsInitializedLoc(AnAddress) then
|
|
exit;
|
|
Result := LocationFromTag(DW_AT_location, AValueObj, AnAddress);
|
|
AValueObj.DataAddressCache[0] := AnAddress;
|
|
end;
|
|
|
|
function TFpDwarfSymbolValueParameter.HasAddress: Boolean;
|
|
begin
|
|
Result := InformationEntry.HasAttrib(DW_AT_location);
|
|
end;
|
|
|
|
{ TFpDwarfSymbolUnit }
|
|
|
|
procedure TFpDwarfSymbolUnit.Init;
|
|
begin
|
|
inherited Init;
|
|
SetSymbolType(stNone);
|
|
SetKind(skUnit);
|
|
end;
|
|
|
|
function TFpDwarfSymbolUnit.GetMemberByName(AIndex: String): TFpDbgSymbol;
|
|
var
|
|
Ident: TDwarfInformationEntry;
|
|
begin
|
|
// Todo, param to only search external.
|
|
ReleaseRefAndNil(FLastChildByName);
|
|
Result := nil;
|
|
|
|
Ident := InformationEntry.Clone;
|
|
Ident.GoNamedChildEx(AIndex);
|
|
if Ident <> nil then
|
|
Result := TFpDwarfSymbol.CreateSubClass('', Ident);
|
|
// No need to set ParentTypeInfo
|
|
ReleaseRefAndNil(Ident);
|
|
FLastChildByName := Result;
|
|
end;
|
|
|
|
destructor TFpDwarfSymbolUnit.Destroy;
|
|
begin
|
|
ReleaseRefAndNil(FLastChildByName);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
initialization
|
|
DwarfSymbolClassMapList.SetDefaultMap(TFpDwarfDefaultSymbolClassMap);
|
|
|
|
FPDBG_DWARF_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , True {$ENDIF} );
|
|
FPDBG_DWARF_ERRORS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS' {$IFDEF FPDBG_DWARF_ERRORS} , True {$ENDIF} );
|
|
FPDBG_DWARF_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS' {$IFDEF FPDBG_DWARF_WARNINGS} , True {$ENDIF} );
|
|
FPDBG_DWARF_SEARCH := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} );
|
|
FPDBG_DWARF_DATA_WARNINGS := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_DATA_WARNINGS' {$IFDEF FPDBG_DWARF_DATA_WARNINGS} , True {$ENDIF} );
|
|
|
|
end.
|
|
|