mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 12:12:25 +02:00
FpDebug: restructure dwarf classes, preparation for adding fpc specific subclasses
git-svn-id: trunk@44598 -
This commit is contained in:
martin
parent
46d6c25c33
commit
ad1e9548a3
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1271,6 +1271,7 @@ components/fpdebug/fpdbgdisasx86.pp svneol=native#text/plain
|
||||
components/fpdebug/fpdbgdwarf.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarfconst.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarfdataclasses.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarffreepascal.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarfverboseprinter.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbginfo.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgloader.pp svneol=native#text/pascal
|
||||
|
||||
@ -53,6 +53,8 @@ type
|
||||
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
||||
class function CreateContext(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol;
|
||||
ADwarf: TDbgDwarf): TDbgInfoAddressContext; override;
|
||||
class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfInfoAddressContext }
|
||||
@ -67,6 +69,17 @@ type
|
||||
function GetAddress: TDbgPtr; override;
|
||||
function GetSizeOfAddress: Integer; override;
|
||||
function GetMemManager: TFpDbgMemManager; override;
|
||||
|
||||
property Symbol: TFpDbgSymbol read FSymbol;
|
||||
property Address: TDBGPtr read FAddress;
|
||||
property Dwarf: TDbgDwarf read FDwarf;
|
||||
function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
SkipCompUnit: TDwarfCompilationUnit): TFpDbgSymbol; inline;
|
||||
function FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgSymbol; inline;
|
||||
// FindLocalSymbol: for the subroutine itself
|
||||
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgSymbol; virtual;
|
||||
public
|
||||
constructor Create(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf);
|
||||
destructor Destroy; override;
|
||||
@ -781,7 +794,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
// function GetFlags: TDbgSymbolFlags; override;
|
||||
function GetLine: Cardinal; override;
|
||||
public
|
||||
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); override;
|
||||
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); overload;
|
||||
destructor Destroy; override;
|
||||
// TODO members = locals ?
|
||||
end;
|
||||
@ -876,6 +889,12 @@ begin
|
||||
Result := TDbgDwarfInfoAddressContext.Create(AnAddress, ASymbol, ADwarf);
|
||||
end;
|
||||
|
||||
class function TFpDwarfDefaultSymbolClassMap.CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase;
|
||||
begin
|
||||
Result := TDbgDwarfProcSymbol.Create(ACompilationUnit, AInfo, AAddress);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfInfoAddressContext }
|
||||
|
||||
function TDbgDwarfInfoAddressContext.GetSymbolAtAddress: TFpDbgSymbol;
|
||||
@ -899,6 +918,123 @@ begin
|
||||
Result := FDwarf.MemManager;
|
||||
end;
|
||||
|
||||
function TDbgDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgSymbol;
|
||||
var
|
||||
i, ExtVal: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
InfoEntry: TDwarfInformationEntry;
|
||||
s: String;
|
||||
begin
|
||||
Result := nil;
|
||||
InfoEntry := nil;
|
||||
i := FDwarf.CompilationUnitsCount;
|
||||
while i > 0 do begin
|
||||
dec(i);
|
||||
CU := FDwarf.CompilationUnits[i];
|
||||
if CU = SkipCompUnit then
|
||||
continue;
|
||||
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier search UNIT Name=', CU.FileName]);
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
InfoEntry := TDwarfInformationEntry.Create(CU, nil);
|
||||
InfoEntry.ScopeIndex := CU.FirstScope.Index;
|
||||
|
||||
if not InfoEntry.AbbrevTag = DW_TAG_compile_unit then
|
||||
continue;
|
||||
// compile_unit can not have startscope
|
||||
|
||||
s := CU.UnitName;
|
||||
if (s <> '') and (CompareUtf8BothCase(PNameUpper, PNameLower, @s[1])) then begin
|
||||
Result.ReleaseReference;
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
break;
|
||||
end;
|
||||
|
||||
CU.ScanAllEntries;
|
||||
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
||||
// only variables are marked "external", but types not / so we may need all top level
|
||||
Result.ReleaseReference;
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier MAYBE FOUND Name=', CU.FileName]);
|
||||
|
||||
// DW_AT_visibility ?
|
||||
if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
|
||||
if ExtVal <> 0 then
|
||||
break;
|
||||
// Search for better result
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TDbgDwarfInfoAddressContext.FindSymbolInStructure(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgSymbol;
|
||||
var
|
||||
InfoEntryInheritance: TDwarfInformationEntry;
|
||||
FwdInfoPtr: Pointer;
|
||||
FwdCompUint: TDwarfCompilationUnit;
|
||||
SelfParam: TDbgDwarfValueIdentifier;
|
||||
begin
|
||||
Result := nil;
|
||||
InfoEntry.AddReference;
|
||||
|
||||
while True do begin
|
||||
if not InfoEntry.IsAddressInStartScope(FAddress) then
|
||||
break;
|
||||
|
||||
InfoEntryInheritance := InfoEntry.FindChildByTag(DW_TAG_inheritance);
|
||||
|
||||
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
||||
SelfParam := TDbgDwarfProcSymbol(FSymbol).GetSelfParameter(FAddress);
|
||||
if (SelfParam <> nil) then begin
|
||||
// TODO: only valid, as long as context is valid, because if comnext is freed, then self is lost too
|
||||
Result := SelfParam.MemberByName[AName];
|
||||
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
if Result = nil then debugln(['TDbgDwarfInfoAddressContext.FindSymbol NOT IN SELF !!!!!!!!!!!!!']);
|
||||
end
|
||||
else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
|
||||
;
|
||||
if Result = nil then // Todo: abort the searh /SetError
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
InfoEntry.ReleaseReference;
|
||||
InfoEntryInheritance.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
if not( (InfoEntryInheritance <> nil) and
|
||||
(InfoEntryInheritance.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)) )
|
||||
then
|
||||
break;
|
||||
InfoEntry.ReleaseReference;
|
||||
InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
||||
InfoEntryInheritance.ReleaseReference;
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier PARENT ', dbgs(InfoEntry, FwdCompUint) ]);
|
||||
end;
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TDbgDwarfInfoAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
if not InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then
|
||||
exit;
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
TDbgDwarfIdentifier(Result).ParentTypeInfo := TDbgDwarfProcSymbol(FSymbol);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfInfoAddressContext.Create(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol;
|
||||
ADwarf: TDbgDwarf);
|
||||
begin
|
||||
@ -919,36 +1055,32 @@ end;
|
||||
function TDbgDwarfInfoAddressContext.FindSymbol(const AName: String): TFpDbgSymbol;
|
||||
var
|
||||
SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol;
|
||||
CU, CU2, FwdCompUint: TDwarfCompilationUnit;
|
||||
CU: TDwarfCompilationUnit;
|
||||
//Scope,
|
||||
StartScopeIdx, ExtVal, i: Integer;
|
||||
InfoEntry, InfoEntryTmp, InfoEntryParent: TDwarfInformationEntry;
|
||||
s, s1, s2: String;
|
||||
StartScopeIdx: Integer;
|
||||
InfoEntry: TDwarfInformationEntry;
|
||||
NameUpper, NameLower: String;
|
||||
InfoName: PChar;
|
||||
FwdInfoPtr: Pointer;
|
||||
tg: Cardinal;
|
||||
p1, p2: PChar;
|
||||
SelfParam: TDbgDwarfValueIdentifier;
|
||||
PNameUpper, PNameLower: PChar;
|
||||
begin
|
||||
Result := nil;
|
||||
if (FSymbol = nil) or not(FSymbol is TDbgDwarfProcSymbol) or (AName = '') then
|
||||
exit;
|
||||
|
||||
SubRoutine := TDbgDwarfProcSymbol(FSymbol);
|
||||
s1 := UTF8UpperCase(AName);
|
||||
s2 := UTF8LowerCase(AName);
|
||||
p1 := @s1[1];
|
||||
p2 := @s2[1];
|
||||
NameUpper := UTF8UpperCase(AName);
|
||||
NameLower := UTF8LowerCase(AName);
|
||||
PNameUpper := @NameUpper[1];
|
||||
PNameLower := @NameLower[1];
|
||||
|
||||
try
|
||||
CU := SubRoutine.CompilationUnit;
|
||||
InfoEntry := SubRoutine.InformationEntry.Clone;
|
||||
//InfoEntry := TDwarfInformationEntry.Create(CU, nil);
|
||||
//InfoEntry.ScopeIndex := SubRoutine.FAddressInfo^.ScopeIndex;
|
||||
|
||||
// special: search "self"
|
||||
// special: search "self" // depends on dwarf version
|
||||
// Todo nested procs
|
||||
if s2 = 'self' then begin
|
||||
if NameLower = 'self' then begin
|
||||
Result := SubRoutine.GetSelfParameter(FAddress);
|
||||
if Result <> nil then begin
|
||||
Result.AddReference;
|
||||
@ -966,132 +1098,52 @@ begin
|
||||
if not InfoEntry.IsAddressInStartScope(FAddress) // StartScope = first valid address
|
||||
then begin
|
||||
// CONTINUE: Search parent(s)
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
//InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
InfoEntry.GoParent;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if InfoEntry.ReadName(InfoName) and not InfoEntry.IsArtificial
|
||||
then begin
|
||||
if (CompareUtf8BothCase(p1, p2, InfoName)) then begin
|
||||
if (CompareUtf8BothCase(PNameUpper, PNameLower, InfoName)) then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
tg := InfoEntry.AbbrevTag;
|
||||
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
|
||||
Result := FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry);
|
||||
// TODO: check error
|
||||
if Result <> nil then
|
||||
exit;
|
||||
//InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
end
|
||||
|
||||
if InfoEntry.GoNamedChildEx(p1, p2) then begin
|
||||
else
|
||||
if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then begin // searching in subroutine
|
||||
Result := FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry);
|
||||
// TODO: check error
|
||||
if Result <> nil then
|
||||
exit;
|
||||
//InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
end
|
||||
// TODO: nested subroutine
|
||||
|
||||
else
|
||||
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
||||
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
|
||||
// access via self
|
||||
SelfParam := SubRoutine.GetSelfParameter(FAddress);
|
||||
if (SelfParam <> nil) then begin
|
||||
// TODO: only valid, as long as context is valid, because if comnext is freed, then self is lost too
|
||||
Result := SelfParam.MemberByName[AName];
|
||||
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
if Result= nil then debugLn(['TDbgDwarfInfoAddressContext.FindSymbol NOT IN SELF !!!!!!!!!!!!!']);
|
||||
end;
|
||||
end;
|
||||
if Result = nil then
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
|
||||
// TODO: nested
|
||||
if (StartScopeIdx = SubRoutine.InformationEntry.ScopeIndex) then // searching in subroutine
|
||||
TDbgDwarfIdentifier(Result).ParentTypeInfo := SubRoutine;
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
|
||||
// TODO: only search most inner class (if classes can be nested.
|
||||
// outer classes static data may be available.
|
||||
// search parent class
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
InfoEntryParent := InfoEntry.FindChildByTag(DW_TAG_inheritance);
|
||||
while (InfoEntryParent <> nil) and (InfoEntryParent.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)) do begin
|
||||
InfoEntryParent.ReleaseReference;
|
||||
InfoEntryParent := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier PARENT ', dbgs(InfoEntryParent, FwdCompUint) ]);
|
||||
|
||||
if not InfoEntry.IsAddressInStartScope(FAddress) then
|
||||
break;
|
||||
|
||||
InfoEntryTmp := InfoEntryParent.FindChildByTag(DW_TAG_inheritance);
|
||||
if InfoEntryParent.GoNamedChildEx(p1, p2) then begin
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
||||
SelfParam := SubRoutine.GetSelfParameter(FAddress);
|
||||
if (SelfParam <> nil) then begin
|
||||
// TODO: only valid, as long as context is valid, because if comnext is freed, then self is lost too
|
||||
Result := SelfParam.MemberByName[AName];
|
||||
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
if Result<> nil then debugln(['TDbgDwarfInfoAddressContext.FindSymbol NOT IN SELF !!!!!!!!!!!!!']);
|
||||
end
|
||||
else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
|
||||
;
|
||||
if Result = nil then
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntryParent);
|
||||
InfoEntryParent.ReleaseReference;
|
||||
InfoEntryTmp.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
InfoEntryParent.ReleaseReference;
|
||||
InfoEntryParent := InfoEntryTmp;
|
||||
end;
|
||||
InfoEntryParent.ReleaseReference;
|
||||
end;
|
||||
|
||||
// Search parent(s)
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
InfoEntry.GoParent;
|
||||
end;
|
||||
|
||||
// other units
|
||||
i := FDwarf.CompilationUnitsCount;
|
||||
while i > 0 do begin
|
||||
dec(i);
|
||||
CU2 := FDwarf.CompilationUnits[i];
|
||||
if CU2 = CU then
|
||||
continue;
|
||||
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier search UNIT Name=', CU2.FileName]);
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
InfoEntry := TDwarfInformationEntry.Create(CU2, nil);
|
||||
InfoEntry.ScopeIndex := CU2.FirstScope.Index;
|
||||
|
||||
if not InfoEntry.AbbrevTag = DW_TAG_compile_unit then
|
||||
continue;
|
||||
// compile_unit can not have startscope
|
||||
|
||||
s := CU2.UnitName;
|
||||
if (s <> '') and (CompareUtf8BothCase(p1, p2, @s[1])) then begin
|
||||
Result.ReleaseReference;
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
break;
|
||||
end;
|
||||
|
||||
CU2.ScanAllEntries;
|
||||
if InfoEntry.GoNamedChildEx(p1, p2) then begin
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) then begin
|
||||
// only variables are marked "external", but types not / so we may need all top level
|
||||
Result.ReleaseReference;
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier MAYBE FOUND Name=', CU2.FileName]);
|
||||
|
||||
// DW_AT_visibility ?
|
||||
if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
|
||||
if ExtVal <> 0 then
|
||||
break;
|
||||
// Search for better result
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
Result := FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU);
|
||||
|
||||
finally
|
||||
if (Result = nil) or (InfoEntry = nil)
|
||||
|
||||
@ -420,7 +420,6 @@ type
|
||||
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry);
|
||||
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry;
|
||||
AKind: TDbgSymbolKind; AAddress: TFpDbgMemLocation);
|
||||
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); virtual; // TODO: onsly for PRoc symbol
|
||||
destructor Destroy; override;
|
||||
|
||||
property CompilationUnit: TDwarfCompilationUnit read FCU;
|
||||
@ -438,6 +437,8 @@ type
|
||||
class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
|
||||
class function CreateContext(AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol;
|
||||
ADwarf: TDbgDwarf): TDbgInfoAddressContext; virtual; abstract;
|
||||
class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; virtual; abstract;
|
||||
end;
|
||||
TFpDwarfSymbolClassMapClass = class of TFpDwarfSymbolClassMap;
|
||||
|
||||
@ -2898,7 +2899,7 @@ begin
|
||||
end;
|
||||
|
||||
// TDbgDwarfProcSymbol
|
||||
Result := Cu.DwarfSymbolClassMap.GetDwarfSymbolClass(DW_TAG_subprogram).Create(CU, Iter.DataPtr, AAddress);
|
||||
Result := Cu.DwarfSymbolClassMap.CreateProcSymbol(CU, Iter.DataPtr, AAddress);
|
||||
finally
|
||||
Iter.Free;
|
||||
end;
|
||||
@ -3026,12 +3027,6 @@ begin
|
||||
Init;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfSymbolBase.Create(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr);
|
||||
begin
|
||||
assert(False, 'TDbgDwarfSymbolBase.Create: False');
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfSymbolBase.Destroy;
|
||||
begin
|
||||
ReleaseRefAndNil(FInformationEntry);
|
||||
|
||||
78
components/fpdebug/fpdbgdwarffreepascal.pas
Normal file
78
components/fpdebug/fpdbgdwarffreepascal.pas
Normal file
@ -0,0 +1,78 @@
|
||||
unit FpDbgDwarfFreePascal;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, DbgIntfBaseTypes;
|
||||
|
||||
type
|
||||
|
||||
{ TFpDwarfFreePascalSymbolClassMap }
|
||||
|
||||
TFpDwarfFreePascalSymbolClassMap = class(TFpDwarfDefaultSymbolClassMap)
|
||||
public
|
||||
class function HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
|
||||
//class function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
||||
class function CreateContext(AnAddress: TDBGPtr; ASymbol: TFpDbgSymbol;
|
||||
ADwarf: TDbgDwarf): TDbgInfoAddressContext; override;
|
||||
//class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
// AInfo: PDwarfAddressInfo; AAddress: TDbgPtr): TDbgDwarfSymbolBase; override;
|
||||
end;
|
||||
|
||||
{ TFpDwarfFreePascalAddressContext }
|
||||
|
||||
TFpDwarfFreePascalAddressContext = class(TDbgDwarfInfoAddressContext)
|
||||
protected
|
||||
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgSymbol; override;
|
||||
public
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TFpDwarfFreePascalSymbolClassMap }
|
||||
|
||||
class function TFpDwarfFreePascalSymbolClassMap.HandleCompUnit(ACU: TDwarfCompilationUnit): Boolean;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
s := LowerCase(ACU.Producer);
|
||||
Result := pos('free pascal', s) > 0;
|
||||
end;
|
||||
|
||||
class function TFpDwarfFreePascalSymbolClassMap.CreateContext(AnAddress: TDbgPtr;
|
||||
ASymbol: TFpDbgSymbol; ADwarf: TDbgDwarf): TDbgInfoAddressContext;
|
||||
begin
|
||||
Result := TFpDwarfFreePascalAddressContext.Create(AnAddress, ASymbol, ADwarf);
|
||||
end;
|
||||
|
||||
{ TFpDwarfFreePascalAddressContext }
|
||||
|
||||
function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgSymbol;
|
||||
const
|
||||
parentfp: string = 'parentfp';
|
||||
var
|
||||
StartScopeIdx: Integer;
|
||||
begin
|
||||
StartScopeIdx := InfoEntry.ScopeIndex;
|
||||
Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry);
|
||||
if Result <> nil then
|
||||
exit;
|
||||
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
// TODO: cache
|
||||
if not InfoEntry.GoNamedChildEx(@parentfp, @parentfp) then
|
||||
exit;
|
||||
|
||||
|
||||
// check $parentfp
|
||||
end;
|
||||
|
||||
initialization
|
||||
DwarfSymbolClassMapList.AddMap(TFpDwarfDefaultSymbolClassMap);
|
||||
|
||||
end.
|
||||
|
||||
@ -34,7 +34,7 @@ File(s) with other licenses (see also header in file(s):
|
||||
|
||||
(Any modifications/translations of this file are from duby)
|
||||
"/>
|
||||
<Files Count="25">
|
||||
<Files Count="26">
|
||||
<Item1>
|
||||
<Filename Value="fpdbgclasses.pp"/>
|
||||
<UnitName Value="FpDbgClasses"/>
|
||||
@ -138,6 +138,10 @@ File(s) with other licenses (see also header in file(s):
|
||||
<Filename Value="fpdbgdwarfdataclasses.pas"/>
|
||||
<UnitName Value="FpDbgDwarfDataClasses"/>
|
||||
</Item25>
|
||||
<Item26>
|
||||
<Filename Value="fpdbgdwarffreepascal.pas"/>
|
||||
<UnitName Value="fpdbgdwarffreepascal"/>
|
||||
</Item26>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
|
||||
@ -11,7 +11,7 @@ uses
|
||||
FpDbgSymbols, FpDbgUtil, FpImgReaderWinPE, FpImgReaderElf, FpImgReaderElfTypes,
|
||||
FpImgReaderBase, FpPascalParser, macho, FpImgReaderMachoFile, FpImgReaderMacho,
|
||||
FpPascalBuilder, FpDbgInfo, FpdMemoryTools, FpErrorMessages, FpDbgDwarfVerbosePrinter,
|
||||
FpDbgDwarfDataClasses, LazarusPackageIntf;
|
||||
FpDbgDwarfDataClasses, FpDbgDwarfFreePascal, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -136,13 +136,13 @@ type
|
||||
): boolean; override;
|
||||
|
||||
function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType;
|
||||
ATargetPointer: TDbgPtr; ADestPointer: Pointer;
|
||||
{%H-}ATargetPointer: TDbgPtr; ADestPointer: Pointer;
|
||||
ATargetSize, ADestSize: Cardinal;
|
||||
AConvertorData: TFpDbgMemConvData
|
||||
{%H-}AConvertorData: TFpDbgMemConvData
|
||||
): boolean; override;
|
||||
procedure FailedTargetRead(AConvertorData: TFpDbgMemConvData); override;
|
||||
procedure FailedTargetRead({%H-}AConvertorData: TFpDbgMemConvData); override;
|
||||
|
||||
procedure AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); override;
|
||||
procedure AdjustIntPointer(var {%H-}ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); override;
|
||||
|
||||
|
||||
//procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override;
|
||||
|
||||
@ -230,7 +230,7 @@ end;
|
||||
function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode; AnError: TFpError;
|
||||
AData: array of const): TFpError;
|
||||
var
|
||||
i, j: Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := CreateError(AnErrorCode, AData);
|
||||
SetLength(Result, Length(AnError) + 1);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user