paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 16:39:56 +01:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: small optimizations in dwarf search for name. Also skip enum-value names when looking for procedures or class-names.

Browse Source
This commit is contained in:
Martin 2024-08-10 16:40:40 +02:00
parent c476c440bc
commit 6123662232
8 changed files with 111 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
components/fpdebug/fpdbgdwarf.pas
View File

@ -82,9 +82,6 @@ type
TDwarfCompilationUnitArray = array of TDwarfCompilationUnit;
TFindExportedSymbolsFlag = (fsfIgnoreEnumVals, fsfMatchUnitName);
TFindExportedSymbolsFlags = set of TFindExportedSymbolsFlag;
{ TFpThreadWorkerFindSymbolInUnits }
TFpThreadWorkerFindSymbolInUnits = class(TFpThreadWorkerItem)
@ -128,7 +125,8 @@ type
function FindExportedSymbolInUnit(CU: TDwarfCompilationUnit; const ANameInfo: TNameSearchInfo;
out AnInfoEntry: TDwarfInformationEntry; out AnIsExternal: Boolean; AFindFlags: TFindExportedSymbolsFlags = []): Boolean; virtual;
function FindExportedSymbolInUnits(const AName: String; const ANameInfo: TNameSearchInfo;
SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue; const OnlyUnitNameLower: String = ''): Boolean; virtual;
SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue; const OnlyUnitNameLower: String = '';
AFindFlags: TFindExportedSymbolsFlags = []): Boolean; virtual;
function FindSymbolInStructure(const AName: String; const ANameInfo: TNameSearchInfo;
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; virtual;
function FindSymbolInStructureRecursive(const AName: String; const ANameInfo: TNameSearchInfo;
@ -140,7 +138,8 @@ type
public
constructor Create(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo);
destructor Destroy; override;
function FindSymbol(const AName: String; const OnlyUnitName: String = ''): TFpValue; override;
function FindSymbol(const AName: String; const OnlyUnitName: String = '';
AFindFlags: TFindExportedSymbolsFlags = []): TFpValue; override;
end;
TFpSymbolDwarfType = class;
@ -1497,8 +1496,8 @@ begin
end;
function TFpDwarfInfoSymbolScope.FindExportedSymbolInUnits(const AName: String;
const ANameInfo: TNameSearchInfo; SkipCompUnit: TDwarfCompilationUnit; out
ADbgValue: TFpValue; const OnlyUnitNameLower: String): Boolean;
const ANameInfo: TNameSearchInfo; SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue;
const OnlyUnitNameLower: String; AFindFlags: TFindExportedSymbolsFlags): Boolean;
const
PER_WORKER_CNT = 20;
var
@ -1508,7 +1507,6 @@ var
FoundInfoEntry: TDwarfInformationEntry;
IsExt: Boolean;
WorkItem, PrevWorkItem: TFpThreadWorkerFindSymbolInUnits;
AFindFlags: TFindExportedSymbolsFlags;
begin
Result := False;
@ -1516,9 +1514,8 @@ begin
FoundInfoEntry := nil;
PrevWorkItem := nil;
IsExt := False;
AFindFlags := [];
if OnlyUnitNameLower = '' then
AFindFlags := [fsfMatchUnitName];
AFindFlags := AFindFlags + [fsfMatchUnitName];
i := FDwarf.CompilationUnitsCount;
while i > 0 do begin
@ -1750,8 +1747,8 @@ begin
inherited Destroy;
end;
function TFpDwarfInfoSymbolScope.FindSymbol(const AName: String;
const OnlyUnitName: String): TFpValue;
function TFpDwarfInfoSymbolScope.FindSymbol(const AName: String; const OnlyUnitName: String;
AFindFlags: TFindExportedSymbolsFlags): TFpValue;
var
SubRoutine: TFpSymbolDwarfDataProc; // TDbgSymbol;
CU: TDwarfCompilationUnit;
@ -1773,7 +1770,7 @@ begin
if OnlyUnitName <> '' then begin
// TODO: dwarf info for libraries
FindExportedSymbolInUnits(AName, NameInfo, nil, Result, LowerCase(OnlyUnitName));
FindExportedSymbolInUnits(AName, NameInfo, nil, Result, LowerCase(OnlyUnitName), AFindFlags);
ApplyContext(Result);
exit;
end;
@ -1784,10 +1781,10 @@ begin
SubRoutine := nil;
if Symbol = nil then begin
FindExportedSymbolInUnits(AName, NameInfo, nil, Result);
FindExportedSymbolInUnits(AName, NameInfo, nil, Result, '', AFindFlags);
ApplyContext(Result);
if Result = nil then
Result := inherited FindSymbol(AName);
Result := inherited FindSymbol(AName, OnlyUnitName, AFindFlags);
exit;
end;
@ -1878,7 +1875,7 @@ begin
end;
end;
FindExportedSymbolInUnits(AName, NameInfo, CU, Result);
FindExportedSymbolInUnits(AName, NameInfo, CU, Result, '', AFindFlags);
finally
if (Result = nil) or (InfoEntry = nil)
@ -1891,7 +1888,7 @@ begin
ApplyContext(Result);
end;
if Result = nil then
Result := inherited FindSymbol(AName);
Result := inherited FindSymbol(AName, OnlyUnitName, AFindFlags);
end;
{ TFpValueDwarfTypeDefinition }
@ -7081,18 +7078,18 @@ begin
tg := InfoEntry.AbbrevTag;
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
found := InfoEntry.GoNamedChildEx(ThisNameInfo);
found := InfoEntry.GoNamedChild(ThisNameInfo);
if found then
found := InfoEntry.IsArtificial;
if not found then begin
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
found := InfoEntry.GoNamedChildEx(SelfDollarNameInfo);
found := InfoEntry.GoNamedChild(SelfDollarNameInfo);
if found then
found := InfoEntry.IsArtificial;
end;
if not found then begin
InfoEntry.ScopeIndex := InformationEntry.ScopeIndex;
found := InfoEntry.GoNamedChildEx(SelfNameInfo);
found := InfoEntry.GoNamedChild(SelfNameInfo);
end;
if found then begin
if ((AnAddress = 0) or InfoEntry.IsAddressInStartScope(AnAddress)) and
@ -7280,7 +7277,7 @@ begin
AnParentTypeSymbol := nil;
Ident := InformationEntry.Clone;
Ident.GoNamedChildEx(AIndex);
Ident.GoNamedChildEx(NameInfoForSearch(AIndex));
if Ident <> nil then
Result := TFpSymbolDwarf.CreateSubClass('', Ident);
ReleaseRefAndNil(Ident);

111
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -344,6 +344,7 @@ type
FInformationEntry: Pointer; // pointer to the LEB128 Abbrev at the start of an Information entry in debug_info
FInformationData: Pointer; // poinetr after the LEB128
FScope: TDwarfScopeInfo;
FScopeCurrentInfoPtr: PDwarfScopeInfoRec; // only valid after GoNext/Child[Fast]
FAbbrev: PDwarfAbbrev;
FAbbrevData: PDwarfAbbrevEntry;
FAbstractOrigin: TDwarfInformationEntry;
@ -376,7 +377,7 @@ type
procedure ComputeKnownHashes(AKNownHashes: PKnownNameHashesArray);
function GoNamedChild(const AName: String): Boolean;
function GoNamedChild(const ANameInfo: TNameSearchInfo): Boolean;
// find in enum too // TODO: control search with a flags param, if needed
function GoNamedChildEx(const ANameInfo: TNameSearchInfo; ASkipArtificial: Boolean = False; ASkipEnumMembers: Boolean = False): Boolean;
// GoNamedChildMatchCaseEx will use
@ -384,7 +385,6 @@ type
// - LowerName for compare
// GoNamedChildMatchCaseEx does not search in enums
function GoNamedChildMatchCaseEx(const ANameInfo: TNameSearchInfo): Boolean;
function GoNamedChildEx(const AName: String): Boolean; inline;
function FindNamedChild(const AName: String): TDwarfInformationEntry;
function FindChildByTag(ATag: Cardinal): TDwarfInformationEntry;
@ -424,6 +424,8 @@ type
procedure GoParent; inline;
procedure GoNext; inline;
procedure GoChild; inline;
procedure GoNextFast; inline; // Only if we know we have a valid scope
procedure GoChildFast; inline; // Only if we know we have a valid scope
function HasValidScope: Boolean; inline;
property ScopeIndex: Integer read GetScopeIndex write SetScopeIndex;
@ -2717,7 +2719,11 @@ end;
procedure TDwarfInformationEntry.ScopeChanged;
begin
FInformationEntry := FScope.Entry;
FScopeCurrentInfoPtr := FScope.Current;
if FScopeCurrentInfoPtr <> nil then
FInformationEntry := FScopeCurrentInfoPtr^.Entry
else
FInformationEntry := nil;
FFlags := [];
FInformationData := nil;
if FAbstractOrigin <> nil then
@ -2801,6 +2807,18 @@ begin
ScopeChanged;
end;
procedure TDwarfInformationEntry.GoNextFast;
begin
FScope.GoNext;
ScopeChanged;
end;
procedure TDwarfInformationEntry.GoChildFast;
begin
FScope.GoChild;
ScopeChanged;
end;
procedure TDwarfInformationEntry.GoChild;
begin
if not MaybeSearchScope then
@ -2929,38 +2947,41 @@ begin
ScopeChanged;
end;
function TDwarfInformationEntry.GoNamedChild(const AName: String): Boolean;
function TDwarfInformationEntry.GoNamedChild(const ANameInfo: TNameSearchInfo): Boolean;
var
EntryName: PChar;
s1, s2: String;
begin
Result := False;
if AName = '' then
if ANameInfo.NameUpper = '' then
exit;
GoChild;
if not HasValidScope then
exit;
s1 := UTF8UpperCaseFast(AName);
s2 := UTF8LowerCaseFast(AName);
while HasValidScope do begin
PrepareAbbrev;
if (FAbbrev = nil) or not (dafHasName in FAbbrev^.flags) then begin
GoNext;
Continue;
end;
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
if FScopeCurrentInfoPtr^.NameHash <> ANameInfo.NameHash then begin
GoNextFast;
Continue;
end;
if CompareUtf8BothCase(@s1[1], @s2[1], EntryName) then begin
PrepareAbbrev;
if (FAbbrev = nil) or not (dafHasName in FAbbrev^.flags) then begin
GoNextFast;
Continue;
end;
if not ReadValue(DW_AT_name, EntryName) then begin
GoNextFast;
Continue;
end;
if CompareUtf8BothCase(PChar(ANameInfo.NameUpper), PChar(ANameInfo.nameLower), EntryName) then begin
// TODO: check DW_AT_start_scope;
DebugLn(FPDBG_DWARF_SEARCH, ['GoNamedChild found ', dbgs(FScope, FCompUnit), ' Result=', DbgSName(Self), ' FOR ', AName]);
DebugLn(FPDBG_DWARF_SEARCH, ['GoNamedChild found ', dbgs(FScope, FCompUnit), ' Result=', DbgSName(Self), ' FOR ', ANameInfo.NameUpper]);
Result := True;
exit;
end;
GoNext;
GoNextFast;
end;
end;
@ -2983,29 +3004,37 @@ begin
exit;
while true do begin
while HasValidScope do begin
sc := FScope.Current;
if sc^.NameHash = 0 then begin
GoNext;
Continue;
sc := FScopeCurrentInfoPtr;
if ASkipEnumMembers then begin
if (sc^.NameHash <> ANameInfo.NameHash) then begin
GoNextFast;
Continue;
end;
end
else begin
if sc^.NameHash = 0 then begin
GoNextFast;
Continue;
end;
end;
PrepareAbbrev;
if (FAbbrev = nil) or not (dafHasName in FAbbrev^.flags) then begin
assert(false);
GoNext;
GoNextFast;
Continue;
end;
if (sc^.NameHash <> ANameInfo.NameHash) and
( ASkipEnumMembers or (FAbbrev^.tag <> DW_TAG_enumeration_type) )
then begin
GoNext;
GoNextFast;
Continue;
end;
if ASkipArtificial and (dafHasArtifical in FAbbrev^.flags) then begin
if ReadValue(DW_AT_artificial, Val) and (Val <> 0) then begin
GoNext;
GoNextFast;
Continue;
end;
end;
@ -3013,7 +3042,7 @@ begin
if (sc^.NameHash = ANameInfo.NameHash) then begin
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
GoNextFast;
Continue;
end;
@ -3029,17 +3058,17 @@ begin
assert(not InEnum, 'nested enum');
InEnum := True;
ParentScopIdx := ScopeIndex;
GoChild;
GoChildFast;
Continue;
end;
GoNext;
GoNextFast;
end;
if InEnum then begin
InEnum := False;
ScopeIndex := ParentScopIdx;
GoNext;
GoNextFast;
continue;
end;
break;
@ -3050,7 +3079,6 @@ function TDwarfInformationEntry.GoNamedChildMatchCaseEx(
const ANameInfo: TNameSearchInfo): Boolean;
var
EntryName: PChar;
sc: PDwarfScopeInfoRec;
begin
Result := False;
if ANameInfo.NameUpper = '' then
@ -3060,22 +3088,21 @@ begin
exit;
while HasValidScope do begin
sc := FScope.Current;
if sc^.NameHash = 0 then begin
GoNext;
if FScopeCurrentInfoPtr^.NameHash = 0 then begin
GoNextFast;
Continue;
end;
PrepareAbbrev;
if (FAbbrev = nil) or not (dafHasName in FAbbrev^.flags) then begin
Assert(false);
GoNext;
GoNextFast;
Continue;
end;
if (sc^.NameHash = ANameInfo.NameHash) then begin
if (FScopeCurrentInfoPtr^.NameHash = ANameInfo.NameHash) then begin
if not ReadValue(DW_AT_name, EntryName) then begin
GoNext;
GoNextFast;
Continue;
end;
@ -3087,18 +3114,10 @@ begin
end;
end;
GoNext;
GoNextFast;
end;
end;
function TDwarfInformationEntry.GoNamedChildEx(const AName: String): Boolean;
begin
Result := False;
if AName = '' then
exit;
Result := GoNamedChildEx(NameInfoForSearch(AName));
end;
constructor TDwarfInformationEntry.Create(ACompUnit: TDwarfCompilationUnit;
AnInformationEntry: Pointer);
begin
@ -3173,7 +3192,7 @@ begin
Result := TDwarfInformationEntry.Create(FCompUnit, FScope);
// TODO: parent
if Result.GoNamedChild(AName) then
if Result.GoNamedChild(NameInfoForSearch(AName)) then
exit;
ReleaseRefAndNil(Result);
end;

14
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -110,7 +110,8 @@ type
AFindFlags: TFindExportedSymbolsFlags = []): Boolean; override;
function FindExportedSymbolInUnits(const AName: String;
const ANameInfo: TNameSearchInfo; SkipCompUnit: TDwarfCompilationUnit;
out ADbgValue: TFpValue; const OnlyUnitNameLower: String = ''): Boolean;
out ADbgValue: TFpValue; const OnlyUnitNameLower: String = '';
AFindFlags: TFindExportedSymbolsFlags = []): Boolean;
override;
function FindLocalSymbol(const AName: String; const ANameInfo: TNameSearchInfo;
InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; override;
@ -693,10 +694,9 @@ begin
end;
end;
function TFpDwarfFreePascalSymbolScope.FindExportedSymbolInUnits(
const AName: String; const ANameInfo: TNameSearchInfo;
SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue;
const OnlyUnitNameLower: String): Boolean;
function TFpDwarfFreePascalSymbolScope.FindExportedSymbolInUnits(const AName: String;
const ANameInfo: TNameSearchInfo; SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue;
const OnlyUnitNameLower: String; AFindFlags: TFindExportedSymbolsFlags): Boolean;
var
i: Integer;
CU: TDwarfCompilationUnit;
@ -719,7 +719,7 @@ begin
FInAllUnitSearch := True;
FFoundSystemInfoEntry := nil;
Result := inherited FindExportedSymbolInUnits(AName, ANameInfo, SkipCompUnit,
ADbgValue, OnlyUnitNameLower);
ADbgValue, OnlyUnitNameLower, AFindFlags);
FInAllUnitSearch := False;
if (not Result) and (FFoundSystemInfoEntry <> nil) then
@ -881,7 +881,7 @@ begin
MangledNameInfo := NameInfoForSearch(StaticName);
if CU.KnownNameHashes^[MangledNameInfo.NameHash and KnownNameHashesBitMask] then begin
if FindExportedSymbolInUnit(CU, MangledNameInfo, FoundInfoEntry, IsExternal) then begin
if FindExportedSymbolInUnit(CU, MangledNameInfo, FoundInfoEntry, IsExternal, [fsfIgnoreEnumVals]) then begin
if {(IsExternal) and} (FoundInfoEntry.ReadName(FoundName)) then begin
if FoundName = StaticName then begin // must be case-sensitive
ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, FoundInfoEntry));

