paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-01 19:43:37 +02:00
Code Issues Packages Projects Releases Wiki Activity
0473f430ec
lazarus/components/fpdebug/fpdbgdwarfdataclasses.pas
martin 5191e4d8a2 FpDebug: Added some safety checks 
git-svn-id: trunk@65144 -
2021-05-28 16:19:23 +00:00

4962 lines
152 KiB
ObjectPascal
Raw Blame History

{
---------------------------------------------------------------------------
fpdbgdwarfdataclasses.pas - Native Freepascal debugger - Dwarf symbol reader
---------------------------------------------------------------------------
This unit contains helper classes for loading and resolving of DWARF debug
symbols
---------------------------------------------------------------------------
@created(Mon Aug 1st WET 2006)
@lastmod($Date$)
@author(Marc Weustink <marc@@dommelstein.nl>)
@author(Martin Friebe)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit FpDbgDwarfDataClasses;
{$mode objfpc}{$H+}
//{$INLINE OFF}
{off $DEFINE USE_ABBREV_TMAP}
interface
uses
Classes, Types, SysUtils, contnrs, Math,
Maps, LazClasses, LazFileUtils, LazLoggerBase, LazUTF8,
// FpDebug
FpDbgUtil, FpDbgInfo, FpDbgDwarfConst,
FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages, DbgIntfBaseTypes;
type
TDwarfSection = (dsAbbrev, dsARanges, dsFrame, dsInfo, dsLine, dsLoc, dsMacinfo, dsPubNames, dsPubTypes, dsRanges, dsStr);
const
DWARF_SECTION_NAME: array[TDwarfSection] of String = (
'.debug_abbrev', '.debug_aranges', '.debug_frame', '.debug_info',
'.debug_line', '.debug_loc', '.debug_macinfo', '.debug_pubnames',
'.debug_pubtypes', '.debug_ranges', '.debug_str'
);
type
TFpDwarfInfo = class;
TDwarfCompilationUnit = class;
{%region Dwarf Header Structures }
// compilation unit header
{$PACKRECORDS 1}
PDwarfCUHeader32 = ^TDwarfCUHeader32;
TDwarfCUHeader32 = record
Length: LongWord;
Version: Word;
AbbrevOffset: LongWord;
AddressSize: Byte;
end;
PDwarfCUHeader64 = ^TDwarfCUHeader64;
TDwarfCUHeader64 = record
Signature: LongWord;
Length: QWord;
Version: Word;
AbbrevOffset: QWord;
AddressSize: Byte;
end;
// Line number program header
PDwarfLNPInfoHeader = ^TDwarfLNPInfoHeader;
TDwarfLNPInfoHeader = record
MinimumInstructionLength: Byte;
DefaultIsStmt: Byte;
LineBase: ShortInt;
LineRange: Byte;
OpcodeBase: Byte;
StandardOpcodeLengths: record end; {array[1..OpcodeBase-1] of Byte}
{IncludeDirectories: asciiz, asciiz..z}
{FileNames: asciiz, asciiz..z}
end;
PDwarfLNPHeader32 = ^TDwarfLNPHeader32;
TDwarfLNPHeader32 = record
UnitLength: LongWord;
Version: Word;
HeaderLength: LongWord;
Info: TDwarfLNPInfoHeader;
end;
PDwarfLNPHeader64 = ^TDwarfLNPHeader64;
TDwarfLNPHeader64 = record
Signature: LongWord;
UnitLength: QWord;
Version: Word;
HeaderLength: QWord;
Info: TDwarfLNPInfoHeader;
end;
{$PACKRECORDS C}
{%endregion Dwarf Header Structures }
const
KnownNameHashesBitMask = $7FF; // 256 bytes
type
TKnownNameHashesArray = bitpacked array [0..KnownNameHashesBitMask] of Boolean;
PKnownNameHashesArray = ^TKnownNameHashesArray;
{%region Abbreviation Data / Section "debug_abbrev"}
{ TDwarfAbbrev }
TDwarfAbbrevFlag = (
dafHasChildren,
dafHasName,
dafHasLowAddr,
dafHasStartScope,
dafHasAbstractOrigin
);
TDwarfAbbrevFlags = set of TDwarfAbbrevFlag;
TDwarfAbbrev = record
tag: Cardinal;
index: Integer;
count: SmallInt; // Integer;
flags: TDwarfAbbrevFlags;
end;
PDwarfAbbrev = ^TDwarfAbbrev;
TDwarfAbbrevEntry = record
Attribute: Cardinal;
Form: Cardinal;
end;
PDwarfAbbrevEntry = ^TDwarfAbbrevEntry;
TLeb128TableEntry = record
LeadLow, LeadHigh: Byte; // bytes >= 128, more to follow
EndLow, EndHigh: Byte; // bytes < 128, pointer to data
LeadIndex: cardinal; // first index in LeadTableData
EndIndex: cardinal; // first index in EndTableData
end;
PLeb128TableEntry = ^TLeb128TableEntry;
TPointerDynArray = array of Pointer;
TAttribPointerList = record
List: TPointerDynArray;
Abbrev: PDwarfAbbrev;
EvalCount: Integer;
end;
{ TLEB128PreFixTree }
TLEB128PreFixTree = class
private
FTableList: Array of TLeb128TableEntry;
FTableListGaps: Array of record LeadTable, EndTable: Byte; end;
FTableListNextFreeIndex: Cardinal;
FLeadTableData: Array of Cardinal; // Next Table number
FLeadTableNextFreeIndex: Cardinal;
FEndTableData: Array of TDwarfAbbrev; //Pointer;
FEndTableNextFreeIndex: Cardinal;
FDataGrowStep, FTableListGrowStep: Cardinal;
protected
public
procedure SetCapacity(ACapacity: integer);
procedure Finish;
function AddLeb128FromPointer(APointer: Pointer; const AData: TDwarfAbbrev): Pointer;
function FindLe128bFromPointer(APointer: Pointer; out AData: PDwarfAbbrev): Pointer; // returnns pointer to first address after LEB128
function FindLe128bFromPointer(APointer: Pointer; out AData: TDwarfAbbrev): Pointer; inline; // returnns pointer to first address after LEB128
end;
{ TDwarfAbbrevList }
TDwarfAbbrevList = class{$IFnDEF USE_ABBREV_TMAP}(TLEB128PreFixTree){$Endif}
private
FAbbrDataEnd: Pointer;
{$IFDEF USE_ABBREV_TMAP}
FMap: TMap; // Abbrevs
{$Endif}
FDefinitions: array of TDwarfAbbrevEntry;
function GetEntryPointer(AIndex: Integer): PDwarfAbbrevEntry; inline;
protected
procedure LoadAbbrevs(AnAbbrevDataPtr: Pointer);
public
constructor Create(AnAbbrData, AnAbbrDataEnd: Pointer; AnAbbrevOffset, AInfoLen: QWord);
destructor Destroy; override;
{$IFDEF USE_ABBREV_TMAP}
function FindLe128bFromPointer(AnAbbrevPtr: Pointer; out AData: TDwarfAbbrev{Pointer}): Pointer; reintroduce;
{$Endif}
property EntryPointer[AIndex: Integer]: PDwarfAbbrevEntry read GetEntryPointer;
end;
{%endregion Abbreviation Data / Section "debug_abbrev"}
TNameSearchInfo = record
NameUpper, NameLower: String;
NameHash: Word;
end;
{%region Information Entry / Section "debug_info"}
(* Link, can either be
- "Next Sibling" (for the parent): Link will be greater than current index
- "Parent": Link will be smaller than current index
By Default link is "Parent".
A first child does not need a "Parent" link (Parent is always at CurrentIndex - 1),
it will therefore store "Parent"."Next Sibling"
A first Child of a parent with no Next sibling, has Link = Parent
"Next Sibling" is either CurrentIndex + 1 (no children), or can be found via
the first childs link.
A Sibling has the same Parent. (If there is no child, and CurrentIndex+1 has
a diff parent, then there is no Next)
TopLevel Scopes have Link=-1
*)
TDwarfScopeInfoRec = record
Link: Integer;
Entry: Pointer;
NameHash: Word;
end;
PDwarfScopeInfoRec = ^TDwarfScopeInfoRec;
TDwarfScopeArray = Array of TDwarfScopeInfoRec;
TDwarfScopeList = record
List: TDwarfScopeArray;
HighestKnown: Integer;
end;
PDwarfScopeList = ^TDwarfScopeList;
{ TDwarfScopeInfo }
TDwarfScopeInfo = object
private
FScopeList: PDwarfScopeList;
FIndex: Integer;
function GetChild: TDwarfScopeInfo; inline;
function GetChildIndex: Integer; inline;
function GetCurrent: PDwarfScopeInfoRec;
function GetEntry: Pointer; inline;
function GetNext: TDwarfScopeInfo; inline;
function GetNextIndex: Integer; inline;
function GetParent: TDwarfScopeInfo; inline;
function GetParentIndex: Integer;
procedure SetIndex(AIndex: Integer);
function CreateScopeForEntry(AEntry: Pointer; ALink: Integer): Integer; inline;
public
procedure Init(AScopeList: PDwarfScopeList);
function CreateNextForEntry(AEntry: Pointer): Integer; inline;
function CreateChildForEntry(AEntry: Pointer): Integer; inline;
function IsValid: Boolean; inline;
property Index: Integer read FIndex write SetIndex;
property Entry: Pointer read GetEntry;
property Current: PDwarfScopeInfoRec read GetCurrent;
function HasParent: Boolean; inline;
function HasNext: Boolean; inline;
function HasChild: Boolean; inline;
procedure GoParent; inline;
procedure GoNext; inline;
procedure GoChild; inline;
property Parent: TDwarfScopeInfo read GetParent;
property ParentIndex: Integer read GetParentIndex;
property Next: TDwarfScopeInfo read GetNext;
property NextIndex: Integer read GetNextIndex;
property Child: TDwarfScopeInfo read GetChild;
property ChildIndex: Integer read GetChildIndex;
end;
{ TDwarfInformationEntry }
TDwarfInformationEntry = class;
TDwarfAttribData = record
Idx: Integer;
InfoPointer: pointer;
InformationEntry: TDwarfInformationEntry;
end;
TDwarfInformationEntry = class(TRefCountedObject)
private
FCompUnit: TDwarfCompilationUnit;
FInformationEntry: Pointer; // pointer to the LEB128 Abbrev at the start of an Information entry in debug_info
FInformationData: Pointer; // poinetr after the LEB128
FScope: TDwarfScopeInfo;
FAbbrev: PDwarfAbbrev;
FAbbrevData: PDwarfAbbrevEntry;
FAbstractOrigin: TDwarfInformationEntry;
FFlags: set of (dieAbbrevValid, dieAbbrevDataValid, dieAbstractOriginValid);
function GetAttribForm(AnIdx: Integer): Cardinal;
procedure PrepareAbbrev; inline;
function PrepareAbbrevData: Boolean; inline;
function PrepareAbstractOrigin: Boolean; inline; // Onli call, if abbrev is valid AND dafHasAbstractOrigin set
function SearchScope: Boolean;
function MaybeSearchScope: Boolean; inline;
procedure ScopeChanged; inline;
function GetAbbrevTag: Cardinal; inline;
function GetScopeIndex: Integer;
procedure SetScopeIndex(AValue: Integer);
function DoReadReference(InfoIdx: Integer; InfoData: pointer;
out AValue: Pointer; out ACompUnit: TDwarfCompilationUnit): Boolean;
public
constructor Create(ACompUnit: TDwarfCompilationUnit; AnInformationEntry: Pointer);
constructor Create(ACompUnit: TDwarfCompilationUnit; AScope: TDwarfScopeInfo);
destructor Destroy; override;
property CompUnit: TDwarfCompilationUnit read FCompUnit;
function GetAttribData(AnAttrib: Cardinal; out AnAttribData: TDwarfAttribData): Boolean;
function HasAttrib(AnAttrib: Cardinal): Boolean; inline;
property AttribForm[AnIdx: Integer]: Cardinal read GetAttribForm;
procedure ComputeKnownHashes(AKNownHashes: PKnownNameHashesArray);
function GoNamedChild(const AName: String): Boolean;
// find in enum too // TODO: control search with a flags param, if needed
function GoNamedChildEx(const ANameInfo: TNameSearchInfo): Boolean;
// GoNamedChildMatchCaseEx will use
// - UpperName for Hash
// - LowerName for compare
// GoNamedChildMatchCaseEx does not search in enums
function GoNamedChildMatchCaseEx(const ANameInfo: TNameSearchInfo): Boolean;
function GoNamedChildEx(const AName: String): Boolean; inline;
function FindNamedChild(const AName: String): TDwarfInformationEntry;
function FindChildByTag(ATag: Cardinal): TDwarfInformationEntry;
function FirstChild: TDwarfInformationEntry;
function Clone: TDwarfInformationEntry;
property AbbrevTag: Cardinal read GetAbbrevTag;
property InfoScope: TDwarfScopeInfo read FScope;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: Integer): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: Int64): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: Cardinal): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: QWord): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: PChar): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: String): Boolean; inline;
function ReadValue(const AnAttribData: TDwarfAttribData; out AValue: TByteDynArray; AnFormString: Boolean = False): Boolean; inline;
function ReadAddressValue(const AnAttribData: TDwarfAttribData; out AValue: TDBGPtr): Boolean; inline;
function ReadReference(const AnAttribData: TDwarfAttribData; out AValue: Pointer; out ACompUnit: TDwarfCompilationUnit): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: Integer): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: Int64): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: Cardinal): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: QWord): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: PChar): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: String): Boolean; inline;
function ReadValue(AnAttrib: Cardinal; out AValue: TByteDynArray; AnFormString: Boolean = False): Boolean; inline;
function ReadReference(AnAttrib: Cardinal; out AValue: Pointer; out ACompUnit: TDwarfCompilationUnit): Boolean; inline;
function ReadName(out AName: String): Boolean; inline;
function ReadName(out AName: PChar): Boolean; inline;
function ReadStartScope(out AStartScope: TDbgPtr): Boolean; inline;
function IsAddressInStartScope(AnAddress: TDbgPtr): Boolean; inline;
function IsArtificial: Boolean; inline;
public
// Scope
procedure GoParent; inline;
procedure GoNext; inline;
procedure GoChild; inline;
function HasValidScope: Boolean; inline;
property ScopeIndex: Integer read GetScopeIndex write SetScopeIndex;
function ScopeDebugText: String;
end;
{%endregion Information Entry / Section "debug_info"}
{%region Line Info / Section "debug_line"}
{ TDwarfLineInfoStateMachine }
TDwarfLineInfoStateMachine = class(TObject)
private
FOwner: TDwarfCompilationUnit;
FLineInfoPtr: Pointer;
FMaxPtr: Pointer;
FEnded: Boolean;
FAddress: QWord;
FFileName: String;
FLine: Cardinal;
FColumn: Cardinal;
FIsStmt: Boolean;
FBasicBlock: Boolean;
FEndSequence: Boolean;
FPrologueEnd: Boolean;
FEpilogueBegin: Boolean;
FIsa: QWord;
procedure SetFileName(AIndex: Cardinal);
protected
public
constructor Create(AOwner: TDwarfCompilationUnit; ALineInfoPtr, AMaxPtr: Pointer);
function Clone: TDwarfLineInfoStateMachine;
function NextLine: Boolean;
procedure Reset;
property Address: QWord read FAddress;
property FileName: String read FFileName;
property Line: Cardinal read FLine;
property Column: Cardinal read FColumn;
property IsStmt: Boolean read FIsStmt;
property BasicBlock: Boolean read FBasicBlock;
property EndSequence: Boolean read FEndSequence;
property PrologueEnd: Boolean read FPrologueEnd;
property EpilogueBegin: Boolean read FEpilogueBegin;
property Isa: QWord read FIsa;
property Ended: Boolean read FEnded;
end;
PDwarfAddressInfo = ^TDwarfAddressInfo;
TDwarfAddressInfo = record
ScopeIndex: Integer;
ScopeList: PDwarfScopeList;
StartPC: QWord;
EndPC: QWord;
StateMachine: TDwarfLineInfoStateMachine; // set if info found
Name: PChar;
end;
{ TDWarfLineMap }
TDWarfLineMap = object
private
// FLineIndexList[ line div 256 ]
FLineIndexList: Array of record
LineOffsets: Array of Byte;
Addresses: Array of TDBGPtr;
end;
public
procedure Init;
procedure SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr); inline;
function GetAddressesForLine(ALine: Cardinal; var AResultList: TDBGPtrArray;
NoData: Boolean = False): Boolean; inline;
// NoData: only return True/False, but nothing in AResultList
procedure Compress;
end;
PDWarfLineMap = ^TDWarfLineMap;
{%endregion Line Info / Section "debug_line"}
{%region Base classes for handling Symbols in unit FPDbgDwarf}
{ TDbgDwarfSymbolBase }
TDbgDwarfSymbolBase = class(TFpSymbolForwarder)
private
FCU: TDwarfCompilationUnit;
FInformationEntry: TDwarfInformationEntry;
protected
procedure Init; virtual;
public
constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry);
constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry;
AKind: TDbgSymbolKind; AAddress: TFpDbgMemLocation);
destructor Destroy; override;
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; virtual; overload;
property CompilationUnit: TDwarfCompilationUnit read FCU;
property InformationEntry: TDwarfInformationEntry read FInformationEntry;
end;
TDbgDwarfSymbolBaseClass = class of TDbgDwarfSymbolBase;
{ TFpSymbolDwarfClassMap
Provides Symbol and VAlue evaluation classes depending on the compiler
}
PFpDwarfSymbolClassMap = ^TFpSymbolDwarfClassMap;
TFpSymbolDwarfClassMap = class
private
NextExistingClassMap: TFpSymbolDwarfClassMap;
protected
function CanHandleCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): Boolean; virtual;
class function GetExistingClassMap: PFpDwarfSymbolClassMap; virtual; abstract; // Each class must have its own storage
class function DoGetInstanceForCompUnit(ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpSymbolDwarfClassMap;
public
class function GetInstanceForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap; virtual;
class procedure FreeAllInstances;
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; virtual; abstract;
public
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); virtual;
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; virtual; abstract;
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; virtual; abstract;
function CreateUnitSymbol(ACompilationUnit: TDwarfCompilationUnit;
AInfoEntry: TDwarfInformationEntry; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; virtual; abstract;
end;
TFpSymbolDwarfClassMapClass = class of TFpSymbolDwarfClassMap;
{ TFpSymbolDwarfClassMapList }
TFpSymbolDwarfClassMapList = class
private
FDefaultMap: TFpSymbolDwarfClassMapClass;
FMapList: array of TFpSymbolDwarfClassMapClass;
public
destructor Destroy; override;
function FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
procedure FreeAllInstances;
procedure AddMap(AMap: TFpSymbolDwarfClassMapClass);
procedure SetDefaultMap(AMap: TFpSymbolDwarfClassMapClass);
end;
{%endregion Base classes for handling Symbols in unit FPDbgDwarf}
TDwarfSectionInfo = record
Section: TDwarfSection;
VirtualAddress: QWord;
Size: QWord; // the virtual size
RawData: Pointer;
end;
PDwarfSectionInfo = ^TDwarfSectionInfo;
TDwarfDebugFile = record
Sections: array[TDwarfSection] of TDwarfSectionInfo;
AddressMapList: TDbgAddressMapList;
end;
PDwarfDebugFile = ^TDwarfDebugFile;
{ TFpThreadWorkerComputeNameHashes }
TFpThreadWorkerComputeNameHashes = class(TFpThreadWorkerItem)
protected
FCU: TDwarfCompilationUnit;
FReadyToRun: Cardinal;
procedure DoExecute; override;
public
constructor Create(CU: TDwarfCompilationUnit);
procedure MarkReadyToRun; // will queue to run on the 2nd call
end;
{ TFpThreadWorkerScanAll }
TFpThreadWorkerScanAll = class(TFpThreadWorkerItem)
protected
FCU: TDwarfCompilationUnit;
FCompNameHashWorker: TFpThreadWorkerComputeNameHashes;
procedure DoExecute; override;
public
constructor Create(CU: TDwarfCompilationUnit; ACompNameHashWorker: TFpThreadWorkerComputeNameHashes);
end;
{ TDwarfCompilationUnit }
TDwarfCompilationUnitClass = class of TDwarfCompilationUnit;
TDwarfCompilationUnit = class
private
FOwner: TFpDwarfInfo;
FDebugFile: PDwarfDebugFile;
FDwarfSymbolClassMap: TFpSymbolDwarfClassMap;
FValid: Boolean; // set if the compilationunit has compile unit tag.
// --- Header ---
FLength: QWord; // length of info
FVersion: Word;
FAbbrevOffset: QWord;
FAddressSize: Byte; // the address size of the target in bytes
FIsDwarf64: Boolean; // Set if the dwarf info in this unit is 64bit
// ------
FInfoData: Pointer;
FFileName: String;
FCompDir: String;
FUnitName: String;
FIdentifierCase: Integer;
FProducer: String;
FAbbrevList: TDwarfAbbrevList;
{$IFDEF DwarfTestAccess} public {$ENDIF}
FLineInfo: record
Header: Pointer;
DataStart: Pointer;
DataEnd: Pointer;
Valid: Boolean;
Addr64: Boolean;
MinimumInstructionLength: Byte;
DefaultIsStmt: Boolean;
LineBase: ShortInt;
LineRange: Byte;
StandardOpcodeLengths: array of Byte; //record end; {array[1..OpcodeBase-1] of Byte}
Directories: TStringList;
FileNames: TStringList;
// the line info is build incrementy when needed
StateMachine: TDwarfLineInfoStateMachine;
StateMachines: TFPObjectList; // list of state machines to be freed
end;
{$IFDEF DwarfTestAccess} private {$ENDIF}
FLineNumberMap: TStringListUTF8Fast;
FAddressMap: TMap; // Holds a key for each DW_TAG_subprogram / TFpSymbolDwarfDataProc, stores TDwarfAddressInfo
FAddressMapBuild: Boolean;
FMinPC: QWord; // the min and max PC value found in this unit.
FMaxPC: QWord; //
FScope: TDwarfScopeInfo;
FScopeList: TDwarfScopeList;
FKnownNameHashes: TKnownNameHashesArray;
FScanAllWorker: TFpThreadWorkerScanAll;
FComputeNameHashesWorker: TFpThreadWorkerComputeNameHashes;
procedure BuildAddressMap;
function GetAddressMap: TMap;
function GetKnownNameHashes: PKnownNameHashesArray; inline;
function GetUnitName: String;
function ReadTargetAddressFromDwarfSection(var AData: Pointer; AIncPointer: Boolean = False): TFpDbgMemLocation;
function ReadDwarfSectionOffsetOrLenFromDwarfSection(var AData: Pointer; AIncPointer: Boolean = False): TFpDbgMemLocation;
protected
function LocateEntry(ATag: Cardinal; out AResultScope: TDwarfScopeInfo): Boolean;
function InitLocateAttributeList(AEntry: Pointer; var AList: TAttribPointerList): Boolean;
function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal; var AList: TAttribPointerList;
out AAttribPtr: Pointer; out AForm: Cardinal): Boolean;
function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal;
out AAttribPtr: Pointer; out AForm: Cardinal): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Integer): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Int64): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Cardinal): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: QWord): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: String): Boolean;
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: PChar): Boolean; // Same as: out AValue: String
function ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: TByteDynArray; AnFormString: Boolean = False): Boolean;
// Read a value that contains an address. The address is evaluated using MapAddressToNewValue
function ReadAddressValue(AAttribute: Pointer; AForm: Cardinal; out AValue: QWord): Boolean;
public
constructor Create(AOwner: TFpDwarfInfo; ADebugFile: PDwarfDebugFile; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean); virtual;
destructor Destroy; override;
procedure WaitForScopeScan; inline; // MUST be called, before accessing the CU
procedure WaitForComputeHashes; inline;
function GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean; inline;
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): boolean;
procedure BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
// On Darwin it could be that the debug-information is not included into the executable by the linker.
// This function is to map object-file addresses into the corresponding addresses in the executable.
function MapAddressToNewValue(AValue: QWord): QWord;
property Valid: Boolean read FValid;
property FileName: String read FFileName;
property UnitName: String read GetUnitName;
property IdentifierCase: Integer read FIdentifierCase;
property Producer: String read FProducer;
property Version: Word read FVersion;
//property AbbrevOffset: QWord read FAbbrevOffset;
property AddressSize: Byte read FAddressSize; // the address size of the target in bytes
(* IsDwarf64, From the spec:
In the 64-bit DWARF format, all values that
*** "represent lengths of DWARF sections and offsets relative to the beginning of DWARF sections" ***
are represented using 64-bits.
A special convention applies to the initial length field of certain DWARF sections, as well as the CIE and FDE structures,
so that the 32-bit and 64-bit DWARF formats can coexist and be distinguished within a single linked object.
*)
property IsDwarf64: Boolean read FIsDwarf64; // Set if the dwarf info in this unit is 64bit
property Owner: TFpDwarfInfo read FOwner;
property DebugFile: PDwarfDebugFile read FDebugFile;
property DwarfSymbolClassMap: TFpSymbolDwarfClassMap read FDwarfSymbolClassMap;
property FirstScope: TDwarfScopeInfo read FScope;
// public for FpDbgDwarfVerbosePrinter
property InfoData: Pointer read FInfoData;
property InfoDataLength: QWord read FLength; // length of info
property AddressMap: TMap read GetAddressMap;
property AbbrevList: TDwarfAbbrevList read FAbbrevList;
property KnownNameHashes: PKnownNameHashesArray read GetKnownNameHashes; // Only for TOP-LEVEL entries
end;
{ TFpDwarfInfo }
TFpDwarfInfo = class(TDbgInfo)
private
FWorkQueue: TFpGlobalThreadWorkerQueue;
FCompilationUnits: TList;
FImageBase: QWord;
FFiles: array of TDwarfDebugFile;
function GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit;
protected
function GetCompilationUnitClass: TDwarfCompilationUnitClass; virtual;
function FindCompilationUnitByOffs(AOffs: QWord): TDwarfCompilationUnit;
function FindDwarfUnitSymbol(AAddress: TDbgPtr): TDbgDwarfSymbolBase; inline;
public
constructor Create(ALoaderList: TDbgImageLoaderList; AMemManager: TFpDbgMemManager); override;
destructor Destroy; override;
function FindSymbolScope(ALocationContext: TFpDbgLocationContext; AAddress: TDbgPtr = 0): TFpDbgSymbolScope; override;
function FindDwarfProcSymbol(AAddress: TDbgPtr): TDbgDwarfSymbolBase; inline;
function FindProcSymbol(AAddress: TDbgPtr): TFpSymbol; override; overload;
//function FindSymbol(const AName: String): TDbgSymbol; override; overload;
function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean; override;
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
function LoadCompilationUnits: Integer;
function PointerFromRVA(ARVA: QWord): Pointer;
function CompilationUnitsCount: Integer;
property CompilationUnits[AIndex: Integer]: TDwarfCompilationUnit read GetCompilationUnit;
property ImageBase: QWord read FImageBase;
property WorkQueue: TFpGlobalThreadWorkerQueue read FWorkQueue;
end;
TDwarfLocationExpression = class;
{ TDwarfLocationStack }
TDwarfLocationStack = object
private
FList: array of TFpDbgMemLocation; //TDwarfLocationStackEntry;
FCount: Integer;
FError: TFpErrorCode;
procedure IncCapacity;
public
procedure Clear;
function Count: Integer; inline;
function Pop: TFpDbgMemLocation;
function PopForDeref: TFpDbgMemLocation;
procedure Push(const AEntry: TFpDbgMemLocation);
procedure PushCopy(AFromIndex: Integer);
procedure PushConst(const AVal: TDBGPtr);
procedure PushTargetMem(const AVal: TDBGPtr);
procedure PushTargetRegister(const ARegNum: Cardinal);
function Peek: PFpDbgMemLocation;
function PeekForDeref: PFpDbgMemLocation;
function PeekKind: TFpDbgMemLocationType; // Can be called on empty stack
function Peek(AIndex: Integer): PFpDbgMemLocation;
procedure Modify(AIndex: Integer; const AEntry: TFpDbgMemLocation);
procedure Copy(AFromIndex, AIndex: Integer);
end;
{ TDwarfLocationExpression }
TDwarfLocationExpression = class
private
FContext: TFpDbgLocationContext;
FCurrentObjectAddress: TFpDbgMemLocation;
FFrameBase: TDbgPtr;
FLastError: TFpError;
FOnFrameBaseNeeded: TNotifyEvent;
FStack: TDwarfLocationStack;
FCU: TDwarfCompilationUnit;
FData: PByte;
FMaxData: PByte;
public
//TODO: caller keeps data, and determines livetime of data
constructor Create(AExpressionData: Pointer; AMaxCount: Integer; ACU: TDwarfCompilationUnit;
AContext: TFpDbgLocationContext);
procedure SetLastError(ALastError: TFpError);
procedure Evaluate;
function ResultData: TFpDbgMemLocation;
procedure Push(AValue: TFpDbgMemLocation);
property FrameBase: TDbgPtr read FFrameBase write FFrameBase;
property OnFrameBaseNeeded: TNotifyEvent read FOnFrameBaseNeeded write FOnFrameBaseNeeded;
property LastError: TFpError read FLastError;
property Context: TFpDbgLocationContext read FContext write FContext;
// for DW_OP_push_object_address
property CurrentObjectAddress: TFpDbgMemLocation read FCurrentObjectAddress write FCurrentObjectAddress;
end;
function ULEB128toOrdinal(var p: PByte): QWord;
function SLEB128toOrdinal(var p: PByte): Int64;
function Dbgs(AInfoData: Pointer; ACompUnit: TDwarfCompilationUnit): String; overload;
function Dbgs(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String; overload;
function Dbgs(AInfoEntry: TDwarfInformationEntry; ACompUnit: TDwarfCompilationUnit): String; overload;
function DbgsDump(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String; overload;
function GetDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList; inline;
function NameInfoForSearch(const AName: String): TNameSearchInfo;
property DwarfSymbolClassMapList: TFpSymbolDwarfClassMapList read GetDwarfSymbolClassMapList;
implementation
var
FPDBG_DWARF_ERRORS, FPDBG_DWARF_WARNINGS, FPDBG_DWARF_SEARCH, FPDBG_DWARF_VERBOSE,
// FPDBG_DWARF_DATA_WARNINGS,
FPDBG_DWARF_VERBOSE_LOAD: PLazLoggerLogGroup;
var
TheDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
const
SCOPE_ALLOC_BLOCK_SIZE = 4096; // Increase scopelist in steps of
function GetDwarfSymbolClassMapList: TFpSymbolDwarfClassMapList;
begin
Result := TheDwarfSymbolClassMapList;
end;
function NameInfoForSearch(const AName: String): TNameSearchInfo;
begin
Result.NameLower := QuickUtf8LowerCase(AName);
Result.NameUpper := QuickUtf8UpperCase(AName);
Result.NameHash := objpas.Hash(Result.NameUpper) and $7fff or $8000;
end;
function Dbgs(AInfoData: Pointer; ACompUnit: TDwarfCompilationUnit): String;
var
Attrib: Pointer;
Form: Cardinal;
Name: String;
Def: TDwarfAbbrev;
begin
Result := '';
if ACompUnit.LocateAttribute(AInfoData, DW_AT_name, Attrib, Form) then
if (Form = DW_FORM_string) or (Form = DW_FORM_strp) then
ACompUnit.ReadValue(Attrib, Form, Name);
if ACompUnit.GetDefinition(AInfoData, Def) then
Result := Format('Tag=%s Name=%s', [DwarfTagToString(Def.tag), Name])
else
Result := Format('Name=%s', [Name]);
end;
function dbgs(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String;
begin
if not AScope.IsValid then
exit('Invalid-Scope');
Result := Format('AScope(Idx=%d %s)', [AScope.Index, dbgs(AScope.Entry, ACompUnit)]);
end;
function Dbgs(AInfoEntry: TDwarfInformationEntry; ACompUnit: TDwarfCompilationUnit): String;
begin
if AInfoEntry.HasValidScope
then Result := Dbgs(AInfoEntry.FScope, ACompUnit)
else Result := Dbgs(AInfoEntry.FInformationEntry, ACompUnit);
end;
function DbgsDump(AScope: TDwarfScopeInfo; ACompUnit: TDwarfCompilationUnit): String;
var
Def: TDwarfAbbrev;
i: Integer;
begin
Result := '';
if not AScope.IsValid then
exit('Invalid-Scope');
if ACompUnit.GetDefinition(AScope.Entry, Def) then begin
Result := LineEnding;
for i := Def.index to Def.index + Def.count - 1 do begin
Result := Result +
DwarfAttributeToString(ACompUnit.FAbbrevList.EntryPointer[i]^.Attribute) + ' ' +
DwarfAttributeFormToString(ACompUnit.FAbbrevList.EntryPointer[i]^.Form) +
LineEnding;
end;
end;
end;
function ULEB128toOrdinal(var p: PByte): QWord;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + QWord(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
end;
function SLEB128toOrdinal(var p: PByte): Int64;
var
n: Byte;
Stop: Boolean;
begin
Result := 0;
n := 0;
repeat
Stop := (p^ and $80) = 0;
Result := Result + Int64(p^ and $7F) shl n;
Inc(n, 7);
Inc(p);
until Stop or (n > 128);
// sign extend when msbit = 1
if ((p[-1] and $40) <> 0) and (n < 64) // only supports 64 bit
then Result := Result or (Int64(-1) shl n);
end;
function SkipEntryDataForForm(var AEntryData: Pointer; AForm: Cardinal; AddrSize: Byte; IsDwarf64: boolean; Version: word): Boolean; inline;
var
UValue: QWord;
begin
Result := True;
case AForm of
DW_FORM_addr : Inc(AEntryData, AddrSize);
DW_FORM_block : begin
UValue := ULEB128toOrdinal(AEntryData);
Inc(AEntryData, UValue);
end;
DW_FORM_block1 : Inc(AEntryData, PByte(AEntryData)^ + 1);
DW_FORM_block2 : Inc(AEntryData, PWord(AEntryData)^ + 2);
DW_FORM_block4 : Inc(AEntryData, PLongWord(AEntryData)^ + 4);
DW_FORM_data1 : Inc(AEntryData, 1);
DW_FORM_data2 : Inc(AEntryData, 2);
DW_FORM_data4 : Inc(AEntryData, 4);
DW_FORM_data8 : Inc(AEntryData, 8);
DW_FORM_sdata : begin
while (PByte(AEntryData)^ and $80) <> 0 do Inc(AEntryData);
Inc(AEntryData);
end;
DW_FORM_udata : begin
while (PByte(AEntryData)^ and $80) <> 0 do Inc(AEntryData);
Inc(AEntryData);
end;
DW_FORM_flag : Inc(AEntryData, 1);
DW_FORM_ref1 : Inc(AEntryData, 1);
DW_FORM_ref2 : Inc(AEntryData, 2);
DW_FORM_ref4 : Inc(AEntryData, 4);
DW_FORM_ref8 : Inc(AEntryData, 8);
DW_FORM_ref_udata: begin
while (PByte(AEntryData)^ and $80) <> 0 do Inc(AEntryData);
Inc(AEntryData);
end;
DW_FORM_strp: begin
if IsDwarf64 then
Inc(AEntryData, 8)
else
Inc(AEntryData, 4);
end;
DW_FORM_ref_addr : begin
// In Dwarf-version 3 and higher, the size of a DW_FORM_ref_addr depends
// on the Dwarf-format. In prior Dwarf-versions it is equal to the
// Addres-size.
if Version>2 then begin
if IsDwarf64 then
Inc(AEntryData, 8)
else
Inc(AEntryData, 4);
end else begin
Inc(AEntryData, AddrSize);
end;
end;
DW_FORM_string : begin
while PByte(AEntryData)^ <> 0 do Inc(AEntryData);
Inc(AEntryData);
end;
DW_FORM_indirect : begin
while AForm = DW_FORM_indirect do AForm := ULEB128toOrdinal(AEntryData);
Result := SkipEntryDataForForm(AEntryData, AForm, AddrSize, IsDwarf64, Version);
end;
else begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Unknown Form: ', AForm]);
Result := False;
end;
end;
end;
{ TFpSymbolDwarfClassMap }
class function TFpSymbolDwarfClassMap.GetInstanceForCompUnit(
ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
begin
Result := DoGetInstanceForCompUnit(ACU, nil);
end;
class procedure TFpSymbolDwarfClassMap.FreeAllInstances;
var
pm, next: TFpSymbolDwarfClassMap;
begin
pm := GetExistingClassMap^;
while pm <> nil do begin
next := pm.NextExistingClassMap;
pm.Destroy;
pm := next;
end;
GetExistingClassMap^ := nil;
end;
constructor TFpSymbolDwarfClassMap.Create(ACU: TDwarfCompilationUnit;
AHelperData: Pointer);
begin
inherited Create;
end;
function TFpSymbolDwarfClassMap.CanHandleCompUnit(ACU: TDwarfCompilationUnit;
AHelperData: Pointer): Boolean;
begin
Result := True;
end;
class function TFpSymbolDwarfClassMap.DoGetInstanceForCompUnit(
ACU: TDwarfCompilationUnit; AHelperData: Pointer): TFpSymbolDwarfClassMap;
var
pm: PFpDwarfSymbolClassMap;
begin
pm := GetExistingClassMap;
while pm^ <> nil do begin
if pm^.CanHandleCompUnit(ACU, AHelperData) then
exit(pm^);
pm := @pm^.NextExistingClassMap;
end;
Result := Self.Create(ACU, AHelperData);
pm^ := Result;
end;
{ TLEB128PreFixTree }
procedure TLEB128PreFixTree.SetCapacity(ACapacity: integer);
begin
FDataGrowStep := Min(512, Max(64, ACapacity));
FTableListGrowStep := Min(32, Max(4, ACapacity div 128));
//debugln(['TLEB128PreFixTree.SetCapacity ', ACapacity, ' ', FDataGrowStep, ' ', FTableListGrowStep]);
SetLength(FTableList, 1); //FTableListGrowStep div 2);
SetLength(FTableListGaps, 1); //FTableListGrowStep div 2);
SetLength(FEndTableData, FDataGrowStep div 4);
FTableList[0].LeadLow := 255;
FTableList[0].LeadHigh := 0;
FTableList[0].EndLow := 255;
FTableList[0].EndHigh := 0;
FTableListGaps[0].LeadTable := 0;
FTableListGaps[0].EndTable := 0;
FLeadTableNextFreeIndex := 0; // first 16 are reserved
FEndTableNextFreeIndex := 0;
FTableListNextFreeIndex := 1;
end;
procedure TLEB128PreFixTree.Finish;
begin
//debugln(['TLEB128PreFixTree.Finish ',' t:', Length(FTableList) ,' => ', FTableListNextFreeIndex,' p:', Length(FLeadTableData) ,' => ', FLeadTableNextFreeIndex,' e:', Length(FEndTableData) ,' => ', FEndTableNextFreeIndex]);
dec(FLeadTableNextFreeIndex, FTableListGaps[FTableListNextFreeIndex-1].LeadTable);
dec(FEndTableNextFreeIndex, FTableListGaps[FTableListNextFreeIndex-1].EndTable);
SetLength(FTableList, FTableListNextFreeIndex);
SetLength(FLeadTableData, FLeadTableNextFreeIndex);
SetLength(FEndTableData, FEndTableNextFreeIndex);
// TODO: clear gaps
SetLength(FTableListGaps, 0);
end;
function TLEB128PreFixTree.AddLeb128FromPointer(APointer: Pointer;
const AData: TDwarfAbbrev): Pointer;
var
TableListLen: Integer;
procedure AllocLeadTableIndexes(AnAmount: Integer); inline;
begin
inc(FLeadTableNextFreeIndex, AnAmount);
if Length(FLeadTableData) < FLeadTableNextFreeIndex then begin
SetLength(FLeadTableData, FLeadTableNextFreeIndex + FDataGrowStep);
//debugln(['IncreaseLeadTableListSize ', DbgS(self), ' ', FLeadTableNextFreeIndex ]);
end;
end;
procedure AllocEndTableIndexes(AnAmount: Integer); inline;
begin
inc(FEndTableNextFreeIndex, AnAmount);
if Length(FEndTableData) < FEndTableNextFreeIndex then begin
SetLength(FEndTableData, FEndTableNextFreeIndex + FDataGrowStep);
//debugln(['IncreaseEndTableListSize ', DbgS(self), ' ', FEndTableNextFreeIndex ]);
end;
end;
function NewEntryInTableList: Cardinal; inline;
begin
if FTableListNextFreeIndex >= TableListLen then begin
//debugln(['inc(TableListLen, 512) ', DbgS(self), ' ', TableListLen]);
inc(TableListLen, FTableListGrowStep);
SetLength(FTableList, TableListLen);
SetLength(FTableListGaps, TableListLen);
end;
Result := FTableListNextFreeIndex;
FTableList[Result].LeadLow := 255;
FTableList[Result].LeadHigh := 0;
FTableList[Result].EndLow := 255;
FTableList[Result].EndHigh := 0;
FTableListGaps[Result].LeadTable := 0;
FTableListGaps[Result].EndTable := 0;
inc(FTableListNextFreeIndex);
end;
procedure AppendToLeadTable(ATableListIndex: Cardinal; AEntry: PLeb128TableEntry;
ALeadByte: Byte; ATarget: Cardinal); //inline;
var
GapAvail, ANeeded: Integer;
AtEnd: Boolean;
i, NewIndex: Cardinal;
begin
if AEntry^.LeadLow > AEntry^.LeadHigh then
begin // empty table // create new
AEntry^.LeadLow := ALeadByte;
AEntry^.LeadIndex := FLeadTableNextFreeIndex;
AllocLeadTableIndexes(16);
FTableListGaps[ATableListIndex].LeadTable := 15; // 16-1
end
else
begin // append to existing
GapAvail := FTableListGaps[ATableListIndex].LeadTable;
assert(AEntry^.LeadIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail <= FLeadTableNextFreeIndex);
AtEnd := AEntry^.LeadIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail = FLeadTableNextFreeIndex;
ANeeded := ALeadByte - AEntry^.LeadHigh;
if ANeeded <= GapAvail then begin
dec(FTableListGaps[ATableListIndex].LeadTable, ANeeded);
end
else
if AtEnd then begin
AllocLeadTableIndexes(ANeeded + 16);
FTableListGaps[ATableListIndex].LeadTable := 16;
end
else
begin
// Todo deal with the GAP at the old location
i := AEntry^.LeadHigh - AEntry^.LeadLow + 1; // Current Size
NewIndex := FLeadTableNextFreeIndex;
//DebugLn(['MOVING LEAD', DbgS(self), ' From: ', AEntry^.LeadIndex, ' To: ', NewIndex] );
AllocLeadTableIndexes(i + ANeeded +16);
move(FLeadTableData[AEntry^.LeadIndex], FLeadTableData[NewIndex], i * SizeOf(FLeadTableData[0]));
AEntry^.LeadIndex := NewIndex;
FTableListGaps[ATableListIndex].LeadTable := 16;
end;
end; // append to existing
AEntry^.LeadHigh := ALeadByte;
i := AEntry^.LeadIndex + ALeadByte - AEntry^.LeadLow;
FLeadTableData[i] := ATarget;
end;
procedure PrependToLeadTable(ATableListIndex: Cardinal; AEntry: PLeb128TableEntry;
ALeadByte: Byte; ATarget: Cardinal); //inline;
var
GapAvail, ANeeded: Integer;
AtEnd: Boolean;
i, NewIndex: Cardinal;
begin
Assert(AEntry^.LeadLow <= AEntry^.LeadHigh, 'emty table must be handled by append');
GapAvail := FTableListGaps[ATableListIndex].LeadTable;
assert(AEntry^.LeadIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail <= FLeadTableNextFreeIndex);
AtEnd := AEntry^.LeadIndex + AEntry^.LeadHigh - AEntry^.LeadLow + 1 + GapAvail = FLeadTableNextFreeIndex;
ANeeded := AEntry^.LeadLow - ALeadByte;
if (ANeeded <= GapAvail) or AtEnd then begin
if (ANeeded > GapAvail) then begin
AllocLeadTableIndexes(ANeeded + 16);
FTableListGaps[ATableListIndex].LeadTable := 16;
end
else
dec(FTableListGaps[ATableListIndex].LeadTable, ANeeded);
NewIndex := AEntry^.LeadIndex + ANeeded;
i := AEntry^.LeadHigh - AEntry^.LeadLow + 1; // Current size
move(FLeadTableData[AEntry^.LeadIndex], FLeadTableData[NewIndex], i * SizeOf(FLeadTableData[0]));
FillByte(FLeadTableData[AEntry^.LeadIndex+1], Min(i, ANeeded-1) * SizeOf(FLeadTableData[0]), 0);
end
else
begin
// Todo deal with the GAP at the old location
i := AEntry^.LeadHigh - AEntry^.LeadLow + 1; // Current Size
NewIndex := FLeadTableNextFreeIndex;
//DebugLn(['MOVING LEAD', DbgS(self), ' From: ', AEntry^.LeadIndex, ' To: ', NewIndex] );
AllocLeadTableIndexes(i + ANeeded + 16);
move(FLeadTableData[AEntry^.LeadIndex], FLeadTableData[NewIndex+ANeeded], i * SizeOf(FLeadTableData[0]));
// FillByte only neede, if gap will be reclaimed
//FillByte(FLeadTableData[AEntry^.LeadIndex], i * SizeOf(FLeadTableData[0]), 0);
AEntry^.LeadIndex := NewIndex;
FTableListGaps[ATableListIndex].LeadTable := 16;
end;
AEntry^.LeadLow := ALeadByte;
FLeadTableData[AEntry^.LeadIndex] := ATarget;
end;
procedure AppendToEndTable(ATableListIndex: Cardinal; AEntry: PLeb128TableEntry;
ALeadByte: Byte; const AData: TDwarfAbbrev {Pointer}); //inline;
var
GapAvail, ANeeded: Integer;
AtEnd: Boolean;
i, NewIndex: Cardinal;
begin
if AEntry^.EndLow > AEntry^.EndHigh then
begin // empty table // create new
AEntry^.EndLow := ALeadByte;
AEntry^.EndIndex := FEndTableNextFreeIndex;
AllocEndTableIndexes(16);
FTableListGaps[ATableListIndex].EndTable := 15; // 16-1
end
else
begin // append to existing
GapAvail := FTableListGaps[ATableListIndex].EndTable;
assert(Int64(AEntry^.EndIndex) + Int64(AEntry^.LeadHigh) - Int64(AEntry^.LeadLow) + 1 + GapAvail <= FEndTableNextFreeIndex);
AtEnd := Int64(AEntry^.EndIndex) + Int64(AEntry^.EndHigh) - Int64(AEntry^.EndLow) + 1 + GapAvail = FEndTableNextFreeIndex;
ANeeded := ALeadByte - AEntry^.EndHigh;
if ANeeded <= GapAvail then begin
dec(FTableListGaps[ATableListIndex].EndTable, ANeeded);
end
else
if AtEnd then begin
AllocEndTableIndexes(ANeeded + 16);
FTableListGaps[ATableListIndex].EndTable := 16;
end
else
begin
// Todo deal with the GAP at the old location
i := AEntry^.EndHigh - AEntry^.EndLow + 1; // Current Size
NewIndex := FEndTableNextFreeIndex;
//DebugLn(['MOVING END', DbgS(self), ' From: ', AEntry^.EndIndex, ' To: ', NewIndex ]);
AllocEndTableIndexes(i + ANeeded + 16);
move(FEndTableData[AEntry^.EndIndex], FEndTableData[NewIndex], i * SizeOf(FEndTableData[0]));
AEntry^.EndIndex := NewIndex;
FTableListGaps[ATableListIndex].EndTable := 16;
end;
end; // append to existing
AEntry^.EndHigh := ALeadByte;
i := AEntry^.EndIndex + ALeadByte - AEntry^.EndLow;
FEndTableData[i] := AData;
end;
procedure PrependToEndTable(ATableListIndex: Cardinal; AEntry: PLeb128TableEntry;
AEndByte: Byte; const AData: TDwarfAbbrev); //inline;
var
GapAvail, ANeeded: Integer;
AtEnd: Boolean;
i, NewIndex: Cardinal;
begin
Assert(AEntry^.EndLow <= AEntry^.EndHigh, 'emty table must be handled by append');
GapAvail := FTableListGaps[ATableListIndex].EndTable;
assert(AEntry^.EndIndex + AEntry^.EndHigh - AEntry^.EndLow + 1 + GapAvail <= FEndTableNextFreeIndex);
AtEnd := AEntry^.EndIndex + AEntry^.EndHigh - AEntry^.EndLow + 1 + GapAvail = FEndTableNextFreeIndex;
ANeeded := AEntry^.EndLow - AEndByte;
if (ANeeded <= GapAvail) or AtEnd then begin
if (ANeeded > GapAvail) then begin
AllocEndTableIndexes(ANeeded + 16);
FTableListGaps[ATableListIndex].EndTable := 16;
end
else
dec(FTableListGaps[ATableListIndex].EndTable, ANeeded);
NewIndex := AEntry^.EndIndex + ANeeded;
i := AEntry^.EndHigh - AEntry^.EndLow + 1; // Current size
move(FEndTableData[AEntry^.EndIndex], FEndTableData[NewIndex], i * SizeOf(FEndTableData[0]));
FillByte(FEndTableData[AEntry^.EndIndex+1], Min(i, ANeeded-1) * SizeOf(FEndTableData[0]), 0);
end
else
begin
// Todo deal with the GAP at the old location
i := AEntry^.EndHigh - AEntry^.EndLow + 1; // Current Size
NewIndex := FEndTableNextFreeIndex;
//DebugLn(['MOVING END', DbgS(self), ' From: ', AEntry^.EndIndex, ' To: ', NewIndex] );
AllocEndTableIndexes(i + ANeeded + 16);
move(FEndTableData[AEntry^.EndIndex], FEndTableData[NewIndex+ANeeded], i * SizeOf(FEndTableData[0]));
// FillByte only neede, if gap will be reclaimed
//FillByte(FEndTableData[AEntry^.EndIndex], i * SizeOf(FEndTableData[0]), 0);
AEntry^.EndIndex := NewIndex;
FTableListGaps[ATableListIndex].EndTable := 16;
end;
AEntry^.EndLow := AEndByte;
FEndTableData[AEntry^.EndIndex] := AData;
end;
var
LEB128: PByte;
b: Byte;
TableListIndex: Integer;
e: PLeb128TableEntry;
i, NewIdx: Cardinal;
begin
LEB128 := APointer;
i := 16; // Just an abort condition, for malformed data.
while (LEB128^ >= 128) do begin
inc(LEB128);
dec(i);
if i = 0 then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['ENDLESS LEB128']);
exit;
end;
end;
Result := LEB128 + 1;
TableListIndex := 0;
TableListLen := Length(FTableList);
while (LEB128 > APointer) and ((LEB128^ and $7f) = 0) do
dec(LEB128);
// LeadByte
while LEB128 > APointer do begin
b := LEB128^ and $7f;
Assert(TableListIndex < TableListLen);
e := @FTableList[TableListIndex];
if (b > e^.LeadHigh) or (e^.LeadHigh < e^.LeadLow) then begin
NewIdx := NewEntryInTableList;
e := @FTableList[TableListIndex];
AppendToLeadTable(TableListIndex, e, b, NewIdx);
TableListIndex := NewIdx;
end
else
if (b < e^.LeadLow) then begin
NewIdx := NewEntryInTableList;
e := @FTableList[TableListIndex];
PrependToLeadTable(TableListIndex, e, b, NewIdx);
TableListIndex := NewIdx;
end
else
begin
// existing entry
i := e^.LeadIndex + b - e^.LeadLow;
TableListIndex := FLeadTableData[i];
if TableListIndex = 0 then begin // not yet assigned (not allowed to point back to 0)
TableListIndex := NewEntryInTableList;
FLeadTableData[i] := TableListIndex;
end;
end;
dec(LEB128);
end;
// EndByte
//if AData = nil then AData := LEB128;
Assert(TableListIndex < TableListLen);
b := LEB128^ and $7f;
e := @FTableList[TableListIndex];
if (b > e^.EndHigh) or (e^.EndHigh < e^.EndLow) then begin
AppendToEndTable(TableListIndex, e, b, AData);
end
else
if (b < e^.EndLow) then begin
PrependToEndTable(TableListIndex, e, b, AData);
end
else
begin
// in existingc range
i := e^.EndIndex + b - e^.EndLow;
//assert(FEndTableData[i] = nil, 'Duplicate LEB128');
FEndTableData[i] := AData;
end;
end;
function TLEB128PreFixTree.FindLe128bFromPointer(APointer: Pointer; out
AData: PDwarfAbbrev): Pointer;
var
LEB128: PByte;
b: Byte;
TableListIndex: Integer;
e: PLeb128TableEntry;
i: Cardinal;
TableListLen: Integer;
LEB128End: PByte;
begin
AData := nil;
Result := nil;
TableListLen := Length(FTableList);
if TableListLen = 0 then
exit;
LEB128 := APointer;
i := 16; // Just an abort condition, for malformed data.
while (LEB128^ >= 128) do begin
inc(LEB128);
dec(i);
if i = 0 then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['ENDLESS LEB128']);
exit;
end;
end;
LEB128End := LEB128;
while (LEB128 > APointer) and ((LEB128^ and $7f) = 0) do
dec(LEB128);
TableListIndex := 0;
// LeadByte
while LEB128 > APointer do begin
b := LEB128^ and $7f;
Assert(TableListIndex < TableListLen);
e := @FTableList[TableListIndex];
if (b > e^.LeadHigh) or (b < e^.LeadLow) then begin
//debugln('1 OUT OF RANGE / NOT FOUND!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
exit;
end
else
begin
TableListIndex := FLeadTableData[e^.LeadIndex + b - e^.LeadLow];
if TableListIndex = 0 then begin // not yet assigned (not allowed to point back to 0)
//debugln('3 OUT OF RANGE / NOT FOUND!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
exit;
end;
end;
dec(LEB128);
end;
// EndByte
Assert(TableListIndex < TableListLen);
b := LEB128^ and $7f;
e := @FTableList[TableListIndex];
if (b > e^.EndHigh) or (b < e^.EndLow) then begin
//debugln('4 OUT OF RANGE / NOT FOUND!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
exit;
end
else
begin
i := e^.EndIndex + b - e^.EndLow;
//assert(FEndTableData[i] = nil, 'Duplicate LEB128');
AData := @FEndTableData[i];
if AData^.tag > 0 then // tag 0 does not exist
Result := LEB128End+1;
end;
end;
function TLEB128PreFixTree.FindLe128bFromPointer(APointer: Pointer; out
AData: TDwarfAbbrev): Pointer;
var
p: PDwarfAbbrev;
begin
Result := FindLe128bFromPointer(APointer, p);
if p = nil then begin
AData.index := -1;
AData.tag := 0;
AData.count := 0;
AData.flags := [];
end
else
AData := p^;
end;
{ TDwarfAbbrevList }
function TDwarfAbbrevList.GetEntryPointer(AIndex: Integer): PDwarfAbbrevEntry;
begin
Result := @FDefinitions[AIndex];
end;
procedure TDwarfAbbrevList.LoadAbbrevs(AnAbbrevDataPtr: Pointer);
procedure MakeRoom(AMinSize: Integer);
var
len: Integer;
begin
len := Length(FDefinitions);
if len > AMinSize then Exit;
if len > $4000
then Inc(len, $4000)
else len := len * 2;
SetLength(FDefinitions, len);
end;
var
p: Pointer;
Def: TDwarfAbbrev;
Def2: PDwarfAbbrev;
abbrev, attrib, form: Cardinal;
n: Integer;
CurAbbrevIndex: Integer;
DbgVerbose: Boolean;
f: TDwarfAbbrevFlags;
begin
abbrev := 0;
CurAbbrevIndex := 0;
DbgVerbose := (FPDBG_DWARF_VERBOSE_LOAD <> nil) and (FPDBG_DWARF_VERBOSE_LOAD^.Enabled);
while (pbyte(AnAbbrevDataPtr) < FAbbrDataEnd) and (pbyte(AnAbbrevDataPtr)^ <> 0) do
begin
p := AnAbbrevDataPtr;
abbrev := ULEB128toOrdinal(pbyte(AnAbbrevDataPtr));
Def.tag := ULEB128toOrdinal(pbyte(AnAbbrevDataPtr));
{$IFDEF USE_ABBREV_TMAP}
if FMap.HasId(abbrev)
{$ELSE}
if FindLe128bFromPointer(p, Def2) <> nil
{$Endif}
then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Duplicate abbrev=', abbrev, ' found. Ignoring....']);
while pword(AnAbbrevDataPtr)^ <> 0 do Inc(pword(AnAbbrevDataPtr));
Inc(pword(AnAbbrevDataPtr));
Continue;
end;
if DbgVerbose
then begin
DebugLn(FPDBG_DWARF_VERBOSE_LOAD, [' abbrev: ', abbrev]);
DebugLn(FPDBG_DWARF_VERBOSE_LOAD, [' tag: ', Def.tag, '=', DwarfTagToString(Def.tag)]);
DebugLn(FPDBG_DWARF_VERBOSE_LOAD, [' children:', pbyte(AnAbbrevDataPtr)^, '=', DwarfChildrenToString(pbyte(AnAbbrevDataPtr)^)]);
end;
if pbyte(AnAbbrevDataPtr)^ = DW_CHILDREN_yes then
f := [dafHasChildren]
else
f := [];
Inc(pbyte(AnAbbrevDataPtr));
n := 0;
Def.Index := CurAbbrevIndex;
while pword(AnAbbrevDataPtr)^ <> 0 do
begin
attrib := ULEB128toOrdinal(pbyte(AnAbbrevDataPtr));
if attrib = DW_AT_name then
Include(f, dafHasName)
else
if attrib = DW_AT_low_pc then
Include(f, dafHasLowAddr)
else
if attrib = DW_AT_start_scope then
Include(f, dafHasStartScope)
else
if attrib = DW_AT_abstract_origin then
Include(f, dafHasAbstractOrigin);
form := ULEB128toOrdinal(pbyte(AnAbbrevDataPtr));
MakeRoom(CurAbbrevIndex + 1);
FDefinitions[CurAbbrevIndex].Attribute := attrib;
FDefinitions[CurAbbrevIndex].Form := form;
Inc(CurAbbrevIndex);
if DbgVerbose
then DebugLn(FPDBG_DWARF_VERBOSE_LOAD, [' [', n, '] attrib: ', attrib, '=', DwarfAttributeToString(attrib), ', form: ', form, '=', DwarfAttributeFormToString(form)]);
Inc(n);
end;
Def.Count := n;
Def.flags := f;
{$IFDEF USE_ABBREV_TMAP}
FMap.Add(abbrev, Def);
{$ELSE}
AddLeb128FromPointer(p, Def);
{$Endif}
Inc(pword(AnAbbrevDataPtr));
end;
end;
constructor TDwarfAbbrevList.Create(AnAbbrData, AnAbbrDataEnd: Pointer; AnAbbrevOffset,
AInfoLen: QWord);
begin
inherited Create;
FAbbrDataEnd := AnAbbrDataEnd;
{$IFDEF USE_ABBREV_TMAP}
FMap := TMap.Create(itu4, SizeOf(TDwarfAbbrev));
{$ELSE}
SetCapacity(AInfoLen div 16 + 1);
{$Endif}
SetLength(FDefinitions, 256);
LoadAbbrevs(AnAbbrData + AnAbbrevOffset);
{$IFnDEF USE_ABBREV_TMAP}
Finish;
{$Endif}
end;
destructor TDwarfAbbrevList.Destroy;
begin
{$IFDEF USE_ABBREV_TMAP}
FreeAndNil(FMap);
{$Endif}
inherited Destroy;
end;
{$IFDEF USE_ABBREV_TMAP}
function TDwarfAbbrevList.FindLe128bFromPointer(AnAbbrevPtr: Pointer; out
AData: TDwarfAbbrev): Pointer;
begin
Result := AnAbbrevPtr;
if not FMap.GetData(ULEB128toOrdinal(Result), AData) then
Result := nil;
end;
{$Endif}
{ TDwarfScopeInfo }
procedure TDwarfScopeInfo.Init(AScopeList: PDwarfScopeList);
begin
FIndex := -1;
FScopeList := AScopeList;
end;
function TDwarfScopeInfo.IsValid: Boolean;
begin
Result := FIndex >= 0;
end;
function TDwarfScopeInfo.GetNextIndex: Integer;
var
l: Integer;
p: PDwarfScopeInfoRec;
begin
Result := -1;
if (not IsValid) or (FScopeList^.HighestKnown = FIndex) then exit;
// Use pointer, to avoid calculating the index twice
p := @FScopeList^.List[FIndex + 1];
Result := p^.Link;
assert(Result <= FScopeList^.HighestKnown);
if (Result > FIndex + 1) then // Index+1 is First Child, with pointer to Next
exit;
l := (p-1)^.Link; // GetParent (or -1 for toplevel)
assert(l <= FScopeList^.HighestKnown);
if l > Index then l := Index - 1; // This is a first child, make l = parent
if (Result = l) then begin // Index + 1 has same parent
Result := Index + 1;
exit;
end;
Result := -1;
end;
function TDwarfScopeInfo.GetNext: TDwarfScopeInfo;
begin
Result.Init(FScopeList);
if IsValid then
Result.Index := GetNextIndex;
end;
function TDwarfScopeInfo.GetEntry: Pointer;
begin
Result := nil;
if IsValid then
Result := FScopeList^.List[FIndex].Entry;
end;
function TDwarfScopeInfo.HasChild: Boolean;
var
l2: Integer;
begin
Result := (IsValid) and (FScopeList^.HighestKnown > FIndex);
if not Result then exit;
l2 := FScopeList^.List[FIndex + 1].Link;
assert(l2 <= FScopeList^.HighestKnown);
Result := (l2 > FIndex + 1) or // Index+1 is First Child, with pointer to Next
(l2 = FIndex); // Index+1 is First Child, with pointer to parent (self)
end;
function TDwarfScopeInfo.GetChild: TDwarfScopeInfo;
begin
Result.Init(FScopeList);
if HasChild then begin
Result.Index := FIndex + 1;
assert(Result.Parent.Index = FIndex, 'child has self as parent');
end;
end;
function TDwarfScopeInfo.GetChildIndex: Integer;
begin
if HasChild then
Result := FIndex + 1
else
Result := -1;
end;
function TDwarfScopeInfo.GetCurrent: PDwarfScopeInfoRec;
begin
Result := nil;
if IsValid then
Result := @FScopeList^.List[FIndex];
end;
function TDwarfScopeInfo.GetParent: TDwarfScopeInfo;
var
l: Integer;
begin
Result.Init(FScopeList);
if not IsValid then exit;
l := FScopeList^.List[FIndex].Link; // GetParent (or -1 for toplevel)
assert(l <= FScopeList^.HighestKnown);
if l > Index then
l := Index - 1; // This is a first child, make l = parent
Result.Index := l;
end;
function TDwarfScopeInfo.GetParentIndex: Integer;
begin
Result := -1;
if not IsValid then exit;
Result := FScopeList^.List[FIndex].Link; // GetParent (or -1 for toplevel)
assert(Result <= FScopeList^.HighestKnown);
if Result > Index then
Result := Index - 1; // This is a first child, make l = parent
end;
procedure TDwarfScopeInfo.SetIndex(AIndex: Integer);
begin
if (AIndex >= 0) and (AIndex <= FScopeList^.HighestKnown) then
FIndex := AIndex
else
FIndex := -1;
end;
function TDwarfScopeInfo.CreateScopeForEntry(AEntry: Pointer; ALink: Integer): Integer;
begin
inc(FScopeList^.HighestKnown);
Result := FScopeList^.HighestKnown;
if Result >= Length(FScopeList^.List) then
SetLength(FScopeList^.List, Result + SCOPE_ALLOC_BLOCK_SIZE);
with FScopeList^.List[Result] do begin
Entry := AEntry;
Link := ALink;
end;
end;
function TDwarfScopeInfo.HasParent: Boolean;
var
l: Integer;
begin
Result := (IsValid);
if not Result then exit;
l := FScopeList^.List[FIndex].Link;
assert(l <= FScopeList^.HighestKnown);
Result := (l >= 0);
end;
function TDwarfScopeInfo.HasNext: Boolean;
var
l, l2: Integer;
begin
Result := (IsValid) and (FScopeList^.HighestKnown > FIndex);
if not Result then exit;
l2 := FScopeList^.List[FIndex + 1].Link;
assert(l2 <= FScopeList^.HighestKnown);
Result := (l2 > FIndex + 1); // Index+1 is First Child, with pointer to Next
if Result then
exit;
l := FScopeList^.List[FIndex].Link; // GetParent (or -1 for toplevel)
assert(l <= FScopeList^.HighestKnown);
if l > Index then
l := Index - 1; // This is a first child, make l = parent
Result := (l2 = l); // Index + 1 has same parent
end;
procedure TDwarfScopeInfo.GoParent;
var
l: Integer;
begin
if not IsValid then exit;
l := FScopeList^.List[FIndex].Link; // GetParent (or -1 for toplevel)
assert(l <= FScopeList^.HighestKnown);
if l > Index then
l := Index - 1; // This is a first child, make l = parent
FIndex := l;
end;
procedure TDwarfScopeInfo.GoNext;
begin
FIndex := GetNextIndex;
end;
procedure TDwarfScopeInfo.GoChild;
begin
if HasChild then
FIndex := FIndex + 1
else
FIndex := -1;
end;
function TDwarfScopeInfo.CreateNextForEntry(AEntry: Pointer): Integer;
var
l: Integer;
begin
assert(IsValid, 'Creating Child for invalid scope');
assert(NextIndex<0, 'Next already set');
l := FScopeList^.List[FIndex].Link; // GetParent (or -1 for toplevel)
assert(l <= FScopeList^.HighestKnown);
if l > Index then l := Index - 1; // This is a first child, make l = parent
Result := CreateScopeForEntry(AEntry, l);
if Result > FIndex + 1 then // We have children
FScopeList^.List[FIndex+1].Link := Result;
end;
function TDwarfScopeInfo.CreateChildForEntry(AEntry: Pointer): Integer;
begin
assert(IsValid, 'Creating Child for invalid scope');
assert(FIndex=FScopeList^.HighestKnown, 'Cannot creating Child.Not at end of list');
Result := CreateScopeForEntry(AEntry, FIndex); // First Child, but no parent.next yet
end;
{ TDwarfLocationStack }
procedure TDwarfLocationStack.IncCapacity;
begin
SetLength(FList, Max(Length(FList), FCount) + 64);
end;
procedure TDwarfLocationStack.Clear;
begin
FCount := 0;
FError := fpErrNoError;
end;
function TDwarfLocationStack.Count: Integer;
begin
Result := FCount;
end;
function TDwarfLocationStack.Pop: TFpDbgMemLocation;
begin
Assert(0 < FCount);
dec(FCount);
Result := FList[FCount];
if Result.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
function TDwarfLocationStack.PopForDeref: TFpDbgMemLocation;
begin
Assert(0 < FCount);
dec(FCount);
Result := FList[FCount];
end;
procedure TDwarfLocationStack.Push(const AEntry: TFpDbgMemLocation);
begin
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := AEntry;
inc(FCount);
end;
procedure TDwarfLocationStack.PushCopy(AFromIndex: Integer);
begin
Assert(AFromIndex < FCount);
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := FList[FCount-1-AFromIndex];
inc(FCount);
end;
procedure TDwarfLocationStack.PushConst(const AVal: TDBGPtr);
begin
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := Default(TFpDbgMemLocation);
with FList[FCount] do begin
Address := AVal;
MType := mlfConstant;
end;
inc(FCount);
end;
procedure TDwarfLocationStack.PushTargetMem(const AVal: TDBGPtr);
begin
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := Default(TFpDbgMemLocation);
with FList[FCount] do begin
Address := AVal;
MType := mlfTargetMem;
end;
inc(FCount);
end;
procedure TDwarfLocationStack.PushTargetRegister(const ARegNum: Cardinal);
begin
if Length(FList) <= FCount then
IncCapacity;
FList[FCount] := Default(TFpDbgMemLocation);
FList[FCount] := RegisterLoc(ARegNum);
inc(FCount);
end;
function TDwarfLocationStack.Peek: PFpDbgMemLocation;
begin
Assert(0 < FCount);
Result := @FList[FCount-1];
if Result^.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
function TDwarfLocationStack.PeekForDeref: PFpDbgMemLocation;
begin
Assert(0 < FCount);
Result := @FList[FCount-1];
end;
function TDwarfLocationStack.PeekKind: TFpDbgMemLocationType;
begin
if FCount = 0 then
Result := mlfInvalid
else
Result := FList[FCount-1].MType;
end;
function TDwarfLocationStack.Peek(AIndex: Integer): PFpDbgMemLocation;
begin
Assert(AIndex < FCount);
Result := @FList[FCount-1-AIndex];
if Result^.MType = mlfConstantDeref then
FError := fpErrLocationParser;
end;
procedure TDwarfLocationStack.Modify(AIndex: Integer;
const AEntry: TFpDbgMemLocation);
begin
Assert(AIndex < FCount);
FList[FCount-1-AIndex] := AEntry;
end;
procedure TDwarfLocationStack.Copy(AFromIndex, AIndex: Integer);
begin
Assert(AIndex < FCount);
Assert(AFromIndex < FCount);
FList[FCount-1-AIndex] := FList[FCount-1-AFromIndex];
end;
{ TDwarfLocationExpression }
constructor TDwarfLocationExpression.Create(AExpressionData: Pointer;
AMaxCount: Integer; ACU: TDwarfCompilationUnit;
AContext: TFpDbgLocationContext);
begin
FStack.Clear;
FCU := ACU;
FData := AExpressionData;
FMaxData := FData + AMaxCount;
FContext := AContext;
end;
procedure TDwarfLocationExpression.SetLastError(ALastError: TFpError);
begin
assert(Not IsError(FLastError), 'TDwarfLocationExpression.SetLastError: Not IsError(FLastError)');
FLastError := ALastError;
end;
procedure TDwarfLocationExpression.Evaluate;
var
CurInstr, CurData: PByte;
AddrSize: Byte;
procedure SetError(AnInternalErrorCode: TFpErrorCode = fpErrNoError);
begin
FStack.Push(InvalidLoc); // Mark as failed
if IsError(FContext.LastMemError)
then FLastError := CreateError(fpErrLocationParserMemRead, FContext.LastMemError, [])
else FLastError := CreateError(fpErrLocationParser, []);
debugln(FPDBG_DWARF_ERRORS,
['DWARF ERROR in TDwarfLocationExpression: Failed at Pos=', CurInstr-FData,
' OpCode=', IntToHex(CurInstr^, 2), ' Depth=', FStack.Count,
' Data: ', dbgMemRange(FData, FMaxData-FData),
' MemReader.LastError: ', ErrorHandler.ErrorAsString(FContext.LastMemError),
' Extra: ', ErrorHandler.ErrorAsString(AnInternalErrorCode, []) ]);
end;
function AssertAddressOnStack: Boolean; inline;
begin
Result := (FStack.PeekKind in [mlfTargetMem, mlfSelfMem, mlfConstantDeref]);
if not Result then
SetError(fpErrLocationParserNoAddressOnStack);
end;
function AssertMinCount(ACnt: Integer): Boolean; inline;
begin
Result := FStack.Count >= ACnt;
if not Result then
SetError(fpErrLocationParserMinStack);
end;
function ReadAddressFromMemory(AnAddress: TFpDbgMemLocation; ASize: Cardinal; out AValue: TFpDbgMemLocation): Boolean;
begin
//TODO: zero fill / sign extend
if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False);
Result := FContext.ReadAddress(AnAddress, SizeVal(ASize), AValue);
if not Result then
SetError;
end;
function ReadAddressFromMemoryEx(AnAddress: TFpDbgMemLocation; AnAddrSpace: TDbgPtr; ASize: Cardinal; out AValue: TFpDbgMemLocation): Boolean;
begin
//TODO: zero fill / sign extend
if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False);
AValue := FContext.ReadAddressEx(AnAddress, AnAddrSpace, SizeVal(ASize));
Result := IsValidLoc(AValue);
if not Result then
SetError;
end;
function ReadUnsignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Result := PByte(CurInstr)^;
2: Result := PWord(CurInstr)^;
4: Result := PLongWord(CurInstr)^;
8: Result := PQWord(CurInstr)^;
0: Result := ULEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
function ReadSignedFromExpression(var CurInstr: Pointer; ASize: Integer): TDbgPtr;
begin
case ASize of
1: Int64(Result) := PShortInt(CurInstr)^;
2: Int64(Result) := PSmallInt(CurInstr)^;
4: Int64(Result) := PLongint(CurInstr)^;
8: Int64(Result) := PInt64(CurInstr)^;
0: Int64(Result) := SLEB128toOrdinal(CurInstr);
end;
inc(CurInstr, ASize);
end;
var
NewLoc, Loc: TFpDbgMemLocation;
NewValue: TDbgPtr;
i: TDbgPtr;
x : integer;
Entry: TFpDbgMemLocation;
EntryP: PFpDbgMemLocation;
begin
(* Returns the address of the value.
- Except for DW_OP_regN and DW_OP_piece, which return the value itself. (Not sure about DW_OP_constN)
- Some tags override that, e.g.: DW_AT_upper_bound will allways interpret the result as a value.
*)
AddrSize := FCU.FAddressSize;
FContext.ClearLastMemError;
FLastError := NoError;
CurData := FData;
while CurData < FMaxData do begin
CurInstr := CurData;
inc(CurData);
case CurInstr^ of
DW_OP_nop: ;
DW_OP_addr: begin
FStack.Push(FCU.ReadTargetAddressFromDwarfSection(CurData, True)); // always mlfTargetMem;
end;
DW_OP_deref: begin
if not AssertAddressOnStack then exit;
EntryP := FStack.PeekForDeref;
if not ReadAddressFromMemory(EntryP^, AddrSize, NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
DW_OP_xderef: begin
if not AssertAddressOnStack then exit;
Loc := FStack.Pop;
if not AssertAddressOnStack then exit;
EntryP := FStack.Peek;
// TODO check address is valid
if not ReadAddressFromMemoryEx(Loc, EntryP^.Address, AddrSize, NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
DW_OP_deref_size: begin
if not AssertAddressOnStack then exit;
EntryP := FStack.PeekForDeref;
if not ReadAddressFromMemory(EntryP^, ReadUnsignedFromExpression(CurData, 1), NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
DW_OP_xderef_size: begin
if not AssertAddressOnStack then exit;
Loc := FStack.Pop;
if not AssertAddressOnStack then exit;
EntryP := FStack.Peek;
// TODO check address is valid
if not ReadAddressFromMemoryEx(Loc, EntryP^.Address, ReadUnsignedFromExpression(CurData, 1), NewLoc) then exit;
EntryP^ := NewLoc; // mlfTargetMem;
end;
DW_OP_const1u: FStack.PushConst(ReadUnsignedFromExpression(CurData, 1));
DW_OP_const2u: FStack.PushConst(ReadUnsignedFromExpression(CurData, 2));
DW_OP_const4u: FStack.PushConst(ReadUnsignedFromExpression(CurData, 4));
DW_OP_const8u: FStack.PushConst(ReadUnsignedFromExpression(CurData, 8));
DW_OP_constu: FStack.PushConst(ReadUnsignedFromExpression(CurData, 0));
DW_OP_const1s: FStack.PushConst(ReadSignedFromExpression(CurData, 1));
DW_OP_const2s: FStack.PushConst(ReadSignedFromExpression(CurData, 2));
DW_OP_const4s: FStack.PushConst(ReadSignedFromExpression(CurData, 4));
DW_OP_const8s: FStack.PushConst(ReadSignedFromExpression(CurData, 8));
DW_OP_consts: FStack.PushConst(ReadSignedFromExpression(CurData, 0));
DW_OP_lit0..DW_OP_lit31: FStack.PushConst(CurInstr^-DW_OP_lit0);
DW_OP_reg0..DW_OP_reg31: begin
if not FContext.ReadRegister(CurInstr^-DW_OP_reg0, NewValue) then begin
SetError;
exit;
end;
FStack.PushConst(NewValue);
end;
DW_OP_regx: begin
FStack.PushTargetRegister(ULEB128toOrdinal(CurData));
end;
DW_OP_breg0..DW_OP_breg31: begin
if not FContext.ReadRegister(CurInstr^-DW_OP_breg0, NewValue) then begin
SetError;
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.PushTargetMem(NewValue+SLEB128toOrdinal(CurData));
{$POP}
end;
DW_OP_bregx: begin
if not FContext.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
SetError;
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.PushTargetMem(NewValue+SLEB128toOrdinal(CurData));
{$POP}
end;
DW_OP_fbreg: begin
if (FFrameBase = 0) and (FOnFrameBaseNeeded <> nil) then FOnFrameBaseNeeded(Self);
if FFrameBase = 0 then begin
if not IsError(FLastError) then
SetError;
exit;
end;
{$PUSH}{$R-}{$Q-}
FStack.PushTargetMem(FFrameBase+SLEB128toOrdinal(CurData));
{$POP}
end;
DW_OP_dup: begin
if not AssertMinCount(1) then exit;
FStack.PushCopy(0);
end;
DW_OP_drop: begin
if not AssertMinCount(1) then exit;
FStack.Pop;
end;
DW_OP_over: begin
if not AssertMinCount(2) then exit;
FStack.PushCopy(1);
end;
DW_OP_pick: begin
i := ReadUnsignedFromExpression(CurData, 1);
if not AssertMinCount(i) then exit;
FStack.PushCopy(i);
end;
DW_OP_swap: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Peek^;
FStack.Copy(1, 0);
FStack.Modify(1, Entry);
end;
DW_OP_rot: begin
if not AssertMinCount(3) then exit;
Entry := FStack.Peek^;
FStack.Copy(1, 0);
FStack.Copy(2, 1);
FStack.Modify(2, Entry);
end;
DW_OP_abs: begin
if not AssertMinCount(1) then exit;
EntryP := FStack.Peek;
EntryP^.Address := abs(int64(EntryP^.Address));
end;
DW_OP_neg: begin
if not AssertMinCount(1) then exit;
EntryP := FStack.Peek;
EntryP^.Address := TDbgPtr(-int64(EntryP^.Address));
end;
DW_OP_plus: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
//TODO: 32 bit overflow?
EntryP^.Address := Entry.Address+EntryP^.Address;
{$POP}
(* TargetMem may be a constant after deref. So if SelfMem is involved, keep it. *)
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_plus_uconst: begin
if not AssertMinCount(1) then exit;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
EntryP^.Address := EntryP^.Address + ULEB128toOrdinal(CurData);
{$POP}
end;
DW_OP_minus: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
//TODO: 32 bit overflow?
EntryP^.Address := EntryP^.Address - Entry.Address;
{$POP}
(* TargetMem may be a constant after deref. So if SelfMem is involved, keep it. *)
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_mul: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
//{$PUSH}{$R-}{$Q-}
EntryP^.Address := TDbgPtr(int64(EntryP^.Address) * int64(Entry.Address));
//{$POP}
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_div: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
//{$PUSH}{$R-}{$Q-}
EntryP^.Address := TDbgPtr(int64(EntryP^.Address) div int64(Entry.Address));
//{$POP}
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_mod: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
//{$PUSH}{$R-}{$Q-}
EntryP^.Address := TDbgPtr(int64(EntryP^.Address) mod int64(Entry.Address));
//{$POP}
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_and: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := EntryP^.Address and Entry.Address;
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_not: begin
if not AssertMinCount(1) then exit;
EntryP := FStack.Peek;
EntryP^.Address := not EntryP^.Address;
end;
DW_OP_or: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := EntryP^.Address or Entry.Address;
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_xor: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := EntryP^.Address xor Entry.Address;
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_shl: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := EntryP^.Address shl Entry.Address;
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_shr: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := EntryP^.Address shr Entry.Address;
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_shra: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
EntryP^.Address := TDBGPtr( int64(EntryP^.Address) div int64(1 shl (Entry.Address - 1)) );
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
DW_OP_skip: begin
x := ReadSignedFromExpression(CurData, 2);
CurData := CurData + x;
end;
DW_OP_bra: begin
if not AssertMinCount(1) then exit;
Entry := FStack.PopForDeref;
x := ReadSignedFromExpression(CurData, 2);
// mlfConstantDeref => The virtual address pointing to this constant is not nil
if (Entry.Address <> 0) or (Entry.MType = mlfConstantDeref) then
CurData := CurData + x;
end;
DW_OP_eq: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if Entry.Address = EntryP^.Address
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_ge: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if int64(Entry.Address) >= int64(EntryP^.Address)
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_gt: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if int64(Entry.Address) > int64(EntryP^.Address)
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_le: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if int64(Entry.Address) <= int64(EntryP^.Address)
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_lt: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if int64(Entry.Address) < int64(EntryP^.Address)
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_ne: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
if Entry.Address <> EntryP^.Address
then EntryP^.Address := 1
else EntryP^.Address := 0;
EntryP^.MType := mlfConstant;
end;
DW_OP_piece: begin
if not AssertMinCount(1) then exit; // no piece avail
x := ReadUnsignedFromExpression(CurData, 0);
Entry := FStack.Pop;
// TODO: assemble data // Not implemented
// If entry is an address (not a register) then it points to the value
SetError(fpErrLocationParser);
exit;
end;
// dwarf 3
DW_OP_push_object_address: begin
if not IsValidLoc(FCurrentObjectAddress) then begin
SetError;
exit;
end;
Push(FCurrentObjectAddress);
end;
(*
// --- DWARF3 ---
DW_OP_call2 = $98; // 1 2-byte offset of DIE
DW_OP_call4 = $99; // 1 4-byte offset of DIE
DW_OP_call_ref = $9a; // 1 4- or 8-byte offset of DIE
DW_OP_form_tls_address = $9b; // 0
DW_OP_call_frame_cfa = $9c; // 0
DW_OP_bit_piece = $9d; // 2
*)
else
begin
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDwarfLocationExpression.Evaluate UNKNOWN ', CurInstr^]);
SetError;
exit;
end;
end;
if FStack.FError <> fpErrNoError then begin
SetError(FStack.FError);
exit;
end;
end;
if (FLastError = nil) and (FStack.FError = fpErrNoError) then begin
if not AssertMinCount(1) then exit; // no value for result
//TODO: If a caller expects it, it could accept mlfConstantDeref as result (but it would still need to deref it)
FStack.Peek(); // check that the result value is valid
if FStack.FError <> fpErrNoError then
SetError(FStack.FError);
end;
end;
function TDwarfLocationExpression.ResultData: TFpDbgMemLocation;
begin
if (FLastError <> nil) or (FStack.FError <> fpErrNoError) or (FStack.Count = 0) then
exit(InvalidLoc);
if FStack.Count > 0 then
Result := FStack.Peek^
else
Result := InvalidLoc;
end;
procedure TDwarfLocationExpression.Push(AValue: TFpDbgMemLocation);
begin
FStack.Push(AValue);
end;
{ TDwarfInformationEntry }
procedure TDwarfInformationEntry.ScopeChanged;
begin
FInformationEntry := FScope.Entry;
FFlags := [];
FInformationData := nil;
if FAbstractOrigin <> nil then
ReleaseRefAndNil(FAbstractOrigin);
end;
procedure TDwarfInformationEntry.PrepareAbbrev;
begin
if dieAbbrevValid in FFlags then
exit;
FInformationData := FCompUnit.FAbbrevList.FindLe128bFromPointer(FInformationEntry, FAbbrev);
Include(FFlags, dieAbbrevValid);
end;
function TDwarfInformationEntry.GetAttribForm(AnIdx: Integer): Cardinal;
begin
Result := FAbbrevData[AnIdx].Form;
end;
function TDwarfInformationEntry.PrepareAbbrevData: Boolean;
var
AbbrList: TDwarfAbbrevList;
begin
Result := FAbbrevData <> nil;
if dieAbbrevDataValid in FFlags then
exit;
AbbrList := FCompUnit.FAbbrevList;
// PrepareAbbrev;
if not(dieAbbrevValid in FFlags) then
FInformationData := AbbrList.FindLe128bFromPointer(FInformationEntry, FAbbrev);
Result := FInformationData <> nil;
if Result
then FAbbrevData := AbbrList.EntryPointer[FAbbrev^.index]
else FAbbrevData := nil;
FFlags := FFlags + [dieAbbrevValid, dieAbbrevDataValid];
end;
function TDwarfInformationEntry.PrepareAbstractOrigin: Boolean;
var
FwdInfoPtr: Pointer;
FwdCompUint: TDwarfCompilationUnit;
begin
if (dieAbstractOriginValid in FFlags) then begin
Result := FAbstractOrigin <> nil;
exit;
end;
Assert(dieAbbrevValid in FFlags);
Assert(dafHasAbstractOrigin in FAbbrev^.flags);
Include(FFlags, dieAbstractOriginValid);
if ReadReference(DW_AT_abstract_origin, FwdInfoPtr, FwdCompUint) then begin
FAbstractOrigin := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
// TODO, check correct tag
Result := FAbstractOrigin <> nil;
end
else
Result := False;
end;
function TDwarfInformationEntry.GetAbbrevTag: Cardinal;
begin
PrepareAbbrev;
if FAbbrev <> nil
then Result := FAbbrev^.tag
else Result := 0;
end;
procedure TDwarfInformationEntry.GoParent;
begin
if not MaybeSearchScope then
exit;
FScope.GoParent;
ScopeChanged;
end;
procedure TDwarfInformationEntry.GoNext;
begin
if not MaybeSearchScope then
exit;
FScope.GoNext;
ScopeChanged;
end;
procedure TDwarfInformationEntry.GoChild;
begin
if not MaybeSearchScope then
exit;
FScope.GoChild;
ScopeChanged;
end;
function TDwarfInformationEntry.HasValidScope: Boolean;
begin
Result := FScope.IsValid;
end;
function TDwarfInformationEntry.ScopeDebugText: String;
begin
Result := dbgs(FScope, FCompUnit);
end;
function TDwarfInformationEntry.SearchScope: Boolean;
var
l, h, m: Integer;
lst: TDwarfScopeArray;
begin
Result := FInformationEntry <> nil;
if not Result then exit;
l := 0;
h := FCompUnit.FScopeList.HighestKnown;
lst := FCompUnit.FScopeList.List;
while h > l do begin
m := (h + l) div 2;
if lst[m].Entry >= FInformationEntry
then h := m
else l := m + 1;
end;
Result := lst[h].Entry = FInformationEntry;
if Result then
ScopeIndex := h;
//debugln(['TDwarfInformationEntry.SearchScope ', h]);
end;
function TDwarfInformationEntry.MaybeSearchScope: Boolean;
begin
Result := FScope.IsValid;
if Result then exit;
Result := SearchScope;
end;
function TDwarfInformationEntry.HasAttrib(AnAttrib: Cardinal): Boolean;
var
i: Integer;
begin
Result := False;
if not PrepareAbbrevData then exit;
for i := 0 to FAbbrev^.count - 1 do
if FAbbrevData[i].Attribute = AnAttrib then begin
Result := True;
exit;
end;
end;
procedure TDwarfInformationEntry.ComputeKnownHashes(
AKNownHashes: PKnownNameHashesArray);
var
EntryName: PChar;
NextTopLevel: Integer;
h: LongWord;
InEnum: Boolean;
begin
InEnum := False;
if not HasValidScope then
exit;
NextTopLevel := 0;
dec(FScope.FIndex);
while (FScope.Index < FScope.FScopeList^.HighestKnown) do begin
inc(FScope.FIndex);
ScopeChanged;
PrepareAbbrev;
if not (dafHasName in FAbbrev^.flags) then begin
if FScope.Index >= NextTopLevel then
NextTopLevel := FScope.GetNextIndex;
Continue;
end;
if not ReadValue(DW_AT_name, EntryName) then begin
if FScope.Index >= NextTopLevel then
NextTopLevel := FScope.GetNextIndex;
Continue;
end;
h := objpas.Hash(QuickUtf8UpperCase(EntryName)) and $7fff or $8000;
FScope.Current^.NameHash := h;
if (FScope.Index >= NextTopLevel) or InEnum then
AKNownHashes^[h and KnownNameHashesBitMask] := True;
if FScope.Index >= NextTopLevel then begin
InEnum := False;
if FAbbrev^.tag = DW_TAG_enumeration_type then begin
InEnum := True;
NextTopLevel := FScope.GetNextIndex;
Continue;
end;
end;
if FScope.Index >= NextTopLevel then
NextTopLevel := FScope.GetNextIndex;
end;
end;
function TDwarfInformationEntry.GetScopeIndex: Integer;
begin
Result := FScope.Index;
end;
procedure TDwarfInformationEntry.SetScopeIndex(AValue: Integer);
begin
if FScope.Index = AValue then
exit;
FScope.Index := AValue;
ScopeChanged;
end;
function TDwarfInformationEntry.GoNamedChild(const AName: String): Boolean;
var
EntryName: PChar;
s1, s2: String;
begin
Result := False;
if AName = '' then
exit;
GoChild;
if not HasValidScope then
exit;
s1 := QuickUtf8UpperCase(AName);
s2 := UTF8LowerCase(AName);
while HasValidScope do begin
PrepareAbbrev;
if not (dafHasName in FAbbrev^.flags) then begin
GoNext;
Continue;
end;
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
Continue;
end;
if CompareUtf8BothCase(@s1[1], @s2[1], EntryName) then begin
// TODO: check DW_AT_start_scope;
DebugLn(FPDBG_DWARF_SEARCH, ['GoNamedChild found ', dbgs(FScope, FCompUnit), ' Result=', DbgSName(Self), ' FOR ', AName]);
Result := True;
exit;
end;
GoNext;
end;
end;
function TDwarfInformationEntry.GoNamedChildEx(const ANameInfo: TNameSearchInfo): Boolean;
var
EntryName: PChar;
InEnum: Boolean;
ParentScopIdx: Integer;
sc: PDwarfScopeInfoRec;
begin
Result := False;
InEnum := False;
if ANameInfo.NameUpper = '' then
exit;
GoChild;
if not HasValidScope then
exit;
while true do begin
while HasValidScope do begin
sc := FScope.Current;
if sc^.NameHash = 0 then begin
GoNext;
Continue;
end;
PrepareAbbrev;
if not (dafHasName in FAbbrev^.flags) then begin
assert(false);
GoNext;
Continue;
end;
if (sc^.NameHash = ANameInfo.NameHash) then begin
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
Continue;
end;
if CompareUtf8BothCase(PChar(ANameInfo.NameUpper), PChar(ANameInfo.nameLower), EntryName) then begin
// TODO: check DW_AT_start_scope;
DebugLn(FPDBG_DWARF_SEARCH, ['GoNamedChildEX found ', dbgs(FScope, FCompUnit), ' Result=', DbgSName(Self), ' FOR ', ANameInfo.nameLower]);
Result := True;
exit;
end;
end;
if FAbbrev^.tag = DW_TAG_enumeration_type then begin
assert(not InEnum, 'nested enum');
InEnum := True;
ParentScopIdx := ScopeIndex;
GoChild;
Continue;
end;
GoNext;
end;
if InEnum then begin
InEnum := False;
ScopeIndex := ParentScopIdx;
GoNext;
continue;
end;
break;
end;
end;
function TDwarfInformationEntry.GoNamedChildMatchCaseEx(
const ANameInfo: TNameSearchInfo): Boolean;
var
EntryName: PChar;
sc: PDwarfScopeInfoRec;
begin
Result := False;
if ANameInfo.NameUpper = '' then
exit;
GoChild;
if not HasValidScope then
exit;
while HasValidScope do begin
sc := FScope.Current;
if sc^.NameHash = 0 then begin
GoNext;
Continue;
end;
PrepareAbbrev;
if not (dafHasName in FAbbrev^.flags) then begin
Assert(false);
GoNext;
Continue;
end;
if (sc^.NameHash = ANameInfo.NameHash) then begin
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
Continue;
end;
if CompareMem(PChar(ANameInfo.nameLower), @EntryName, Length(EntryName)) then begin
// TODO: check DW_AT_start_scope;
DebugLn(FPDBG_DWARF_SEARCH, ['GoNamedChildEX found ', dbgs(FScope, FCompUnit), ' Result=', DbgSName(Self), ' FOR ', ANameInfo.nameLower]);
Result := True;
exit;
end;
end;
GoNext;
end;
end;
function TDwarfInformationEntry.GoNamedChildEx(const AName: String): Boolean;
begin
Result := False;
if AName = '' then
exit;
Result := GoNamedChildEx(NameInfoForSearch(AName));
end;
constructor TDwarfInformationEntry.Create(ACompUnit: TDwarfCompilationUnit;
AnInformationEntry: Pointer);
begin
inherited Create;
AddReference;
FCompUnit := ACompUnit;
FInformationEntry := AnInformationEntry;
FScope.Init(@FCompUnit.FScopeList);
end;
constructor TDwarfInformationEntry.Create(ACompUnit: TDwarfCompilationUnit;
AScope: TDwarfScopeInfo);
begin
inherited Create;
AddReference;
FCompUnit := ACompUnit;
FScope := AScope;
ScopeChanged;
end;
destructor TDwarfInformationEntry.Destroy;
begin
FAbstractOrigin.ReleaseReference;
inherited Destroy;
end;
function TDwarfInformationEntry.GetAttribData(AnAttrib: Cardinal; out
AnAttribData: TDwarfAttribData): Boolean;
var
i: Integer;
p: PDwarfAbbrevEntry;
AddrSize: Byte;
InfoPointer: Pointer;
IsDwarf64: Boolean;
Version: Word;
begin
Result := False;
if not PrepareAbbrevData then
exit;
AddrSize := FCompUnit.FAddressSize;
IsDwarf64 := FCompUnit.IsDwarf64;
Version := FCompUnit.Version;
InfoPointer := FInformationData;
p := FAbbrevData;
for i := 0 to FAbbrev^.count - 1 do begin
if p^.Attribute = AnAttrib then begin
AnAttribData.Idx := i;
AnAttribData.InfoPointer := InfoPointer;
AnAttribData.InformationEntry := Self;
Result := True;
exit;
end;
SkipEntryDataForForm(InfoPointer, p^.Form, AddrSize, IsDwarf64, Version);
inc(p);
end;
if (dafHasAbstractOrigin in FAbbrev^.flags) and PrepareAbstractOrigin then
Result := FAbstractOrigin.GetAttribData(AnAttrib, AnAttribData);
end;
function TDwarfInformationEntry.FindNamedChild(const AName: String
): TDwarfInformationEntry;
begin
Result := nil;
if not MaybeSearchScope then
exit;
Result := TDwarfInformationEntry.Create(FCompUnit, FScope);
// TODO: parent
if Result.GoNamedChild(AName) then
exit;
ReleaseRefAndNil(Result);
end;
function TDwarfInformationEntry.FindChildByTag(ATag: Cardinal): TDwarfInformationEntry;
var
Scope: TDwarfScopeInfo;
AbbrList: TDwarfAbbrevList;
Abbr: TDwarfAbbrev;
begin
Result := nil;
if not MaybeSearchScope then
exit;
Scope := FScope.Child;
while Scope.IsValid do begin
AbbrList := FCompUnit.FAbbrevList;
if AbbrList.FindLe128bFromPointer(Scope.Entry, Abbr) <> nil then begin
if Abbr.tag = ATag then begin
Result := TDwarfInformationEntry.Create(FCompUnit, Scope);
exit;
end;
end;
Scope.GoNext;
end;
end;
function TDwarfInformationEntry.FirstChild: TDwarfInformationEntry;
var
Scope: TDwarfScopeInfo;
begin
Result := nil;
if not MaybeSearchScope then
exit;
Scope := FScope.Child;
if Scope.IsValid then
Result := TDwarfInformationEntry.Create(FCompUnit, Scope);
end;
function TDwarfInformationEntry.Clone: TDwarfInformationEntry;
begin
if FScope.IsValid then
Result := TDwarfInformationEntry.Create(FCompUnit, FScope)
else
Result := TDwarfInformationEntry.Create(FCompUnit, FInformationEntry);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: Integer): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: Int64): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: Cardinal): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: QWord): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: PChar): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: String): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadValue(const AnAttribData: TDwarfAttribData;
out AValue: TByteDynArray; AnFormString: Boolean): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue, AnFormString
);
end;
function TDwarfInformationEntry.ReadAddressValue(
const AnAttribData: TDwarfAttribData; out AValue: TDBGPtr): Boolean;
begin
Result := AnAttribData.InformationEntry.FCompUnit.ReadAddressValue(
AnAttribData.InfoPointer,
AnAttribData.InformationEntry.FAbbrevData[AnAttribData.Idx].Form,
AValue
);
end;
function TDwarfInformationEntry.ReadReference(
const AnAttribData: TDwarfAttribData; out AValue: Pointer; out
ACompUnit: TDwarfCompilationUnit): Boolean;
begin
Result := AnAttribData.InformationEntry.DoReadReference(
AnAttribData.Idx, AnAttribData.InfoPointer,
AValue, ACompUnit
);
end;
function TDwarfInformationEntry.DoReadReference(
InfoIdx: Integer; InfoData: pointer; out AValue: Pointer; out
ACompUnit: TDwarfCompilationUnit): Boolean;
const
CU_HEADER_SIZE: array [boolean] of QWord = (SizeOf(TDwarfCUHeader32), SizeOf(TDwarfCUHeader64));
var
Form: Cardinal;
Offs: QWord;
begin
// reference to other debug info
{Note: Dwarf2 defines DW_FORM_ref_addr as relocated address in the exe,
Dwarf 3 defines it as offset.
Since we load the debug_info section without applying any relocation (if indeed present at all),
this field will always be an offset from start of the debug_info section
}
Result := False;
if InfoIdx < 0 then
exit;
Form := FAbbrevData[InfoIdx].Form;
if (Form = DW_FORM_ref1) or (Form = DW_FORM_ref2) or (Form = DW_FORM_ref4) or
(Form = DW_FORM_ref8) or (Form = DW_FORM_ref_udata)
then begin
Result := FCompUnit.ReadValue(InfoData, Form, Offs);
if not Result then
exit;
ACompUnit := FCompUnit;
{$PUSH}{$R-}
AValue := ACompUnit.FScope.Entry - CU_HEADER_SIZE[ACompUnit.FIsDwarf64] + Offs;
{$POP}
if (AValue < ACompUnit.FInfoData) or (AValue >= ACompUnit.FInfoData + ACompUnit.FLength) then begin
DebugLn(FPDBG_DWARF_ERRORS, 'Error: Reference to invalid location. Offset %d is outsize the CU of size %d', [Offs, ACompUnit.FLength]);
AValue := nil;
Result := False;
end;
end
else
if (Form = DW_FORM_ref_addr) then begin
if FCompUnit.Version=2 then
Result := FCompUnit.ReadAddressValue(InfoData, Form, Offs)
else
Result := FCompUnit.ReadValue(InfoData, Form, Offs);
if not Result then
exit;
AValue := FCompUnit.DebugFile^.Sections[dsInfo].RawData + Offs;
if (AValue >= FCompUnit.FInfoData) and (AValue < FCompUnit.FInfoData + FCompUnit.FLength) then
ACompUnit := FCompUnit
else
ACompUnit := FCompUnit.FOwner.FindCompilationUnitByOffs(Offs);
Result := ACompUnit <> nil;
DebugLn(FPDBG_DWARF_WARNINGS and (not Result), ['Comp unit not found DW_FORM_ref_addr']);
end
else begin
DebugLn(FPDBG_DWARF_VERBOSE, ['FORM for ReadReference not expected ', DwarfAttributeFormToString(Form)]);
end;
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: Integer): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: Int64): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: Cardinal): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: QWord): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: PChar): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out AValue: String): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue);
end;
function TDwarfInformationEntry.ReadValue(AnAttrib: Cardinal; out
AValue: TByteDynArray; AnFormString: Boolean): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := ReadValue(AttrData, AValue, AnFormString);
end;
function TDwarfInformationEntry.ReadReference(AnAttrib: Cardinal; out AValue: Pointer; out
ACompUnit: TDwarfCompilationUnit): Boolean;
var
AttrData: TDwarfAttribData;
begin
Result := GetAttribData(AnAttrib, AttrData);
if Result then
Result := AttrData.InformationEntry.DoReadReference(
AttrData.Idx, AttrData.InfoPointer,
AValue, ACompUnit
);
end;
function TDwarfInformationEntry.ReadName(out AName: String): Boolean;
var
AttrData: TDwarfAttribData;
begin
PrepareAbbrev;
if dafHasName in FAbbrev^.flags then begin
Result := GetAttribData(DW_AT_name, AttrData);
assert(Result and (AttrData.InformationEntry = Self), 'TDwarfInformationEntry.ReadName');
Result := ReadValue(AttrData, AName);
end
else
if (dafHasAbstractOrigin in FAbbrev^.flags) and PrepareAbstractOrigin then
Result := FAbstractOrigin.ReadName(AName)
else
Result := False;
end;
function TDwarfInformationEntry.ReadName(out AName: PChar): Boolean;
var
AttrData: TDwarfAttribData;
begin
PrepareAbbrev;
if dafHasName in FAbbrev^.flags then begin
Result := GetAttribData(DW_AT_name, AttrData);
assert(Result and (AttrData.InformationEntry = Self), 'TDwarfInformationEntry.ReadName');
Result := ReadValue(AttrData, AName);
end
else
if (dafHasAbstractOrigin in FAbbrev^.flags) and PrepareAbstractOrigin then
Result := FAbstractOrigin.ReadName(AName)
else
Result := False;
end;
function TDwarfInformationEntry.ReadStartScope(out AStartScope: TDbgPtr): Boolean;
var
AttrData: TDwarfAttribData;
begin
PrepareAbbrev;
if dafHasStartScope in FAbbrev^.flags then begin
Result := GetAttribData(DW_AT_start_scope, AttrData);
assert(Result and (AttrData.InformationEntry = Self), 'TDwarfInformationEntry.ReadName');
Result := ReadValue(AttrData, AStartScope);
end
else
if (dafHasAbstractOrigin in FAbbrev^.flags) and PrepareAbstractOrigin then
Result := FAbstractOrigin.ReadStartScope(AStartScope)
else
Result := False;
end;
function TDwarfInformationEntry.IsAddressInStartScope(AnAddress: TDbgPtr): Boolean;
var
StartScope: TDbgPtr;
begin
Result := not ReadStartScope(StartScope);
if Result then exit; // no startscope, always in scope
Result := AnAddress >= StartScope;
end;
function TDwarfInformationEntry.IsArtificial: Boolean;
var
Val: Integer;
begin
Result := ReadValue(DW_AT_artificial, Val);
if Result then Result := Val <> 0;
end;
{ TDWarfLineMap }
procedure TDWarfLineMap.Init;
begin
end;
procedure TDWarfLineMap.SetAddressForLine(ALine: Cardinal; AnAddress: TDBGPtr);
var
SectLen, SectCnt, i, j, o, o2: Integer;
idx, offset: TDBGPtr;
LineOffsets: Array of Byte;
Addresses: Array of TDBGPtr;
begin
idx := ALine div 256;
offset := ALine mod 256;
i := Length(FLineIndexList);
if idx >= i then
SetLength(FLineIndexList, idx+4);
LineOffsets := FLineIndexList[idx].LineOffsets;
Addresses := FLineIndexList[idx].Addresses;
if Addresses = nil then begin
SectLen := 192;
SectCnt := 0;
SetLength(FLineIndexList[idx].Addresses, 193);
SetLength(FLineIndexList[idx].LineOffsets, 192);
LineOffsets := FLineIndexList[idx].LineOffsets;
Addresses := FLineIndexList[idx].Addresses;
end
else begin
SectLen := Length(LineOffsets);
SectCnt := Integer(Addresses[SectLen]);
if SectCnt >= SectLen then begin
SectLen := SectCnt + 64;
SetLength(FLineIndexList[idx].Addresses, SectLen+1);
SetLength(FLineIndexList[idx].LineOffsets, SectLen);
LineOffsets := FLineIndexList[idx].LineOffsets;
Addresses := FLineIndexList[idx].Addresses;
end;
end;
i := 0;
o := 0;
while (i < SectCnt) do begin
o2 := o + LineOffsets[i];
if o2 > offset then break;
o := o2;
inc(i);
end;
j := SectCnt;
while j > i do begin
LineOffsets[j] := LineOffsets[j-1];
Addresses[j] := Addresses[j-1];
dec(j);
end;
offset := offset - o;
LineOffsets[i] := offset;
Addresses[i] := AnAddress;
if i < SectCnt then begin
assert(LineOffsets[i+1] >= offset, 'TDWarfLineMap.SetAddressForLine LineOffsets[i+1] > offset');
LineOffsets[i+1] := LineOffsets[i+1] - offset;
end;
Addresses[SectLen] := SectCnt + 1;
end;
function TDWarfLineMap.GetAddressesForLine(ALine: Cardinal;
var AResultList: TDBGPtrArray; NoData: Boolean): Boolean;
var
idx, offset: TDBGPtr;
LineOffsets: Array of Byte;
Addresses: Array of TDBGPtr;
o: Byte;
i, j, k, l: Integer;
begin
Result := False;
idx := ALine div 256;
offset := ALine mod 256;
if idx >= Length(FLineIndexList) then
exit;
LineOffsets := FLineIndexList[idx].LineOffsets;
Addresses := FLineIndexList[idx].Addresses;
if Addresses = nil then
exit;
l := Length(LineOffsets);
i := 0;
while (i < l) do begin
o := LineOffsets[i];
if o > offset then exit;
offset := offset - o;
if offset = 0 then break;
inc(i);
end;
If (offset > 0) then
exit;
if NoData then begin
Result := True;
exit;
end;
j := i + 1;
while (j < l) and (LineOffsets[j] = 0) do inc(j);
k := Length(AResultList);
SetLength(AResultList, k + (j-i));
while i < j do begin
AResultList[k] := Addresses[i];
inc(i);
inc(k);
end;
Result := True;
end;
procedure TDWarfLineMap.Compress;
var
i, j: Integer;
begin
for i := 0 to high(FLineIndexList) do begin
j := Length(FLineIndexList[i].LineOffsets);
if j <> 0 then begin
j := FLineIndexList[i].Addresses[j];
SetLength(FLineIndexList[i].Addresses, j+1);
FLineIndexList[i].Addresses[j] := j;
SetLength(FLineIndexList[i].LineOffsets, j);
end;
end;
end;
{ TFpDwarfInfo }
constructor TFpDwarfInfo.Create(ALoaderList: TDbgImageLoaderList;
AMemManager: TFpDbgMemManager);
var
Section: TDwarfSection;
p: PDbgImageSection;
i: Integer;
begin
FWorkQueue := FpDbgGlobalWorkerQueue;
FWorkQueue.AddRef;
inherited Create(ALoaderList, AMemManager);
FTargetInfo := ALoaderList.TargetInfo;
FCompilationUnits := TList.Create;
FImageBase := ALoaderList.ImageBase;
SetLength(FFiles, ALoaderList.Count);
for i := 0 to ALoaderList.Count-1 do
begin
FFiles[i].AddressMapList:=ALoaderList[i].AddressMapList;
for Section := Low(Section) to High(Section) do
begin
p := ALoaderList[i].Section[DWARF_SECTION_NAME[Section]];
if p = nil then Continue;
FFiles[i].Sections[Section].Section := Section;
FFiles[i].Sections[Section].RawData := p^.RawData;
FFiles[i].Sections[Section].Size := p^.Size;
FFiles[i].Sections[Section].VirtualAddress := p^.VirtualAddress;
end;
ALoaderList[i].CloseFileLoader;
end;
end;
destructor TFpDwarfInfo.Destroy;
var
n: integer;
begin
FWorkQueue.DecRef;
for n := 0 to FCompilationUnits.Count - 1 do
TObject(FCompilationUnits[n]).Free;
FreeAndNil(FCompilationUnits);
inherited Destroy;
end;
function TFpDwarfInfo.FindSymbolScope(ALocationContext: TFpDbgLocationContext;
AAddress: TDbgPtr): TFpDbgSymbolScope;
var
Proc, UnitSym: TDbgDwarfSymbolBase;
begin
Result := nil;
Proc := FindDwarfProcSymbol(AAddress); // TFpSymbolDwarfDataProc
if Proc <> nil then begin
Result := Proc.CreateSymbolScope(ALocationContext, Self);
Proc.ReleaseReference;
exit;
end;
UnitSym := FindDwarfUnitSymbol(AAddress);
if UnitSym <> nil then begin
Result := UnitSym.CreateSymbolScope(ALocationContext, Self);
UnitSym.ReleaseReference;
exit;
end;
if CompilationUnitsCount > 0 then
Result := CompilationUnits[0].DwarfSymbolClassMap.CreateScopeForSymbol
(ALocationContext, nil, Self);
end;
function TFpDwarfInfo.GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit;
begin
Result := TDwarfCompilationUnit(FCompilationUnits[Aindex]);
Result.WaitForScopeScan;
end;
function TFpDwarfInfo.GetCompilationUnitClass: TDwarfCompilationUnitClass;
begin
Result := TDwarfCompilationUnit;
end;
function TFpDwarfInfo.FindCompilationUnitByOffs(AOffs: QWord): TDwarfCompilationUnit;
var
l, h, m: Integer;
p: Pointer;
begin
Result := nil;
l := 0;
h := FCompilationUnits.Count - 1;
m := h;
while h > l do begin
p := TDwarfCompilationUnit(FCompilationUnits[m]).DebugFile^.Sections[dsInfo].RawData + AOffs;
m := (h + l + 1) div 2;
if TDwarfCompilationUnit(FCompilationUnits[m]).FInfoData <= p
then l := m
else h := m - 1;
end;
Result := TDwarfCompilationUnit(FCompilationUnits[h]);
if (p < Result.FInfoData) or (p > Result.FInfoData + Result.FLength) then
Result := nil
else
Result.WaitForScopeScan;
end;
function TFpDwarfInfo.FindDwarfProcSymbol(AAddress: TDbgPtr
): TDbgDwarfSymbolBase;
begin
Result := TDbgDwarfSymbolBase(FindProcSymbol(AAddress));
end;
function TFpDwarfInfo.FindProcSymbol(AAddress: TDbgPtr): TFpSymbol;
var
n: Integer;
CU: TDwarfCompilationUnit;
Iter: TLockedMapIterator;
Info: PDwarfAddressInfo;
MinMaxSet: boolean;
begin
Result := nil;
for n := 0 to FCompilationUnits.Count - 1 do
begin
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
CU.WaitForScopeScan;
if not CU.Valid then Continue;
MinMaxSet := CU.FMinPC <> CU.FMaxPC;
if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
then Continue;
CU.BuildAddressMap;
Iter := TLockedMapIterator.Create(CU.FAddressMap);
try
if not Iter.Locate(AAddress)
then begin
if not Iter.BOM
then Iter.Previous;
if Iter.BOM
then Continue;
end;
// iter is at the closest defined address before AAddress
Info := Iter.DataPtr;
if AAddress > Info^.EndPC
then Continue;
// TDbgDwarfProcSymbol
Result := Cu.DwarfSymbolClassMap.CreateProcSymbol(CU, Iter.DataPtr, AAddress, Self);
if Result<>nil then
break;
finally
Iter.Free;
end;
end;
end;
function TFpDwarfInfo.FindDwarfUnitSymbol(AAddress: TDbgPtr
): TDbgDwarfSymbolBase;
var
n: Integer;
CU: TDwarfCompilationUnit;
MinMaxSet: boolean;
Scope: TDwarfScopeInfo;
begin
Result := nil;
for n := 0 to FCompilationUnits.Count - 1 do
begin
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
CU.WaitForScopeScan;
if not CU.Valid then Continue;
MinMaxSet := CU.FMinPC <> CU.FMaxPC;
if (not MinMaxSet) or ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
then Continue;
if not CU.LocateEntry(DW_TAG_compile_unit, Scope) then
break;
Result := Cu.DwarfSymbolClassMap.CreateUnitSymbol(CU, TDwarfInformationEntry.Create(CU, Scope), Self);
break;
end;
end;
function TFpDwarfInfo.GetLineAddresses(const AFileName: String;
ALine: Cardinal; var AResultList: TDBGPtrArray): Boolean;
var
n: Integer;
CU: TDwarfCompilationUnit;
begin
Result := False;
for n := 0 to FCompilationUnits.Count - 1 do
begin
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
CU.WaitForScopeScan;
Result := CU.GetLineAddresses(AFileName, ALine, AResultList) or Result;
end;
end;
function TFpDwarfInfo.GetLineAddressMap(const AFileName: String): PDWarfLineMap;
var
n: Integer;
CU: TDwarfCompilationUnit;
begin
// TODO: Deal with line info split on 2 compilation units?
for n := 0 to FCompilationUnits.Count - 1 do
begin
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
CU.WaitForScopeScan;
Result := CU.GetLineAddressMap(AFileName);
if Result <> nil then Exit;
end;
Result := nil;
end;
function TFpDwarfInfo.LoadCompilationUnits: Integer;
var
p, pe: Pointer;
CU32: PDwarfCUHeader32 absolute p;
CU64: PDwarfCUHeader64 absolute p;
CU: TDwarfCompilationUnit;
CUClass: TDwarfCompilationUnitClass;
inf: TDwarfSectionInfo;
i: integer;
DataOffs, DataLen: QWord;
begin
CUClass := GetCompilationUnitClass;
for i := 0 to high(FFiles) do
begin
inf := FFiles[i].Sections[dsInfo];
p := inf.RawData;
pe := inf.RawData + inf.Size;
while (p <> nil) and (p < pe) do
begin
if CU64^.Signature = DWARF_HEADER64_SIGNATURE
then begin
if CU64^.Version < 3 then
DebugLn(FPDBG_DWARF_WARNINGS, ['Unexpected 64 bit signature found for DWARF version 2']); // or version 1...
DataOffs := PtrUInt(CU64 + 1) - PtrUInt(inf.RawData);
DataLen := CU64^.Length - SizeOf(CU64^) + SizeOf(CU64^.Signature) + SizeOf(CU64^.Length);
if DataOffs + DataLen > inf.Size then begin
DebugLn(FPDBG_DWARF_ERRORS, 'Error: Invalid size for compilation unit at offest %d with size %d exceeds section size %d', [DataOffs, DataLen, inf.Size]);
break; // Do not process invalid data
end;
CU := CUClass.Create(
Self,
@FFiles[i],
DataOffs,
DataLen,
CU64^.Version,
CU64^.AbbrevOffset,
CU64^.AddressSize,
True);
p := Pointer(@CU64^.Version) + CU64^.Length;
end
else begin
if CU32^.Length = 0 then Break;
DataOffs := PtrUInt(CU32 + 1) - PtrUInt(inf.RawData);
DataLen := CU32^.Length - SizeOf(CU32^) + SizeOf(CU32^.Length);
if DataOffs + DataLen > inf.Size then begin
DebugLn(FPDBG_DWARF_ERRORS, 'Error: Invalid size for compilation unit at offest %d with size %d exceeds section size %d', [DataOffs, DataLen, inf.Size]);
break; // Do not process invalid data
end;
CU := CUClass.Create(
Self,
@FFiles[i],
DataOffs,
DataLen,
CU32^.Version,
CU32^.AbbrevOffset,
CU32^.AddressSize,
False);
p := Pointer(@CU32^.Version) + CU32^.Length;
end;
FCompilationUnits.Add(CU);
if CU.Valid then SetHasInfo;
end;
end;
Result := FCompilationUnits.Count;
for i := 0 to Result - 1 do
TDwarfCompilationUnit(FCompilationUnits[i]).FComputeNameHashesWorker.MarkReadyToRun;
end;
function TFpDwarfInfo.PointerFromRVA(ARVA: QWord): Pointer;
begin
Result := Pointer(PtrUInt(FImageBase + ARVA));
end;
function TFpDwarfInfo.CompilationUnitsCount: Integer;
begin
Result := FCompilationUnits.Count;
end;
{ TDbgDwarfSymbolBase }
procedure TDbgDwarfSymbolBase.Init;
begin
//
end;
constructor TDbgDwarfSymbolBase.Create(const AName: String;
AnInformationEntry: TDwarfInformationEntry);
begin
FCU := AnInformationEntry.CompUnit;
FInformationEntry := AnInformationEntry;
FInformationEntry.AddReference;
inherited Create(AName);
Init;
end;
constructor TDbgDwarfSymbolBase.Create(const AName: String;
AnInformationEntry: TDwarfInformationEntry; AKind: TDbgSymbolKind;
AAddress: TFpDbgMemLocation);
begin
FCU := AnInformationEntry.CompUnit;
FInformationEntry := AnInformationEntry;
FInformationEntry.AddReference;
inherited Create(AName, AKind, AAddress);
Init;
end;
destructor TDbgDwarfSymbolBase.Destroy;
begin
ReleaseRefAndNil(FInformationEntry);
inherited Destroy;
end;
function TDbgDwarfSymbolBase.CreateSymbolScope(
ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
): TFpDbgSymbolScope;
begin
Result := nil;
end;
{ TDwarfLineInfoStateMachine }
function TDwarfLineInfoStateMachine.Clone: TDwarfLineInfoStateMachine;
begin
Result := TDwarfLineInfoStateMachine.Create(FOwner, FLineInfoPtr, FMaxPtr);
Result.FAddress := FAddress;
Result.FFileName := FFileName;
Result.FLine := FLine;
Result.FColumn := FColumn;
Result.FIsStmt := FIsStmt;
Result.FBasicBlock := FBasicBlock;
Result.FEndSequence := FEndSequence;
Result.FPrologueEnd := FPrologueEnd;
Result.FEpilogueBegin := FEpilogueBegin;
Result.FIsa := FIsa;
Result.FEnded := FEnded;
end;
constructor TDwarfLineInfoStateMachine.Create(AOwner: TDwarfCompilationUnit; ALineInfoPtr, AMaxPtr: Pointer);
begin
inherited Create;
FOwner := AOwner;
FLineInfoPtr := ALineInfoPtr;
FMaxPtr := AMaxPtr;
Reset;
end;
function TDwarfLineInfoStateMachine.NextLine: Boolean;
var
p: Pointer;
Opcode: Byte;
instrlen: Cardinal;
diridx: Cardinal;
begin
Result := False;
if FEndSequence
then begin
Reset;
end
else begin
FBasicBlock := False;
FPrologueEnd := False;
FEpilogueBegin := False;
end;
while pbyte(FLineInfoPtr) < FMaxPtr do
begin
Opcode := pbyte(FLineInfoPtr)^;
Inc(pbyte(FLineInfoPtr));
if Opcode <= Length(FOwner.FLineInfo.StandardOpcodeLengths)
then begin
// Standard opcode
case Opcode of
DW_LNS_copy: begin
Result := True;
Exit;
end;
DW_LNS_advance_pc: begin
Inc(FAddress, ULEB128toOrdinal(pbyte(FLineInfoPtr)));
end;
DW_LNS_advance_line: begin
Inc(FLine, SLEB128toOrdinal(pbyte(FLineInfoPtr)));
end;
DW_LNS_set_file: begin
SetFileName(ULEB128toOrdinal(pbyte(FLineInfoPtr)));
end;
DW_LNS_set_column: begin
FColumn := ULEB128toOrdinal(pbyte(FLineInfoPtr));
end;
DW_LNS_negate_stmt: begin
FIsStmt := not FIsStmt;
end;
DW_LNS_set_basic_block: begin
FBasicBlock := True;
end;
DW_LNS_const_add_pc: begin
Opcode := 255 - Length(FOwner.FLineInfo.StandardOpcodeLengths);
if FOwner.FLineInfo.LineRange = 0
then Inc(FAddress, Opcode * FOwner.FLineInfo.MinimumInstructionLength)
else Inc(FAddress, (Opcode div FOwner.FLineInfo.LineRange) * FOwner.FLineInfo.MinimumInstructionLength);
end;
DW_LNS_fixed_advance_pc: begin
Inc(FAddress, PWord(FLineInfoPtr)^);
Inc(pbyte(FLineInfoPtr), 2);
end;
DW_LNS_set_prologue_end: begin
FPrologueEnd := True;
end;
DW_LNS_set_epilogue_begin: begin
FEpilogueBegin := True;
end;
DW_LNS_set_isa: begin
FIsa := ULEB128toOrdinal(pbyte(FLineInfoPtr));
end;
// Extended opcode
DW_LNS_extended_opcode: begin
instrlen := ULEB128toOrdinal(pbyte(FLineInfoPtr)); // instruction length
case pbyte(FLineInfoPtr)^ of
DW_LNE_end_sequence: begin
FEndSequence := True;
Result := True;
Inc(pbyte(FLineInfoPtr), instrlen);
Exit;
end;
DW_LNE_set_address: begin
if FOwner.FLineInfo.Addr64
then FAddress := PQWord(pbyte(FLineInfoPtr)+1)^
else FAddress := PLongWord(pbyte(FLineInfoPtr)+1)^;
FAddress:=FOwner.MapAddressToNewValue(FAddress);
end;
DW_LNE_define_file: begin
// don't move pb, it's done at the end by instruction length
p := pbyte(FLineInfoPtr);
FFileName := String(PChar(p));
Inc(p, Length(FFileName) + 1);
//diridx
diridx := ULEB128toOrdinal(p);
if diridx < FOwner.FLineInfo.Directories.Count
then FFileName := FOwner.FLineInfo.Directories[diridx] + FFileName
else FFileName := Format('Unknown dir(%u)', [diridx]) + DirectorySeparator + FFileName;
//last modified
//ULEB128toOrdinal(p);
//length
//ULEB128toOrdinal(p));
end;
else
// unknown extendend opcode
end;
Inc(pbyte(FLineInfoPtr), instrlen);
end;
else
// unknown opcode
Inc(pbyte(FLineInfoPtr), FOwner.FLineInfo.StandardOpcodeLengths[Opcode])
end;
Continue;
end;
// Special opcode
Dec(Opcode, Length(FOwner.FLineInfo.StandardOpcodeLengths)+1);
if FOwner.FLineInfo.LineRange = 0
then begin
Inc(FAddress, Opcode * FOwner.FLineInfo.MinimumInstructionLength);
end
else begin
Inc(FAddress, (Opcode div FOwner.FLineInfo.LineRange) * FOwner.FLineInfo.MinimumInstructionLength);
Inc(FLine, FOwner.FLineInfo.LineBase + (Opcode mod FOwner.FLineInfo.LineRange));
end;
Result := True;
Exit;
end;
Result := False;
FEnded := True;
end;
procedure TDwarfLineInfoStateMachine.Reset;
begin
FAddress := 0;
SetFileName(1);
FLine := 1;
FColumn := 0;
FIsStmt := FOwner.FLineInfo.DefaultIsStmt;
FBasicBlock := False;
FEndSequence := False;
FPrologueEnd := False;
FEpilogueBegin := False;
FIsa := 0;
end;
procedure TDwarfLineInfoStateMachine.SetFileName(AIndex: Cardinal);
begin
if (Aindex > 0) and (AIndex <= FOwner.FLineInfo.FileNames.Count)
then FFileName := FOwner.FLineInfo.FileNames[AIndex - 1]
else FFileName := Format('Unknown fileindex(%u)', [AIndex]);
end;
{ TFpSymbolDwarfClassMapList }
destructor TFpSymbolDwarfClassMapList.Destroy;
begin
FreeAllInstances;
inherited Destroy;
end;
function TFpSymbolDwarfClassMapList.FindMapForCompUnit(ACU: TDwarfCompilationUnit): TFpSymbolDwarfClassMap;
var
i: Integer;
ResClass: TFpSymbolDwarfClassMapClass;
begin
ResClass := FDefaultMap;
for i := 0 to length(FMapList) - 1 do
if FMapList[i].ClassCanHandleCompUnit(ACU) then begin
ResClass := FMapList[i];
break;
end;
Result := ResClass.GetInstanceForCompUnit(ACU);
end;
procedure TFpSymbolDwarfClassMapList.FreeAllInstances;
var
i: Integer;
begin
for i := 0 to length(FMapList) - 1 do begin
if FMapList[i] = FDefaultMap then
FDefaultMap := nil; // Should not happen, default map should not be added to list
FMapList[i].FreeAllInstances;
end;
if FDefaultMap <> nil then
FDefaultMap.FreeAllInstances;
end;
procedure TFpSymbolDwarfClassMapList.AddMap(AMap: TFpSymbolDwarfClassMapClass);
var
l: Integer;
begin
l := length(FMapList);
SetLength(FMapList, l + 1);
FMapList[l] := AMap;
end;
procedure TFpSymbolDwarfClassMapList.SetDefaultMap(AMap: TFpSymbolDwarfClassMapClass);
begin
FDefaultMap := AMap;
end;
{ TFpThreadWorkerScanAll }
procedure TFpThreadWorkerScanAll.DoExecute;
var
ResultScope: TDwarfScopeInfo;
begin
FCU.LocateEntry(0, ResultScope);
FCompNameHashWorker.MarkReadyToRun;
end;
constructor TFpThreadWorkerScanAll.Create(CU: TDwarfCompilationUnit;
ACompNameHashWorker: TFpThreadWorkerComputeNameHashes);
begin
FCU := CU;
FCompNameHashWorker := ACompNameHashWorker;
end;
{ TFpThreadWorkerComputeNameHashes }
procedure TFpThreadWorkerComputeNameHashes.DoExecute;
var
InfoEntry: TDwarfInformationEntry;
begin
InfoEntry := TDwarfInformationEntry.Create(FCU, nil);
InfoEntry.ScopeIndex := FCU.FirstScope.Index;
InfoEntry.ComputeKnownHashes(@FCU.FKnownNameHashes);
InfoEntry.ReleaseReference;
end;
constructor TFpThreadWorkerComputeNameHashes.Create(CU: TDwarfCompilationUnit);
begin
FCU := CU;
end;
procedure TFpThreadWorkerComputeNameHashes.MarkReadyToRun;
var
c: Cardinal;
begin
c := InterLockedIncrement(FReadyToRun);
if c = 2 then
FCU.FOwner.WorkQueue.PushItem(Self);
end;
{ TDwarfCompilationUnit }
procedure TDwarfCompilationUnit.BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean);
var
Iter: TMapIterator;
Info, NextInfo: PDwarfAddressInfo;
idx: Integer;
LineMap: PDWarfLineMap;
Line: Cardinal;
CurrentFileName: String;
addr: QWord;
begin
if not ADoAll
then begin
if AAddressInfo = nil then Exit;
if AAddressInfo^.StateMachine <> nil then Exit;
end;
if FLineInfo.StateMachine = nil then Exit;
if FLineInfo.StateMachine.Ended then Exit;
BuildAddressMap;
Iter := TMapIterator.Create(FAddressMap);
idx := -1;
Info := nil;
NextInfo := nil;
while FLineInfo.StateMachine.NextLine do
begin
Line := FLineInfo.StateMachine.Line;
if (idx < 0) or (CurrentFileName <> FLineInfo.StateMachine.FileName) then begin
idx := FLineNumberMap.IndexOf(FLineInfo.StateMachine.FileName);
if idx = -1
then begin
LineMap := New(PDWarfLineMap);
LineMap^.Init;
FLineNumberMap.AddObject(FLineInfo.StateMachine.FileName, TObject(LineMap));
end
else begin
LineMap := PDWarfLineMap(FLineNumberMap.Objects[idx]);
end;
CurrentFileName := FLineInfo.StateMachine.FileName;
end;
addr := FLineInfo.StateMachine.Address;
if (not FLineInfo.StateMachine.EndSequence) and (FLineInfo.StateMachine.IsStmt)
and (Line > 0)
then
LineMap^.SetAddressForLine(Line, addr);
if (Info = nil) or
(addr < Info^.StartPC) or
( (NextInfo <> nil) and (addr >= NextInfo^.StartPC) )
then begin
if Iter.Locate(FLineInfo.StateMachine.Address)
then begin
// set lineinfo
Info := Iter.DataPtr;
Iter.Next;
if not Iter.EOM
then NextInfo := Iter.DataPtr
else NextInfo := nil;
if Info^.StateMachine = nil
then begin
Info^.StateMachine := FLineInfo.StateMachine.Clone;
FLineInfo.StateMachines.Add(Info^.StateMachine);
end;
if not ADoAll and (Info = AAddressInfo)
then Break;
end;
end;
end;
Iter.Free;
for Idx := 0 to FLineNumberMap.Count - 1 do
PDWarfLineMap(FLineNumberMap.Objects[idx])^.Compress;
end;
function TDwarfCompilationUnit.GetAddressMap: TMap;
begin
BuildAddressMap;
Result := FAddressMap;
end;
function TDwarfCompilationUnit.GetKnownNameHashes: PKnownNameHashesArray;
begin
WaitForComputeHashes;
Result := @FKnownNameHashes;
end;
function TDwarfCompilationUnit.GetUnitName: String;
begin
Result := FUnitName;
if Result <> '' then exit;
FUnitName := LazFileUtils.ExtractFileNameOnly(FileName);
Result := FUnitName;
end;
function TDwarfCompilationUnit.GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean;
begin
Result := FAbbrevList.FindLe128bFromPointer(AAbbrevPtr, ADefinition) <> nil;
end;
procedure TDwarfCompilationUnit.WaitForScopeScan;
begin
if FScanAllWorker <> nil then begin
FOwner.WorkQueue.WaitForItem(FScanAllWorker);
FScanAllWorker.DecRef;
end;
FScanAllWorker := nil;
end;
procedure TDwarfCompilationUnit.WaitForComputeHashes;
begin
if FComputeNameHashesWorker <> nil then begin
FOwner.WorkQueue.WaitForItem(FComputeNameHashesWorker);
FComputeNameHashesWorker.DecRef;
end;
FComputeNameHashesWorker := nil;
end;
procedure TDwarfCompilationUnit.BuildAddressMap;
var
AttribList: TAttribPointerList;
Attrib: Pointer;
Form: Cardinal;
Info: TDwarfAddressInfo;
Scope: TDwarfScopeInfo;
ScopeIdx: Integer;
Abbrev: TDwarfAbbrev;
begin
if FAddressMapBuild then Exit;
Scope := FScope;
ScopeIdx := Scope.Index;
while Scope.IsValid do
begin
if not GetDefinition(Scope.Entry, Abbrev) then begin
inc(ScopeIdx);
Scope.Index := ScopeIdx; // Child or Next, or parent.next
continue;
//DebugLn(FPDBG_DWARF_WARNINGS, ['No abbrev found']);
//break;
end;
if Abbrev.tag = DW_TAG_subprogram then begin
AttribList.EvalCount := 0;
Info.ScopeIndex := Scope.Index;
Info.ScopeList := Scope.FScopeList;
// TODO: abstract origin
if InitLocateAttributeList(Scope.Entry, AttribList) then begin // TODO: error if not
if (dafHasLowAddr in AttribList.Abbrev^.flags) and
LocateAttribute(Scope.Entry, DW_AT_low_pc, AttribList, Attrib, Form)
then begin
ReadAddressValue(Attrib, Form, Info.StartPC);
if LocateAttribute(Scope.Entry, DW_AT_high_pc, AttribList, Attrib, Form)
then ReadAddressValue(Attrib, Form, Info.EndPC)
else Info.EndPC := Info.StartPC;
// TODO (dafHasName in Abbrev.flags)
if (dafHasName in AttribList.Abbrev^.flags) and
LocateAttribute(Scope.Entry, DW_AT_name, AttribList, Attrib, Form)
then ReadValue(Attrib, Form, Info.Name)
else Info.Name := 'undefined';
Info.StateMachine := nil;
if Info.StartPC <> 0
then begin
if FAddressMap.HasId(Info.StartPC)
then DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING duplicate start address: ', IntToHex(Info.StartPC, FAddressSize * 2)])
else FAddressMap.Add(Info.StartPC, Info);
end;
end;
end;
end;
inc(ScopeIdx);
Scope.Index := ScopeIdx; // Child or Next, or parent.next
end;
FAddressMapBuild := True;
end;
constructor TDwarfCompilationUnit.Create(AOwner: TFpDwarfInfo; ADebugFile: PDwarfDebugFile; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean);
procedure FillLineInfo(AData: Pointer);
var
LNP32: PDwarfLNPHeader32 absolute AData;
LNP64: PDwarfLNPHeader64 absolute AData;
Info: PDwarfLNPInfoHeader;
UnitLength: QWord;
Version: Word;
HeaderLength: QWord;
Name: PChar;
diridx: Cardinal;
S, S2: String;
pb: PByte absolute Name;
begin
FLineInfo.Header := AData;
if LNP64^.Signature = DWARF_HEADER64_SIGNATURE
then begin
if FVersion < 3 then
DebugLn(FPDBG_DWARF_WARNINGS, ['Unexpected 64 bit signature found for DWARF version 2']); // or version 1...
UnitLength := LNP64^.UnitLength;
FLineInfo.DataEnd := Pointer(@LNP64^.Version) + UnitLength;
Version := LNP64^.Version;
HeaderLength := LNP64^.HeaderLength;
Info := @LNP64^.Info;
end
else begin
UnitLength := LNP32^.UnitLength;
FLineInfo.DataEnd := Pointer(@LNP32^.Version) + UnitLength;
Version := LNP32^.Version;
HeaderLength := LNP32^.HeaderLength;
Info := @LNP32^.Info;
end;
if Version=0 then ;
FLineInfo.Addr64 := FAddressSize = 8;
FLineInfo.DataStart := PByte(Info) + HeaderLength;
FLineInfo.MinimumInstructionLength := Info^.MinimumInstructionLength;
FLineInfo.DefaultIsStmt := Info^.DefaultIsStmt <> 0;
FLineInfo.LineBase := Info^.LineBase;
FLineInfo.LineRange := Info^.LineRange;
// opcodelengths
SetLength(FLineInfo.StandardOpcodeLengths, Info^.OpcodeBase - 1);
Move(Info^.StandardOpcodeLengths, FLineInfo.StandardOpcodeLengths[0], Info^.OpcodeBase - 1);
// directories & filenames
FLineInfo.Directories := TStringList.Create;
FLineInfo.Directories.Add(''); // current dir
Name := @Info^.StandardOpcodeLengths;
Inc(Name, Info^.OpcodeBase-1);
// directories
while Name^ <> #0 do
begin
S := String(Name);
Inc(pb, Length(S)+1);
FLineInfo.Directories.Add(S + DirectorySeparator);
end;
Inc(Name);
// filenames
FLineInfo.FileNames := TStringList.Create;
while Name^ <> #0 do
begin
S := String(Name);
Inc(pb, Length(S)+1);
//diridx
diridx := ULEB128toOrdinal(pb);
if diridx < FLineInfo.Directories.Count then begin
S2 := FLineInfo.Directories[diridx] + S;
S := CreateAbsolutePath(S2, FCompDir);
if (diridx = 0) and not FileExistsUTF8(S2) and (FLineInfo.FileNames.Count > 0) then // https://bugs.freepascal.org/view.php?id=37658
S := S2;
end
else
S := Format('Unknown dir(%u)', [diridx]) + DirectorySeparator + S;
FLineInfo.FileNames.Add(S);
//last modified
ULEB128toOrdinal(pb);
//length
ULEB128toOrdinal(pb);
end;
FLineInfo.StateMachine := TDwarfLineInfoStateMachine.Create(Self, FLineInfo.DataStart, FLineInfo.DataEnd);
FLineInfo.StateMachines := TFPObjectList.Create(True);
FLineInfo.Valid := True;
end;
var
AttribList: TAttribPointerList;
Attrib: Pointer;
Form: Cardinal;
StatementListOffs, Offs: QWord;
Scope: TDwarfScopeInfo;
begin
//DebugLn(FPDBG_DWARF_VERBOSE, ['-- compilation unit --']);
//DebugLn(FPDBG_DWARF_VERBOSE, [' data offset: ', ADataOffset]);
//DebugLn(FPDBG_DWARF_VERBOSE, [' length: ', ALength]);
//DebugLn(FPDBG_DWARF_VERBOSE, [' version: ', AVersion]);
//DebugLn(FPDBG_DWARF_VERBOSE, [' abbrev offset: ', AAbbrevOffset]);
//DebugLn(FPDBG_DWARF_VERBOSE, [' address size: ', AAddressSize]);
//DebugLn(FPDBG_DWARF_VERBOSE, [' 64bit: ', AIsDwarf64]);
//DebugLn(FPDBG_DWARF_VERBOSE, ['----------------------']);
inherited Create;
FOwner := AOwner;
FDebugFile := ADebugFile;
FInfoData := ADebugFile^.Sections[dsInfo].RawData + ADataOffset;
FLength := ALength;
FVersion := AVersion;
FAbbrevOffset := AAbbrevOffset;
// check for address as offset
if FAbbrevOffset > ADebugFile^.Sections[dsAbbrev].Size
then begin
Offs := FAbbrevOffset - FOwner.FImageBase - ADebugFile^.Sections[dsAbbrev].VirtualAddress;
if (Offs >= 0) and (Offs < ADebugFile^.Sections[dsAbbrev].Size)
then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING: Got Abbrev offset as address, adjusting..']);
FAbbrevOffset := Offs;
end;
end;
FAddressSize := AAddressSize;
FIsDwarf64 := AIsDwarf64;
FAbbrevList := TDwarfAbbrevList.Create(ADebugFile^.Sections[dsAbbrev].RawData,
ADebugFile^.Sections[dsAbbrev].RawData + ADebugFile^.Sections[dsAbbrev].Size,
FAbbrevOffset, FLength);
// use internally 64 bit target pointer
FAddressMap := TMap.Create(itu8, SizeOf(TDwarfAddressInfo));
FLineNumberMap := TStringListUTF8Fast.Create;
FLineNumberMap.Sorted := True;
FLineNumberMap.Duplicates := dupError;
SetLength(FScopeList.List, Min(SCOPE_ALLOC_BLOCK_SIZE, FLength div 2 + 1));
FScopeList.List[0].Link := -1;
FScopeList.List[0].Entry := FInfoData;
FScopeList.HighestKnown := 0;
FScope.Init(@FScopeList);
FScope.Index := 0;
// retrieve some info about this unit
if not LocateEntry(DW_TAG_compile_unit, Scope)
then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING compilation unit has no compile_unit tag']);
Exit;
end;
FValid := True;
FComputeNameHashesWorker := TFpThreadWorkerComputeNameHashes.Create(Self);
FComputeNameHashesWorker.AddRef;
FScanAllWorker := TFpThreadWorkerScanAll.Create(Self, FComputeNameHashesWorker);
FScanAllWorker.AddRef;
FOwner.WorkQueue.PushItem(FScanAllWorker);
AttribList.EvalCount := 0;
/// TODO: (dafHasName in Abbrev.flags)
if LocateAttribute(Scope.Entry, DW_AT_name, AttribList, Attrib, Form)
then ReadValue(Attrib, Form, FFileName);
if LocateAttribute(Scope.Entry, DW_AT_comp_dir, AttribList, Attrib, Form)
then ReadValue(Attrib, Form, FCompDir);
if LocateAttribute(Scope.Entry, DW_AT_producer, AttribList, Attrib, Form)
then ReadValue(Attrib, Form, FProducer);
FDwarfSymbolClassMap := DwarfSymbolClassMapList.FindMapForCompUnit(Self);
assert(FDwarfSymbolClassMap <> nil, 'TDwarfCompilationUnit.Create: FDwarfSymbolClassMap <> nil');
if not LocateAttribute(Scope.Entry, DW_AT_identifier_case, AttribList, Attrib, Form)
and not ReadValue(Attrib, Form, FIdentifierCase)
then FIdentifierCase := DW_ID_case_sensitive;
if LocateAttribute(Scope.Entry, DW_AT_stmt_list, AttribList, Attrib, Form)
and ReadValue(Attrib, Form, StatementListOffs)
then begin
// check for address as offset
if StatementListOffs < ADebugFile^.Sections[dsLine].Size
then begin
FillLineInfo(ADebugFile^.Sections[dsLine].RawData + StatementListOffs);
end
else begin
Offs := StatementListOffs - FOwner.FImageBase - ADebugFile^.Sections[dsLine].VirtualAddress;
if (Offs >= 0) and (Offs < ADebugFile^.Sections[dsLine].Size)
then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING: Got Lineinfo offset as address, adjusting..']);
FillLineInfo(ADebugFile^.Sections[dsLine].RawData + Offs);
end;
end;
end;
if LocateAttribute(Scope.Entry, DW_AT_low_pc, AttribList, Attrib, Form)
then ReadAddressValue(Attrib, Form, FMinPC);
if LocateAttribute(Scope.Entry, DW_AT_high_pc, AttribList, Attrib, Form)
then ReadAddressValue(Attrib, Form, FMaxPC);
if FMinPC = 0 then FMinPC := FMaxPC;
if FMaxPC = 0 then FMAxPC := FMinPC;
end;
destructor TDwarfCompilationUnit.Destroy;
procedure FreeLineNumberMap;
var
n: Integer;
begin
for n := 0 to FLineNumberMap.Count - 1 do
Dispose(PDWarfLineMap(FLineNumberMap.Objects[n]));
FreeAndNil(FLineNumberMap);
end;
begin
FOwner.WorkQueue.RemoveItem(FComputeNameHashesWorker);
FOwner.WorkQueue.RemoveItem(FScanAllWorker);
FComputeNameHashesWorker.DecRef;
FScanAllWorker.DecRef;
FreeAndNil(FAbbrevList);
FreeAndNil(FAddressMap);
FreeLineNumberMap;
FreeAndNil(FLineInfo.StateMachines);
FreeAndNil(FLineInfo.StateMachine);
FreeAndNil(FLineInfo.Directories);
FreeAndNil(FLineInfo.FileNames);
inherited Destroy;
end;
function TDwarfCompilationUnit.GetLineAddressMap(const AFileName: String): PDWarfLineMap;
function FindIndex: Integer;
var
Name: String;
begin
// try fullname first
Result := FLineNumberMap.IndexOf(AFileName);
if Result <> -1 then Exit;
Name := ExtractFileName(AFileName);
Result := FLineNumberMap.IndexOf(Name);
if Result <> -1 then Exit;
for Result := 0 to FLineNumberMap.Count - 1 do
if UTF8CompareLatinTextFast(Name, ExtractFileName(FLineNumberMap[Result])) = 0 then
Exit;
Result := -1;
end;
var
idx: Integer;
begin
Result := nil;
if not Valid then Exit;
// make sure all filenames are there
BuildLineInfo(nil, True);
idx := FindIndex;
if idx = -1 then Exit;
Result := PDWarfLineMap(FLineNumberMap.Objects[idx]);
end;
function TDwarfCompilationUnit.GetLineAddresses(const AFileName: String;
ALine: Cardinal; var AResultList: TDBGPtrArray): boolean;
var
Map: PDWarfLineMap;
begin
Result := False;
Map := GetLineAddressMap(AFileName);
if Map = nil then exit;
Result := Map^.GetAddressesForLine(ALine, AResultList);
end;
function TDwarfCompilationUnit.InitLocateAttributeList(AEntry: Pointer;
var AList: TAttribPointerList): Boolean;
var
AbrCnt: Integer;
begin
if FAbbrevList.FindLe128bFromPointer(AEntry, AList.Abbrev) = nil then begin
//if not GetDefinition(AEntry, AList.Abbrev)
//then begin //???
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', ULEB128toOrdinal(AEntry)]);
AList.EvalCount := -1;
Result := False;
Exit;
end;
AbrCnt := AList.Abbrev^.count;
if AbrCnt = 0 then begin
AList.EvalCount := -1;
exit;
end;
SetLength(AList.List, AbrCnt);
ULEB128toOrdinal(AEntry);
AList.List[0] := AEntry;
AList.EvalCount := 1;
Result := True;
end;
function TDwarfCompilationUnit.LocateAttribute(AEntry: Pointer; AAttribute: Cardinal;
var AList: TAttribPointerList; out AAttribPtr: Pointer; out AForm: Cardinal): Boolean;
var
Abbrev: Cardinal;
i, EvalCnt, AbrIdx, AbrCnt: Integer;
ADefs: PDwarfAbbrevEntry;
begin
Result := False;
if AList.EvalCount < 0 then
exit;
if AList.EvalCount = 0 then begin
if FAbbrevList.FindLe128bFromPointer(AEntry, AList.Abbrev) = nil then begin
//if not GetDefinition(AEntry, AList.Abbrev)
//then begin //???
Abbrev := ULEB128toOrdinal(AEntry);
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]);
AList.EvalCount := -1;
Exit;
end;
AbrIdx := AList.Abbrev^.count;
if AbrIdx = 0 then begin
AList.EvalCount := -1;
exit;
end;
SetLength(AList.List, AbrIdx);
ULEB128toOrdinal(AEntry);
AList.List[0] := AEntry;
AList.EvalCount := 1;
end;
ADefs := FAbbrevList.EntryPointer[0];
AbrIdx := AList.Abbrev^.Index;
AbrCnt := AList.Abbrev^.Count - 1;
EvalCnt := AList.EvalCount - 1;
i := 0;
while true do begin
if ADefs[AbrIdx].Attribute = AAttribute
then begin
Result := True;
AAttribPtr := AList.List[i];
AForm := ADefs[AbrIdx].Form;
break;
end;
if i = AbrCnt then
break;
if (i < EvalCnt) then begin
inc(i);
inc(AbrIdx);
Continue;
end;
AEntry := AList.List[i];
if not SkipEntryDataForForm(AEntry, ADefs[AbrIdx].Form, FAddressSize, IsDwarf64, Version) then
break;
AList.List[i+1] := AEntry;
inc(i);
inc(AbrIdx);
end;
if i {+ 1} > EvalCnt {+ 1} then
AList.EvalCount := i + 1
end;
function TDwarfCompilationUnit.LocateAttribute(AEntry: Pointer; AAttribute: Cardinal; out
AAttribPtr: Pointer; out AForm: Cardinal): Boolean;
var
Def: TDwarfAbbrev;
n: Integer;
ADefs: PDwarfAbbrevEntry;
begin
AEntry := FAbbrevList.FindLe128bFromPointer(AEntry, Def);
if AEntry = nil
then begin
//???
//Abbrev := ULEB128toOrdinal(AEntry);
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: '{, Abbrev}]);
Result := False;
Exit;
end;
ADefs := FAbbrevList.EntryPointer[0];
for n := Def.Index to Def.Index + Def.Count - 1 do
begin
if ADefs[n].Attribute = AAttribute
then begin
Result := True;
AAttribPtr := AEntry;
AForm := ADefs[n].Form;
Exit;
end
else begin
if not SkipEntryDataForForm(AEntry, ADefs[n].Form, FAddressSize, IsDwarf64, Version) then
break;
end;
end;
Result := False;
end;
//----------------------------------------
// Params
// ATag: a tag to search for
// AStartScope: a startpoint in the data
// ACurrentOnly: if set, process only current entry
// AResultScope: the located scope info
//----------------------------------------
function TDwarfCompilationUnit.LocateEntry(ATag: Cardinal; out
AResultScope: TDwarfScopeInfo): Boolean;
function ParseAttribs(const ADef: PDwarfAbbrev; var p: Pointer): Boolean;
var
idx: Integer;
ADefs: PDwarfAbbrevEntry;
AddrSize: Byte;
begin
ADefs := FAbbrevList.EntryPointer[ADef^.Index];
AddrSize := FAddressSize;
for idx := 0 to ADef^.Count - 1 do
begin
if not SkipEntryDataForForm(p, ADefs^.Form, AddrSize, IsDwarf64, Version) then
exit(False);
inc(ADefs);
end;
Result := True;
end;
var
Abbrev: Cardinal;
Def: PDwarfAbbrev;
MaxData: Pointer;
p, EntryDataPtr, NextEntryDataPtr: Pointer;
Scope: TDwarfScopeInfo;
ni: Integer;
AppendAsChild: Boolean;
begin
Result := False;
if not FScope.IsValid then Exit;
MaxData := FInfoData + FLength;
Scope := FScope;
Scope.Index := FScopeList.HighestKnown; // last known scope
// "last rounds" NextEntryDataPtr
NextEntryDataPtr := Scope.Entry;
while (NextEntryDataPtr < MaxData) do
begin
EntryDataPtr := NextEntryDataPtr;
NextEntryDataPtr := FAbbrevList.FindLe128bFromPointer(EntryDataPtr, Def);
if NextEntryDataPtr = nil then begin
Abbrev := ULEB128toOrdinal(EntryDataPtr);
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]);
// TODO shorten array
exit;
end;
if (ATag <> 0) and (Def^.tag = ATag) then begin
Result := True;
AResultScope := Scope;
Break;
end;
if not ParseAttribs(Def, NextEntryDataPtr) then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: data not parsed:']);
exit;
end;
// NextEntryDataPtr is now at next scope
if NextEntryDataPtr >= MaxData then
break;
p := NextEntryDataPtr;
Abbrev := ULEB128toOrdinal(p);
if Abbrev = 0 then begin // no more sibling
AppendAsChild := False; // children already done
if (dafHasChildren in Def^.flags) then begin // current has 0 children
NextEntryDataPtr := p;
if NextEntryDataPtr >= MaxData then
break;
Abbrev := ULEB128toOrdinal(p);
end;
while (Abbrev = 0) do begin
NextEntryDataPtr := p;
if NextEntryDataPtr >= MaxData then
break;
Scope.GoParent;
if not Scope.IsValid then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]);
// TODO shorten array
exit;
end;
Abbrev := ULEB128toOrdinal(p);
end;
if NextEntryDataPtr >= MaxData then
break;
end
else
AppendAsChild := (dafHasChildren in Def^.flags);
if AppendAsChild then
ni := Scope.CreateChildForEntry(NextEntryDataPtr)
else
ni := Scope.CreateNextForEntry(NextEntryDataPtr);
Scope.FIndex := ni; // skip check, index was just created / must exist
end;
if (NextEntryDataPtr >= MaxData) then begin
if (EntryDataPtr > MaxData) then
debugln(FPDBG_DWARF_WARNINGS, ['LocateEntry went past end of memory: ', EntryDataPtr-MaxData]);
SetLength(FScopeList.List, FScopeList.HighestKnown + 1);
end;
end;
function TDwarfCompilationUnit.ReadTargetAddressFromDwarfSection(var AData: Pointer;
AIncPointer: Boolean): TFpDbgMemLocation;
begin
// do not need mem reader, address is in dwarf. Should be in correct format
if (FAddressSize = 8) then
Result := TargetLoc(PQWord(AData)^)
else
Result := TargetLoc(PLongWord(AData)^);
if AIncPointer then inc(AData, FAddressSize);
end;
function TDwarfCompilationUnit.ReadDwarfSectionOffsetOrLenFromDwarfSection(var AData: Pointer;
AIncPointer: Boolean): TFpDbgMemLocation;
begin
// do not need mem reader, address is in dwarf. Should be in correct format
if ((Version>2) and IsDwarf64) or ((version < 3) and (FAddressSize = 8)) then
Result := TargetLoc(PQWord(AData)^)
else
Result := TargetLoc(PLongWord(AData)^);
if AIncPointer then inc(AData, FAddressSize);
end;
function TDwarfCompilationUnit.MapAddressToNewValue(AValue: QWord): QWord;
var
i: Integer;
AddrMap: TDbgAddressMap;
begin
result := avalue;
if assigned(DebugFile^.AddressMapList) then
for i := 0 to DebugFile^.AddressMapList.Count-1 do
begin
AddrMap:=DebugFile^.AddressMapList[i];
if AddrMap.OrgAddr=AValue then
begin
result:=AddrMap.NewAddr;
break;
end
else if (AddrMap.OrgAddr<AValue) and (AValue<=(AddrMap.OrgAddr+AddrMap.Length)) then
begin
result:=AddrMap.NewAddr + (AValue-AddrMap.OrgAddr) ;
break;
end;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Cardinal): Boolean;
begin
Result := True;
case AForm of
DW_FORM_addr:
AValue := LocToAddrOrNil(ReadTargetAddressFromDwarfSection(AAttribute));
DW_FORM_ref_addr : begin
AValue := LocToAddrOrNil(ReadDwarfSectionOffsetOrLenFromDwarfSection(AAttribute));
end;
DW_FORM_flag,
DW_FORM_ref1,
DW_FORM_data1 : begin
AValue := PByte(AAttribute)^;
end;
DW_FORM_ref2,
DW_FORM_data2 : begin
AValue := PWord(AAttribute)^;
end;
DW_FORM_ref4,
DW_FORM_data4 : begin
AValue := PLongWord(AAttribute)^;
end;
DW_FORM_ref8,
DW_FORM_data8 : begin
AValue := PQWord(AAttribute)^;
end;
DW_FORM_sdata : begin
AValue := SLEB128toOrdinal(AAttribute);
end;
DW_FORM_ref_udata,
DW_FORM_udata : begin
AValue := ULEB128toOrdinal(AAttribute);
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Int64): Boolean;
begin
Result := True;
case AForm of
DW_FORM_addr:
AValue := LocToAddrOrNil(ReadTargetAddressFromDwarfSection(AAttribute));
DW_FORM_ref_addr : begin
AValue := LocToAddrOrNil(ReadDwarfSectionOffsetOrLenFromDwarfSection(AAttribute));
end;
DW_FORM_flag,
DW_FORM_ref1,
DW_FORM_data1 : begin
AValue := PShortInt(AAttribute)^;
end;
DW_FORM_ref2,
DW_FORM_data2 : begin
AValue := PSmallInt(AAttribute)^;
end;
DW_FORM_ref4,
DW_FORM_data4 : begin
AValue := PLongInt(AAttribute)^;
end;
DW_FORM_ref8,
DW_FORM_data8 : begin
AValue := PInt64(AAttribute)^;
end;
DW_FORM_sdata : begin
AValue := SLEB128toOrdinal(AAttribute);
end;
DW_FORM_ref_udata,
DW_FORM_udata : begin
AValue := Int64(ULEB128toOrdinal(AAttribute));
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Integer): Boolean;
begin
Result := True;
case AForm of
DW_FORM_addr:
AValue := LocToAddrOrNil(ReadTargetAddressFromDwarfSection(AAttribute));
DW_FORM_ref_addr : begin
AValue := LocToAddrOrNil(ReadDwarfSectionOffsetOrLenFromDwarfSection(AAttribute));
end;
DW_FORM_flag,
DW_FORM_ref1,
DW_FORM_data1 : begin
AValue := PShortInt(AAttribute)^;
end;
DW_FORM_ref2,
DW_FORM_data2 : begin
AValue := PSmallInt(AAttribute)^;
end;
DW_FORM_ref4,
DW_FORM_data4 : begin
AValue := PLongInt(AAttribute)^;
end;
DW_FORM_ref8,
DW_FORM_data8 : begin
AValue := PInt64(AAttribute)^;
end;
DW_FORM_sdata : begin
AValue := SLEB128toOrdinal(AAttribute);
end;
DW_FORM_ref_udata,
DW_FORM_udata : begin
AValue := ULEB128toOrdinal(AAttribute);
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: PChar): Boolean;
begin
Result := True;
case AForm of
DW_FORM_string: begin
AValue := PChar(AAttribute);
end;
DW_FORM_strp: begin
if IsDwarf64 then
AValue := pchar(PtrUInt(FDebugFile^.Sections[dsStr].RawData)+PQWord(AAttribute)^)
else
AValue := pchar(PtrUInt(FDebugFile^.Sections[dsStr].RawData)+PDWord(AAttribute)^);
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: QWord): Boolean;
begin
Result := True;
case AForm of
DW_FORM_addr:
AValue := LocToAddrOrNil(ReadTargetAddressFromDwarfSection(AAttribute));
DW_FORM_ref_addr : begin
AValue := LocToAddrOrNil(ReadDwarfSectionOffsetOrLenFromDwarfSection(AAttribute));
end;
DW_FORM_flag,
DW_FORM_ref1,
DW_FORM_data1 : begin
AValue := PByte(AAttribute)^;
end;
DW_FORM_ref2,
DW_FORM_data2 : begin
AValue := PWord(AAttribute)^;
end;
DW_FORM_ref4,
DW_FORM_data4 : begin
AValue := PLongWord(AAttribute)^;
end;
DW_FORM_ref8,
DW_FORM_data8 : begin
AValue := PQWord(AAttribute)^;
end;
DW_FORM_sdata : begin
AValue := QWord(SLEB128toOrdinal(AAttribute));
end;
DW_FORM_ref_udata,
DW_FORM_udata : begin
AValue := ULEB128toOrdinal(AAttribute);
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: String): Boolean;
begin
Result := True;
case AForm of
DW_FORM_string: begin
AValue := PChar(AAttribute);
end;
DW_FORM_strp: begin
if IsDwarf64 then
AValue := pchar(PtrUInt(FDebugFile^.Sections[dsStr].RawData)+PQWord(AAttribute)^)
else
AValue := pchar(PtrUInt(FDebugFile^.Sections[dsStr].RawData)+PDWord(AAttribute)^);
end;
else
Result := False;
end;
end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal;
out AValue: TByteDynArray; AnFormString: Boolean): Boolean;
var
Size: Cardinal;
mx, i: Pointer;
begin
Result := True;
case AForm of
DW_FORM_block : begin
Size := ULEB128toOrdinal(AAttribute);
end;
DW_FORM_block1 : begin
Size := PByte(AAttribute)^;
Inc(AAttribute, 1);
end;
DW_FORM_block2 : begin
Size := PWord(AAttribute)^;
Inc(AAttribute, 2);
end;
DW_FORM_block4 : begin
Size := PLongWord(AAttribute)^;
Inc(AAttribute, 4);
end;
DW_FORM_strp, DW_FORM_string: begin
Result := AnFormString;
Size := 0;
if Result then begin
mx := FDebugFile^.Sections[dsInfo].RawData +FDebugFile^.Sections[dsInfo].Size;
if AForm = DW_FORM_strp then begin
AAttribute := FDebugFile^.Sections[dsStr].RawData+PDWord(AAttribute)^;
mx := FDebugFile^.Sections[dsStr].RawData +FDebugFile^.Sections[dsStr].Size;
end;
i := AAttribute;
while (PByte(i)^ <> 0) and (i < mx) do Inc(i);
if i = mx then begin
DebugLn(FPDBG_DWARF_ERRORS, 'String exceeds section');
Result := False;
end
else begin
Size := i + 1 - AAttribute; // include #0
end;
end;
end;
else
Result := False;
Size := 0;
end;
SetLength(AValue, Size);
if Size > 0 then
Move(AAttribute^, AValue[0], Size);
end;
function TDwarfCompilationUnit.ReadAddressValue(AAttribute: Pointer; AForm: Cardinal; out AValue: QWord): Boolean;
begin
result := ReadValue(AAttribute, AForm, AValue);
if result then
AValue := MapAddressToNewValue(AValue);
end;
initialization
TheDwarfSymbolClassMapList := TFpSymbolDwarfClassMapList.Create;
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_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE' {$IFDEF FPDBG_DWARF_VERBOSE} , True {$ENDIF} );
FPDBG_DWARF_VERBOSE_LOAD := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE_LOAD' {$IFDEF FPDBG_DWARF_VERBOSE_LOAD} , True {$ENDIF} );
FPDBG_DWARF_SEARCH := DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} );
// Target data anormalities
//FPDBG_DWARF_DATA_WARNINGS :=
DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_DATA_WARNINGS' {$IFDEF FPDBG_DWARF_DATA_WARNINGS} , True {$ENDIF} );
finalization
FreeAndNil(TheDwarfSymbolClassMapList);
end.
Reference in New Issue View Git Blame Copy Permalink