From 59f33821613e710df8b0a07346078d098468d19b Mon Sep 17 00:00:00 2001 From: Martin Date: Sun, 11 Aug 2024 17:59:11 +0200 Subject: [PATCH] FpDebug: Improve calling methods in watches, search SymbolTable for mangled method name to get address. --- components/fpdebug/fpdbgclasses.pp | 1 + components/fpdebug/fpdbgdwarf.pas | 32 ++-- components/fpdebug/fpdbgdwarfdataclasses.pas | 10 +- components/fpdebug/fpdbgdwarffreepascal.pas | 163 +++++++++++++++++- components/fpdebug/fpdbginfo.pas | 68 ++------ components/fpdebug/fpdbgsymtablecontext.pas | 23 ++- components/fpdebug/fppascalbuilder.pas | 2 +- components/fpdebug/fppascalparser.pas | 4 +- .../lazdebuggerfp/test/testwatches.pas | 108 +++++++++++- 9 files changed, 320 insertions(+), 91 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index e95807fea6..c8354677a1 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -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; diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 8a5e3706f3..f644f4220e 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -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 diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index c59ec0bc93..1abea8e2cf 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -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; diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index 74375374e2..cca668fc4b 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/components/fpdebug/fpdbgdwarffreepascal.pas @@ -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; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 393ff82145..d9b2003c33 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -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; diff --git a/components/fpdebug/fpdbgsymtablecontext.pas b/components/fpdebug/fpdbgsymtablecontext.pas index 51bb4db25e..f141f005ae 100644 --- a/components/fpdebug/fpdbgsymtablecontext.pas +++ b/components/fpdebug/fpdbgsymtablecontext.pas @@ -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. diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index f490d53550..53bf553afa 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -120,7 +120,7 @@ function GetParamsAsString( var ProcVal: TFpValue; ProcSymbol: TFpSymbol; - AContext: TFpDbgLocationContext; + AContext: TFpDbgSimpleLocationContext; m: TFpValue; v: String; i: Integer; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index e77046d0c7..f45fa48462 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -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 } diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index 1cadd7cf34..ab67f073de 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -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.