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

FpDebug: Optimize building result data for arrays. Type-name is the same for each array element.

Browse Source
This commit is contained in:
Martin 2023-03-07 17:50:51 +01:00
parent ce5e45acc2
commit 50296e8cf9
1 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/fpdebug/fpwatchresultdata.pas
View File

@ -27,12 +27,13 @@ type
FFirstIndexOffs: Integer; FFirstIndexOffs: Integer;
FRecurseCnt, FRecurseCntLow, FRecurseCnt, FRecurseCntLow,
FRecursePointerCnt, FRecursePointerCnt,
FRecurseInstanceCnt, FRecurseDynArray: integer; FRecurseInstanceCnt, FRecurseDynArray, FRecurseArray: integer;
FRecurseAddrList: TDbgPtrList; FRecurseAddrList: TDbgPtrList;
FLastValueKind: TDbgSymbolKind; FLastValueKind: TDbgSymbolKind;
FHasEmbeddedPointer: Boolean; FHasEmbeddedPointer: Boolean;
FOuterArrayIdx, FTotalArrayCnt: integer; FOuterArrayIdx, FTotalArrayCnt: integer;
FRepeatCount: Integer; FRepeatCount: Integer;
FArrayTypeDone: Boolean;
protected protected
function CheckError(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): boolean; function CheckError(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): boolean;
@ -111,6 +112,8 @@ var
t: TFpSymbol; t: TFpSymbol;
TpName: String; TpName: String;
begin begin
if FArrayTypeDone then
exit;
t := AnFpValue.TypeInfo; t := AnFpValue.TypeInfo;
if ADeref and (t <> nil) then if ADeref and (t <> nil) then
t := t.TypeInfo; t := t.TypeInfo;
@ -331,8 +334,10 @@ begin
Result := True; Result := True;
Cnt := AnFpValue.MemberCount; Cnt := AnFpValue.MemberCount;
if CheckError(AnFpValue, AnResData) then if CheckError(AnFpValue, AnResData) then begin
AddTypeNameToResData(AnFpValue, AnResData);
exit; exit;
end;
CurRecurseDynArray := FRecurseDynArray; CurRecurseDynArray := FRecurseDynArray;
OuterIdx := FOuterArrayIdx; OuterIdx := FOuterArrayIdx;
@ -363,6 +368,7 @@ begin
AddTypeNameToResData(AnFpValue, AnResData); AddTypeNameToResData(AnFpValue, AnResData);
inc(FRecurseArray);
Cache := nil; Cache := nil;
try try
if (Cnt <= 0) or if (Cnt <= 0) or
@ -455,13 +461,18 @@ begin
else else
DoWritePointerWatchResultData(MemberValue, EntryRes, Addr); DoWritePointerWatchResultData(MemberValue, EntryRes, Addr);
MemberValue.ReleaseReference; MemberValue.ReleaseReference;
if FRecurseArray = 1 then
FArrayTypeDone := True;
end; end;
DebugLn(IsError(AnFpValue.LastError), ['!!! ArrayToResData() unexpected error in array value', ErrorHandler.ErrorAsString(AnFpValue.LastError)]); DebugLn(IsError(AnFpValue.LastError), ['!!! ArrayToResData() unexpected error in array value', ErrorHandler.ErrorAsString(AnFpValue.LastError)]);
AnFpValue.ResetError; AnFpValue.ResetError;
finally finally
if FRecurseArray = 1 then
FArrayTypeDone := False;
FRecurseDynArray := CurRecurseDynArray; FRecurseDynArray := CurRecurseDynArray;
FOuterArrayIdx := OuterIdx; FOuterArrayIdx := OuterIdx;
dec(FRecurseArray);
if Cache <> nil then if Cache <> nil then
Context.MemManager.CacheManager.RemoveCache(Cache); Context.MemManager.CacheManager.RemoveCache(Cache);
end end
@ -473,10 +484,10 @@ function TFpWatchResultConvertor.StructToResData(AnFpValue: TFpValue;
procedure AddVariantMembers(VariantPart: TFpValue; ResAnch: TLzDbgWatchDataIntf); procedure AddVariantMembers(VariantPart: TFpValue; ResAnch: TLzDbgWatchDataIntf);
var var
VariantContainer, VMember: TFpValue; VariantContainer, VMember: TFpValue;
i, j: Integer; i, j, CurRecurseArray: Integer;
ResField, ResList: TLzDbgWatchDataIntf; ResField, ResList: TLzDbgWatchDataIntf;
discr: QWord; discr: QWord;
hasDiscr, FoundDiscr, UseDefault: Boolean; hasDiscr, FoundDiscr, UseDefault, CurArrayTypeDone: Boolean;
MBVis: TLzDbgFieldVisibility; MBVis: TLzDbgFieldVisibility;
n: String; n: String;
begin begin
@ -484,6 +495,12 @@ function TFpWatchResultConvertor.StructToResData(AnFpValue: TFpValue;
if VariantContainer = nil then if VariantContainer = nil then
exit; exit;
CurRecurseArray := FRecurseArray;
CurArrayTypeDone := FArrayTypeDone;
FArrayTypeDone := False;
FRecurseArray := 0; // Allow an inside array to optimize
try
ResList := ResAnch.AddField('', dfvUnknown, [dffVariant]); ResList := ResAnch.AddField('', dfvUnknown, [dffVariant]);
ResList.CreateArrayValue(datUnknown); ResList.CreateArrayValue(datUnknown);
@ -556,6 +573,10 @@ function TFpWatchResultConvertor.StructToResData(AnFpValue: TFpValue;
if FoundDiscr then if FoundDiscr then
break; break;
end; end;
finally
FRecurseArray := CurRecurseArray;
FArrayTypeDone := CurArrayTypeDone;
end;
end; end;
type type
@ -893,10 +914,12 @@ begin
FRecurseCnt := -2; FRecurseCnt := -2;
FRecurseInstanceCnt := 0; FRecurseInstanceCnt := 0;
FRecurseDynArray := 0; FRecurseDynArray := 0;
FRecurseArray := 0;
FRecursePointerCnt := 0; FRecursePointerCnt := 0;
FRecurseCntLow := FRecurseCnt+1; FRecurseCntLow := FRecurseCnt+1;
FOuterArrayIdx := -1; FOuterArrayIdx := -1;
FTotalArrayCnt := 0; FTotalArrayCnt := 0;
FArrayTypeDone := False;
FLastValueKind := AnFpValue.Kind; FLastValueKind := AnFpValue.Kind;
FHasEmbeddedPointer := False; FHasEmbeddedPointer := False;