FpDebug: added mem-read cache for ArrayToResData / PascalBuilder

components/fpdebug/fppascalbuilder.pas

@@ -7,7 +7,7 @@ unit FpPascalBuilder;
 interface
 
 uses
-  Classes, SysUtils, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo,
+  Classes, SysUtils, Math, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo,
   FpdMemoryTools, FpErrorMessages, FpDbgDwarfDataClasses, FpDbgDwarf,
   FpDbgClasses,
   {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},
@@ -1247,9 +1247,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
   var
     s: String;
     i: Integer;
-    MemberValue: TFpValue;
+    MemberValue, TmpVal: TFpValue;
-    Cnt, FullCnt: Integer;
+    Cnt, FullCnt, CacheCnt, LowBnd: Integer;
-    d: Int64;
+    CacheMax, CacheSize: Int64;
+    StartIdx, j: Int64;
+    Cache: TFpDbgMemCacheBase;
   begin
     APrintedValue := '';
 
@@ -1281,19 +1283,82 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
     else if (ANestLevel > 0) and (Cnt > 10) then Cnt := 10
     else if (Cnt > 300)                     then Cnt := 300;
 
-    if (AValue.IndexTypeCount = 0) or (not AValue.IndexType[0].GetValueLowBound(AValue, d)) then
+    if (AValue.IndexTypeCount = 0) or (not AValue.IndexType[0].GetValueLowBound(AValue, StartIdx)) then
-      d := 0;
+      StartIdx := 0;
-    for i := d to d + Cnt - 1 do begin
+
-      MemberValue := AValue.Member[i];
+    Cache := nil;
-      if MemberValue <> nil then
+    try
-        InternalPrintValue(s, MemberValue, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat, -1, nil, AOptions)
+      LowBnd := 0; // TODO: see WatchResultData
-      else
+      CacheMax  := StartIdx;
-        s := '{error}';
+      CacheSize := 0;
+      CacheCnt  := 200;
+      MemberValue := AValue.Member[StartIdx+LowBnd]; // // TODO : CheckError // ClearError for AValue
+      if (MemberValue = nil) or (not IsTargetNotNil(MemberValue.Address)) or
+         (Context.MemManager.CacheManager = nil)
+      then begin
+        CacheMax := StartIdx + Cnt; // no caching possible
+      end
+      else begin
+        repeat
+          TmpVal := AValue.Member[StartIdx + min(CacheCnt, Cnt) + LowBnd]; // // TODO : CheckError // ClearError for AValue
+          if IsTargetNotNil(TmpVal.Address) then begin
+            {$PUSH}{$R-}{$Q-}
+            CacheSize := TmpVal.Address.Address - MemberValue.Address.Address;
+            TmpVal.ReleaseReference;
+            {$POP}
+            if CacheSize > Context.MemManager.MemLimits.MaxMemReadSize then begin
+              CacheSize := 0;
+              CacheCnt := CacheCnt div 2;
+              if CacheCnt <= 1 then
+                break;
+              continue;
+            end;
+          end;
+          break;
+        until false;
+        if CacheSize = 0 then
+          CacheMax := StartIdx + Cnt; // no caching possible
+      end;
       MemberValue.ReleaseReference;
-      if APrintedValue = ''
+
-      then APrintedValue := s
+      for i := StartIdx to StartIdx + Cnt - 1 do begin
-      else APrintedValue := APrintedValue + ', ' + s;
+        MemberValue := AValue.Member[i];
+        if MemberValue <> nil then begin
+          if (i >= CacheMax) and (CacheSize > 0) then begin
+            if Cache <> nil then
+              Context.MemManager.CacheManager.RemoveCache(Cache);
+            Cache := nil;
+
+            if IsTargetNotNil(MemberValue.Address) then begin
+              CacheMax := Min(i + CacheCnt, StartIdx + Cnt);
+              if (CacheMax > i + 1) then begin
+                j := CacheMax - i;
+                if j < CacheCnt then
+                  CacheSize := (CacheSize div CacheCnt) * j + j div 2;
+
+                if CacheSize > 0 then
+                  Cache := Context.MemManager.CacheManager.AddCache(MemberValue.Address.Address, CacheSize)
+              end;
+            end
+            else
+              CacheMax := StartIdx + Cnt; // no caching possible
+          end;
+
+          InternalPrintValue(s, MemberValue, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat, -1, nil, AOptions)
+        end
+        else
+          s := '{error}';
+        MemberValue.ReleaseReference;
+        if APrintedValue = ''
+        then APrintedValue := s
+        else APrintedValue := APrintedValue + ', ' + s;
+      end;
+
+    finally
+      if Cache <> nil then
+        Context.MemManager.CacheManager.RemoveCache(Cache);
     end;