10
components/fpdebug/fpdbginfo.pas
View File

@ -111,6 +111,9 @@ type
);
TFpValueFlags = set of TFpValueFlag;
TFindExportedSymbolsFlag = (fsfIgnoreEnumVals, fsfMatchUnitName);
TFindExportedSymbolsFlags = set of TFindExportedSymbolsFlag;
{ TFpValue }
TFpValue = class(TRefCountedObject)
@ -656,7 +659,8 @@ type
property SymbolAtAddress: TFpSymbol read GetSymbolAtAddress;
property ProcedureAtAddress: TFpValue read GetProcedureAtAddress;
// search this, and all parent context
function FindSymbol(const {%H-}AName: String; const OnlyUnitName: String = ''): TFpValue; virtual;
function FindSymbol(const {%H-}AName: String; const OnlyUnitName: String = '';
AFindFlags: TFindExportedSymbolsFlags = []): TFpValue; virtual;
property MemManager: TFpDbgMemManager read GetMemManager;
property MemModel: TFpDbgMemModel read GetMemModel;
property SizeOfAddress: Integer read GetSizeOfAddress;
@ -1785,8 +1789,8 @@ begin
Result := nil;
end;
function TFpDbgSymbolScope.FindSymbol(const AName: String;
const OnlyUnitName: String): TFpValue;
function TFpDbgSymbolScope.FindSymbol(const AName: String; const OnlyUnitName: String;
AFindFlags: TFindExportedSymbolsFlags): TFpValue;
begin
Result := nil;
end;

