mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-19 14:00:18 +02:00
FPDebug: refactor
git-svn-id: trunk@43392 -
This commit is contained in:
martin
parent
4cc7a3f380
commit
98508349df
@ -811,6 +811,17 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfUnit }
|
||||
|
||||
TDbgDwarfUnit = class(TDbgDwarfIdentifier)
|
||||
private
|
||||
FLastChildByName: TDbgSymbol;
|
||||
protected
|
||||
procedure Init; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
type
|
||||
TDwarfSection = (dsAbbrev, dsARanges, dsFrame, dsInfo, dsLine, dsLoc, dsMacinfo, dsPubNames, dsPubTypes, dsRanges, dsStr);
|
||||
@ -833,6 +844,7 @@ const
|
||||
{ TDbgDwarf }
|
||||
|
||||
type
|
||||
|
||||
TDbgDwarf = class(TDbgInfo)
|
||||
private
|
||||
FCompilationUnits: TList;
|
||||
@ -842,12 +854,13 @@ type
|
||||
protected
|
||||
function GetCompilationUnitClass: TDwarfCompilationUnitClass; virtual;
|
||||
function FindCompilationUnitByOffs(AOffs: QWord): TDwarfCompilationUnit;
|
||||
function FindProcSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
public
|
||||
constructor Create(ALoader: TDbgImageLoader); override;
|
||||
destructor Destroy; override;
|
||||
function FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext; override;
|
||||
function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; override;
|
||||
//function FindSymbol(const AName: String): TDbgSymbol; override;
|
||||
function FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol;
|
||||
function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override;
|
||||
function GetLineAddressMap(const AFileName: String): PDWarfLineMap;
|
||||
function LoadCompilationUnits: Integer;
|
||||
@ -865,6 +878,22 @@ type
|
||||
public
|
||||
end;
|
||||
|
||||
{ TDbgDwarfInfoAddressContext }
|
||||
|
||||
TDbgDwarfInfoAddressContext = class(TDbgInfoAddressContext)
|
||||
private
|
||||
FSymbol: TDbgSymbol;
|
||||
FAddress: TDbgPtr;
|
||||
FDwarf: TDbgDwarf;
|
||||
protected
|
||||
function GetSymbolAtAddress: TDbgSymbol; override;
|
||||
function GetAddress: TDbgPtr; override;
|
||||
public
|
||||
constructor Create(AnAddress: TDbgPtr; ASymbol: TDbgSymbol; ADwarf: TDbgDwarf);
|
||||
destructor Destroy; override;
|
||||
function FindSymbol(const AName: String): TDbgSymbol; override;
|
||||
end;
|
||||
|
||||
|
||||
function DwarfTagToString(AValue: Integer): String;
|
||||
function DwarfAttributeToString(AValue: Integer): String;
|
||||
@ -1331,6 +1360,119 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfInfoAddressContext }
|
||||
|
||||
function TDbgDwarfInfoAddressContext.GetSymbolAtAddress: TDbgSymbol;
|
||||
begin
|
||||
Result := FSymbol;
|
||||
end;
|
||||
|
||||
function TDbgDwarfInfoAddressContext.GetAddress: TDbgPtr;
|
||||
begin
|
||||
Result := FAddress;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfInfoAddressContext.Create(AnAddress: TDbgPtr; ASymbol: TDbgSymbol;
|
||||
ADwarf: TDbgDwarf);
|
||||
begin
|
||||
inherited Create;
|
||||
AddReference;
|
||||
FAddress := AnAddress;
|
||||
FDwarf := ADwarf;
|
||||
FSymbol := ASymbol;
|
||||
FSymbol.AddReference;
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfInfoAddressContext.Destroy;
|
||||
begin
|
||||
FSymbol.ReleaseReference;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDbgDwarfInfoAddressContext.FindSymbol(const AName: String): TDbgSymbol;
|
||||
var
|
||||
SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol;
|
||||
CU: TDwarfCompilationUnit;
|
||||
//Scope,
|
||||
StartScopeIdx: Integer;
|
||||
InfoEntry: TDwarfInformationEntry;
|
||||
s, InfoName: String;
|
||||
begin
|
||||
Result := nil;
|
||||
if (FSymbol = nil) or not(FSymbol is TDbgDwarfProcSymbol) then
|
||||
exit;
|
||||
|
||||
SubRoutine := TDbgDwarfProcSymbol(FSymbol);
|
||||
s := UpperCase(AName);
|
||||
|
||||
try
|
||||
CU := SubRoutine.FCU;
|
||||
InfoEntry := SubRoutine.InformationEntry.Clone;
|
||||
//InfoEntry := TDwarfInformationEntry.Create(CU, nil);
|
||||
//InfoEntry.ScopeIndex := SubRoutine.FAddressInfo^.ScopeIndex;
|
||||
|
||||
while InfoEntry.HasValidScope do begin
|
||||
debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]);
|
||||
StartScopeIdx := InfoEntry.ScopeIndex;
|
||||
|
||||
if InfoEntry.ReadValue(DW_AT_name, InfoName) then begin
|
||||
if UpperCase(InfoName) = s then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if InfoEntry.GoNamedChildEx(AName) then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
|
||||
break;
|
||||
end;
|
||||
|
||||
// Search parent(s)
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
InfoEntry.GoParent;
|
||||
end;
|
||||
|
||||
// other units
|
||||
|
||||
finally
|
||||
ReleaseRefAndNil(InfoEntry);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfUnit }
|
||||
|
||||
procedure TDbgDwarfUnit.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
SetSymbolType(stNone);
|
||||
SetKind(skUnit);
|
||||
end;
|
||||
|
||||
function TDbgDwarfUnit.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
Ident: TDwarfInformationEntry;
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
// Todo, param to only search external.
|
||||
ReleaseRefAndNil(FLastChildByName);
|
||||
Result := nil;
|
||||
|
||||
Ident := FInformationEntry.Clone;
|
||||
Ident.GoNamedChildEx(AIndex);
|
||||
if Ident <> nil then
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass('', Ident);
|
||||
ReleaseRefAndNil(Ident);
|
||||
FLastChildByName := Result;
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfUnit.Destroy;
|
||||
begin
|
||||
ReleaseRefAndNil(FLastChildByName);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifierSubRange }
|
||||
|
||||
procedure TDbgDwarfIdentifierSubRange.ReadBounds;
|
||||
@ -2577,6 +2719,8 @@ begin
|
||||
// Value types
|
||||
DW_TAG_member: Result := TDbgDwarfIdentifierMember;
|
||||
DW_TAG_subprogram: Result := TDbgDwarfProcSymbol;
|
||||
//
|
||||
DW_TAG_compile_unit: Result := TDbgDwarfUnit;
|
||||
|
||||
else
|
||||
Result := TDbgDwarfIdentifier;
|
||||
@ -3571,110 +3715,22 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.FindSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
function TDbgDwarf.FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext;
|
||||
var
|
||||
n: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
Iter: TMapIterator;
|
||||
Info: PDwarfAddressInfo;
|
||||
MinMaxSet: boolean;
|
||||
Proc: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
for n := 0 to FCompilationUnits.Count - 1 do
|
||||
begin
|
||||
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
|
||||
if not CU.Valid then Continue;
|
||||
MinMaxSet := CU.FMinPC <> CU.FMaxPC;
|
||||
if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
|
||||
then Continue;
|
||||
|
||||
CU.BuildAddressMap;
|
||||
|
||||
Iter := TMapIterator.Create(CU.FAddressMap);
|
||||
try
|
||||
if Iter.EOM
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no procs defined ???
|
||||
else Continue;
|
||||
end;
|
||||
|
||||
if not Iter.Locate(AAddress)
|
||||
then begin
|
||||
if not Iter.BOM
|
||||
then Iter.Previous;
|
||||
|
||||
if Iter.BOM
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no proc @ minpc ???
|
||||
else Continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
// iter is at the closest defined adress before AAddress
|
||||
Info := Iter.DataPtr;
|
||||
if AAddress > Info^.EndPC
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no proc @ maxpc ???
|
||||
else Continue;
|
||||
end;
|
||||
|
||||
Result := TDbgDwarfProcSymbol.Create(CU, Iter.DataPtr, AAddress);
|
||||
finally
|
||||
Iter.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol;
|
||||
var
|
||||
SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol;
|
||||
CU: TDwarfCompilationUnit;
|
||||
//Scope,
|
||||
StartScopeIdx: Integer;
|
||||
InfoEntry: TDwarfInformationEntry;
|
||||
begin
|
||||
Result := nil;
|
||||
SubRoutine := TDbgDwarfProcSymbol(FindSymbol(AAddress));
|
||||
if SubRoutine = nil then
|
||||
Proc := FindProcSymbol(AAddress);
|
||||
if Proc = nil then
|
||||
exit;
|
||||
|
||||
try
|
||||
CU := SubRoutine.FCU;
|
||||
InfoEntry := TDwarfInformationEntry.Create(CU, nil);
|
||||
InfoEntry.ScopeIndex := SubRoutine.FAddressInfo^.ScopeIndex;
|
||||
Result := TDbgDwarfInfoAddressContext.Create(AAddress, Proc, Self);
|
||||
Proc.ReleaseReference;
|
||||
end;
|
||||
|
||||
while InfoEntry.HasValidScope do begin
|
||||
debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]);
|
||||
StartScopeIdx := InfoEntry.ScopeIndex;
|
||||
|
||||
if InfoEntry.GoNamedChildEx(AName) then begin
|
||||
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
|
||||
DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
|
||||
break;
|
||||
end;
|
||||
|
||||
// Search parent(s)
|
||||
InfoEntry.ScopeIndex := StartScopeIdx;
|
||||
InfoEntry.GoParent;
|
||||
end;
|
||||
|
||||
// unitname?
|
||||
|
||||
//// debugln:
|
||||
// if Result <> nil then begin
|
||||
// TDbgDwarfIdentifier(Result).TypeInfo; // debugln...
|
||||
// if TDbgDwarfIdentifier(Result).TypeInfo <> nil then TDbgDwarfIdentifier(Result).TypeInfo.TypeInfo;
|
||||
// end;
|
||||
//// end debugln
|
||||
|
||||
|
||||
finally
|
||||
ReleaseRefAndNil(SubRoutine);
|
||||
ReleaseRefAndNil(InfoEntry);
|
||||
end;
|
||||
function TDbgDwarf.FindSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
begin
|
||||
Result := FindProcSymbol(AAddress);
|
||||
end;
|
||||
|
||||
function TDbgDwarf.GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit;
|
||||
@ -3708,6 +3764,63 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.FindProcSymbol(AAddress: TDbgPtr): TDbgSymbol;
|
||||
var
|
||||
n: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
Iter: TMapIterator;
|
||||
Info: PDwarfAddressInfo;
|
||||
MinMaxSet: boolean;
|
||||
begin
|
||||
Result := nil;
|
||||
for n := 0 to FCompilationUnits.Count - 1 do
|
||||
begin
|
||||
CU := TDwarfCompilationUnit(FCompilationUnits[n]);
|
||||
if not CU.Valid then Continue;
|
||||
MinMaxSet := CU.FMinPC <> CU.FMaxPC;
|
||||
if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC))
|
||||
then Continue;
|
||||
|
||||
CU.BuildAddressMap;
|
||||
|
||||
Iter := TMapIterator.Create(CU.FAddressMap);
|
||||
try
|
||||
if Iter.EOM
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no procs defined ???
|
||||
else Continue;
|
||||
end;
|
||||
|
||||
if not Iter.Locate(AAddress)
|
||||
then begin
|
||||
if not Iter.BOM
|
||||
then Iter.Previous;
|
||||
|
||||
if Iter.BOM
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no proc @ minpc ???
|
||||
else Continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
// iter is at the closest defined adress before AAddress
|
||||
Info := Iter.DataPtr;
|
||||
if AAddress > Info^.EndPC
|
||||
then begin
|
||||
if MinMaxSet
|
||||
then Exit // minmaxset and no proc @ maxpc ???
|
||||
else Continue;
|
||||
end;
|
||||
|
||||
Result := TDbgDwarfProcSymbol.Create(CU, Iter.DataPtr, AAddress);
|
||||
finally
|
||||
Iter.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDwarf.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr;
|
||||
var
|
||||
n: Integer;
|
||||
|
||||
@ -209,6 +209,19 @@ type
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgInfoAddressContext }
|
||||
|
||||
TDbgInfoAddressContext = class(TRefCountedObject)
|
||||
protected
|
||||
function GetAddress: TDbgPtr; virtual; abstract;
|
||||
function GetSymbolAtAddress: TDbgSymbol; virtual;
|
||||
public
|
||||
property Address: TDbgPtr read GetAddress;
|
||||
property SymbolAtAddress: TDbgSymbol read GetSymbolAtAddress;
|
||||
// search this, and all parent context
|
||||
function FindSymbol(const AName: String): TDbgSymbol; virtual;
|
||||
end;
|
||||
|
||||
{ TDbgInfo }
|
||||
|
||||
TDbgInfo = class(TObject)
|
||||
@ -218,8 +231,9 @@ type
|
||||
procedure SetHasInfo;
|
||||
public
|
||||
constructor Create({%H-}ALoader: TDbgImageLoader); virtual;
|
||||
function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual;
|
||||
function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual;
|
||||
function FindContext({%H-}AAddress: TDbgPtr): TDbgInfoAddressContext; virtual;
|
||||
function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual; deprecated;
|
||||
function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual; deprecated;
|
||||
property HasInfo: Boolean read FHasInfo;
|
||||
function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual;
|
||||
end;
|
||||
@ -234,6 +248,18 @@ begin
|
||||
WriteStr(Result, ADbgSymbolKind);
|
||||
end;
|
||||
|
||||
{ TDbgInfoAddressContext }
|
||||
|
||||
function TDbgInfoAddressContext.GetSymbolAtAddress: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfoAddressContext.FindSymbol(const AName: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
constructor TDbgSymbol.Create(const AName: String);
|
||||
@ -661,6 +687,11 @@ begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgInfo.FindSymbol(const AName: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
@ -392,6 +392,15 @@ begin
|
||||
TestExpr([0,0,1], TFpPascalExpressionPartIdentifer, 'a', 0);
|
||||
TestExpr([0,1], TFpPascalExpressionPartIdentifer, 'b', 0);
|
||||
|
||||
CreateExpr('f[a]', True);
|
||||
TestExpr([], TFpPascalExpressionPartBracketIndex, '[', 2);
|
||||
TestExpr([0], TFpPascalExpressionPartIdentifer, 'f', 0);
|
||||
TestExpr([1], TFpPascalExpressionPartIdentifer, 'a', 0);
|
||||
|
||||
CreateExpr('TFoo(f^[0]).a', True);
|
||||
|
||||
CreateExpr('^^int(1)', True);
|
||||
|
||||
finally
|
||||
CurrentTestExprObj.Free;
|
||||
end;
|
||||
|
||||
@ -44,10 +44,14 @@ var
|
||||
function TTestPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol;
|
||||
var
|
||||
Loc: TDBGPtr;
|
||||
Ctx: TDbgInfoAddressContext;
|
||||
begin
|
||||
Result := nil;
|
||||
if (FDwarfInfo <> nil) and (AnIdent <> '') then
|
||||
Result := FDwarfInfo.FindIdentifier(Location, AnIdent);
|
||||
if (FDwarfInfo <> nil) and (AnIdent <> '') then begin
|
||||
Ctx := FDwarfInfo.FindContext(Location);
|
||||
Result := Ctx.FindSymbol(AnIdent);
|
||||
Ctx.ReleaseReference;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestTypInfo.LoadDwarf(AFileName: String);
|
||||
@ -261,6 +265,8 @@ GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
DoTest('testc2.a5', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType, [tdfSkipClassBody, tdfSkipRecordBody]); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('testc2.a6', skArray);
|
||||
AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags);
|
||||
@ -272,6 +278,37 @@ GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
|
||||
DoTest('a1[1]', skBoolean);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a1[3]', skBoolean);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('a1b[1]', skArray);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a1b[3]', skArray);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('a1b[1][3]', skBoolean);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('a1b[3][4]', skBoolean);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('TTestClass(0)', skClass);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
DoTest('TTestClass(0).FWord', skCardinal);
|
||||
GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s);
|
||||
|
||||
|
||||
DoTest('TTestClass2(0).enum4', skPointer);
|
||||
DoTest('TTestClass2(0).enum4^', skEnum);
|
||||
|
||||
FreeAndNil(expr);
|
||||
end;
|
||||
|
||||
@ -292,5 +329,6 @@ end;
|
||||
initialization
|
||||
|
||||
RegisterTest(TTestTypInfo);
|
||||
DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} )^.Enabled := True;
|
||||
end.
|
||||
|
||||
|
||||
@ -38,12 +38,19 @@ type
|
||||
property Debugger: TFpGDBMIDebugger read FDebugger;
|
||||
end;
|
||||
|
||||
const
|
||||
MAX_CTX_CACHE = 10;
|
||||
|
||||
type
|
||||
{ TFpGDBMIDebugger }
|
||||
|
||||
TFpGDBMIDebugger = class(TGDBMIDebugger)
|
||||
private
|
||||
FImageLoader: TDbgImageLoader;
|
||||
FDwarfInfo: TDbgDwarf;
|
||||
// cache last context
|
||||
FlastStackFrame, FLastThread: Integer;
|
||||
FLastContext: array [0..MAX_CTX_CACHE-1] of TDbgInfoAddressContext;
|
||||
protected
|
||||
function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override;
|
||||
function CreateLineInfo: TDBGLineInfo; override;
|
||||
@ -56,6 +63,7 @@ type
|
||||
|
||||
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
|
||||
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
|
||||
function GetInfoContextForContext(AThreadId, AStackFrame: Integer): TDbgInfoAddressContext;
|
||||
function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
|
||||
public
|
||||
class function Caption: String; override;
|
||||
@ -113,13 +121,19 @@ type
|
||||
function TFpGDBMIPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol;
|
||||
var
|
||||
Loc: TDBGPtr;
|
||||
Ctx: TDbgInfoAddressContext;
|
||||
begin
|
||||
Result := nil;
|
||||
if FDebugger.HasDwarf then begin
|
||||
if AnIdent <> '' then begin
|
||||
Loc := FDebugger.GetLocationForContext(FThreadId, FStackFrame);
|
||||
if (Loc <> 0) then
|
||||
Result := FDebugger.FDwarfInfo.FindIdentifier(Loc, AnIdent);
|
||||
//Loc := FDebugger.GetLocationForContext(FThreadId, FStackFrame);
|
||||
//if (Loc <> 0) then begin
|
||||
Ctx := FDebugger.GetInfoContextForContext(FThreadId, FStackFrame);
|
||||
//Ctx := FDebugger.FDwarfInfo.FindContext(Loc);
|
||||
if Ctx <> nil then
|
||||
Result := Ctx.FindSymbol(AnIdent);
|
||||
//Ctx.ReleaseReference;
|
||||
//end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -439,7 +453,7 @@ const
|
||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
||||
ASrcType, ABaseType: TDbgSymbol);
|
||||
var
|
||||
s, s2: String;
|
||||
s: String;
|
||||
ElemPointerLevel: Integer;
|
||||
ElemDeRefType, ElemBaseType: TDbgSymbol;
|
||||
ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName: String;
|
||||
@ -724,10 +738,16 @@ end;
|
||||
{ TFpGDBMIDebugger }
|
||||
|
||||
procedure TFpGDBMIDebugger.DoState(const OldState: TDBGState);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited DoState(OldState);
|
||||
if State in [dsStop, dsError, dsNone] then
|
||||
UnLoadDwarf;
|
||||
|
||||
if OldState in [dsPause, dsInternalPause] then
|
||||
for i := 0 to MAX_CTX_CACHE-1 do
|
||||
ReleaseRefAndNil(FLastContext[i]);
|
||||
end;
|
||||
|
||||
function TFpGDBMIDebugger.HasDwarf: Boolean;
|
||||
@ -830,6 +850,40 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
function TFpGDBMIDebugger.GetInfoContextForContext(AThreadId,
|
||||
AStackFrame: Integer): TDbgInfoAddressContext;
|
||||
var
|
||||
Addr: TDBGPtr;
|
||||
begin
|
||||
if (AThreadId <= 0) then begin
|
||||
GetCurrentContext(AThreadId, AStackFrame);
|
||||
end;
|
||||
|
||||
Addr := GetLocationForContext(AThreadId, AStackFrame);
|
||||
|
||||
if Addr = 0 then begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (AStackFrame >= FlastStackFrame) and
|
||||
(AStackFrame - FlastStackFrame < MAX_CTX_CACHE) and
|
||||
(FLastContext[AStackFrame - FlastStackFrame] <> nil) and
|
||||
(FLastContext[AStackFrame - FlastStackFrame].Address = Addr)
|
||||
then begin
|
||||
DebugLn('cached contex');
|
||||
Result := FLastContext[AStackFrame - FlastStackFrame];
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := FDwarfInfo.FindContext(Addr);
|
||||
|
||||
FLastThread := AThreadId;
|
||||
FlastStackFrame := AStackFrame;
|
||||
FLastContext[0].ReleaseReference;
|
||||
FLastContext[0] := Result;
|
||||
end;
|
||||
|
||||
type
|
||||
TGDBMIDwarfTypeIdentifier = class(TDbgDwarfTypeIdentifier)
|
||||
public
|
||||
|
||||
Loading…
Reference in New Issue
Block a user