+
     if Cnt < FullCnt then
       APrintedValue := APrintedValue + ', {'+IntToStr(FullCnt-Cnt)+' more elements}';
     APrintedValue := '(' + APrintedValue + ')';

components/fpdebug/fpwatchresultdata.pas

@@ -320,12 +320,13 @@ const
   MAX_TOTAL_ARRAY_CNT = 5000;
   MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH = 3500; // reset
 var
-  Cnt, i, CurRecurseDynArray, OuterIdx: Integer;
+  Cnt, i, CurRecurseDynArray, OuterIdx, CacheCnt: Integer;
-  LowBnd, StartIdx: Int64;
+  LowBnd, StartIdx, CacheMax, CacheSize, j: Int64;
   Addr: TDBGPtr;
   ti: TFpSymbol;
   EntryRes: TLzDbgWatchDataIntf;
-  MemberValue: TFpValue;
+  MemberValue, TmpVal: TFpValue;
+  Cache: TFpDbgMemCacheBase;
 begin
   Result := True;
 
@@ -362,6 +363,7 @@ begin
 
   AddTypeNameToResData(AnFpValue, AnResData);
 
+  Cache := nil;
   try
     if (Cnt <= 0) or
        (FHasEmbeddedPointer) or
@@ -385,8 +387,39 @@ begin
     else if (FRecurseCnt > 0) and (FOuterArrayIdx >   1) and (Cnt >   50) then Cnt := 50;
 
     /////////////////////
-    // add mem read cache ??
+    // Bound types ??
-    // Bound types
+
+    CacheMax  := StartIdx;
+    CacheSize := 0;
+    CacheCnt  := 200;
+    MemberValue := AnFpValue.Member[StartIdx+LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
+    if (MemberValue = nil) or (not IsTargetNotNil(MemberValue.Address)) or
+       (Context.MemManager.CacheManager = nil)
+    then begin
+      CacheMax := StartIdx + Cnt; // no caching possible
+    end
+    else begin
+      repeat
+        TmpVal := AnFpValue.Member[StartIdx + Min(CacheCnt, Cnt) + LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
+        if IsTargetNotNil(TmpVal.Address) then begin
+          {$PUSH}{$R-}{$Q-}
+          CacheSize := TmpVal.Address.Address - MemberValue.Address.Address;
+          TmpVal.ReleaseReference;
+          {$POP}
+          if CacheSize > Context.MemManager.MemLimits.MaxMemReadSize then begin
+            CacheSize := 0;
+            CacheCnt := CacheCnt div 2;
+            if CacheCnt <= 1 then
+              break;
+            continue;
+          end;
+        end;
+        break;
+      until false;
+      if CacheSize = 0 then
+        CacheMax := StartIdx + Cnt; // no caching possible
+    end;
+    MemberValue.ReleaseReference;
 
     inc(FTotalArrayCnt, Cnt);
     for i := StartIdx to StartIdx + Cnt - 1 do begin
@@ -394,7 +427,28 @@ begin
         FTotalArrayCnt := MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH;
       if i > FOuterArrayIdx then
         FOuterArrayIdx := i;
+
       MemberValue := AnFpValue.Member[i+LowBnd]; // // TODO : CheckError // ClearError for AnFpValue
+      if (i >= CacheMax) and (CacheSize > 0) and (MemberValue <> nil) then begin
+        if Cache <> nil then
+          Context.MemManager.CacheManager.RemoveCache(Cache);
+        Cache := nil;
+
+        if IsTargetNotNil(MemberValue.Address) then begin
+          CacheMax := Min(i + CacheCnt, StartIdx + Cnt);
+          if (CacheMax > i + 1) then begin
+            j := CacheMax - i;
+            if j < CacheCnt then
+              CacheSize := (CacheSize div CacheCnt) * j + j div 2;
+
+            if CacheSize > 0 then
+              Cache := Context.MemManager.CacheManager.AddCache(MemberValue.Address.Address, CacheSize)
+          end;
+        end
+        else
+          CacheMax := StartIdx + Cnt; // no caching possible
+      end;
+
       EntryRes := AnResData.SetNextArrayData;
       if MemberValue = nil then
         EntryRes.CreateError('Error: Could not get member')
@@ -408,6 +462,8 @@ begin
   finally
     FRecurseDynArray := CurRecurseDynArray;
     FOuterArrayIdx := OuterIdx;
+    if Cache <> nil then
+      Context.MemManager.CacheManager.RemoveCache(Cache);
   end
 end;