From 2c1cc645e3d35e6cc7dbce7081d5562853758fc8 Mon Sep 17 00:00:00 2001 From: martin Date: Wed, 20 May 2015 21:00:18 +0000 Subject: [PATCH] fpdebug: added params to stack git-svn-id: trunk@49123 - --- components/fpdebug/fpdbgclasses.pp | 1 + components/fpdebug/fpdbgdwarf.pas | 6 ++ components/fpdebug/fpdbginfo.pas | 1 + components/fpdebug/fppascalbuilder.pas | 24 ++++-- .../lazdebuggerfp/fpdebugdebugger.pas | 73 ++++++++++++++++++- 5 files changed, 95 insertions(+), 10 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 8d872de2d9..a050d0b492 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -106,6 +106,7 @@ type property FunctionName: string read GetFunctionName; property Line: integer read GetLine; property RegisterValueList: TDbgRegisterValueList read FRegisterValueList; + property ProcSymbol: TFpDbgSymbol read GetSymbol; end; TDbgCallstackEntryList = specialize TFPGObjectList; diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index f987b06740..a631eb9f40 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -869,6 +869,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line protected function GetValueAddress(AValueObj: TFpDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; override; function HasAddress: Boolean; override; + function GetFlags: TDbgSymbolFlags; override; public end; @@ -4718,6 +4719,11 @@ begin Result := InformationEntry.HasAttrib(DW_AT_location); end; +function TFpDwarfSymbolValueParameter.GetFlags: TDbgSymbolFlags; +begin + Result := (inherited GetFlags) + [sfParameter]; +end; + { TFpDwarfSymbolUnit } procedure TFpDwarfSymbolUnit.Init; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 27c328deb4..9237442feb 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -85,6 +85,7 @@ type sfDynArray, // skArray is known to be a dynamic array sfStatArray, // skArray is known to be a static array sfVirtual, // skProcedure,skFunction: virtual function (or overriden) + sfParameter, // Parameter to a function // unimplemented: sfInternalRef, // TODO: (May not always be present) Internal ref/pointer e.g. var/constref parameters sfConst, // The sym is a constant and cannot be modified diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index e1ed95a7c4..67a0b93f51 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -34,6 +34,11 @@ type ); TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag; + TFpPrettyPrintOption = ( + ppoStackParam + ); + TFpPrettyPrintOptions = set of TFpPrettyPrintOption; + const PV_FORWARD_FLAGS = [ppvSkipClassBody, ppvSkipRecordBody]; @@ -54,14 +59,16 @@ type ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer = -1; - ADBGTypeInfo: PDBGType = nil + ADBGTypeInfo: PDBGType = nil; + AOptions: TFpPrettyPrintOptions = [] ): Boolean; public constructor Create(AnAddressSize: Integer); function PrintValue(out APrintedValue: String; AValue: TFpDbgValue; ADisplayFormat: TWatchDisplayFormat = wdfDefault; - ARepeatCount: Integer = -1 + ARepeatCount: Integer = -1; + AOptions: TFpPrettyPrintOptions = [] ): Boolean; function PrintValue(out APrintedValue: String; out ADBGTypeInfo: TDBGType; @@ -443,7 +450,7 @@ end; function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags; ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat; - ARepeatCount: Integer; ADBGTypeInfo: PDBGType): Boolean; + ARepeatCount: Integer; ADBGTypeInfo: PDBGType; AOptions: TFpPrettyPrintOptions): Boolean; function ResTypeName: String; @@ -681,7 +688,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; end; end; - if ADisplayFormat = wdfPointer then begin + if (ADisplayFormat = wdfPointer) or (ppoStackParam in AOptions) then begin if not (ppvCreateDbgType in AFlags) then s := ResTypeName; APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2); @@ -725,7 +732,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; if (m = nil) or (m.Kind in [skProcedure, skFunction]) then continue; s := ''; - InternalPrintValue(MbVal, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat); + InternalPrintValue(MbVal, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat, -1, nil, AOptions); if m.DbgSymbol <> nil then begin MbName := m.DbgSymbol.Name; s := MbName + ' = ' + MbVal; @@ -794,7 +801,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; for i := d to d + Cnt - 1 do begin m := AValue.Member[i]; if m <> nil then - InternalPrintValue(s, m, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat) + InternalPrintValue(s, m, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat, -1, nil, AOptions) else s := '{error}'; if APrintedValue = '' @@ -899,10 +906,11 @@ begin end; function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue; - ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer): Boolean; + ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer; + AOptions: TFpPrettyPrintOptions): Boolean; begin Result := InternalPrintValue(APrintedValue, AValue, - AddressSize, [], 0, '', ADisplayFormat, ARepeatCount); + AddressSize, [], 0, '', ADisplayFormat, ARepeatCount, nil, AOptions); end; function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; out diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 067968658b..7e4ef3614a 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -207,9 +207,14 @@ type { TFPCallStackSupplier } TFPCallStackSupplier = class(TCallStackSupplier) + private + FPrettyPrinter: TFpPascalPrettyPrinter; protected + function FpDebugger: TFpDebugDebugger; procedure DoStateLeavePause; override; public + constructor Create(const ADebugger: TDebuggerIntf); + destructor Destroy; override; procedure RequestCount(ACallstack: TCallStackBase); override; procedure RequestEntries(ACallstack: TCallStackBase); override; procedure RequestCurrent(ACallstack: TCallStackBase); override; @@ -405,6 +410,11 @@ end; { TFPCallStackSupplier } +function TFPCallStackSupplier.FpDebugger: TFpDebugDebugger; +begin + Result := TFpDebugDebugger(Debugger); +end; + procedure TFPCallStackSupplier.DoStateLeavePause; begin if (TFpDebugDebugger(Debugger).FDbgController <> nil) and @@ -415,6 +425,18 @@ begin inherited DoStateLeavePause; end; +constructor TFPCallStackSupplier.Create(const ADebugger: TDebuggerIntf); +begin + inherited Create(ADebugger); + FPrettyPrinter := TFpPascalPrettyPrinter.Create(sizeof(pointer)); +end; + +destructor TFPCallStackSupplier.Destroy; +begin + inherited Destroy; + FPrettyPrinter.Free; +end; + procedure TFPCallStackSupplier.RequestCount(ACallstack: TCallStackBase); var ThreadCallStack: TDbgCallstackEntryList; @@ -446,27 +468,74 @@ var e: TCallStackEntry; It: TMapIterator; ThreadCallStack: TDbgCallstackEntryList; + v, params: String; + i: Integer; + ProcVal, m: TFpDbgValue; + RegList: TDbgRegisterValueList; + Reg: TDbgRegisterValue; + AController: TDbgController; + CurThreadId: Integer; + AContext: TFpDbgInfoContext; + OldContext: TFpDbgAddressContext; begin It := TMapIterator.Create(ACallstack.RawEntries); //TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.MainThread.PrepareCallStackEntryList; - ThreadCallStack := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.MainThread.CallStackEntryList; + //CurThreadId := FpDebugger.Threads.CurrentThreads.CurrentThreadId; + //ThreadCallStack := FpDebugger.Threads.CurrentThreads.Entries[CurThreadId].CallStackEntryList; + + CurThreadId := FpDebugger.FDbgController.CurrentProcess.MainThread.ID; + ThreadCallStack := FpDebugger.FDbgController.CurrentProcess.MainThread.CallStackEntryList; if not It.Locate(ACallstack.LowestUnknown ) then if not It.EOM then It.Next; + AController := FpDebugger.FDbgController; + OldContext := FpDebugger.FMemManager.DefaultContext; + while (not IT.EOM) and (TCallStackEntry(It.DataPtr^).Index < ACallstack.HighestUnknown) do begin e := TCallStackEntry(It.DataPtr^); if e.Validity = ddsRequested then begin + if ThreadCallStack[e.Index].ProcSymbol <> nil then + ProcVal := ThreadCallStack[e.Index].ProcSymbol.Value; + + params := ''; + if (ProcVal <> nil) then begin + if e.Index = 0 then + RegList := AController.CurrentProcess.MainThread.RegisterValueList + else + RegList := ThreadCallStack[e.Index].RegisterValueList; + if AController.CurrentProcess.Mode=dm32 then + Reg := RegList.FindRegisterByDwarfIndex(8) + else + Reg := RegList.FindRegisterByDwarfIndex(16); + if Reg <> nil then begin + AContext := AController.CurrentProcess.DbgInfo.FindContext(CurThreadId, e.Index, Reg.NumValue); + AContext.MemManager.DefaultContext := AContext; + FPrettyPrinter.AddressSize := AContext.SizeOfAddress; + + for i := 0 to ProcVal.MemberCount - 1 do begin + m := ProcVal.Member[i]; + if (m <> nil) and (sfParameter in m.DbgSymbol.Flags) then begin + FPrettyPrinter.PrintValue(v, m, wdfDefault, -1, [ppoStackParam]); + if params <> '' then params := params + ', '; + params := params + v; + end; + end; + end; + end; + if params <> '' then + params := '(' + params + ')'; e.Init(ThreadCallStack[e.Index].AnAddress, nil, - ThreadCallStack[e.Index].FunctionName, ThreadCallStack[e.Index].SourceFile, + ThreadCallStack[e.Index].FunctionName+params, ThreadCallStack[e.Index].SourceFile, '', ThreadCallStack[e.Index].Line, ddsValid); end; It.Next; end; It.Free; + FpDebugger.FMemManager.DefaultContext := OldContext; end; procedure TFPCallStackSupplier.RequestCurrent(ACallstack: TCallStackBase);