{ --------------------------------------------------------------------------- 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 ) @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 . 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+} interface uses Classes, SysUtils, types, math, FpDbgInfo, FpDbgDwarfDataClasses, FpdMemoryTools, FpErrorMessages, FpDbgUtil, FpDbgDwarfConst, DbgIntfBaseTypes, LazUTF8, LazLoggerBase, LazClasses; type TDbgDwarf = FpDbgDwarfDataClasses.TDbgDwarf; { TFpDwarfDefaultSymbolClassMap } TFpDwarfDefaultSymbolClassMap = class(TFpDwarfSymbolClassMap) public class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override; class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override; class function CreateContext(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf): TDbgInfoAddressContext; override; class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override; end; { TDbgDwarfInfoAddressContext } TDbgDwarfInfoAddressContext = class(TDbgInfoAddressContext) private FSymbol: TFpDbgSymbol; FAddress: TDBGPtr; FDwarf: TDbgDwarf; FlastResult: TFpDbgValue; protected function GetSymbolAtAddress: TFpDbgSymbol; override; function GetAddress: TDbgPtr; override; function GetSizeOfAddress: Integer; override; function GetMemManager: TFpDbgMemManager; override; property Symbol: TFpDbgSymbol read FSymbol; property Address: TDBGPtr read FAddress; property Dwarf: TDbgDwarf read FDwarf; function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline; function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; inline; function FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue; inline; // FindLocalSymbol: for the subroutine itself function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue; virtual; public constructor Create(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf); destructor Destroy; override; function FindSymbol(const AName: String): TFpDbgValue; override; end; TDbgDwarfIdentifier = class; TDbgDwarfTypeIdentifier = class; TDbgDwarfValueIdentifier = class; TDbgDwarfIdentifierStructure = class; //TDbgDwarfIdentifierClass = class of TDbgDwarfIdentifier; TDbgDwarfValueIdentifierClass = class of TDbgDwarfValueIdentifier; TDbgDwarfTypeIdentifierClass = class of TDbgDwarfTypeIdentifier; {%region Value objects } { TFpDbgDwarfValue } TFpDbgDwarfValue = class(TFpDbgValue) private FOwner: TDbgDwarfTypeIdentifier; // the creator, usually the type FValueSymbol: TDbgDwarfValueIdentifier; FTypeCastTargetType: TDbgDwarfTypeIdentifier; FTypeCastSourceValue: TFpDbgValue; FDataAddressCache: array of TFpDbgMemLocation; FStructureValue: TFpDbgDwarfValue; FLastMember: TFpDbgDwarfValue; FLastError: TFpError; function GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation; function MemManager: TFpDbgMemManager; inline; function AddressSize: Byte; inline; procedure SetDataAddressCache(AIndex: Integer; AValue: TFpDbgMemLocation); procedure SetStructureValue(AValue: TFpDbgDwarfValue); protected procedure DoReferenceAdded; override; procedure DoReferenceReleased; override; procedure CircleBackRefActiveChanged(NewActive: Boolean); override; procedure SetLastMember(ALastMember: TFpDbgDwarfValue); 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: TDbgDwarfTypeIdentifier = nil): Boolean; function GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier = 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: TDbgDwarfTypeIdentifier); destructor Destroy; override; procedure SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier); function SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier; ASource: TFpDbgValue): Boolean; // Used for Typecast // StructureValue: Any Value returned via GetMember points to its structure property StructureValue: TFpDbgDwarfValue read FStructureValue write SetStructureValue; // DataAddressCache[0]: ValueAddress // DataAddressCache[1..n]: DataAddress property DataAddressCache[AIndex: Integer]: TFpDbgMemLocation read GetDataAddressCache write SetDataAddressCache; end; { TFpDbgDwarfValueSized } TFpDbgDwarfValueSized = class(TFpDbgDwarfValue) private FSize: Integer; protected function CanUseTypeCastAddress: Boolean; function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetSize: Integer; override; public constructor Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer); end; { TFpDbgDwarfValueNumeric } TFpDbgDwarfValueNumeric = class(TFpDbgDwarfValueSized) 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: TDbgDwarfTypeIdentifier; ASize: Integer); end; { TFpDbgDwarfValueInteger } TFpDbgDwarfValueInteger = class(TFpDbgDwarfValueNumeric) private FIntValue: Int64; protected function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetAsCardinal: QWord; override; function GetAsInteger: Int64; override; end; { TDbgDwarfValueCardinal } // xxxxxxxxxx TODO fix name TDbgDwarfValueCardinal = class(TFpDbgDwarfValueNumeric) private FValue: QWord; protected function GetAsCardinal: QWord; override; function GetFieldFlags: TFpDbgValueFieldFlags; override; end; { TFpDbgDwarfValueFloat } TFpDbgDwarfValueFloat = class(TFpDbgDwarfValueNumeric) // TDbgDwarfSymbolValue // TODO: typecasts to int should convert private FValue: Extended; protected function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetAsFloat: Extended; override; end; { TFpDbgDwarfValueBoolean } TFpDbgDwarfValueBoolean = class(TDbgDwarfValueCardinal) protected function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetAsBool: Boolean; override; end; { TFpDbgDwarfValueChar } TFpDbgDwarfValueChar = class(TDbgDwarfValueCardinal) protected // returns single char(byte) / widechar function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetAsString: AnsiString; override; function GetAsWideString: WideString; override; end; { TFpDbgDwarfValuePointer } TFpDbgDwarfValuePointer = class(TFpDbgDwarfValueNumeric) private FPointetToAddr: TFpDbgMemLocation; protected function GetAsCardinal: QWord; override; function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetDataAddress: TFpDbgMemLocation; override; function GetAsString: AnsiString; override; end; { TFpDbgDwarfValueEnum } TFpDbgDwarfValueEnum = class(TFpDbgDwarfValueNumeric) 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; { TFpDbgDwarfValueEnumMember } TFpDbgDwarfValueEnumMember = class(TFpDbgDwarfValue) private FOwnerVal: TDbgDwarfValueIdentifier; protected function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetAsCardinal: QWord; override; function GetAsString: AnsiString; override; function IsValidTypeCast: Boolean; override; public constructor Create(AOwner: TDbgDwarfValueIdentifier); end; { TFpDbgDwarfValueConstNumber } TFpDbgDwarfValueConstNumber = class(TFpDbgValueConstNumber) protected procedure Update(AValue: QWord; ASigned: Boolean); end; { TFpDbgDwarfValueSet } TFpDbgDwarfValueSet = class(TFpDbgDwarfValueSized) private FMem: array of Byte; FMemberCount: Integer; FMemberMap: array of Integer; FNumValue: TFpDbgDwarfValueConstNumber; 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; { TFpDbgDwarfValueStruct } TFpDbgDwarfValueStruct = class(TFpDbgDwarfValue) 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; { TFpDbgDwarfValueStructTypeCast } TFpDbgDwarfValueStructTypeCast = class(TFpDbgDwarfValue) private FMembers: TFpDbgCircularRefCntObjList; FDataAddress: TFpDbgMemLocation; FDataAddressDone: Boolean; protected procedure Reset; override; procedure ClearMembers; 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; { TFpDbgDwarfValueConstAddress } TFpDbgDwarfValueConstAddress = class(TFpDbgValueConstAddress) protected procedure Update(AnAddress: TFpDbgMemLocation); end; { TFpDbgDwarfValueArray } TFpDbgDwarfValueArray = class(TFpDbgDwarfValue) private FAddrObj: TFpDbgDwarfValueConstAddress; 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 } { TDbgDwarfIdentifier } TDbgDwarfIdentifier = class(TDbgDwarfSymbolBase) private FNestedTypeInfo: TDbgDwarfTypeIdentifier; FParentTypeInfo: TDbgDwarfIdentifier; FDwarfReadFlags: set of (didtNameRead, didtTypeRead, didtArtificialRead, didtIsArtifical); function GetNestedTypeInfo: TDbgDwarfTypeIdentifier; 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: TDbgDwarfIdentifier); virtual; function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; virtual; function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean; function IsArtificial: Boolean; // usud by formal param and subprogram procedure NameNeeded; override; procedure TypeInfoNeeded; override; property NestedTypeInfo: TDbgDwarfTypeIdentifier 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: TDbgDwarfIdentifier read FParentTypeInfo write SetParentTypeInfo; function DataSize: Integer; virtual; protected function InitLocationParser(const {%H-}ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; {%H-}AnObjectDataAddress: TFpDbgMemLocation): Boolean; virtual; function LocationFromTag(ATag: Cardinal; AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation; AnObjectDataAddress: TFpDbgMemLocation; AnInformationEntry: TDwarfInformationEntry = nil ): Boolean; // GetDataAddress: data of a class, or string function GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; virtual; function HasAddress: Boolean; virtual; procedure Init; override; public class function CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier; destructor Destroy; override; function StartScope: TDbgPtr; // return 0, if none. 0 includes all anyway end; { TDbgDwarfValueIdentifier } TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ... private // StructureValueInfo, Member and subproc may need containing class FStructureValueInfo: TDbgDwarfIdentifier; procedure SetStructureValueInfo(AValue: TDbgDwarfIdentifier); protected FValueObject: TFpDbgDwarfValue; FMembers: TFpDbgCircularRefCntObjList; procedure CircleBackRefActiveChanged(ANewActive: Boolean); override; procedure SetParentTypeInfo(AValue: TDbgDwarfIdentifier); override; function GetValueAddress({%H-}AValueObj: TFpDbgDwarfValue;{%H-} out AnAddress: TFpDbgMemLocation): Boolean; virtual; function GetValueDataAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier = 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): TDbgDwarfValueIdentifier; property StructureValueInfo: TDbgDwarfIdentifier read FStructureValueInfo write SetStructureValueInfo; end; { TDbgDwarfValueLocationIdentifier } TDbgDwarfValueLocationIdentifier = class(TDbgDwarfValueIdentifier) private procedure FrameBaseNeeded(ASender: TObject); protected function GetValueObject: TFpDbgValue; override; function InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; override; end; { TDbgDwarfTypeIdentifier } (* 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 *) TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier) protected procedure Init; override; procedure MemberVisibilityNeeded; override; procedure SizeNeeded; override; function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDbgDwarfValue; virtual; // returns refcount=1 for caller, no cached copy kept // TODO: flag bounds as cardinal if needed function GetValueBounds(AValueObj: TFpDbgDwarfValue; out ALowBound, AHighBound: Int64): Boolean; virtual; public class function CreateTypeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier; function TypeCastValue(AValue: TFpDbgValue): TFpDbgValue; override; end; { TDbgDwarfBaseIdentifierBase } TDbgDwarfBaseIdentifierBase = class(TDbgDwarfTypeIdentifier) //function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; // return nil protected procedure KindNeeded; override; procedure TypeInfoNeeded; override; function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDbgDwarfValue; override; function GetHasBounds: Boolean; override; function GetOrdHighBound: Int64; override; function GetOrdLowBound: Int64; override; end; { TDbgDwarfTypeIdentifierModifier } TDbgDwarfTypeIdentifierModifier = class(TDbgDwarfTypeIdentifier) protected procedure TypeInfoNeeded; override; procedure ForwardToSymbolNeeded; override; function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override; end; { TDbgDwarfTypeIdentifierRef } TDbgDwarfTypeIdentifierRef = class(TDbgDwarfTypeIdentifierModifier) protected function GetFlags: TDbgSymbolFlags; override; function GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; override; end; { TDbgDwarfTypeIdentifierDeclaration } TDbgDwarfTypeIdentifierDeclaration = class(TDbgDwarfTypeIdentifierModifier) 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: TDbgDwarfTypeIdentifier; override; end; { TDbgDwarfIdentifierSubRange } TDbgDwarfSubRangeBoundReadState = (rfNotRead, rfNotFound, rfConst, rfValue); TDbgDwarfIdentifierSubRange = class(TDbgDwarfTypeIdentifierModifier) // TODO not a modifier, maybe have a forwarder base class private FLowBoundConst: Int64; FLowBoundValue: TDbgDwarfValueIdentifier; FLowBoundState: TDbgDwarfSubRangeBoundReadState; FHighBoundConst: Int64; FHighBoundValue: TDbgDwarfValueIdentifier; FHighBoundState: TDbgDwarfSubRangeBoundReadState; FCountConst: Int64; FCountValue: TDbgDwarfValueIdentifier; FCountState: TDbgDwarfSubRangeBoundReadState; FLowEnumIdx, FHighEnumIdx: Integer; FEnumIdxValid: Boolean; procedure InitEnumIdx; procedure ReadBounds; protected function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;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; function GetValueBounds(AValueObj: TFpDbgDwarfValue; out ALowBound, AHighBound: Int64): Boolean; override; procedure Init; override; end; { TDbgDwarfTypeIdentifierPointer } TDbgDwarfTypeIdentifierPointer = class(TDbgDwarfTypeIdentifier) 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 GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; override; function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override; function DataSize: Integer; override; public property IsInternalPointer: Boolean read GetIsInternalPointer write FIsInternalPointer; // Class (also DynArray, but DynArray is handled without this) end; { TDbgDwarfIdentifierEnumMember } TDbgDwarfIdentifierEnumMember = class(TDbgDwarfValueIdentifier) 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; { TDbgDwarfIdentifierEnum } TDbgDwarfIdentifierEnum = class(TDbgDwarfTypeIdentifier) private FMembers: TFpDbgCircularRefCntObjList; procedure CreateMembers; protected function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDbgDwarfValue; 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; { TDbgDwarfIdentifierSet } TDbgDwarfIdentifierSet = class(TDbgDwarfTypeIdentifier) protected procedure KindNeeded; override; function GetTypedValueObject({%H-}ATypeCast: Boolean): TFpDbgDwarfValue; 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 = TDbgDwarfIdentifierVariable |-- .TypeInfo --> TBar = TDbgDwarfIdentifierStructure [*1] |-- .ParentTypeInfo --> may point to subroutine, if param or local var // TODO TBar = TDbgDwarfIdentifierStructure |-- .TypeInfo --> TBarBase = TDbgDwarfIdentifierStructure TBarBase = TDbgDwarfIdentifierStructure |-- .TypeInfo --> TOBject = TDbgDwarfIdentifierStructure TObject = TDbgDwarfIdentifierStructure |-- .TypeInfo --> nil FField = TDbgDwarfIdentifierMember (declared in TBarBase) |-- .TypeInfo --> Integer = TDbgDwarfBaseIdentifierBase [*1] |-- .ParentTypeInfo --> TBarBase [*1] May have TDbgDwarfTypeIdentifierDeclaration or others *) { TDbgDwarfIdentifierMember } TDbgDwarfIdentifierMember = class(TDbgDwarfValueLocationIdentifier) protected function InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; override; function GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override; function HasAddress: Boolean; override; end; { TDbgDwarfIdentifierStructure } TDbgDwarfIdentifierStructure = class(TDbgDwarfTypeIdentifier) // record or class private FMembers: TFpDbgCircularRefCntObjList; FLastChildByName: TDbgDwarfIdentifier; FInheritanceInfo: TDwarfInformationEntry; procedure CreateMembers; procedure InitInheritanceInfo; inline; protected function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; override; procedure KindNeeded; override; function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override; // GetMember, if AIndex > Count then parent function GetMember(AIndex: Int64): TFpDbgSymbol; override; function GetMemberByName(AIndex: String): TFpDbgSymbol; override; function GetMemberCount: Integer; override; function InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; override; function GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; override; public destructor Destroy; override; end; { TDbgDwarfIdentifierArray } TDbgDwarfIdentifierArray = class(TDbgDwarfTypeIdentifier) 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): TFpDbgDwarfValue; 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: TFpDbgDwarfValue; AIndex: Array of Int64): TFpDbgMemLocation; public destructor Destroy; override; end; { TDbgDwarfProcSymbol } TDbgDwarfProcSymbol = class(TDbgDwarfValueIdentifier) private //FCU: TDwarfCompilationUnit; FAddress: TDbgPtr; FAddressInfo: PDwarfAddressInfo; FStateMachine: TDwarfLineInfoStateMachine; FFrameBaseParser: TDwarfLocationExpression; FSelfParameter: TFpDbgDwarfValue; function StateMachineValid: Boolean; function ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean; protected function GetFrameBase: TDbgPtr; procedure KindNeeded; override; procedure SizeNeeded; override; function GetFlags: TDbgSymbolFlags; override; function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpDbgDwarfValue; function GetColumn: Cardinal; override; function GetFile: String; override; // function GetFlags: TDbgSymbolFlags; override; function GetLine: Cardinal; override; public constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); overload; destructor Destroy; override; // TODO members = locals ? end; { TDbgDwarfIdentifierVariable } TDbgDwarfIdentifierVariable = class(TDbgDwarfValueLocationIdentifier) protected function GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override; function HasAddress: Boolean; override; public end; { TDbgDwarfIdentifierParameter } TDbgDwarfIdentifierParameter = class(TDbgDwarfValueLocationIdentifier) protected function GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override; function HasAddress: Boolean; override; public end; { TDbgDwarfUnit } TDbgDwarfUnit = class(TDbgDwarfIdentifier) 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_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 := TDbgDwarfValueIdentifier; 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 := TDbgDwarfTypeIdentifier; // Type types DW_TAG_packed_type, DW_TAG_const_type, DW_TAG_volatile_type: Result := TDbgDwarfTypeIdentifierModifier; DW_TAG_reference_type: Result := TDbgDwarfTypeIdentifierRef; DW_TAG_typedef: Result := TDbgDwarfTypeIdentifierDeclaration; DW_TAG_pointer_type: Result := TDbgDwarfTypeIdentifierPointer; DW_TAG_base_type: Result := TDbgDwarfBaseIdentifierBase; DW_TAG_subrange_type: Result := TDbgDwarfIdentifierSubRange; DW_TAG_enumeration_type: Result := TDbgDwarfIdentifierEnum; DW_TAG_enumerator: Result := TDbgDwarfIdentifierEnumMember; DW_TAG_set_type: Result := TDbgDwarfIdentifierSet; DW_TAG_structure_type, DW_TAG_class_type: Result := TDbgDwarfIdentifierStructure; DW_TAG_array_type: Result := TDbgDwarfIdentifierArray; // Value types DW_TAG_variable: Result := TDbgDwarfIdentifierVariable; DW_TAG_formal_parameter: Result := TDbgDwarfIdentifierParameter; DW_TAG_member: Result := TDbgDwarfIdentifierMember; DW_TAG_subprogram: Result := TDbgDwarfProcSymbol; // DW_TAG_compile_unit: Result := TDbgDwarfUnit; else Result := TDbgDwarfIdentifier; end; end; class function TFpDwarfDefaultSymbolClassMap.CreateContext(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf): TDbgInfoAddressContext; begin Result := TDbgDwarfInfoAddressContext.Create(AnAddress, ASymbol, ADwarf); end; class function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; begin Result := TDbgDwarfProcSymbol.Create(ACompilationUnit, AInfo, AAddress); end; { TDbgDwarfInfoAddressContext } function TDbgDwarfInfoAddressContext.GetSymbolAtAddress: TFpDbgSymbol; begin Result := FSymbol; end; function TDbgDwarfInfoAddressContext.GetAddress: TDbgPtr; begin Result := FAddress; end; function TDbgDwarfInfoAddressContext.GetSizeOfAddress: Integer; begin assert(FSymbol is TDbgDwarfIdentifier, 'TDbgDwarfInfoAddressContext.GetSizeOfAddress'); Result := TDbgDwarfIdentifier(FSymbol).CompilationUnit.AddressSize; end; function TDbgDwarfInfoAddressContext.GetMemManager: TFpDbgMemManager; begin Result := FDwarf.MemManager; end; function TDbgDwarfInfoAddressContext.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 := TFpDbgValueTypeDeclaration.Create(ASym); {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(@FlastResult, 'FindSymbol'){$ENDIF}; end; ASym.ReleaseReference; end; function TDbgDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; var i, ExtVal: Integer; CU: TDwarfCompilationUnit; InfoEntry, FoundInfoEntry: TDwarfInformationEntry; s: String; begin Result := 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); Result := SymbolToValue(TDbgDwarfIdentifier.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 result end; end; end; if FoundInfoEntry <> nil then begin; Result := SymbolToValue(TDbgDwarfIdentifier.CreateSubClass(AName, FoundInfoEntry)); FoundInfoEntry.ReleaseReference; end; InfoEntry.ReleaseReference; end; function TDbgDwarfInfoAddressContext.FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue; var InfoEntryInheritance: TDwarfInformationEntry; FwdInfoPtr: Pointer; FwdCompUint: TDwarfCompilationUnit; SelfParam: TFpDbgDwarfValue; begin Result := 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 := TDbgDwarfProcSymbol(FSymbol).GetSelfParameter(FAddress); if (SelfParam <> nil) then begin // TODO: only valid, as long as context is valid, because if context is freed, then self is lost too Result := SelfParam.MemberByName[AName]; assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]'); if Result <> nil then Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF}; end else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']); ; if Result = nil then begin // Todo: abort the searh /SetError Result := SymbolToValue(TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry)); end; InfoEntry.ReleaseReference; InfoEntryInheritance.ReleaseReference; 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; end; function TDbgDwarfInfoAddressContext.FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue; begin Result := nil; if not InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then exit; if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin Result := SymbolToValue(TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry)); TDbgDwarfIdentifier(Result.DbgSymbol).ParentTypeInfo := TDbgDwarfProcSymbol(FSymbol); end; end; constructor TDbgDwarfInfoAddressContext.Create(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf); begin inherited Create; AddReference; FAddress := AnAddress; FDwarf := ADwarf; FSymbol := ASymbol; FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF}; end; destructor TDbgDwarfInfoAddressContext.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 TDbgDwarfInfoAddressContext.FindSymbol(const AName: String): TFpDbgValue; var SubRoutine: TDbgDwarfProcSymbol; // 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 TDbgDwarfProcSymbol) or (AName = '') then exit; SubRoutine := TDbgDwarfProcSymbol(FSymbol); NameUpper := UTF8UpperCase(AName); NameLower := UTF8LowerCase(AName); PNameUpper := @NameUpper[1]; PNameLower := @NameLower[1]; try CU := SubRoutine.CompilationUnit; InfoEntry := SubRoutine.InformationEntry.Clone; // special: search "self" // depends on dwarf version // Todo nested procs // TODO: Move to FindLocal if NameLower = 'self' then begin Result := SubRoutine.GetSelfParameter(FAddress); if Result <> nil then begin Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF}; exit; end; end; 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 Result := SymbolToValue(TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry)); exit; end; end; tg := InfoEntry.AbbrevTag; if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin Result := FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry); // TODO: check error if Result <> nil then exit; //InfoEntry.ScopeIndex := StartScopeIdx; end else if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine Result := FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry); // TODO: check error if Result <> nil then exit; //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(TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry)); exit; end; end; // Search parent(s) InfoEntry.ScopeIndex := StartScopeIdx; InfoEntry.GoParent; end; Result := FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU); 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=', TDbgDwarfIdentifier(Result.DbgSymbol).InformationEntry.ScopeDebugText, ' ResultSymbol=', DbgSName(Result.DbgSymbol), ' ', Result.DbgSymbol.Name, ' in ', TDbgDwarfIdentifier(Result.DbgSymbol).CompilationUnit.FileName]); ReleaseRefAndNil(InfoEntry); FlastResult.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF}; FlastResult := Result; end; end; { TFpDbgDwarfValue } function TFpDbgDwarfValue.MemManager: TFpDbgMemManager; begin assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil) and (FOwner.CompilationUnit.Owner <> nil), 'TDbgDwarfSymbolValue.MemManager'); Result := FOwner.CompilationUnit.Owner.MemManager; end; function TFpDbgDwarfValue.GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation; begin if AIndex < Length(FDataAddressCache) then Result := FDataAddressCache[AIndex] else Result := UnInitializedLoc; end; function TFpDbgDwarfValue.AddressSize: Byte; begin assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil), 'TDbgDwarfSymbolValue.AddressSize'); Result := FOwner.CompilationUnit.AddressSize; end; procedure TFpDbgDwarfValue.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 TFpDbgDwarfValue.SetStructureValue(AValue: TFpDbgDwarfValue); 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 TFpDbgDwarfValue.GetLastError: TFpError; begin Result := FLastError; end; function TFpDbgDwarfValue.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 TFpDbgDwarfValue.OrdOrDataAddr: TFpDbgMemLocation; begin if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then Result := ConstLoc(FTypeCastSourceValue.AsCardinal) else Result := DataAddr; end; function TFpDbgDwarfValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier): Boolean; var fields: TFpDbgValueFieldFlags; begin if FValueSymbol <> nil then begin Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol'); Assert(TypeInfo is TDbgDwarfTypeIdentifier, '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 TFpDbgDwarfValue.GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier): Boolean; begin AnAddress := InvalidLoc; Result := StructureValue <> nil; if Result then Result := StructureValue.GetDwarfDataAddress(AnAddress, ATargetType); end; function TFpDbgDwarfValue.HasDwarfDataAddress: Boolean; begin if FValueSymbol <> nil then begin Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol'); Assert(TypeInfo is TDbgDwarfTypeIdentifier, '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 TFpDbgDwarfValue.Reset; begin FDataAddressCache := nil; FLastError := NoError; end; function TFpDbgDwarfValue.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 TFpDbgDwarfValue.HasTypeCastInfo: Boolean; begin Result := (FTypeCastTargetType <> nil) and (FTypeCastSourceValue <> nil); end; function TFpDbgDwarfValue.IsValidTypeCast: Boolean; begin Result := False; end; procedure TFpDbgDwarfValue.DoReferenceAdded; begin inherited DoReferenceAdded; DoPlainReferenceAdded; end; procedure TFpDbgDwarfValue.DoReferenceReleased; begin inherited DoReferenceReleased; DoPlainReferenceReleased; end; procedure TFpDbgDwarfValue.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 TFpDbgDwarfValue.SetLastMember(ALastMember: TFpDbgDwarfValue); 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}; end; end; function TFpDbgDwarfValue.GetKind: TDbgSymbolKind; begin if FValueSymbol <> nil then Result := FValueSymbol.Kind else if HasTypeCastInfo then Result := FTypeCastTargetType.Kind else Result := inherited GetKind; end; function TFpDbgDwarfValue.GetAddress: TFpDbgMemLocation; begin if FValueSymbol <> nil then FValueSymbol.GetValueAddress(Self, Result) else if HasTypeCastInfo then Result := FTypeCastSourceValue.Address else Result := inherited GetAddress; end; function TFpDbgDwarfValue.OrdOrAddress: TFpDbgMemLocation; begin if HasTypeCastInfo and (svfOrdinal in FTypeCastSourceValue.FieldFlags) then Result := ConstLoc(FTypeCastSourceValue.AsCardinal) else Result := Address; end; function TFpDbgDwarfValue.GetMemberCount: Integer; begin if FValueSymbol <> nil then Result := FValueSymbol.MemberCount else Result := inherited GetMemberCount; end; function TFpDbgDwarfValue.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(TFpDbgDwarfValue(Result)); end; function TFpDbgDwarfValue.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(TFpDbgDwarfValue(Result)); end; function TFpDbgDwarfValue.GetDbgSymbol: TFpDbgSymbol; begin Result := FValueSymbol; end; function TFpDbgDwarfValue.GetTypeInfo: TFpDbgSymbol; begin if HasTypeCastInfo then Result := FTypeCastTargetType else Result := inherited GetTypeInfo; end; function TFpDbgDwarfValue.GetContextTypeInfo: TFpDbgSymbol; begin if (FValueSymbol <> nil) and (FValueSymbol.ParentTypeInfo <> nil) then Result := FValueSymbol.ParentTypeInfo else Result := nil; // internal error end; constructor TFpDbgDwarfValue.Create(AOwner: TDbgDwarfTypeIdentifier); begin FOwner := AOwner; inherited Create; end; destructor TFpDbgDwarfValue.Destroy; begin ReleaseRefAndNil(FTypeCastTargetType); ReleaseRefAndNil(FTypeCastSourceValue); SetLastMember(nil); inherited Destroy; end; procedure TFpDbgDwarfValue.SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier); 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 TFpDbgDwarfValue.SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier; ASource: TFpDbgValue): Boolean; begin Reset; if FTypeCastSourceValue <> ASource then begin if FTypeCastSourceValue <> nil then FTypeCastSourceValue.ReleaseReference; FTypeCastSourceValue := ASource; if FTypeCastSourceValue <> nil then FTypeCastSourceValue.AddReference; end; if FTypeCastTargetType <> AStructure then begin if FTypeCastTargetType <> nil then FTypeCastTargetType.ReleaseReference; FTypeCastTargetType := AStructure; if FTypeCastTargetType <> nil then FTypeCastTargetType.AddReference; end; Result := IsValidTypeCast; end; { TFpDbgDwarfValueSized } function TFpDbgDwarfValueSized.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 TFpDbgDwarfValueSized.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfSize]; end; function TFpDbgDwarfValueSized.GetSize: Integer; begin Result := FSize; end; constructor TFpDbgDwarfValueSized.Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer); begin inherited Create(AOwner); FSize := ASize; end; { TFpDbgDwarfValueNumeric } procedure TFpDbgDwarfValueNumeric.Reset; begin inherited Reset; FEvaluated := []; end; function TFpDbgDwarfValueNumeric.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfOrdinal]; end; function TFpDbgDwarfValueNumeric.IsValidTypeCast: Boolean; begin Result := HasTypeCastInfo; If not Result then exit; if (svfOrdinal in FTypeCastSourceValue.FieldFlags) or CanUseTypeCastAddress then exit; Result := False; end; constructor TFpDbgDwarfValueNumeric.Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer); begin inherited Create(AOwner, ASize); FEvaluated := []; end; { TFpDbgDwarfValueInteger } function TFpDbgDwarfValueInteger.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfInteger]; end; function TFpDbgDwarfValueInteger.GetAsCardinal: QWord; begin Result := QWord(GetAsInteger); // include sign extension end; function TFpDbgDwarfValueInteger.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 TDbgDwarfValueCardinal.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 TDbgDwarfValueCardinal.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfCardinal]; end; { TFpDbgDwarfValueFloat } function TFpDbgDwarfValueFloat.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfFloat] - [svfOrdinal]; end; function TFpDbgDwarfValueFloat.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; { TFpDbgDwarfValueBoolean } function TFpDbgDwarfValueBoolean.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfBoolean]; end; function TFpDbgDwarfValueBoolean.GetAsBool: Boolean; begin Result := QWord(GetAsCardinal) <> 0; end; { TFpDbgDwarfValueChar } function TFpDbgDwarfValueChar.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; case FSize of 1: Result := Result + [svfString]; 2: Result := Result + [svfWideString]; end; end; function TFpDbgDwarfValueChar.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 TFpDbgDwarfValueChar.GetAsWideString: WideString; begin if FSize > 2 then Result := inherited GetAsString else Result := WideChar(Word(GetAsCardinal)); end; { TFpDbgDwarfValuePointer } function TFpDbgDwarfValuePointer.GetAsCardinal: QWord; var a: TFpDbgMemLocation; begin a := GetDataAddress; if IsTargetAddr(a) then Result := LocToAddr(a) else Result := 0; end; function TFpDbgDwarfValuePointer.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 TFpDbgDwarfValuePointer.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 TFpDbgDwarfValuePointer.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; { TFpDbgDwarfValueEnum } procedure TFpDbgDwarfValueEnum.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 TFpDbgDwarfValueEnum.Reset; begin inherited Reset; FMemberValueDone := False; end; function TFpDbgDwarfValueEnum.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfOrdinal, svfMembers, svfIdentifier]; end; function TFpDbgDwarfValueEnum.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 TFpDbgDwarfValueEnum.GetAsString: AnsiString; begin InitMemberIndex; if FMemberIndex >= 0 then Result := FOwner.Member[FMemberIndex].Name else Result := ''; end; function TFpDbgDwarfValueEnum.GetMemberCount: Integer; begin InitMemberIndex; if FMemberIndex < 0 then Result := 0 else Result := 1; end; function TFpDbgDwarfValueEnum.GetMember(AIndex: Int64): TFpDbgValue; begin InitMemberIndex; if (FMemberIndex >= 0) and (AIndex = 0) then Result := FOwner.Member[FMemberIndex].Value else Result := nil; end; { TFpDbgDwarfValueEnumMember } function TFpDbgDwarfValueEnumMember.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfOrdinal, svfIdentifier]; end; function TFpDbgDwarfValueEnumMember.GetAsCardinal: QWord; begin Result := FOwnerVal.OrdinalValue; end; function TFpDbgDwarfValueEnumMember.GetAsString: AnsiString; begin Result := FOwnerVal.Name; end; function TFpDbgDwarfValueEnumMember.IsValidTypeCast: Boolean; begin assert(False, 'TDbgDwarfEnumMemberSymbolValue.IsValidTypeCast can not be returned for typecast'); Result := False; end; constructor TFpDbgDwarfValueEnumMember.Create(AOwner: TDbgDwarfValueIdentifier); begin FOwnerVal := AOwner; inherited Create(nil); end; { TFpDbgDwarfValueConstNumber } procedure TFpDbgDwarfValueConstNumber.Update(AValue: QWord; ASigned: Boolean); begin Signed := ASigned; Value := AValue; end; { TFpDbgDwarfValueSet } procedure TFpDbgDwarfValueSet.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 TFpDbgDwarfValueSet.Reset; begin inherited Reset; SetLength(FMem, 0); end; function TFpDbgDwarfValueSet.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfMembers]; if FSize <= 8 then Result := Result + [svfOrdinal]; end; function TFpDbgDwarfValueSet.GetMemberCount: Integer; begin InitMap; Result := FMemberCount; end; function TFpDbgDwarfValueSet.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 TDbgDwarfTypeIdentifier, '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 := TFpDbgDwarfValueConstNumber.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 TFpDbgDwarfValue(FTypedNumValue).SetTypeCastInfo(TDbgDwarfTypeIdentifier(t), FNumValue); // update FNumValue.ReleaseReference; Assert((FTypedNumValue <> nil) and (TFpDbgDwarfValue(FTypedNumValue).IsValidTypeCast), 'TDbgDwarfSetSymbolValue.GetMember FTypedNumValue'); Assert((FNumValue <> nil) and (FNumValue.RefCount > 0), 'TDbgDwarfSetSymbolValue.GetMember FNumValue'); Result := FTypedNumValue; end; end; function TFpDbgDwarfValueSet.GetAsCardinal: QWord; begin Result := 0; if (FSize <= SizeOf(Result)) and (length(FMem) > 0) then move(FMem[0], Result, FSize); end; function TFpDbgDwarfValueSet.IsValidTypeCast: Boolean; var f: TFpDbgValueFieldFlags; begin Result := HasTypeCastInfo; If not Result then exit; assert(FTypeCastTargetType.Kind = skSet, 'TFpDbgDwarfValueSet.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 TFpDbgDwarfValueSet.Destroy; begin FTypedNumValue.ReleaseReference; inherited Destroy; end; { TFpDbgDwarfValueStruct } procedure TFpDbgDwarfValueStruct.Reset; begin inherited Reset; FDataAddressDone := False; end; function TFpDbgDwarfValueStruct.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 TFpDbgDwarfValueStruct.GetAsCardinal: QWord; begin Result := QWord(LocToAddrOrNil(DataAddress)); end; function TFpDbgDwarfValueStruct.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 TFpDbgDwarfValueStruct.GetDataSize: Integer; begin Assert((FValueSymbol = nil) or (FValueSymbol.TypeInfo is TDbgDwarfIdentifier)); if (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then if FValueSymbol.TypeInfo.Kind = skClass then Result := TDbgDwarfIdentifier(FValueSymbol.TypeInfo).DataSize else Result := FValueSymbol.TypeInfo.Size else Result := -1; end; function TFpDbgDwarfValueStruct.GetSize: Integer; begin if (Kind <> skClass) and (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then Result := FValueSymbol.TypeInfo.Size else Result := -1; end; { TFpDbgDwarfValueStructTypeCast } procedure TFpDbgDwarfValueStructTypeCast.Reset; begin inherited Reset; FDataAddressDone := False; ClearMembers; end; procedure TFpDbgDwarfValueStructTypeCast.ClearMembers; var i: Integer; begin if FMembers <> nil then for i := 0 to FMembers.Count - 1 do TDbgDwarfValueIdentifier(FMembers[i]).StructureValueInfo := nil; end; function TFpDbgDwarfValueStructTypeCast.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 TFpDbgDwarfValueStructTypeCast.GetKind: TDbgSymbolKind; begin if HasTypeCastInfo then Result := FTypeCastTargetType.Kind else Result := inherited GetKind; end; function TFpDbgDwarfValueStructTypeCast.GetAsCardinal: QWord; begin Result := QWord(LocToAddrOrNil(DataAddress)); end; function TFpDbgDwarfValueStructTypeCast.GetSize: Integer; begin if (Kind <> skClass) and (FTypeCastTargetType <> nil) then Result := FTypeCastTargetType.Size else Result := -1; end; function TFpDbgDwarfValueStructTypeCast.GetDataSize: Integer; begin Assert((FTypeCastTargetType = nil) or (FTypeCastTargetType is TDbgDwarfIdentifier)); if FTypeCastTargetType <> nil then if FTypeCastTargetType.Kind = skClass then Result := TDbgDwarfIdentifier(FTypeCastTargetType).DataSize else Result := FTypeCastTargetType.Size else Result := -1; end; function TFpDbgDwarfValueStructTypeCast.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 TFpDbgDwarfValueStructTypeCast.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 TFpDbgDwarfValueStructTypeCast.Destroy; begin ClearMembers; FreeAndNil(FMembers); inherited Destroy; end; function TFpDbgDwarfValueStructTypeCast.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 TDbgDwarfValueIdentifier), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp)); if FMembers = nil then FMembers := TFpDbgCircularRefCntObjList.Create; FMembers.Add(tmp); Result := tmp.Value; end; SetLastMember(TFpDbgDwarfValue(Result)); end; function TFpDbgDwarfValueStructTypeCast.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 TDbgDwarfValueIdentifier), 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp)); if FMembers = nil then FMembers := TFpDbgCircularRefCntObjList.Create; FMembers.Add(tmp); Result := tmp.Value; end; SetLastMember(TFpDbgDwarfValue(Result)); end; function TFpDbgDwarfValueStructTypeCast.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; { TFpDbgDwarfValueConstAddress } procedure TFpDbgDwarfValueConstAddress.Update(AnAddress: TFpDbgMemLocation); begin Address := AnAddress; end; { TFpDbgDwarfValueArray } function TFpDbgDwarfValueArray.GetFieldFlags: TFpDbgValueFieldFlags; begin Result := inherited GetFieldFlags; Result := Result + [svfMembers]; if (TypeInfo <> nil) and (sfDynArray in TypeInfo.Flags) then Result := Result + [svfOrdinal, svfDataAddress]; end; function TFpDbgDwarfValueArray.GetKind: TDbgSymbolKind; begin Result := skArray; end; function TFpDbgDwarfValueArray.GetAsCardinal: QWord; begin // TODO cache if not MemManager.ReadUnsignedInt(OrdOrAddress, AddressSize, Result) then begin FLastError := MemManager.LastError; Result := 0; end; end; function TFpDbgDwarfValueArray.GetDataAddress: TFpDbgMemLocation; begin Result := OrdOrDataAddr; end; function TFpDbgDwarfValueArray.GetMember(AIndex: Int64): TFpDbgValue; begin Result := GetMemberEx([AIndex]); end; function TFpDbgDwarfValueArray.GetMemberEx(AIndex: array of Int64): TFpDbgValue; var Addr: TFpDbgMemLocation; i: Integer; begin Result := nil; assert((FOwner is TDbgDwarfIdentifierArray) and (FOwner.Kind = skArray)); Addr := TDbgDwarfIdentifierArray(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 := TFpDbgDwarfValueConstAddress.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(TFpDbgDwarfValue(FOwner.TypeInfo.TypeCastValue(FAddrObj))); FLastMember.ReleaseReference; end else begin TFpDbgDwarfValue(FLastMember).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner.TypeInfo), FAddrObj); end; Result := FLastMember; end; function TFpDbgDwarfValueArray.GetMemberCount: Integer; var t, t2: TFpDbgSymbol; Addr: TFpDbgMemLocation; i: Int64; begin Result := 0; t := TypeInfo; if t.MemberCount < 1 then // IndexTypeCount; exit; t2 := t.Member[0]; // IndexType[0]; if not t2.HasBounds then begin if (sfDynArray in t.Flags) and (AsCardinal <> 0) and GetDwarfDataAddress(Addr, TDbgDwarfTypeIdentifier(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 TFpDbgDwarfValueArray.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 TFpDbgDwarfValueArray.GetIndexType(AIndex: Integer): TFpDbgSymbol; begin Result := TypeInfo.Member[AIndex]; end; function TFpDbgDwarfValueArray.GetIndexTypeCount: Integer; begin Result := TypeInfo.MemberCount; end; function TFpDbgDwarfValueArray.IsValidTypeCast: Boolean; var f: TFpDbgValueFieldFlags; begin Result := HasTypeCastInfo; If not Result then exit; assert(FTypeCastTargetType.Kind = skArray, 'TFpDbgDwarfValueArray.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 TFpDbgDwarfValueArray.Destroy; begin FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF}; inherited Destroy; end; { TDbgDwarfIdentifier } function TDbgDwarfIdentifier.GetNestedTypeInfo: TDbgDwarfTypeIdentifier; 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 TDbgDwarfIdentifier.SetParentTypeInfo(AValue: TDbgDwarfIdentifier); 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 TDbgDwarfIdentifier.DoReferenceAdded; begin inherited DoReferenceAdded; DoPlainReferenceAdded; end; procedure TDbgDwarfIdentifier.DoReferenceReleased; begin inherited DoReferenceReleased; DoPlainReferenceReleased; end; procedure TDbgDwarfIdentifier.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 TDbgDwarfIdentifier.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; 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 := TDbgDwarfTypeIdentifier.CreateTypeSubClass('', InfoEntry); ReleaseRefAndNil(InfoEntry); end else Result := nil; end; function TDbgDwarfIdentifier.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 TDbgDwarfIdentifier.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 TDbgDwarfIdentifier.NameNeeded; var AName: String; begin if InformationEntry.ReadName(AName) then SetName(AName) else inherited NameNeeded; end; procedure TDbgDwarfIdentifier.TypeInfoNeeded; begin SetTypeInfo(NestedTypeInfo); end; function TDbgDwarfIdentifier.DataSize: Integer; var t: TDbgDwarfTypeIdentifier; begin t := NestedTypeInfo; if t <> nil then Result := t.DataSize else Result := 0; end; function TDbgDwarfIdentifier.InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; begin Result := True; end; function TDbgDwarfIdentifier.LocationFromTag(ATag: Cardinal; AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation; AnObjectDataAddress: TFpDbgMemLocation; AnInformationEntry: TDwarfInformationEntry): Boolean; var Val: TByteDynArray; LocationParser: TDwarfLocationExpression; begin //debugln(['TDbgDwarfIdentifier.LocationFromTag', ClassName, ' ',Name, ' ', DwarfAttributeToString(ATag)]); Result := False; AnAddress := InvalidLoc; 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 DebugLn('LocationFromTag: failed to read DW_AT_location'); exit; end; if Length(Val) = 0 then begin DebugLn('LocationFromTag: Warning DW_AT_location empty'); //exit; end; LocationParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit); InitLocationParser(LocationParser, AValueObj, AnObjectDataAddress); LocationParser.Evaluate; if IsError(LocationParser.LastError) then SetLastError(LocationParser.LastError); if LocationParser.ResultKind in [lseValue] then begin AnAddress := TargetLoc(LocationParser.ResultData); 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 TDbgDwarfIdentifier.GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; var ti: TDbgDwarfTypeIdentifier; begin if ATargetType = Self then begin Result := True; end else begin ti := NestedTypeInfo; if ti <> nil then Result := ti.GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex+1) else Result := ATargetType = nil; // end of type chain end; end; function TDbgDwarfIdentifier.HasAddress: Boolean; begin Result := False; end; procedure TDbgDwarfIdentifier.Init; begin // end; class function TDbgDwarfIdentifier.CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier; var c: TDbgDwarfSymbolBaseClass; begin c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag); Result := TDbgDwarfIdentifier(c.Create(AName, AnInformationEntry)); end; destructor TDbgDwarfIdentifier.Destroy; begin inherited Destroy; ReleaseRefAndNil(FNestedTypeInfo); Assert(not CircleBackRefsActive, 'CircleBackRefsActive can not be is destructor'); // FParentTypeInfo := nil end; function TDbgDwarfIdentifier.StartScope: TDbgPtr; begin if not InformationEntry.ReadStartScope(Result) then Result := 0; end; { TDbgDwarfValueIdentifier } procedure TDbgDwarfValueIdentifier.SetStructureValueInfo(AValue: TDbgDwarfIdentifier); begin if FStructureValueInfo = AValue then Exit; if (FStructureValueInfo <> nil) and CircleBackRefsActive then FStructureValueInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValueInfo, 'FStructureValueInfo'){$ENDIF}; FStructureValueInfo := AValue; if (FStructureValueInfo <> nil) and CircleBackRefsActive then FStructureValueInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValueInfo, 'FStructureValueInfo'){$ENDIF}; end; procedure TDbgDwarfValueIdentifier.CircleBackRefActiveChanged(ANewActive: Boolean); begin inherited; if (FStructureValueInfo = nil) then exit; if ANewActive then FStructureValueInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValueInfo, 'FStructureValueInfo'){$ENDIF} else FStructureValueInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValueInfo, 'FStructureValueInfo'){$ENDIF}; end; procedure TDbgDwarfValueIdentifier.SetParentTypeInfo(AValue: TDbgDwarfIdentifier); begin if AValue <> ParentTypeInfo then StructureValueInfo := nil; inherited SetParentTypeInfo(AValue); end; function TDbgDwarfValueIdentifier.GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; begin Result := False; end; function TDbgDwarfValueIdentifier.GetValueDataAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier): Boolean; begin Result := TypeInfo <> nil; if not Result then exit; Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress'); Result := GetValueAddress(AValueObj, AnAddress); Result := Result and IsReadableLoc(AnAddress); if Result then begin Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1); if not Result then SetLastError(TypeInfo.LastError); end; end; procedure TDbgDwarfValueIdentifier.KindNeeded; var t: TFpDbgSymbol; begin t := TypeInfo; if t = nil then inherited KindNeeded else SetKind(t.Kind); end; procedure TDbgDwarfValueIdentifier.MemberVisibilityNeeded; var Val: TDbgSymbolMemberVisibility; begin if ReadMemberVisibility(Val) then SetMemberVisibility(Val) else if TypeInfo <> nil then SetMemberVisibility(TypeInfo.MemberVisibility) else inherited MemberVisibilityNeeded; end; function TDbgDwarfValueIdentifier.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 TDbgDwarfValueIdentifier), 'TDbgDwarfValueIdentifier.GetMember is Value'); if (k in [skClass, skObject, skRecord {, skArray}]) and (Result <> nil) and (Result is TDbgDwarfValueIdentifier) then begin if FMembers = nil then FMembers := TFpDbgCircularRefCntObjList.Create; FMembers.Add(Result); TDbgDwarfValueIdentifier(Result).StructureValueInfo := Self; end; end; function TDbgDwarfValueIdentifier.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 TDbgDwarfValueIdentifier), 'TDbgDwarfValueIdentifier.GetMember is Value'); if (k in [skClass, skObject, skRecord {, skArray}]) and (Result <> nil) and (Result is TDbgDwarfValueIdentifier) then begin if FMembers = nil then FMembers := TFpDbgCircularRefCntObjList.Create; FMembers.Add(Result); TDbgDwarfValueIdentifier(Result).StructureValueInfo := Self; end; end; function TDbgDwarfValueIdentifier.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 TDbgDwarfValueIdentifier.Init; begin inherited Init; SetSymbolType(stValue); end; destructor TDbgDwarfValueIdentifier.Destroy; var i: Integer; begin Assert(not CircleBackRefsActive, 'CircleBackRefsActive can not be is ddestructor'); if FMembers <> nil then for i := 0 to FMembers.Count - 1 do TDbgDwarfValueIdentifier(FMembers[i]).StructureValueInfo := nil; FreeAndNil(FMembers); if FValueObject <> nil then begin FValueObject.SetValueSymbol(nil); FValueObject.ReleaseCirclularReference; FValueObject := nil; end; ParentTypeInfo := nil; inherited Destroy; end; class function TDbgDwarfValueIdentifier.CreateValueSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfValueIdentifier; var c: TDbgDwarfSymbolBaseClass; begin c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag); if c.InheritsFrom(TDbgDwarfValueIdentifier) then Result := TDbgDwarfValueIdentifierClass(c).Create(AName, AnInformationEntry) else Result := nil; end; { TDbgDwarfValueLocationIdentifier } function TDbgDwarfValueLocationIdentifier.InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; begin Result := inherited InitLocationParser(ALocationParser, AValueObj, AnObjectDataAddress); ALocationParser.OnFrameBaseNeeded := @FrameBaseNeeded; end; procedure TDbgDwarfValueLocationIdentifier.FrameBaseNeeded(ASender: TObject); var p: TDbgDwarfIdentifier; fb: TDBGPtr; begin debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarfIdentifierVariable.FrameBaseNeeded ']); p := ParentTypeInfo; // TODO: what if parent is declaration? if (p <> nil) and (p is TDbgDwarfProcSymbol) then begin fb := TDbgDwarfProcSymbol(p).GetFrameBase; (ASender as TDwarfLocationExpression).FrameBase := fb; if fb = 0 then begin debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfValueLocationIdentifier.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 TDbgDwarfValueLocationIdentifier.FrameBaseNeeded no parent type info']); (ASender as TDwarfLocationExpression).FrameBase := 0; end; function TDbgDwarfValueLocationIdentifier.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 := TDbgDwarfTypeIdentifier(ti).GetTypedValueObject(False); if FValueObject <> nil then begin FValueObject.MakePlainRefToCirclular; FValueObject.SetValueSymbol(self); // Used as reference to "self" if StructureValueInfo <> nil then FValueObject.SetStructureValue(TFpDbgDwarfValue(StructureValueInfo.Value)); // TODO: on request only end; Result := FValueObject; end; { TDbgDwarfTypeIdentifier } procedure TDbgDwarfTypeIdentifier.Init; begin inherited Init; SetSymbolType(stType); end; procedure TDbgDwarfTypeIdentifier.MemberVisibilityNeeded; var Val: TDbgSymbolMemberVisibility; begin if ReadMemberVisibility(Val) then SetMemberVisibility(Val) else inherited MemberVisibilityNeeded; end; procedure TDbgDwarfTypeIdentifier.SizeNeeded; var ByteSize: Integer; begin if InformationEntry.ReadValue(DW_AT_byte_size, ByteSize) then SetSize(ByteSize) else inherited SizeNeeded; end; function TDbgDwarfTypeIdentifier.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin Result := nil; end; function TDbgDwarfTypeIdentifier.GetValueBounds(AValueObj: TFpDbgDwarfValue; out ALowBound, AHighBound: Int64): Boolean; begin Result := HasBounds; ALowBound := OrdLowBound; AHighBound := OrdLowBound; end; class function TDbgDwarfTypeIdentifier.CreateTypeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier; var c: TDbgDwarfSymbolBaseClass; begin c := AnInformationEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(AnInformationEntry.AbbrevTag); if c.InheritsFrom(TDbgDwarfTypeIdentifier) then Result := TDbgDwarfTypeIdentifierClass(c).Create(AName, AnInformationEntry) else Result := nil; end; function TDbgDwarfTypeIdentifier.TypeCastValue(AValue: TFpDbgValue): TFpDbgValue; begin Result := GetTypedValueObject(True); If Result = nil then exit; assert(Result is TFpDbgDwarfValue); if not TFpDbgDwarfValue(Result).SetTypeCastInfo(self, AValue) then ReleaseRefAndNil(Result); end; { TDbgDwarfBaseTypeIdentifier } procedure TDbgDwarfBaseIdentifierBase.KindNeeded; var Encoding, ByteSize: Integer; begin if not InformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin DebugLn(FPDBG_DWARF_WARNINGS, ['TDbgDwarfBaseIdentifierBase.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, ['TDbgDwarfBaseIdentifierBase.KindNeeded: Unknown encoding ', DwarfBaseTypeEncodingToString(Encoding), ' for ', DwarfTagToString(InformationEntry.AbbrevTag)]); inherited KindNeeded; end; end; end; procedure TDbgDwarfBaseIdentifierBase.TypeInfoNeeded; begin SetTypeInfo(nil); end; function TDbgDwarfBaseIdentifierBase.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin case Kind of skPointer: Result := TFpDbgDwarfValuePointer.Create(Self, Size); skInteger: Result := TFpDbgDwarfValueInteger.Create(Self, Size); skCardinal: Result := TDbgDwarfValueCardinal.Create(Self, Size); skBoolean: Result := TFpDbgDwarfValueBoolean.Create(Self, Size); skChar: Result := TFpDbgDwarfValueChar.Create(Self, Size); skFloat: Result := TFpDbgDwarfValueFloat.Create(Self, Size); end; end; function TDbgDwarfBaseIdentifierBase.GetHasBounds: Boolean; begin Result := (kind = skInteger) or (kind = skCardinal); end; function TDbgDwarfBaseIdentifierBase.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 TDbgDwarfBaseIdentifierBase.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; { TDbgDwarfTypeIdentifierModifier } procedure TDbgDwarfTypeIdentifierModifier.TypeInfoNeeded; var p: TDbgDwarfTypeIdentifier; begin p := NestedTypeInfo; if p <> nil then SetTypeInfo(p.TypeInfo) else SetTypeInfo(nil); end; procedure TDbgDwarfTypeIdentifierModifier.ForwardToSymbolNeeded; begin SetForwardToSymbol(NestedTypeInfo) end; function TDbgDwarfTypeIdentifierModifier.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; var ti: TDbgDwarfTypeIdentifier; begin ti := NestedTypeInfo; if ti <> nil then Result := ti.GetTypedValueObject(ATypeCast) else Result := inherited; end; { TDbgDwarfTypeIdentifierRef } function TDbgDwarfTypeIdentifierRef.GetFlags: TDbgSymbolFlags; begin Result := (inherited GetFlags) + [sfInternalRef]; end; function TDbgDwarfTypeIdentifierRef.GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; var t: TFpDbgMemLocation; begin if ATargetType = Self then begin Result := True; exit; end; t := AValueObj.DataAddressCache[ATargetCacheIndex]; if IsInitializedLoc(t) then begin AnAddress := t; end else begin Result := CompilationUnit.Owner.MemManager <> nil; if not Result then exit; AnAddress := CompilationUnit.Owner.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize); AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress; end; Result := IsValidLoc(AnAddress); if Result then Result := inherited GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex) else if IsError(CompilationUnit.Owner.MemManager.LastError) then SetLastError(CompilationUnit.Owner.MemManager.LastError); // Todo: other error end; { TDbgDwarfTypeIdentifierDeclaration } function TDbgDwarfTypeIdentifierDeclaration.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; var ti: TDbgDwarfTypeIdentifier; 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 TDbgDwarfTypeIdentifierModifier) then begin ti := TDbgDwarfTypeIdentifier(ti.TypeInfo); if (Result = nil) then exit; end; if not (ti is TDbgDwarfTypeIdentifierPointer) then exit; ti2 := ti.NestedTypeInfo; // only if it is NOT a declaration if (ti2 <> nil) and (ti2 is TDbgDwarfIdentifierStructure) then begin TDbgDwarfTypeIdentifierPointer(ti).IsInternalPointer := True; // TODO: Flag the structure as class (save teme in KindNeeded) end; end; { TDbgDwarfIdentifierSubRange } procedure TDbgDwarfIdentifierSubRange.InitEnumIdx; var t: TDbgDwarfTypeIdentifier; 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 TDbgDwarfIdentifierSubRange.ReadBounds; var FwdInfoPtr: Pointer; FwdCompUint: TDwarfCompilationUnit; NewInfo: TDwarfInformationEntry; 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 := TDbgDwarfValueIdentifier.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 := TDbgDwarfValueIdentifier.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 FHighBoundState := rfNotFound; if InformationEntry.ReadReference(DW_AT_count, FwdInfoPtr, FwdCompUint) then begin NewInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr); FCountValue := TDbgDwarfValueIdentifier.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; function TDbgDwarfIdentifierSubRange.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; begin Result := inherited DoGetNestedTypeInfo; if Result <> nil then exit; if FLowBoundState = rfValue then Result := FLowBoundValue.TypeInfo as TDbgDwarfTypeIdentifier else if FHighBoundState = rfValue then Result := FHighBoundValue.TypeInfo as TDbgDwarfTypeIdentifier else if FCountState = rfValue then Result := FCountValue.TypeInfo as TDbgDwarfTypeIdentifier; end; function TDbgDwarfIdentifierSubRange.GetHasBounds: Boolean; begin ReadBounds; // 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 TDbgDwarfIdentifierSubRange.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 TDbgDwarfIdentifierSubRange.GetOrdLowBound: Int64; begin //if FLowBoundState = rfValue then // Result := FLowBoundValue.VALUE // TODO //else Result := FLowBoundConst; end; procedure TDbgDwarfIdentifierSubRange.NameNeeded; var AName: String; begin if InformationEntry.ReadName(AName) then SetName(AName) else SetName(''); end; procedure TDbgDwarfIdentifierSubRange.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 TDbgDwarfIdentifierSubRange.SizeNeeded; var t: TFpDbgSymbol; begin t := NestedTypeInfo; if t = nil then begin SetKind(skInteger); SetSize(CompilationUnit.AddressSize); end else SetSize(t.Size); end; function TDbgDwarfIdentifierSubRange.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 TDbgDwarfIdentifierSubRange.GetMemberCount: Integer; begin if Kind = skEnum then begin if not FEnumIdxValid then InitEnumIdx; Result := FHighEnumIdx - FLowEnumIdx + 1; end else Result := inherited GetMemberCount; end; function TDbgDwarfIdentifierSubRange.GetFlags: TDbgSymbolFlags; begin Result := (inherited GetFlags) + [sfSubRange]; end; function TDbgDwarfIdentifierSubRange.GetValueBounds(AValueObj: TFpDbgDwarfValue; out ALowBound, AHighBound: Int64): Boolean; begin ReadBounds; Result := inherited GetValueBounds(AValueObj, ALowBound, AHighBound); end; procedure TDbgDwarfIdentifierSubRange.Init; begin FLowBoundState := rfNotRead; FHighBoundState := rfNotRead; FCountState := rfNotRead; inherited Init; end; { TDbgDwarfTypeIdentifierPointer } function TDbgDwarfTypeIdentifierPointer.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 TDbgDwarfIdentifierArray); if Result then Result := (sfDynArray in ti.Flags); end; procedure TDbgDwarfTypeIdentifierPointer.TypeInfoNeeded; var p: TDbgDwarfTypeIdentifier; begin p := NestedTypeInfo; if IsInternalPointer and (p <> nil) then begin SetTypeInfo(p.TypeInfo); exit; end; SetTypeInfo(p); end; function TDbgDwarfTypeIdentifierPointer.GetIsInternalPointer: Boolean; begin Result := FIsInternalPointer or IsInternalDynArrayPointer; end; procedure TDbgDwarfTypeIdentifierPointer.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 TDbgDwarfTypeIdentifierPointer.SizeNeeded; begin SetSize(CompilationUnit.AddressSize); end; procedure TDbgDwarfTypeIdentifierPointer.ForwardToSymbolNeeded; begin if IsInternalPointer then SetForwardToSymbol(NestedTypeInfo) // Same as TypeInfo, but does not try to be forwarded else SetForwardToSymbol(nil); // inherited ForwardToSymbolNeeded; end; function TDbgDwarfTypeIdentifierPointer.GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; var t: TFpDbgMemLocation; begin if ATargetType = Self then begin Result := True; exit; end; t := AValueObj.DataAddressCache[ATargetCacheIndex]; if IsInitializedLoc(t) then begin AnAddress := t; end else begin Result := CompilationUnit.Owner.MemManager <> nil; if not Result then exit; AnAddress := CompilationUnit.Owner.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize); AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress; end; Result := IsValidLoc(AnAddress); if Result then Result := inherited GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex) else if IsError(CompilationUnit.Owner.MemManager.LastError) then SetLastError(CompilationUnit.Owner.MemManager.LastError); // Todo: other error end; function TDbgDwarfTypeIdentifierPointer.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin if IsInternalPointer then Result := NestedTypeInfo.GetTypedValueObject(ATypeCast) else Result := TFpDbgDwarfValuePointer.Create(Self, CompilationUnit.AddressSize); end; function TDbgDwarfTypeIdentifierPointer.DataSize: Integer; begin if Kind = skClass then Result := NestedTypeInfo.Size else Result := inherited DataSize; end; { TDbgDwarfIdentifierEnumElement } procedure TDbgDwarfIdentifierEnumMember.ReadOrdinalValue; begin if FOrdinalValueRead then exit; FOrdinalValueRead := True; FHasOrdinalValue := InformationEntry.ReadValue(DW_AT_const_value, FOrdinalValue); end; procedure TDbgDwarfIdentifierEnumMember.KindNeeded; begin SetKind(skEnumValue); end; function TDbgDwarfIdentifierEnumMember.GetHasOrdinalValue: Boolean; begin ReadOrdinalValue; Result := FHasOrdinalValue; end; function TDbgDwarfIdentifierEnumMember.GetOrdinalValue: Int64; begin ReadOrdinalValue; Result := FOrdinalValue; end; procedure TDbgDwarfIdentifierEnumMember.Init; begin FOrdinalValueRead := False; inherited Init; end; function TDbgDwarfIdentifierEnumMember.GetValueObject: TFpDbgValue; begin Result := FValueObject; if Result <> nil then exit; FValueObject := TFpDbgDwarfValueEnumMember.Create(Self); FValueObject.MakePlainRefToCirclular; FValueObject.SetValueSymbol(self); Result := FValueObject; end; { TDbgDwarfIdentifierEnum } procedure TDbgDwarfIdentifierEnum.CreateMembers; var Info, Info2: TDwarfInformationEntry; sym: TDbgDwarfIdentifier; 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 := TDbgDwarfIdentifier.CreateSubClass('', Info2); FMembers.Add(sym); sym.ReleaseReference; sym.ParentTypeInfo := self; Info2.ReleaseReference; end; Info.GoNext; end; Info.ReleaseReference; end; function TDbgDwarfIdentifierEnum.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin Result := TFpDbgDwarfValueEnum.Create(Self, Size); end; procedure TDbgDwarfIdentifierEnum.KindNeeded; begin SetKind(skEnum); end; function TDbgDwarfIdentifierEnum.GetMember(AIndex: Int64): TFpDbgSymbol; begin CreateMembers; Result := TFpDbgSymbol(FMembers[AIndex]); end; function TDbgDwarfIdentifierEnum.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 TDbgDwarfIdentifierEnum.GetMemberCount: Integer; begin CreateMembers; Result := FMembers.Count; end; function TDbgDwarfIdentifierEnum.GetHasBounds: Boolean; begin Result := True; end; function TDbgDwarfIdentifierEnum.GetOrdHighBound: Int64; var c: Integer; begin c := MemberCount; if c > 0 then Result := Member[c-1].OrdinalValue else Result := -1; end; function TDbgDwarfIdentifierEnum.GetOrdLowBound: Int64; var c: Integer; begin c := MemberCount; if c > 0 then Result := Member[0].OrdinalValue else Result := 0; end; destructor TDbgDwarfIdentifierEnum.Destroy; var i: Integer; begin if FMembers <> nil then for i := 0 to FMembers.Count - 1 do TDbgDwarfIdentifier(FMembers[i]).ParentTypeInfo := nil; FreeAndNil(FMembers); inherited Destroy; end; { TDbgDwarfIdentifierSet } procedure TDbgDwarfIdentifierSet.KindNeeded; begin SetKind(skSet); end; function TDbgDwarfIdentifierSet.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin Result := TFpDbgDwarfValueSet.Create(Self, Size); end; function TDbgDwarfIdentifierSet.GetMemberCount: Integer; begin if TypeInfo.Kind = skEnum then Result := TypeInfo.MemberCount else Result := inherited GetMemberCount; end; function TDbgDwarfIdentifierSet.GetMember(AIndex: Int64): TFpDbgSymbol; begin if TypeInfo.Kind = skEnum then Result := TypeInfo.Member[AIndex] else Result := inherited GetMember(AIndex); end; { TDbgDwarfIdentifierMember } function TDbgDwarfIdentifierMember.InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; var BaseAddr: TFpDbgMemLocation; begin Result := inherited InitLocationParser(ALocationParser, AValueObj, AnObjectDataAddress); if not Result then exit; if AValueObj = nil then debugln(['TDbgDwarfIdentifierMember.InitLocationParser: NO VAl Obj !!!!!!!!!!!!!!!']) else if AValueObj.StructureValue = nil then debugln(['TDbgDwarfIdentifierMember.InitLocationParser: NO STRUCT Obj !!!!!!!!!!!!!!!']); if (AValueObj <> nil) and (AValueObj.StructureValue <> nil) and (ParentTypeInfo <> nil) then begin Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), ''); if AValueObj.GetStructureDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin ALocationParser.Push(BaseAddr, lseValue); exit end; //TODO: AValueObj.StructureValue.LastError end; debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfIdentifierMember.InitLocationParser Error: ',ErrorCode(LastError),' ValueObject=', DbgSName(FValueObject)]); if not IsError(LastError) then SetLastError(CreateError(fpErrLocationParserInit)); Result := False; end; function TDbgDwarfIdentifierMember.GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; begin AnAddress := AValueObj.DataAddressCache[0]; Result := IsValidLoc(AnAddress); if IsInitializedLoc(AnAddress) then exit; Result := LocationFromTag(DW_AT_data_member_location, AValueObj, AnAddress, InvalidLoc); AValueObj.DataAddressCache[0] := AnAddress; end; function TDbgDwarfIdentifierMember.HasAddress: Boolean; begin Result := (InformationEntry.HasAttrib(DW_AT_data_member_location)); end; { TDbgDwarfIdentifierStructure } function TDbgDwarfIdentifierStructure.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 := TDbgDwarfIdentifier.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 TDbgDwarfIdentifierStructure.GetMemberCount: Integer; begin CreateMembers; Result := FMembers.Count; end; function TDbgDwarfIdentifierStructure.InitLocationParser(const ALocationParser: TDwarfLocationExpression; AValueObj: TFpDbgDwarfValue; AnObjectDataAddress: TFpDbgMemLocation): Boolean; begin Result := inherited InitLocationParser(ALocationParser, AValueObj, AnObjectDataAddress); if not Result then exit; // CURRENTLY ONLY USED for DW_AT_data_member_location if IsReadableLoc(AnObjectDataAddress) then begin debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarfIdentifierStructure.InitLocationParser ', dbgs(AnObjectDataAddress)]); ALocationParser.Push(AnObjectDataAddress, lseValue); exit; end; //TODO: error debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfIdentifierStructure.InitLocationParser no ObjectDataAddress ', dbgs(AnObjectDataAddress)]); if not IsError(LastError) then SetLastError(CreateError(fpErrLocationParserInit)); Result := False; end; function TDbgDwarfIdentifierStructure.GetDataAddress(AValueObj: TFpDbgDwarfValue; var AnAddress: TFpDbgMemLocation; ATargetType: TDbgDwarfTypeIdentifier; ATargetCacheIndex: Integer): Boolean; var t: TFpDbgMemLocation; begin if ATargetType = Self then begin Result := True; exit; end; t := AValueObj.DataAddressCache[ATargetCacheIndex]; if IsInitializedLoc(t) then begin AnAddress := t; Result := IsValidLoc(AnAddress); end else begin InitInheritanceInfo; //TODO: may be a constant // offset Result := LocationFromTag(DW_AT_data_member_location, AValueObj, t, AnAddress, FInheritanceInfo); if not Result then exit; AnAddress := t; AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress; end; Result := inherited GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex); end; function TDbgDwarfIdentifierStructure.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 TDbgDwarfIdentifierStructure.Destroy; var i: Integer; begin ReleaseRefAndNil(FInheritanceInfo); if FMembers <> nil then begin for i := 0 to FMembers.Count - 1 do TDbgDwarfIdentifier(FMembers[i]).ParentTypeInfo := nil; FreeAndNil(FMembers); end; if FLastChildByName <> nil then begin FLastChildByName.ParentTypeInfo := nil; FLastChildByName.ReleaseCirclularReference; FLastChildByName := nil; end; inherited Destroy; end; procedure TDbgDwarfIdentifierStructure.CreateMembers; var Info: TDwarfInformationEntry; Info2: TDwarfInformationEntry; sym: TDbgDwarfIdentifier; 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 := TDbgDwarfIdentifier.CreateSubClass('', Info2); FMembers.Add(sym); sym.ReleaseReference; sym.ParentTypeInfo := self; Info2.ReleaseReference; end; Info.GoNext; end; Info.ReleaseReference; end; procedure TDbgDwarfIdentifierStructure.InitInheritanceInfo; begin if FInheritanceInfo = nil then FInheritanceInfo := InformationEntry.FindChildByTag(DW_TAG_inheritance); end; function TDbgDwarfIdentifierStructure.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; 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 := TDbgDwarfTypeIdentifier.CreateTypeSubClass('', ParentInfo); ParentInfo.ReleaseReference; end; end; procedure TDbgDwarfIdentifierStructure.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 TDbgDwarfIdentifierStructure.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin if ATypeCast then Result := TFpDbgDwarfValueStructTypeCast.Create(Self) else Result := TFpDbgDwarfValueStruct.Create(Self); end; { TDbgDwarfIdentifierArray } procedure TDbgDwarfIdentifierArray.CreateMembers; var Info, Info2: TDwarfInformationEntry; t: Cardinal; sym: TDbgDwarfIdentifier; 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 := TDbgDwarfIdentifier.CreateSubClass('', Info2); FMembers.Add(sym); sym.ReleaseReference; sym.ParentTypeInfo := self; Info2.ReleaseReference; end; Info.GoNext; end; Info.ReleaseReference; end; procedure TDbgDwarfIdentifierArray.ReadStride; var t: TDbgDwarfTypeIdentifier; begin if didtStrideRead in FDwarfArrayReadFlags then exit; Include(FDwarfArrayReadFlags, didtStrideRead); if not InformationEntry.ReadValue(DW_AT_bit_stride, FStrideInBits) then begin t := NestedTypeInfo; if t = nil then FStrideInBits := 0 else FStrideInBits := t.Size * 8; end; end; procedure TDbgDwarfIdentifierArray.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 TDbgDwarfIdentifierArray.KindNeeded; begin SetKind(skArray); // Todo: static/dynamic? end; function TDbgDwarfIdentifierArray.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; begin Result := TFpDbgDwarfValueArray.Create(Self); end; function TDbgDwarfIdentifierArray.GetFlags: TDbgSymbolFlags; function IsDynSubRange(m: TDbgDwarfIdentifier): Boolean; begin Result := sfSubRange in m.Flags; if not Result then exit; while (m <> nil) and not(m is TDbgDwarfIdentifierSubRange) do m := m.NestedTypeInfo; Result := m <> nil; if not Result then exit; // TODO: should not happen, handle error Result := TDbgDwarfIdentifierSubRange(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(TDbgDwarfIdentifier(m))) then Result := Result + [sfDynArray] else Result := Result + [sfStatArray]; end else Result := Result + [sfStatArray]; end; function TDbgDwarfIdentifierArray.GetMember(AIndex: Int64): TFpDbgSymbol; begin CreateMembers; Result := TFpDbgSymbol(FMembers[AIndex]); end; function TDbgDwarfIdentifierArray.GetMemberByName(AIndex: String): TFpDbgSymbol; begin Result := nil; // no named members end; function TDbgDwarfIdentifierArray.GetMemberCount: Integer; begin CreateMembers; Result := FMembers.Count; end; function TDbgDwarfIdentifierArray.GetMemberAddress(AValObject: TFpDbgDwarfValue; AIndex: array of Int64): TFpDbgMemLocation; var Idx, Offs, Factor: Int64; i: Integer; bsize: Integer; m: TDbgDwarfIdentifier; begin assert((AValObject is TFpDbgDwarfValueArray), 'TDbgDwarfIdentifierArray.GetMemberAddress AValObject'); ReadOrdering; ReadStride; Result := InvalidLoc; if (FStrideInBits <= 0) or (FStrideInBits mod 8 <> 0) then exit; CreateMembers; if Length(AIndex) > FMembers.Count then exit; if AValObject is TFpDbgDwarfValueArray then begin if not TFpDbgDwarfValueArray(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 := TDbgDwarfIdentifier(FMembers[i]); if 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 := TDbgDwarfIdentifier(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 TDbgDwarfIdentifierArray.Destroy; var i: Integer; begin if FMembers <> nil then begin for i := 0 to FMembers.Count - 1 do TDbgDwarfIdentifier(FMembers[i]).ParentTypeInfo := nil; FreeAndNil(FMembers); end; inherited Destroy; end; { TDbgDwarfSymbol } constructor TDbgDwarfProcSymbol.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 TDbgDwarfProcSymbol.Destroy; begin 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 TDbgDwarfProcSymbol.GetColumn: Cardinal; begin if StateMachineValid then Result := FStateMachine.Column else Result := inherited GetColumn; end; function TDbgDwarfProcSymbol.GetFile: String; begin if StateMachineValid then Result := FStateMachine.FileName else Result := inherited GetFile; end; function TDbgDwarfProcSymbol.GetLine: Cardinal; begin if StateMachineValid then Result := FStateMachine.Line else Result := inherited GetLine; end; function TDbgDwarfProcSymbol.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 TDbgDwarfProcSymbol.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; function TDbgDwarfProcSymbol.GetFrameBase: 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, ['TDbgDwarfProcSymbol.GetFrameBase failed to read DW_AT_frame_base']); exit; end; if Length(Val) = 0 then begin // error debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase failed to read DW_AT_location']); exit; end; FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit); FFrameBaseParser.Evaluate; if FFrameBaseParser.ResultKind in [lseValue] then Result := FFrameBaseParser.ResultData; if IsError(FFrameBaseParser.LastError) then begin SetLastError(FFrameBaseParser.LastError); debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(LastError)]); end else if Result = 0 then begin debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed. result is 0']); end; end; end; procedure TDbgDwarfProcSymbol.KindNeeded; begin if TypeInfo <> nil then SetKind(skFunction) else SetKind(skProcedure); end; procedure TDbgDwarfProcSymbol.SizeNeeded; begin SetSize(FAddressInfo^.EndPC - FAddressInfo^.StartPC); end; function TDbgDwarfProcSymbol.GetFlags: TDbgSymbolFlags; var flg: TDbgSymbolFlags; begin Result := inherited GetFlags; if ReadVirtuality(flg) then Result := Result + flg; end; function TDbgDwarfProcSymbol.GetSelfParameter(AnAddress: TDbgPtr): TFpDbgDwarfValue; 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 := TFpDbgDwarfValue(TDbgDwarfValueIdentifier.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, ['TDbgDwarfProcSymbol.GetSelfParameter ', InfoEntry.ScopeDebugText, DbgSName(Result)]); end; end; end; InfoEntry.ReleaseReference; end; { TDbgDwarfIdentifierVariable } function TDbgDwarfIdentifierVariable.GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; begin AnAddress := AValueObj.DataAddressCache[0]; Result := IsValidLoc(AnAddress); if IsInitializedLoc(AnAddress) then exit; Result := LocationFromTag(DW_AT_location, AValueObj, AnAddress, InvalidLoc); AValueObj.DataAddressCache[0] := AnAddress; end; function TDbgDwarfIdentifierVariable.HasAddress: Boolean; begin Result := InformationEntry.HasAttrib(DW_AT_location); end; { TDbgDwarfIdentifierParameter } function TDbgDwarfIdentifierParameter.GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; begin AnAddress := AValueObj.DataAddressCache[0]; Result := IsValidLoc(AnAddress); if IsInitializedLoc(AnAddress) then exit; Result := LocationFromTag(DW_AT_location, AValueObj, AnAddress, InvalidLoc); AValueObj.DataAddressCache[0] := AnAddress; end; function TDbgDwarfIdentifierParameter.HasAddress: Boolean; begin Result := InformationEntry.HasAttrib(DW_AT_location); end; { TDbgDwarfUnit } procedure TDbgDwarfUnit.Init; begin inherited Init; SetSymbolType(stNone); SetKind(skUnit); end; function TDbgDwarfUnit.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 := TDbgDwarfIdentifier.CreateSubClass('', Ident); // No need to set ParentTypeInfo ReleaseRefAndNil(Ident); FLastChildByName := Result; end; destructor TDbgDwarfUnit.Destroy; begin ReleaseRefAndNil(FLastChildByName); inherited Destroy; end; initialization DwarfSymbolClassMapList.SetDefaultMap(TFpDwarfDefaultSymbolClassMap); 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.