mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 04:39:36 +02:00
FpDebug: deal with parentfp for nested procs
git-svn-id: trunk@44639 -
This commit is contained in:
martin
parent
03287ea60f
commit
fd9065da9c
@ -84,20 +84,22 @@ type
|
||||
function GetMemManager: TFpDbgMemManager; override;
|
||||
|
||||
property Symbol: TFpDbgSymbol read FSymbol;
|
||||
property Address: TDBGPtr read FAddress;
|
||||
property Dwarf: TFpDwarfInfo read FDwarf;
|
||||
property Address: TDBGPtr read FAddress write FAddress;
|
||||
property ThreadId: Integer read FThreadId write FThreadId;
|
||||
property StackFrame: Integer read FStackFrame write FStackFrame;
|
||||
|
||||
function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline;
|
||||
procedure AddRefToVal(AVal: TFpDbgValue); inline;
|
||||
function GetSelfParameter: TFpDbgValue; virtual;
|
||||
|
||||
function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; inline;
|
||||
SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean; inline;
|
||||
function FindSymbolInStructure(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgValue; inline;
|
||||
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; inline;
|
||||
// FindLocalSymbol: for the subroutine itself
|
||||
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgValue; virtual;
|
||||
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; virtual;
|
||||
public
|
||||
constructor Create(AThreadId, AStackFrame: Integer; AnAddress: TDbgPtr; ASymbol: TFpDbgSymbol; ADwarf: TFpDwarfInfo);
|
||||
destructor Destroy; override;
|
||||
@ -994,15 +996,16 @@ begin
|
||||
TFpDwarfValueBase(Result).FContext := Self;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String;
|
||||
PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue;
|
||||
function TFpDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpDbgValue): Boolean;
|
||||
var
|
||||
i, ExtVal: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
InfoEntry, FoundInfoEntry: TDwarfInformationEntry;
|
||||
s: String;
|
||||
begin
|
||||
Result := nil;
|
||||
Result := False;
|
||||
ADbgValue := nil;
|
||||
InfoEntry := nil;
|
||||
FoundInfoEntry := nil;
|
||||
i := FDwarf.CompilationUnitsCount;
|
||||
@ -1024,7 +1027,7 @@ begin
|
||||
s := CU.UnitName;
|
||||
if (s <> '') and (CompareUtf8BothCase(PNameUpper, PNameLower, @s[1])) then begin
|
||||
ReleaseRefAndNil(FoundInfoEntry);
|
||||
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
break;
|
||||
end;
|
||||
|
||||
@ -1040,28 +1043,30 @@ begin
|
||||
if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
|
||||
if ExtVal <> 0 then
|
||||
break;
|
||||
// Search for better result
|
||||
// Search for better ADbgValue
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if FoundInfoEntry <> nil then begin;
|
||||
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, FoundInfoEntry));
|
||||
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, FoundInfoEntry));
|
||||
FoundInfoEntry.ReleaseReference;
|
||||
end;
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
Result := ADbgValue <> nil;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfoAddressContext.FindSymbolInStructure(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
|
||||
var
|
||||
InfoEntryInheritance: TDwarfInformationEntry;
|
||||
FwdInfoPtr: Pointer;
|
||||
FwdCompUint: TDwarfCompilationUnit;
|
||||
SelfParam: TFpDbgValue;
|
||||
begin
|
||||
Result := nil;
|
||||
Result := False;
|
||||
ADbgValue := nil;
|
||||
InfoEntry.AddReference;
|
||||
|
||||
while True do begin
|
||||
@ -1075,18 +1080,19 @@ begin
|
||||
SelfParam := GetSelfParameter;
|
||||
if (SelfParam <> nil) then begin
|
||||
// TODO: only valid, as long as context is valid, because if context is freed, then self is lost too
|
||||
Result := SelfParam.MemberByName[AName];
|
||||
assert(Result <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
||||
if Result <> nil then
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
||||
ADbgValue := SelfParam.MemberByName[AName];
|
||||
assert(ADbgValue <> nil, 'FindSymbol: SelfParam.MemberByName[AName]');
|
||||
if ADbgValue <> nil then
|
||||
ADbgValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
|
||||
end
|
||||
else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
|
||||
;
|
||||
if Result = nil then begin // Todo: abort the searh /SetError
|
||||
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
if ADbgValue = nil then begin // Todo: abort the searh /SetError
|
||||
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
end;
|
||||
InfoEntry.ReleaseReference;
|
||||
InfoEntryInheritance.ReleaseReference;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -1103,18 +1109,21 @@ else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
|
||||
end;
|
||||
|
||||
InfoEntry.ReleaseReference;
|
||||
Result := ADbgValue <> nil;
|
||||
end;
|
||||
|
||||
function TFpDwarfInfoAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
|
||||
begin
|
||||
Result := nil;
|
||||
Result := False;
|
||||
ADbgValue := nil;
|
||||
if not InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then
|
||||
exit;
|
||||
if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
|
||||
Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
TFpDwarfSymbol(Result.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
|
||||
ADbgValue := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
|
||||
TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
|
||||
end;
|
||||
Result := ADbgValue <> nil;
|
||||
end;
|
||||
|
||||
constructor TFpDwarfInfoAddressContext.Create(AThreadId, AStackFrame: Integer;
|
||||
@ -1188,19 +1197,15 @@ begin
|
||||
|
||||
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;
|
||||
if FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry, Result) then
|
||||
exit; // TODO: check error
|
||||
//InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
end
|
||||
|
||||
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;
|
||||
if FindLocalSymbol(AName,PNameUpper, PNameLower, InfoEntry, Result) then
|
||||
exit; // TODO: check error
|
||||
//InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
end
|
||||
// TODO: nested subroutine
|
||||
@ -1218,7 +1223,7 @@ begin
|
||||
InfoEntry.GoParent;
|
||||
end;
|
||||
|
||||
Result := FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU);
|
||||
FindExportedSymbolInUnits(AName, PNameUpper, PNameLower, CU, Result);
|
||||
|
||||
finally
|
||||
if (Result = nil) or (InfoEntry = nil)
|
||||
|
||||
@ -5,7 +5,8 @@ unit FpDbgDwarfFreePascal;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil, DbgIntfBaseTypes;
|
||||
Classes, SysUtils, FpDbgDwarfDataClasses, FpDbgDwarf, FpDbgInfo, FpDbgUtil, DbgIntfBaseTypes,
|
||||
LazLoggerBase;
|
||||
|
||||
type
|
||||
|
||||
@ -24,10 +25,14 @@ type
|
||||
{ TFpDwarfFreePascalAddressContext }
|
||||
|
||||
TFpDwarfFreePascalAddressContext = class(TFpDwarfInfoAddressContext)
|
||||
private
|
||||
FOuterNestContext: TFpDbgInfoContext;
|
||||
FOuterNotFound: Boolean;
|
||||
protected
|
||||
function FindLocalSymbol(const AName: String; PNameUpper, PNameLower: PChar;
|
||||
InfoEntry: TDwarfInformationEntry): TFpDbgValue; override;
|
||||
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -51,33 +56,111 @@ end;
|
||||
{ TFpDwarfFreePascalAddressContext }
|
||||
|
||||
function TFpDwarfFreePascalAddressContext.FindLocalSymbol(const AName: String; PNameUpper,
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry): TFpDbgValue;
|
||||
PNameLower: PChar; InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpDbgValue): Boolean;
|
||||
const
|
||||
parentfp: string = 'parentfp';
|
||||
selfname: string = 'self';
|
||||
// TODO: get reg num via memreader name-to-num
|
||||
{$IFDEF cpu64}
|
||||
RegFp = 6;
|
||||
RegPc = 16;
|
||||
{$ELSE}
|
||||
RegFp = 5;
|
||||
RegPc = 8;
|
||||
{$ENDIF}
|
||||
var
|
||||
StartScopeIdx: Integer;
|
||||
ParentFpVal: TFpDbgValue;
|
||||
SearchCtx: TFpDwarfFreePascalAddressContext;
|
||||
pfp, fp, pc: TDbgPtr;
|
||||
i: Integer;
|
||||
ParentFpSym: TFpDwarfSymbol;
|
||||
begin
|
||||
Result := False;
|
||||
if (Length(AName) = length(selfname)) and (CompareUtf8BothCase(PNameUpper, PNameLower, @selfname[1])) then begin
|
||||
Result := GetSelfParameter;
|
||||
if Result <> nil then begin
|
||||
AddRefToVal(Result);
|
||||
ADbgValue := GetSelfParameter;
|
||||
if ADbgValue <> nil then begin
|
||||
AddRefToVal(ADbgValue);
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
StartScopeIdx := InfoEntry.ScopeIndex;
|
||||
Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry);
|
||||
if Result <> nil then
|
||||
Result := inherited FindLocalSymbol(AName, PNameUpper, PNameLower, InfoEntry, ADbgValue);
|
||||
if Result then
|
||||
exit;
|
||||
|
||||
if FOuterNotFound then
|
||||
exit;
|
||||
|
||||
if FOuterNestContext <> nil then begin
|
||||
ADbgValue := FOuterNestContext.FindSymbol(AName); // TODO: pass upper/lower
|
||||
Result := True; // self, global was done by outer
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
// TODO: cache
|
||||
if not InfoEntry.GoNamedChildEx(@parentfp, @parentfp) then
|
||||
if not InfoEntry.GoNamedChildEx(@parentfp[1], @parentfp[1]) then begin
|
||||
FOuterNotFound := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
ParentFpSym := TFpDwarfSymbol.CreateSubClass(AName, InfoEntry);
|
||||
ParentFpVal := ParentFpSym.Value;
|
||||
//TFpDwarfSymbol(ADbgValue.DbgSymbol).ParentTypeInfo := TFpDwarfSymbolValueProc(FSymbol);
|
||||
if not (svfOrdinal in ParentFpVal.FieldFlags) then begin
|
||||
DebugLn('no ordinal for parentfp');
|
||||
ParentFpSym.ReleaseReference;
|
||||
FOuterNotFound := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check $parentfp
|
||||
pfp := ParentFpVal.AsCardinal;
|
||||
ParentFpSym.ReleaseReference;
|
||||
DebugLn(['pfp=',pfp]);
|
||||
if pfp = 0 then begin
|
||||
DebugLn('no ordinal for parentfp');
|
||||
FOuterNotFound := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
i := StackFrame + 1;
|
||||
SearchCtx := TFpDwarfFreePascalAddressContext.Create(ThreadId, i, 0, Symbol, Dwarf);
|
||||
|
||||
fp := 0;
|
||||
while not (fp = pfp) do begin
|
||||
SearchCtx.StackFrame := i;
|
||||
// TODO: get reg num via memreader name-to-num
|
||||
if not MemManager.ReadRegister(RegFp, fp, SearchCtx) then
|
||||
break;
|
||||
inc(i);
|
||||
if i > StackFrame + 100 then break; // something wrong? // TODO better check
|
||||
end;
|
||||
dec(i);
|
||||
|
||||
if (pfp <> fp) or
|
||||
not MemManager.ReadRegister(RegPc, pc, SearchCtx)
|
||||
then begin
|
||||
FOuterNotFound := True;
|
||||
SearchCtx.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
|
||||
SearchCtx.ReleaseReference;
|
||||
|
||||
FOuterNestContext := Dwarf.FindContext(ThreadId, i, pc);
|
||||
|
||||
ADbgValue := FOuterNestContext.FindSymbol(AName); // TODO: pass upper/lower
|
||||
Result := True; // self, global was done by outer
|
||||
end;
|
||||
|
||||
destructor TFpDwarfFreePascalAddressContext.Destroy;
|
||||
begin
|
||||
FOuterNestContext.ReleaseReference;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -36,8 +36,8 @@ type
|
||||
function GetSizeOfAddress: Integer; virtual; abstract;
|
||||
public
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property ThreadId: Integer read GetThreadId; // experimental
|
||||
property StackFrame: Integer read GetStackFrame; // experimental
|
||||
property ThreadId: Integer read GetThreadId;
|
||||
property StackFrame: Integer read GetStackFrame;
|
||||
property SizeOfAddress: Integer read GetSizeOfAddress;
|
||||
end;
|
||||
|
||||
|
||||
@ -367,6 +367,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
assert(AContext <> nil, 'TFpGDBMIDbgMemReader.ReadRegister: AContext <> nil');
|
||||
Reg := FDebugger.Registers.CurrentRegistersList[AContext.ThreadId, AContext.StackFrame];
|
||||
for i := 0 to Reg.Count - 1 do
|
||||
if UpperCase(Reg[i].Name) = rname then
|
||||
@ -376,6 +377,7 @@ begin
|
||||
v := RegVObj.Value[rdDefault]
|
||||
else
|
||||
v := '';
|
||||
if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
|
||||
debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
|
||||
Result := true;
|
||||
try
|
||||
|
||||
Loading…
Reference in New Issue
Block a user