paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 14:29:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: speed up scanning scopes / less memory used

Browse Source 
git-svn-id: trunk@43409 -
This commit is contained in:
martin 2013-11-09 19:28:45 +00:00
parent 3ee4e090ac
commit c7584d7702
1 changed files with 71 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

263
components/fpdebug/fpdbgdwarf.pas
View File

@ -352,14 +352,6 @@ type
Name: PChar; Name: PChar;
end; end;
TDwarfLocateEntryFlag = (
lefContinuable, // forces the located scope or the startscope to be contuniable
// meaning that tree traversion can continue from a scope
lefSearchChild,
lefSearchSibling // search toplevel siblings
);
TDwarfLocateEntryFlags = set of TDwarfLocateEntryFlag;
{ TDWarfLineMap } { TDWarfLineMap }
TDWarfLineMap = object TDWarfLineMap = object
@ -435,9 +427,7 @@ type
function MakeAddress(AData: Pointer): QWord; function MakeAddress(AData: Pointer): QWord;
protected protected
procedure ScanAllEntries; procedure ScanAllEntries;
function LocateEntry(ATag: Cardinal; AStartScope: TDwarfScopeInfo; function LocateEntry(ATag: Cardinal; out AResultScope: TDwarfScopeInfo): Boolean;
AFlags: TDwarfLocateEntryFlags;
out AResultScope: TDwarfScopeInfo): Boolean;
function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal; var AList: TAttribPointerList; function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal; var AList: TAttribPointerList;
out AAttribPtr: Pointer; out AForm: Cardinal): Boolean; out AAttribPtr: Pointer; out AForm: Cardinal): Boolean;
function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal; function LocateAttribute(AEntry: Pointer; AAttribute: Cardinal;
@ -4258,7 +4248,7 @@ var
Form: Cardinal; Form: Cardinal;
Info: TDwarfAddressInfo; Info: TDwarfAddressInfo;
Scope, ResultScope: TDwarfScopeInfo; Scope, ResultScope: TDwarfScopeInfo;
i: Integer; ScopeIdx: Integer;
Abbrev: TDwarfAbbrev; Abbrev: TDwarfAbbrev;
begin begin
if FAddressMapBuild then Exit; if FAddressMapBuild then Exit;
@ -4266,14 +4256,14 @@ begin
ScanAllEntries; ScanAllEntries;
Scope := FScope; Scope := FScope;
ScopeIdx := Scope.Index;
while Scope.IsValid do while Scope.IsValid do
begin begin
if not GetDefinition(Scope.Entry, Abbrev) then begin if not GetDefinition(Scope.Entry, Abbrev) then begin
// 0 entry // 0 entry
i := Scope.Index; inc(ScopeIdx);
if i < Scope.FScopeList^.HighestKnown Scope.Index := ScopeIdx; // Child or Next, or parent.next
then Scope.Index := i + 1 // Child or Next, or parent.next
else break;
continue; continue;
//DebugLn(FPDBG_DWARF_WARNINGS, ['No abbrev found']); //DebugLn(FPDBG_DWARF_WARNINGS, ['No abbrev found']);
@ -4306,11 +4296,8 @@ begin
end; end;
end; end;
i := Scope.Index; inc(ScopeIdx);
if i < Scope.FScopeList^.HighestKnown Scope.Index := ScopeIdx; // Child or Next, or parent.next
then Scope.Index := i + 1 // Child or Next, or parent.next
else break;
end; end;
FAddressMapBuild := True; FAddressMapBuild := True;
@ -4443,7 +4430,7 @@ begin
FScope.Init(@FScopeList); FScope.Init(@FScopeList);
FScope.Index := 0; FScope.Index := 0;
// retrieve some info about this unit // retrieve some info about this unit
if not LocateEntry(DW_TAG_compile_unit, FScope, [lefSearchChild], Scope) if not LocateEntry(DW_TAG_compile_unit, Scope)
then begin then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING compilation unit has no compile_unit tag']); DebugLn(FPDBG_DWARF_WARNINGS, ['WARNING compilation unit has no compile_unit tag']);
Exit; Exit;
@ -4667,8 +4654,8 @@ end;
// ACurrentOnly: if set, process only current entry // ACurrentOnly: if set, process only current entry
// AResultScope: the located scope info // AResultScope: the located scope info
//---------------------------------------- //----------------------------------------
function TDwarfCompilationUnit.LocateEntry(ATag: Cardinal; AStartScope: TDwarfScopeInfo; function TDwarfCompilationUnit.LocateEntry(ATag: Cardinal; out
AFlags: TDwarfLocateEntryFlags; out AResultScope: TDwarfScopeInfo): Boolean; AResultScope: TDwarfScopeInfo): Boolean;
procedure ParseAttribs(const ADef: TDwarfAbbrev; var p: Pointer); procedure ParseAttribs(const ADef: TDwarfAbbrev; var p: Pointer);
var var
@ -4686,185 +4673,86 @@ function TDwarfCompilationUnit.LocateEntry(ATag: Cardinal; AStartScope: TDwarfSc
end; end;
end; end;
function CanExit(AResult: Boolean): Boolean;
begin
Result := True;
if AResult
then begin
if not (lefContinuable in AFlags) then Exit; // ready, so ok.
if AResultScope.HasChild then Exit; // we have a child so we are continuable
if AResultScope.HasNext then Exit; // we have a next so we are continuable
end
else begin
if AFlags * [lefSearchSibling, lefSearchChild] = []
then begin
if not (lefContinuable in AFlags) then Exit; // no furteher search, so ok.
if AStartScope.HasChild then Exit; // we have a child so we are continuable
if AStartScope.HasNext then Exit; // we have a next so we are continuable
end;
end;
Result := False;
end;
var var
Abbrev: Cardinal; Abbrev: Cardinal;
Def: TDwarfAbbrev; Def: TDwarfAbbrev;
Level: Integer;
MaxData: Pointer; MaxData: Pointer;
p: Pointer; p, EntryDataPtr, NextEntryDataPtr: Pointer;
Scope: TDwarfScopeInfo; Scope: TDwarfScopeInfo;
Searching: Boolean; // set as long as we need searching for a tag.
p2: Pointer;
ni: Integer; ni: Integer;
// we cannot use result for this, since we might want a topnode search while we need to be continuable AppendAsChild: Boolean;
begin begin
Result := False; Result := False;
if not AStartScope.IsValid then Exit; if not FScope.IsValid then Exit;
Searching := True;
Level := 0;
MaxData := FInfoData + FLength; MaxData := FInfoData + FLength;
Scope := AStartScope; Scope := FScope;
p := Scope.Entry; Scope.Index := FScopeList.HighestKnown; // last known scope
while (p < MaxData) and (Level >= 0) do
// "last rounds" NextEntryDataPtr
NextEntryDataPtr := Scope.Entry;
while (NextEntryDataPtr < MaxData) do
begin begin
p := Scope.Entry; EntryDataPtr := NextEntryDataPtr;
p2:=p;
Abbrev := ULEB128toOrdinal(p);
if Abbrev = 0
then begin
Dec(Level);
Scope.GoParent;
if not Scope.IsValid then Exit;
if Level < 0 then NextEntryDataPtr := FAbbrevList.FindLe128bFromPointer(EntryDataPtr, Def);
begin if NextEntryDataPtr = nil then begin
// p is now the entry of the next of the startparent Abbrev := ULEB128toOrdinal(EntryDataPtr);
// let's see if we need to set it
if not (lefContinuable in AFlags) then Exit;
Scope.Index := AStartScope.ParentIndex;
//if not Scope2.IsValid then Exit;
if Scope.HasNext then Exit;
if p >= MaxData then break;
Scope.CreateNextForEntry(p);
Exit;
end;
ni := Scope.NextIndex;
if ni < 0 // not Scope.HasNext
then begin
if p >= MaxData then break;
ni := Scope.CreateNextForEntry(p);
end;
// if Level = 0 then Exit;
if CanExit(Result) then Exit;
if (Level = 0) and not (lefSearchSibling in AFlags) then Exit;
Scope.Index := ni; // GoNext
Continue;
end;
if not GetDefinition(p2, Def)
then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]); DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]);
// TODO shorten array
exit;
end;
if (ATag <> 0) and (Def.tag = ATag) then begin
Result := True;
AResultScope := Scope;
Break; Break;
end; end;
if Searching ParseAttribs(Def, NextEntryDataPtr);
then begin // NextEntryDataPtr is now at next scope
Result := Def.Tag = ATag;
if Result if NextEntryDataPtr >= MaxData then
then begin break;
Searching := False;
AResultScope := Scope; p := NextEntryDataPtr;
if not (lefContinuable in AFlags) Abbrev := ULEB128toOrdinal(p);
then Exit if Abbrev = 0 then begin // no more sibling
AppendAsChild := False; // children already done
if Def.Children then begin // current has 0 children
NextEntryDataPtr := p;
if NextEntryDataPtr >= MaxData then
break;
Abbrev := ULEB128toOrdinal(p);
end;
while (Abbrev = 0) do begin
NextEntryDataPtr := p;
if NextEntryDataPtr >= MaxData then
break;
Scope.GoParent;
if not Scope.IsValid then begin
DebugLn(FPDBG_DWARF_WARNINGS, ['Error: Abbrev not found: ', Abbrev]);
// TODO shorten array
exit;
end;
Abbrev := ULEB128toOrdinal(p);
end;
if NextEntryDataPtr >= MaxData then
break;
end end
else begin else
if CanExit(False) then Exit; AppendAsChild := Def.Children;
Searching := (lefSearchChild in AFlags)
or ((level = 0) and (lefSearchSibling in AFlags)); if AppendAsChild then
end; ni := Scope.CreateChildForEntry(NextEntryDataPtr)
else
ni := Scope.CreateNextForEntry(NextEntryDataPtr);
Scope.FIndex := ni; // skip check, index was just created / must exist
end; end;
// check if we can shortcut the searches if (NextEntryDataPtr >= MaxData) then begin
ni := Scope.ChildIndex; if (EntryDataPtr > MaxData) then
if (ni >= 0) // (Scope.HasChild) debugln(FPDBG_DWARF_WARNINGS, ['LocateEntry went past end of memory: ', EntryDataPtr-MaxData]);
and ((lefSearchChild in AFlags) or (not Scope.HasNext))
then begin
Inc(Level);
Scope.Index := ni; // GoChild
Continue;
end;
ni := Scope.NextIndex;
if ni >= 0 // Scope.HasNext
then begin
// scope.Childvalid is true, otherwise we can not have a next.
// So no need to check
if lefSearchSibling in AFlags
then begin
Scope.Index := ni; // GoNext
Continue;
end;
if Level = 0 then Exit;
end;
// bummer, we need to parse our attribs, if we want them or not
ParseAttribs(Def, p);
// if we have a result or don't want to search we're done here
if CanExit(Result) then Exit;
// check for shortcuts
if [lefContinuable, lefSearchChild] * AFlags <> []
then begin
ni := Scope.ChildIndex;
if ni >= 0 // Scope.HasChild
then begin
Inc(Level);
Scope.Index := ni; // GoChild
Continue;
end;
end
else if lefSearchSibling in AFlags
then begin
ni := Scope.NextIndex;
if ni >= 0 // Scope.HasNext
then begin
Scope.Index := ni; // GoNext
Continue;
end;
end;
// Def.children can be set while no children are found
// we cannot have a next without a defined child
if Def.Children
then begin
assert(p < MaxData, 'Got data for children');
ni := Scope.ChildIndex;
if ni < 0 // not Scope.HasChild
then ni := Scope.CreateChildForEntry(p);
if CanExit(Result) then Exit;
Inc(Level);
Scope.Index := ni; // GoChild
Continue;
end;
ni := Scope.NextIndex;
if ni < 0 // not Scope.HasNext
then begin
if p >= MaxData then break;
ni := Scope.CreateNextForEntry(p);
end;
if CanExit(Result) then Exit;
if (Level = 0) and not (lefSearchSibling in AFlags) then Exit;
Scope.Index := ni; // GoNext
end;
if (p >= MaxData) then begin
if (p > MaxData) then
debugln(FPDBG_DWARF_WARNINGS, ['LocateEntry went past end of memory: ', p-MaxData]);
SetLength(FScopeList.List, FScopeList.HighestKnown + 1); SetLength(FScopeList.List, FScopeList.HighestKnown + 1);
end; end;
@ -4884,7 +4772,7 @@ begin
if FScannedToEnd then exit; if FScannedToEnd then exit;
FScannedToEnd := True; FScannedToEnd := True;
// scan to end // scan to end
LocateEntry(0, FScope, [lefContinuable, lefSearchChild], ResultScope); LocateEntry(0, ResultScope);
end; end;
function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Cardinal): Boolean; function TDwarfCompilationUnit.ReadValue(AAttribute: Pointer; AForm: Cardinal; out AValue: Cardinal): Boolean;
@ -5439,8 +5327,7 @@ var
ADefs: PDwarfAbbrevEntry; ADefs: PDwarfAbbrevEntry;
begin begin
// Tag - should not exist. Load all scopes // Tag - should not exist. Load all scopes
//FCU.LocateEntry(0, Scope, [lefContinuable, lefSearchChild, lefSearchSibling], FCU.ScanAllEntries;
// ResultScope);
Indent := AIndent; Indent := AIndent;
Level := 0; Level := 0;