7
components/fpdebug/fpdbgsymtablecontext.pas
View File

@ -47,7 +47,8 @@ type
function GetSizeOfAddress: Integer; override;
public
constructor Create(ALocationContext: TFpDbgLocationContext; AFpSymbolInfo: TFpSymbolInfo);
function FindSymbol(const AName: String; const OnlyUnitName: String = ''): TFpValue; override;
function FindSymbol(const AName: String; const OnlyUnitName: String = '';
AFindFlags: TFindExportedSymbolsFlags = []): TFpValue; override;
end;
{ TFpSymbolInfo }
@ -139,8 +140,8 @@ begin
FFpSymbolInfo:=AFpSymbolInfo;
end;
function TFpSymbolContext.FindSymbol(const AName: String;
const OnlyUnitName: String): TFpValue;
function TFpSymbolContext.FindSymbol(const AName: String; const OnlyUnitName: String;
AFindFlags: TFindExportedSymbolsFlags): TFpValue;
var
i: integer;
val: TFpDbgMemLocation;

12
components/fpdebug/fppascalparser.pas
View File

@ -104,7 +104,7 @@ type
constructor Create(ATextExpression: String; AScope: TFpDbgSymbolScope);
destructor Destroy; override;
function GetDbgSymbolForIdentifier({%H-}AnIdent: String): TFpValue;
function GetDbgSymbolForIdentifier({%H-}AnIdent: String; AFindFlags: TFindExportedSymbolsFlags = []): TFpValue;
function GetRegisterValue({%H-}AnIdent: String): TFpValue;
procedure SetError(AMsg: String); // deprecated;
@ -2366,6 +2366,9 @@ begin
exit;
end;
(* If Itm0 is an identifer we could use [fsfIgnoreEnumVals]
But then alTop(1) would give "identifer not found", rather than a proper error
*)
tmp := Itm0.ResultValue;
if (tmp = nil) or (not ExpressionData.Valid) then
exit;
@ -2936,7 +2939,7 @@ begin
exit;
FChildClassCastType.ReleaseReference;
FChildClassCastType := ExpressionData.GetDbgSymbolForIdentifier(CastName);
FChildClassCastType := ExpressionData.GetDbgSymbolForIdentifier(CastName, [fsfIgnoreEnumVals]);
if (FChildClassCastType = nil) or (FChildClassCastType.DbgSymbol = nil) or
(FChildClassCastType.DbgSymbol.SymbolType <> stType) or
(FChildClassCastType.DbgSymbol.Kind <> skClass)
@ -4289,10 +4292,11 @@ begin
SetExceptionMask(FFpuMask);
end;
function TFpPascalExpressionSharedData.GetDbgSymbolForIdentifier(AnIdent: String): TFpValue;
function TFpPascalExpressionSharedData.GetDbgSymbolForIdentifier(AnIdent: String;
AFindFlags: TFindExportedSymbolsFlags): TFpValue;
begin
if FScope <> nil then
Result := FScope.FindSymbol(AnIdent)
Result := FScope.FindSymbol(AnIdent, '', AFindFlags)
else
Result := nil;
end;

2
components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.pas
View File

@ -147,7 +147,7 @@ begin
if CurProc = nil then
exit;
ProcSymVal := AnExpressionScope.FindSymbol(FFunctionName);
ProcSymVal := AnExpressionScope.FindSymbol(FFunctionName, '', [fsfIgnoreEnumVals]);
if ProcSymVal <> nil then begin
if (ProcSymVal.Kind = skProcedure) and IsTargetAddr(ProcSymVal.DataAddress)
//and

2
components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas
View File

@ -523,7 +523,7 @@ begin
//U_$SYSTEM_$$_VARIANTMANAGER
//SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER
ProcVal := AnExpressionScope.FindSymbol('sysvartolstr', 'variants');
ProcVal := AnExpressionScope.FindSymbol('sysvartolstr', 'variants', [fsfIgnoreEnumVals]);
if ProcVal <> nil then begin
ProcSym := ProcVal.DbgSymbol;
if ProcSym <> nil then