paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 03:48:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpdebug: added params to stack

Browse Source 
git-svn-id: trunk@49123 -
This commit is contained in:
martin 2015-05-20 21:00:18 +00:00
parent 43cda43add
commit 2c1cc645e3
5 changed files with 95 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpdebug/fpdbgclasses.pp
View File

@ -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<TDbgCallstackEntry>;

6
components/fpdebug/fpdbgdwarf.pas
View File

@ -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;

1
components/fpdebug/fpdbginfo.pas
View File

@ -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

24
components/fpdebug/fppascalbuilder.pas
View File

@ -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

73
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -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);