mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 12:16:18 +02:00
FpDebug: Improve calling methods in watches, search SymbolTable for mangled method name to get address.
This commit is contained in:
Martin
parent
f235b30e44
commit
59f3382161
@ -2700,6 +2700,7 @@ begin
|
||||
Ctx := TFpDbgSimpleLocationContext.Create(MemManager, Addr, DBGPTRSIZE[Mode], AThreadId, AStackFrame);
|
||||
Ctx.SetFrameBaseCallback(@DoGetFrameBase);
|
||||
Ctx.SetCfaFrameBaseCallback(@DoGetCfiFrameBase);
|
||||
Ctx.SymbolTableInfo := SymbolTableInfo;
|
||||
Frame.Context := Ctx;
|
||||
end;
|
||||
sym := Frame.ProcSymbol;
|
||||
|
||||
@ -69,7 +69,7 @@ type
|
||||
public
|
||||
//function CanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
|
||||
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; override;
|
||||
function CreateUnitSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
@ -136,7 +136,7 @@ type
|
||||
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; virtual;
|
||||
procedure Init; virtual;
|
||||
public
|
||||
constructor Create(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo);
|
||||
constructor Create(ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo);
|
||||
destructor Destroy; override;
|
||||
function FindSymbol(const AName: String; const OnlyUnitName: String = '';
|
||||
AFindFlags: TFindExportedSymbolsFlags = []): TFpValue; override;
|
||||
@ -155,11 +155,11 @@ type
|
||||
|
||||
TFpValueDwarfBase = class(TFpValue)
|
||||
strict private
|
||||
FLocContext: TFpDbgLocationContext;
|
||||
procedure SetContext(AValue: TFpDbgLocationContext);
|
||||
FLocContext: TFpDbgSimpleLocationContext;
|
||||
procedure SetContext(AValue: TFpDbgSimpleLocationContext);
|
||||
public
|
||||
destructor Destroy; override;
|
||||
property Context: TFpDbgLocationContext read FLocContext write SetContext;
|
||||
property Context: TFpDbgSimpleLocationContext read FLocContext write SetContext;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfTypeDefinition }
|
||||
@ -1103,8 +1103,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
public
|
||||
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo = nil); overload;
|
||||
destructor Destroy; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
// TODO members = locals ?
|
||||
function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf;
|
||||
function GetFrameBase(AContext: TFpDbgLocationContext; out AnError: TFpError): TDbgPtr;
|
||||
@ -1173,8 +1173,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
public
|
||||
constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry; ADbgInfo: TFpDwarfInfo = nil); overload;
|
||||
destructor Destroy; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext): TFpDbgSymbolScope; override;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
end;
|
||||
{%endregion Symbol objects }
|
||||
|
||||
@ -1192,7 +1192,7 @@ end;
|
||||
|
||||
{ TFpValueDwarfBase }
|
||||
|
||||
procedure TFpValueDwarfBase.SetContext(AValue: TFpDbgLocationContext);
|
||||
procedure TFpValueDwarfBase.SetContext(AValue: TFpDbgSimpleLocationContext);
|
||||
begin
|
||||
if FLocContext = AValue then Exit;
|
||||
if FLocContext <> nil then
|
||||
@ -1318,7 +1318,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpDwarfDefaultSymbolClassMap.CreateScopeForSymbol(
|
||||
ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := TFpDwarfInfoSymbolScope.Create(ALocationContext,ASymbol, ADwarf);
|
||||
@ -1727,7 +1727,7 @@ begin
|
||||
end;
|
||||
|
||||
constructor TFpDwarfInfoSymbolScope.Create(
|
||||
ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo);
|
||||
begin
|
||||
assert((ASymbol=nil) or (ASymbol is TFpSymbolDwarf), 'TFpDwarfInfoSymbolScope.Create: (ASymbol=nil) or (ASymbol is TFpSymbolDwarf)');
|
||||
@ -6733,7 +6733,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfDataProc.CreateSymbolScope(
|
||||
ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope;
|
||||
ALocationContext: TFpDbgSimpleLocationContext): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := nil;
|
||||
if FDwarf <> nil then
|
||||
@ -6742,7 +6742,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfDataProc.CreateSymbolScope(
|
||||
ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
|
||||
@ -7298,7 +7298,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfUnit.CreateSymbolScope(
|
||||
ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope;
|
||||
ALocationContext: TFpDbgSimpleLocationContext): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := nil;
|
||||
if FDwarf <> nil then
|
||||
@ -7307,7 +7307,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfUnit.CreateSymbolScope(
|
||||
ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := CompilationUnit.DwarfSymbolClassMap.CreateScopeForSymbol
|
||||
|
||||
@ -527,7 +527,7 @@ type
|
||||
AKind: TDbgSymbolKind; const AAddress: TFpDbgMemLocation); overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; virtual; overload;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo): TFpDbgSymbolScope; virtual; overload;
|
||||
|
||||
function IsEqual(AnOther: TFpSymbol): Boolean; override;
|
||||
|
||||
@ -577,7 +577,7 @@ type
|
||||
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); virtual;
|
||||
function IgnoreCfiStackEnd: boolean; virtual;
|
||||
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; virtual; abstract;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; virtual; abstract;
|
||||
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo): TDbgDwarfSymbolBase; virtual; abstract;
|
||||
@ -822,7 +822,7 @@ type
|
||||
public
|
||||
constructor Create(ALoaderList: TDbgImageLoaderList; AMemManager: TFpDbgMemManager; AMemModel: TFpDbgMemModel); override;
|
||||
destructor Destroy; override;
|
||||
function FindSymbolScope(ALocationContext: TFpDbgLocationContext; AAddress: TDbgPtr = 0): TFpDbgSymbolScope; override;
|
||||
function FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; AAddress: TDbgPtr = 0): TFpDbgSymbolScope; override;
|
||||
function FindDwarfProcSymbol(AAddress: TDbgPtr): TDbgDwarfSymbolBase; inline;
|
||||
function FindProcSymbol(AAddress: TDbgPtr): TFpSymbol; override; overload;
|
||||
function FindProcStartEndPC(const AAddress: TDbgPtr; out AStartPC, AEndPC: TDBGPtr): boolean; override;
|
||||
@ -3847,7 +3847,7 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfo.FindSymbolScope(ALocationContext: TFpDbgLocationContext;
|
||||
function TFpDwarfInfo.FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext;
|
||||
AAddress: TDbgPtr): TFpDbgSymbolScope;
|
||||
var
|
||||
Proc, UnitSym: TDbgDwarfSymbolBase;
|
||||
@ -4495,7 +4495,7 @@ begin
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolBase.CreateSymbolScope(
|
||||
ALocationContext: TFpDbgLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ADwarfInfo: TFpDwarfInfo
|
||||
): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
@ -7,10 +7,9 @@ unit FpDbgDwarfFreePascal;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Types, math,
|
||||
FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo,
|
||||
FpDbgUtil, FpDbgDwarfConst, FpErrorMessages, FpdMemoryTools, FpDbgClasses, FpPascalParser, FpDbgDisasX86,
|
||||
DbgIntfBaseTypes,
|
||||
Classes, SysUtils, Types, math, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil,
|
||||
FpDbgDwarfConst, FpErrorMessages, FpdMemoryTools, FpDbgClasses, FpPascalParser, FpDbgDisasX86,
|
||||
fpDbgSymTableContext, DbgIntfBaseTypes,
|
||||
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},
|
||||
LazStringUtils, LazClasses;
|
||||
|
||||
@ -37,7 +36,7 @@ type
|
||||
constructor Create(ACU: TDwarfCompilationUnit; AHelperData: Pointer); override;
|
||||
function IgnoreCfiStackEnd: boolean; override;
|
||||
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
|
||||
AInfo: PDwarfAddressInfo; AAddress: TDbgPtr; ADbgInfo: TFpDwarfInfo
|
||||
@ -80,7 +79,7 @@ type
|
||||
class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
|
||||
public
|
||||
function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
function CreateScopeForSymbol(ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
//class function CreateSymbolScope(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpSymbol;
|
||||
// ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
|
||||
@ -327,6 +326,19 @@ type
|
||||
property DynamicCodePage: TSystemCodePage read GetCodePage;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfFreePascalSubroutine }
|
||||
|
||||
TFpValueDwarfFreePascalSubroutine = class(TFpValueDwarfSubroutine)
|
||||
protected
|
||||
function GetMangledArguments: String;
|
||||
function GetMangledMethodName(AClassName, AnUnitName: String): String;
|
||||
function GetMangledFunctionName(AnUnitName: String): String;
|
||||
function GetEntryPCAddress: TFpDbgMemLocation; override;
|
||||
public
|
||||
function GetMangledAddress: TFpDbgMemLocation;
|
||||
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfFreePascalDataProc }
|
||||
|
||||
TFpSymbolDwarfFreePascalDataProc = class(TFpSymbolDwarfDataProc)
|
||||
@ -336,6 +348,7 @@ type
|
||||
function GetLine: Cardinal; override;
|
||||
function GetColumn: Cardinal; override;
|
||||
// Todo: LineStartAddress, ...
|
||||
function GetValueObject: TFpValue; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
function ResolveInternalFinallySymbol(Process: Pointer): TFpSymbol; override;
|
||||
@ -527,7 +540,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpDwarfFreePascalSymbolClassMap.CreateScopeForSymbol(
|
||||
ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := TFpDwarfFreePascalSymbolScope.Create(ALocationContext, ASymbol, ADwarf);
|
||||
@ -635,7 +648,7 @@ begin
|
||||
end;
|
||||
|
||||
function TFpDwarfFreePascalSymbolClassMapDwarf3.CreateScopeForSymbol(
|
||||
ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
|
||||
ALocationContext: TFpDbgSimpleLocationContext; ASymbol: TFpSymbol;
|
||||
ADwarf: TFpDwarfInfo): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := TFpDwarfFreePascalSymbolScopeDwarf3.Create(ALocationContext, ASymbol, ADwarf);
|
||||
@ -2329,6 +2342,133 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfFreePascalSubroutine }
|
||||
|
||||
function TFpValueDwarfFreePascalSubroutine.GetMangledArguments: String;
|
||||
var
|
||||
i: Integer;
|
||||
m: TFpValue;
|
||||
n: String;
|
||||
begin
|
||||
Result := '';
|
||||
// First argument is SELF, and must be skipped
|
||||
for i := 1 to MemberCount - 1 do begin
|
||||
m := Member[i];
|
||||
if (m.TypeInfo = nil) then
|
||||
exit('');
|
||||
n := m.TypeInfo.Name;
|
||||
if n = '' then
|
||||
exit('');
|
||||
Result := Result + '$' + n;
|
||||
end;
|
||||
if Kind = skFunction then begin
|
||||
if (TypeInfo = nil) or (TypeInfo.TypeInfo = nil) then
|
||||
exit('');
|
||||
n := TypeInfo.TypeInfo.Name;
|
||||
if n = '' then
|
||||
exit('');
|
||||
Result := Result + '$$' + n;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalSubroutine.GetMangledMethodName(AClassName, AnUnitName: String
|
||||
): String;
|
||||
var
|
||||
i: Integer;
|
||||
m: TFpValue;
|
||||
n: String;
|
||||
begin
|
||||
Result := '';
|
||||
if (AClassName = '') or (AnUnitName = '') or (Name = '') then
|
||||
exit;
|
||||
UniqueString(AClassName);
|
||||
i := pos('.', AClassName);
|
||||
while i > 0 do begin
|
||||
AClassName[i] := '_';
|
||||
Insert('_$', AClassName, i);
|
||||
i := pos('.', AClassName);
|
||||
end;
|
||||
Result := AnUnitName + '$_$' + AClassName + '_$__$$_' + Name + GetMangledArguments;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalSubroutine.GetMangledFunctionName(AnUnitName: String): String;
|
||||
var
|
||||
i: Integer;
|
||||
m: TFpValue;
|
||||
n: String;
|
||||
begin
|
||||
Result := '';
|
||||
if (AnUnitName = '') or (Name = '') then
|
||||
exit;
|
||||
Result := AnUnitName + '_$$_' + Name + GetMangledArguments;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalSubroutine.GetEntryPCAddress: TFpDbgMemLocation;
|
||||
begin
|
||||
Result := inherited GetEntryPCAddress;
|
||||
|
||||
if IsValidLoc(Result) then
|
||||
exit;
|
||||
|
||||
Result := GetMangledAddress;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalSubroutine.GetMangledAddress: TFpDbgMemLocation;
|
||||
var
|
||||
ParentIdx: Integer;
|
||||
TheClassName, TheUnitName, n: String;
|
||||
SymTbl: TDbgInfo;
|
||||
SymProc: TFpSymbol;
|
||||
s: TFpValueDwarf;
|
||||
begin
|
||||
Result := InvalidLoc;
|
||||
if (Context = nil) or (Context.SymbolTableInfo = nil) or
|
||||
(not (DbgSymbol is TFpSymbolDwarfDataProc))
|
||||
then
|
||||
exit;
|
||||
|
||||
SymTbl := Context.SymbolTableInfo;
|
||||
n := '';
|
||||
s := StructureValue;
|
||||
if s = nil then begin
|
||||
s := TFpSymbolDwarfDataProc(DbgSymbol).GetSelfParameter(Context.Address);
|
||||
if s <> nil then
|
||||
s.Context := Context;
|
||||
end
|
||||
else
|
||||
s.AddReference;
|
||||
if (s <> nil) then begin
|
||||
ParentIdx := 0;
|
||||
// TODO: we need the structure parent in which we were found
|
||||
while s.GetInstanceClassName(@TheClassName, @TheUnitName, ParentIdx) do begin
|
||||
// if TheClassName = '' then TheClassName := 'P$'+ProjecName;
|
||||
n := GetMangledMethodName(TheClassName, TheUnitName);
|
||||
SymProc := SymTbl.FindProcSymbol(n, True);
|
||||
if SymProc <> nil then begin
|
||||
Result := SymProc.Address;
|
||||
SymProc.ReleaseReference;
|
||||
DebugLn(FPDBG_DWARF_VERBOSE, 'Using mangled address for method "%s": %s', [n, dbgs(Result)]);
|
||||
s.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
|
||||
inc(ParentIdx);
|
||||
if ParentIdx > 100 then break; // safety net
|
||||
end;
|
||||
s.ReleaseReference;
|
||||
end
|
||||
else begin
|
||||
n := GetMangledFunctionName(TFpSymbolDwarfDataProc(DbgSymbol).CompilationUnit.UnitName);
|
||||
SymProc := SymTbl.FindProcSymbol(n, True);
|
||||
if SymProc <> nil then begin
|
||||
Result := SymProc.Address;
|
||||
SymProc.ReleaseReference;
|
||||
DebugLn(FPDBG_DWARF_VERBOSE, 'Using mangled address for function "%s": %s', [n, dbgs(Result)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfFreePascalDataProc }
|
||||
|
||||
function TFpSymbolDwarfFreePascalDataProc.GetLine: Cardinal;
|
||||
@ -2347,6 +2487,13 @@ begin
|
||||
Result := inherited GetColumn;
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfFreePascalDataProc.GetValueObject: TFpValue;
|
||||
begin
|
||||
assert(TypeInfo is TFpSymbolDwarfType, 'TFpSymbolDwarfDataProc.GetValueObject: TypeInfo is TFpSymbolDwarfType');
|
||||
Result := TFpValueDwarfFreePascalSubroutine.Create(TFpSymbolDwarfType(TypeInfo)); // TODO: GetTypedValueObject;
|
||||
TFpValueDwarf(Result).SetDataSymbol(self);
|
||||
end;
|
||||
|
||||
destructor TFpSymbolDwarfFreePascalDataProc.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
@ -114,6 +114,9 @@ type
|
||||
TFindExportedSymbolsFlag = (fsfIgnoreEnumVals, fsfMatchUnitName);
|
||||
TFindExportedSymbolsFlags = set of TFindExportedSymbolsFlag;
|
||||
|
||||
TDbgInfo = class;
|
||||
TFpDbgSimpleLocationContext = class;
|
||||
|
||||
{ TFpValue }
|
||||
|
||||
TFpValue = class(TRefCountedObject)
|
||||
@ -576,7 +579,7 @@ type
|
||||
// Returns a reference to caller / caller must release
|
||||
function TypeCastValue({%H-}AValue: TFpValue): TFpValue; virtual;
|
||||
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgLocationContext): TFpDbgSymbolScope; virtual;
|
||||
function CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext): TFpDbgSymbolScope; virtual;
|
||||
function IsEqual(AnOther: TFpSymbol): Boolean; virtual;
|
||||
end;
|
||||
|
||||
@ -646,7 +649,7 @@ type
|
||||
|
||||
TFpDbgSymbolScope = class(TRefCountedObject)
|
||||
private
|
||||
FLocationContext: TFpDbgLocationContext;
|
||||
FLocationContext: TFpDbgSimpleLocationContext;
|
||||
protected
|
||||
function GetSymbolAtAddress: TFpSymbol; virtual;
|
||||
function GetProcedureAtAddress: TFpValue; virtual;
|
||||
@ -654,7 +657,7 @@ type
|
||||
function GetMemModel: TFpDbgMemModel; virtual;
|
||||
function GetSizeOfAddress: Integer; virtual;
|
||||
public
|
||||
constructor Create(ALocationContext: TFpDbgLocationContext);
|
||||
constructor Create(ALocationContext: TFpDbgSimpleLocationContext);
|
||||
destructor Destroy; override;
|
||||
property SymbolAtAddress: TFpSymbol read GetSymbolAtAddress;
|
||||
property ProcedureAtAddress: TFpValue read GetProcedureAtAddress;
|
||||
@ -664,7 +667,7 @@ type
|
||||
property MemManager: TFpDbgMemManager read GetMemManager;
|
||||
property MemModel: TFpDbgMemModel read GetMemModel;
|
||||
property SizeOfAddress: Integer read GetSizeOfAddress;
|
||||
property LocationContext: TFpDbgLocationContext read FLocationContext;
|
||||
property LocationContext: TFpDbgSimpleLocationContext read FLocationContext;
|
||||
end;
|
||||
|
||||
{ TFpDbgSimpleLocationContext }
|
||||
@ -674,6 +677,7 @@ type
|
||||
FMemManager: TFpDbgMemManager;
|
||||
FMemModel: TFpDbgMemModel;
|
||||
FAddress: TDbgPtr;
|
||||
FSymbolTableInfo: TDbgInfo;
|
||||
FThreadId: Integer;
|
||||
FStackFrame: Integer;
|
||||
FSizeOfAddr: Integer;
|
||||
@ -686,6 +690,7 @@ type
|
||||
function GetSizeOfAddress: Integer; override;
|
||||
public
|
||||
constructor Create(AMemManager: TFpDbgMemManager; AnAddress: TDbgPtr; AnSizeOfAddr, AThreadId: Integer; AStackFrame: Integer);
|
||||
property SymbolTableInfo: TDbgInfo read FSymbolTableInfo write FSymbolTableInfo;
|
||||
end;
|
||||
|
||||
{ TFpDbgCallMemReader }
|
||||
@ -720,21 +725,12 @@ type
|
||||
|
||||
{ TFpDbgAbstractCallContext }
|
||||
|
||||
TFpDbgAbstractCallContext = class(TFpDbgLocationContext)
|
||||
TFpDbgAbstractCallContext = class(TFpDbgSimpleLocationContext)
|
||||
private
|
||||
FBaseContext: TFpDbgLocationContext;
|
||||
FMemManager: TFpDbgMemManager;
|
||||
FMemModel: TFpDbgMemModel;
|
||||
FMemReader: TFpDbgCallMemReader;
|
||||
FIsValid: Boolean;
|
||||
FMessage: string;
|
||||
protected
|
||||
function GetMemManager: TFpDbgMemManager; override;
|
||||
function GetMemModel: TFpDbgMemModel; override;
|
||||
function GetAddress: TDbgPtr; override;
|
||||
function GetThreadId: Integer; override;
|
||||
function GetStackFrame: Integer; override;
|
||||
function GetSizeOfAddress: Integer; override;
|
||||
public
|
||||
constructor Create(const ABaseContext: TFpDbgLocationContext;
|
||||
AMemReader: TFpDbgMemReaderBase; AMemModel: TFpDbgMemModel; AMemConverter: TFpDbgMemConvertor);
|
||||
@ -764,7 +760,7 @@ type
|
||||
However a different Address may be froced.
|
||||
TODO: for now address may be needed, as stack decoding is not done yet
|
||||
*)
|
||||
function FindSymbolScope(ALocationContext: TFpDbgLocationContext; {%H-}AAddress: TDbgPtr = 0): TFpDbgSymbolScope; virtual;
|
||||
function FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; {%H-}AAddress: TDbgPtr = 0): TFpDbgSymbolScope; virtual;
|
||||
function FindProcSymbol(AAddress: TDbgPtr): TFpSymbol; virtual; overload;
|
||||
function FindProcSymbol(const {%H-}AName: String; AIgnoreCase: Boolean = False): TFpSymbol; virtual; overload;
|
||||
function FindLineInfo(AAddress: TDbgPtr): TFpSymbol; virtual;
|
||||
@ -859,13 +855,11 @@ begin
|
||||
FBaseContext:=ABaseContext;
|
||||
FBaseContext.AddReference;
|
||||
|
||||
FMemModel := AMemModel;
|
||||
FMemReader := TFpDbgCallMemReader.Create(AMemReader);
|
||||
FMemManager := TFpDbgMemManager.Create(FMemReader, AMemConverter, FMemModel);
|
||||
|
||||
FIsValid := True;
|
||||
|
||||
Inherited Create;
|
||||
Inherited Create(TFpDbgMemManager.Create(FMemReader, AMemConverter, AMemModel),
|
||||
FBaseContext.Address, FBaseContext.SizeOfAddress, FBaseContext.ThreadId, FBaseContext.StackFrame);
|
||||
end;
|
||||
|
||||
destructor TFpDbgAbstractCallContext.Destroy;
|
||||
@ -876,36 +870,6 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetAddress: TDbgPtr;
|
||||
begin
|
||||
Result := FBaseContext.Address;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetMemManager: TFpDbgMemManager;
|
||||
begin
|
||||
Result := FMemManager;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetMemModel: TFpDbgMemModel;
|
||||
begin
|
||||
Result := FMemModel;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetSizeOfAddress: Integer;
|
||||
begin
|
||||
Result := FBaseContext.SizeOfAddress;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetStackFrame: Integer;
|
||||
begin
|
||||
Result := FBaseContext.StackFrame;
|
||||
end;
|
||||
|
||||
function TFpDbgAbstractCallContext.GetThreadId: Integer;
|
||||
begin
|
||||
Result := FBaseContext.ThreadId;
|
||||
end;
|
||||
|
||||
procedure TFpDbgAbstractCallContext.SetRegisterValue(ARegNum: Cardinal; AValue: TDbgPtr);
|
||||
begin
|
||||
FMemReader.SetRegisterValue(ARegNum, AValue);
|
||||
@ -1755,7 +1719,7 @@ begin
|
||||
Result := LocationContext.MemModel;
|
||||
end;
|
||||
|
||||
constructor TFpDbgSymbolScope.Create(ALocationContext: TFpDbgLocationContext);
|
||||
constructor TFpDbgSymbolScope.Create(ALocationContext: TFpDbgSimpleLocationContext);
|
||||
begin
|
||||
FLocationContext := ALocationContext;
|
||||
FLocationContext.AddReference;
|
||||
@ -1901,7 +1865,7 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFpSymbol.CreateSymbolScope(ALocationContext: TFpDbgLocationContext
|
||||
function TFpSymbol.CreateSymbolScope(ALocationContext: TFpDbgSimpleLocationContext
|
||||
): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := nil;
|
||||
@ -2358,7 +2322,7 @@ begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbolScope(ALocationContext: TFpDbgLocationContext;
|
||||
function TDbgInfo.FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext;
|
||||
AAddress: TDbgPtr): TFpDbgSymbolScope;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
@ -46,7 +46,7 @@ type
|
||||
protected
|
||||
function GetSizeOfAddress: Integer; override;
|
||||
public
|
||||
constructor Create(ALocationContext: TFpDbgLocationContext; AFpSymbolInfo: TFpSymbolInfo);
|
||||
constructor Create(ALocationContext: TFpDbgSimpleLocationContext; AFpSymbolInfo: TFpSymbolInfo);
|
||||
function FindSymbol(const AName: String; const OnlyUnitName: String = '';
|
||||
AFindFlags: TFindExportedSymbolsFlags = []): TFpValue; override;
|
||||
end;
|
||||
@ -57,13 +57,18 @@ type
|
||||
private
|
||||
FSymbolList: TfpSymbolList;
|
||||
FLibName: String;
|
||||
function GetSymbols(AnIndex: integer): TFpSymbol;
|
||||
public
|
||||
constructor Create(ALoaderList: TDbgImageLoaderList; AMemManager: TFpDbgMemManager; AMemModel: TFpDbgMemModel); override; overload;
|
||||
constructor Create(ALoaderList: TDbgImageLoaderList; AMemManager: TFpDbgMemManager; ALibName: String; AMemModel: TFpDbgMemModel); overload;
|
||||
destructor Destroy; override;
|
||||
function FindSymbolScope(ALocationContext: TFpDbgLocationContext; AAddress: TDbgPtr = 0): TFpDbgSymbolScope; override;
|
||||
function FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext; AAddress: TDbgPtr = 0): TFpDbgSymbolScope; override;
|
||||
function FindProcSymbol(const AName: String; AIgnoreCase: Boolean = False): TFpSymbol; override; overload;
|
||||
function FindProcSymbol(AnAdress: TDbgPtr): TFpSymbol; overload;
|
||||
|
||||
// for debugdump
|
||||
function SymbolCount: integer;
|
||||
property Symbols[AnIndex: integer]: TFpSymbol read GetSymbols;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -133,7 +138,7 @@ begin
|
||||
result := FSizeOfAddress;
|
||||
end;
|
||||
|
||||
constructor TFpSymbolContext.Create(ALocationContext: TFpDbgLocationContext;
|
||||
constructor TFpSymbolContext.Create(ALocationContext: TFpDbgSimpleLocationContext;
|
||||
AFpSymbolInfo: TFpSymbolInfo);
|
||||
begin
|
||||
inherited create(ALocationContext);
|
||||
@ -160,6 +165,11 @@ end;
|
||||
|
||||
{ TFpSymbolInfo }
|
||||
|
||||
function TFpSymbolInfo.GetSymbols(AnIndex: integer): TFpSymbol;
|
||||
begin
|
||||
Result := TFpSymbolTableProc.Create(FSymbolList.Keys[AnIndex], FSymbolList.DataPtr[AnIndex]^.Addr);
|
||||
end;
|
||||
|
||||
constructor TFpSymbolInfo.Create(ALoaderList: TDbgImageLoaderList;
|
||||
AMemManager: TFpDbgMemManager; AMemModel: TFpDbgMemModel);
|
||||
|
||||
@ -189,7 +199,7 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFpSymbolInfo.FindSymbolScope(ALocationContext: TFpDbgLocationContext;
|
||||
function TFpSymbolInfo.FindSymbolScope(ALocationContext: TFpDbgSimpleLocationContext;
|
||||
AAddress: TDbgPtr): TFpDbgSymbolScope;
|
||||
begin
|
||||
assert(False, 'TFpSymbolInfo.FindSymbolScope: False');
|
||||
@ -259,5 +269,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpSymbolInfo.SymbolCount: integer;
|
||||
begin
|
||||
Result := FSymbolList.Count;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -120,7 +120,7 @@ function GetParamsAsString(
|
||||
var
|
||||
ProcVal: TFpValue;
|
||||
ProcSymbol: TFpSymbol;
|
||||
AContext: TFpDbgLocationContext;
|
||||
AContext: TFpDbgSimpleLocationContext;
|
||||
m: TFpValue;
|
||||
v: String;
|
||||
i: Integer;
|
||||
|
||||
@ -826,13 +826,13 @@ type
|
||||
|
||||
TFpPasParserValue = class(TFpValue)
|
||||
private
|
||||
FContext: TFpDbgLocationContext;
|
||||
FContext: TFpDbgSimpleLocationContext;
|
||||
FExpressionPart: TFpPascalExpressionPart;
|
||||
protected
|
||||
function DebugText(AIndent: String): String; virtual;
|
||||
public
|
||||
constructor Create(AnExpressionPart: TFpPascalExpressionPart);
|
||||
property Context: TFpDbgLocationContext read FContext;
|
||||
property Context: TFpDbgSimpleLocationContext read FContext;
|
||||
end;
|
||||
|
||||
{ TFpPasParserValueSlicedArray }
|
||||
|
||||
@ -9,7 +9,7 @@ uses
|
||||
FpDebugDebugger, TestDbgControl, TestDbgTestSuites, TestOutputLogger,
|
||||
TTestWatchUtilities, TestCommonSources, TestDbgConfig, LazDebuggerIntf,
|
||||
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, DbgIntfDebuggerBase,
|
||||
DbgIntfBaseTypes, FpDbgInfo, FpPascalParser, FpDbgCommon,
|
||||
DbgIntfBaseTypes, FpDbgInfo, FpPascalParser, FpDbgCommon, FpDbgDwarfFreePascal, FpdMemoryTools,
|
||||
IdeDebuggerWatchValueIntf, Forms, IdeDebuggerBase, IdeDebuggerWatchResult,
|
||||
IdeDebuggerBackendValueConv, FpDebugStringConstants, FpDebugDebuggerUtils;
|
||||
|
||||
@ -39,6 +39,7 @@ type
|
||||
procedure TestWatchesModify;
|
||||
procedure TestWatchesErrors;
|
||||
procedure TestClassRtti;
|
||||
procedure TestClassMangled;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -47,7 +48,7 @@ var
|
||||
ControlTestWatch, ControlTestWatchScope, ControlTestWatchValue, ControlTestWatchIntrinsic, ControlTestWatchIntrinsic2,
|
||||
ControlTestWatchFunct, ControlTestWatchFunct2, ControlTestWatchFunctStr, ControlTestWatchFunctRec,
|
||||
ControlTestWatchFunctVariant, ControlTestWatchAddressOf, ControlTestWatchTypeCast, ControlTestModify,
|
||||
ControlTestExpression, ControlTestErrors, ControlTestRTTI: Pointer;
|
||||
ControlTestExpression, ControlTestErrors, ControlTestRTTI, ControlTestMangled: Pointer;
|
||||
|
||||
procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint;
|
||||
ADisableBreak: Boolean);
|
||||
@ -4869,6 +4870,106 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestWatches.TestClassMangled;
|
||||
var
|
||||
ExeName: String;
|
||||
Src: TCommonSource;
|
||||
BrkPrg: TDBGBreakPoint;
|
||||
fp: TFpDebugDebugger;
|
||||
AnExpressionScope: TFpDbgSymbolScope;
|
||||
APasExpr: TFpPascalExpression;
|
||||
ResValue: TFpValue;
|
||||
InstClass, AnUnitName: String;
|
||||
r: Boolean;
|
||||
a: TFpDbgMemLocation;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestMangled) then exit;
|
||||
if Compiler.Version < 030000 then exit;
|
||||
|
||||
Src := GetCommonSourceFor('WatchesScopePrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
AssertTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
|
||||
AnExpressionScope := nil;
|
||||
try
|
||||
BrkPrg := Debugger.SetBreakPoint(Src, 'WatchesScopeUnit2.pas', 'MethodMainBaseBase');
|
||||
AssertDebuggerNotInErrorState;
|
||||
RunToPause(BrkPrg);
|
||||
|
||||
{$IFDEF FPDEBUG_THREAD_CHECK}
|
||||
ClearCurrentFpDebugThreadIdForAssert;
|
||||
{$ENDIF}
|
||||
|
||||
fp := TFpDebugDebugger(Debugger.LazDebugger);
|
||||
AnExpressionScope := fp.DbgController.CurrentProcess.FindSymbolScope(fp.DbgController.CurrentThread.ID, 0);
|
||||
TestTrue('got scope', AnExpressionScope <> nil);
|
||||
|
||||
if AnExpressionScope <> nil then begin
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('MethodMainBaseBase', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
TestTrue('got inst class ', ResValue is TFpValueDwarfFreePascalSubroutine);
|
||||
if ResValue is TFpValueDwarfFreePascalSubroutine then begin
|
||||
a := TFpValueDwarfFreePascalSubroutine(ResValue).GetMangledAddress;
|
||||
TestTrue('method - got addr ' + dbgs(a), IsTargetAddr(a) );
|
||||
end;
|
||||
APasExpr.Free;
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('Self.MethodMainBaseBase', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
TestTrue('got inst class ', ResValue is TFpValueDwarfFreePascalSubroutine);
|
||||
if ResValue is TFpValueDwarfFreePascalSubroutine then begin
|
||||
a := TFpValueDwarfFreePascalSubroutine(ResValue).GetMangledAddress;
|
||||
TestTrue('self - got addr ' + dbgs(a), IsTargetAddr(a) );
|
||||
end;
|
||||
APasExpr.Free;
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('MethodMainBase', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
TestTrue('got inst class ', ResValue is TFpValueDwarfFreePascalSubroutine);
|
||||
if ResValue is TFpValueDwarfFreePascalSubroutine then begin
|
||||
a := TFpValueDwarfFreePascalSubroutine(ResValue).GetMangledAddress;
|
||||
TestTrue('method other - got addr ' + dbgs(a), IsTargetAddr(a) );
|
||||
end;
|
||||
APasExpr.Free;
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('Self.MethodMainBase', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
TestTrue('got inst class ', ResValue is TFpValueDwarfFreePascalSubroutine);
|
||||
if ResValue is TFpValueDwarfFreePascalSubroutine then begin
|
||||
a := TFpValueDwarfFreePascalSubroutine(ResValue).GetMangledAddress;
|
||||
TestTrue('self other - got addr ' + dbgs(a), IsTargetAddr(a) );
|
||||
end;
|
||||
APasExpr.Free;
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('Unit2Init', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
TestTrue('got inst class ', ResValue is TFpValueDwarfFreePascalSubroutine);
|
||||
if ResValue is TFpValueDwarfFreePascalSubroutine then begin
|
||||
a := TFpValueDwarfFreePascalSubroutine(ResValue).GetMangledAddress;
|
||||
TestTrue('function - got addr '+dbgs(a), IsTargetAddr(a) );
|
||||
end;
|
||||
APasExpr.Free;
|
||||
|
||||
|
||||
end
|
||||
else
|
||||
TestTrue('scope ', False);
|
||||
|
||||
|
||||
finally
|
||||
AnExpressionScope.ReleaseReference;
|
||||
|
||||
Debugger.RunToNextPause(dcStop);
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterDbgTest(TTestWatches);
|
||||
@ -4887,7 +4988,8 @@ initialization
|
||||
ControlTestModify := TestControlRegisterTest('Modify', ControlTestWatch);
|
||||
ControlTestExpression := TestControlRegisterTest('Expression', ControlTestWatch);
|
||||
ControlTestErrors := TestControlRegisterTest('Errors', ControlTestWatch);
|
||||
ControlTestRTTI := TestControlRegisterTest('Rtti', ControlTestWatch);
|
||||
ControlTestRTTI := TestControlRegisterTest('Rtti', ControlTestWatch);
|
||||
ControlTestMangled := TestControlRegisterTest('Mangled', ControlTestWatch);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user