AbstractMem library v1.6

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -24,7 +24,7 @@
 {.$define ABSTRACTMEM_TESTING_MODE}
 // define this if you want some testing mode capabilities
 
-{.$define ABSTRACTMEM_ENABLE_STATS}
+{$define ABSTRACTMEM_ENABLE_STATS}
 // define this to activate some stats on objects usefull for testing
 
 {.$define ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
@@ -66,9 +66,15 @@
     - 32 bits: Fixed 1 unit = 4 bytes: Max size = ((2^24)*4) = 67108864 bytes = 64Mb
     - 64 bits: Customizable: 1 unit from 4..256 bytes (multiple of 4): Max size = from ((2^32)*4) 16Gb ... ((2^32)*256) = 1099511627776 = 1Tb
 
+  Version 1.6 - Dec 2021
+  - Improved 64 bits
+  - Fully redo of CacheMem unit with better improvements on read/write cache
+  - Added BTree index on TAbstractMemBTreeData with TAbstractMemBTreeDataIndex<TBTreeData> class
+  - Added cache on TAbstractMemBTreeData<TData> structures
+
 }
 
 const
-  CT_ABSTRACTMEM_VERSION = 1.5; // Each revision should increase this version...
+  CT_ABSTRACTMEM_VERSION = 1.6; // Each revision should increase this version...
 
 

src/libraries/abstractmem/UAVLCache.pas

@@ -350,7 +350,10 @@ begin
   New(P);
   P^.Clear;
   P^.data := AData;
-  FAVLCacheMem.Add(P);
+  if Not FAVLCacheMem.Add(P) then begin
+    Dispose(P);
+    Exit;
+  end;
   FAVLCacheMem.DoMark(P,True);
   if (FMaxRegisters > 0) And (FAVLCacheMem.FCount>FMaxRegisters) then begin
     // Dispose cache

src/libraries/abstractmem/UAbstractBTree.pas

@@ -144,9 +144,10 @@ type
     procedure CheckConsistency; virtual;
     property Height : Integer read GetHeight;
     property CircularProtection : Boolean read FCircularProtection write FCircularProtection;
-    procedure Lock;
-    procedure Unlock;
-    function FindExt(const AData: TData; out ADataEqualOrPrecessorFound : TData) : Boolean;
+    procedure Lock; virtual;
+    procedure Unlock; virtual;
+    function FindExt(const AData: TData; out ADataEqualOrPrecessorFound : TData; out ANode : TAbstractBTreeNode; out iPos : Integer) : Boolean; overload;
+    function FindExt(const AData: TData; out ADataEqualOrPrecessorFound : TData) : Boolean; overload;
     function GetNullData : TData; virtual;
   End;
 
@@ -861,32 +862,39 @@ begin
 end;
 
 function TAbstractBTree<TIdentify, TData>.FindExt(const AData: TData; out ADataEqualOrPrecessorFound: TData): Boolean;
-var Lnode : TAbstractBTreeNode;
-  LiPosNode : Integer;
+var LNode : TAbstractBTreeNode;
+  iPos : Integer;
+begin
+  Result := FindExt(AData,ADataEqualOrPrecessorFound,LNode,iPos);
+end;
+
+function TAbstractBTree<TIdentify, TData>.FindExt(const AData: TData; out ADataEqualOrPrecessorFound: TData; out ANode : TAbstractBTreeNode; out iPos : Integer): Boolean;
+var
   LCircularProtectionList : TOrderedList<TIdentify>;
   LPrecessorFound : Boolean;
 begin
   FAbstractBTreeLock.Acquire;
   try
-    ClearNode(Lnode);
-    if Find(AData,Lnode,LiPosNode) then begin
-      ADataEqualOrPrecessorFound := Lnode.data[LiPosNode];
+    ClearNode(ANode);
+    iPos := 0;
+    if Find(AData,ANode,iPos) then begin
+      ADataEqualOrPrecessorFound := ANode.data[iPos];
       Result := True;
     end else begin
       // At this point Lnode is a leaf OR a NIL (no root available at tree)
       // Lnode.Count = 0  -> NIL (no root/tree available)
-      if Lnode.Count=0 then begin
+      if ANode.Count=0 then begin
         ADataEqualOrPrecessorFound := GetNullData;
-      end else if Lnode.Count=LiPosNode then begin
-        dec(LiPosNode);
-        ADataEqualOrPrecessorFound := Lnode.data[LiPosNode];
+      end else if ANode.Count=iPos then begin
+        dec(iPos);
+        ADataEqualOrPrecessorFound := ANode.data[iPos];
       end else begin
         // Will find previous valid value by climbing tree
         LCircularProtectionList := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
         try
           LCircularProtectionList.Clear;
-          LPrecessorFound := FindPrecessorExt(LCircularProtectionList,Lnode,LiPosNode);
-          if LPrecessorFound then ADataEqualOrPrecessorFound := Lnode.data[LiPosNode]
+          LPrecessorFound := FindPrecessorExt(LCircularProtectionList,ANode,iPos);
+          if LPrecessorFound then ADataEqualOrPrecessorFound := ANode.data[iPos]
           else ADataEqualOrPrecessorFound := GetNullData;
         finally
           LCircularProtectionList.Free;

src/libraries/abstractmem/UAbstractMemBTree.pas

@@ -39,6 +39,7 @@ uses
   // https://github.com/PascalCoinDev/PascalCoin/tree/master/src/libraries/generics.collections
   // (Download and set folder as a "units include folder" in compiler options)
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+  UAVLCache,
   UOrderedList, UAbstractMem, UAbstractBTree;
 
 {$I ./ConfigAbstractMem.inc }
@@ -50,16 +51,23 @@ type
     // BTree implementation on AbstractMem will use TIdentify and TData as a TAbstractMemPosition (aka pointer inside AbstractMem)
     // Internal search process will convert TData pointer to final TData value for
     // comparisions
+  public
+    type
+      TAVLABTreeCache = Class(TAVLCache<TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode>)
+      end;
   private
     const
           CT_AbstractMemBTree_Magic = 'AMBT'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
     var
     FrootPosition : TAbstractMemPosition;
+    FBTreeCache : TAVLABTreeCache;
     procedure SaveHeader;
     Procedure CheckInitialized;
     procedure LoadNodeHeader(const APosition : TAbstractMemPosition; var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; var AChildsCount : Integer; var AChildsPosition : TAbstractMemPosition);
     procedure SaveNodeHeader(const ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; const AChildsPosition : TAbstractMemPosition);
     function GetNodeHeaderSize : Integer;
+    function CacheCompareBTree(const ALeft,ARight : TAVLCache<TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode>.PAVLCacheMemData) : Integer;
+    function OnGetCopyDataMethod(Const AData : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode) : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
   protected
     FInitialZone : TAMZone;
     FAbstractMem : TAbstractMem;
@@ -71,10 +79,6 @@ type
     procedure SaveNode(var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
     procedure SetCount(const ANewCount : Integer); override;
     //
-    // NOTE: inherited classes will need to override DisposeData if Data is not a new AbstractMem memory region that must be freed
-    //
-    procedure DisposeData(var AData : TAbstractMemPosition); override;
-    //
     // NOTE: inherited classes will need to override DoCompareData function in order to properly compare:
     // function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
     //
@@ -90,10 +94,16 @@ type
     function NodeIdentifyToString(const AIdentify : TAbstractMemPosition) : String; override;
     property InitialZone : TAMZone read FInitialZone;
     function GetNullData : TAbstractMemPosition; override;
+    property BTreeCache : TAVLABTreeCache read FBTreeCache;
   End;
 
+  {$IFnDEF FPC}
+  TAbstractMemBTreeDataIndex<TBTreeData> = Class;
+  {$ENDIF}
+
   TAbstractMemBTreeDataAbstract<TBTreeData> = Class(TAbstractMemBTree)
   private
+    var
     // FLeft_ and FRight_ will be used as a cache for improvement calls on DoCompareData
     FLeft_Pos, FRight_Pos : TAbstractMemPosition;
     FLeft_Data, FRight_Data : TBTreeData;
@@ -104,41 +114,57 @@ type
     //
     function LoadData(const APosition : TAbstractMemPosition) : TBTreeData; virtual; abstract;
     function SaveData(const AData : TBTreeData) : TAMZone; virtual; abstract;
+    function GetCopyOfData(Const AData : TBTreeData) : TBTreeData;  virtual;
     procedure DoOnFindProcessStart; override;
     procedure DoOnFindProcessEnd; override;
     //
+    function GetData(const APosition : TAbstractMemPosition) : TBTreeData; virtual;
     function AddInherited(const AAbstractMemPosition: TAbstractMemPosition) : Boolean;
     function DeleteInherited(const AAbstractMemPosition: TAbstractMemPosition) : Boolean;
   public
-    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer; const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer;
+      const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>); reintroduce;
+    destructor Destroy; override;
     procedure Add(); reintroduce;
     procedure Delete(); reintroduce;
-    function FindData(const AData: TBTreeData; out APosition : TAbstractMemPosition; var AFoundData : TBTreeData) : Boolean; overload;
+    function FindData(const AData: TBTreeData; out ADataEqualOrPrecessorFound : TAbstractMemPosition; var AFoundData : TBTreeData) : Boolean; overload;
     function FindData(const AData: TBTreeData; var AFoundData : TBTreeData) : Boolean; overload;
-    function FindDataPos(const AData: TBTreeData; out APosition : TAbstractMemPosition) : Boolean;
+    function FindDataPos(const AData: TBTreeData; out ADataEqualOrPrecessorFound : TAbstractMemPosition) : Boolean; overload;
+    function FindDataPos(const AData: TBTreeData; out ADataEqualOrPrecessorFound : TAbstractMemPosition; out ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; out iPos : Integer) : Boolean; overload;
     function FindDataPrecessor(const AData : TBTreeData; var APrecessor : TBTreeData) : Boolean;
     function FindDataSuccessor(const AData : TBTreeData; var ASuccessor : TBTreeData) : Boolean;
     function FindDataLowest(out ALowest : TBTreeData) : Boolean;
     function FindDataHighest(out AHighest : TBTreeData) : Boolean;
   End;
 
-  {$IFnDEF FPC}
-  TAbstractMemBTreeDataIndex<TBTreeData> = Class;
-  {$ENDIF}
-
   TAbstractMemBTreeData<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
+  public
+    type
+      TAVLABTreeDataCacheData = record
+        position : TAbstractMemPosition;
+        data : TBTreeData;
+      end;
+      TAVLABTreeDataCache = Class(TAVLCache<TAVLABTreeDataCacheData>)
+      protected
+      public
+    function ToString(const AData : TAVLABTreeDataCacheData) : String; override;
+      end;
   private
-//    Ref: 20211111-1
-//    FreePascal issue: Does not allow recursive Generics...
-//    due to this issue (on Delphi is allowed) then I must use TList< TOjbect > instead
-//    last FreePascal version with this issue: 3.2.0  (will need to check on future versions)
+    //    Ref: 20211111-1  -- TODO
+    //    FreePascal issue: Does not allow recursive Generics...
+    //    due to this issue (on Delphi is allowed) then I must use TList< TOjbect > instead
+    //    last FreePascal version with this issue: 3.2.0  (will need to check on future versions)
     {$IFDEF FPC}
     FIndexes : TList< TObject >;
     {$ELSE}
-//    Ref: 20211111-1 I can't use this... in Delphi it works! Not in FreePascal... SHIT!
+    //    Ref: 20211111-1 I can't use this... in Delphi it works! Not in FreePascal... SHIT!
     FIndexes : TList< TAbstractMemBTreeDataIndex<TBTreeData> >;
     {$ENDIF}
+    FBTreeDataCache : TAVLABTreeDataCache;
+    function CacheCompareBTreeData(const ALeft,ARight : TAVLCache<TAVLABTreeDataCacheData>.PAVLCacheMemData) : Integer;
   protected
+    function GetData(const APosition : TAbstractMemPosition) : TBTreeData; override;
+    procedure DisposeData(var AData : TAbstractMemPosition); override;
     procedure DeletedData(const AData: TBTreeData); virtual;
   public
     constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer;
@@ -148,19 +174,24 @@ type
     function AddData(const AData: TBTreeData) : Boolean;
     function DeleteData(const AData: TBTreeData) : Boolean;
     function IndexesCount : Integer;
-//    See ref: 20211111-1
+    //    See ref: 20211111-1
     {$IFDEF FPC}
     function GetIndex(AIndex : Integer) : TObject;
     {$ELSE}
     function GetIndex(AIndex : Integer) : TAbstractMemBTreeDataIndex<TBTreeData>;
     {$ENDIF}
     procedure CheckConsistency; override;
+    property BTreeDataCache : TAVLABTreeDataCache read FBTreeDataCache;
   End;
 
   TAbstractMemBTreeDataIndex<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
-  protected
+  private
     FIndexed : TAbstractMemBTreeData<TBTreeData>;
+    FCompareModeInsertingOrDeleting : Boolean;
+  protected
+    function DoCompareData(const ALefTBTreeData, ARighTBTreeData: TAbstractMemPosition): Integer; override;
     function LoadData(const APosition : TAbstractMemPosition) : TBTreeData; override;
+    function SaveData(const AData : TBTreeData) : TAMZone; override;
   public
     constructor Create(AAbstractMemBTreeData : TAbstractMemBTreeData<TBTreeData>;
       AInitialZone: TAMZone;
@@ -168,12 +199,22 @@ type
       const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
     destructor Destroy; override;
     procedure CheckConsistency; override;
+    procedure Lock; override;
+    procedure Unlock; override;
   End;
 
 implementation
 
 { TAbstractMemBTree<TBTreeData> }
 
+function TAbstractMemBTree.CacheCompareBTree(const ALeft,
+  ARight: TAVLCache<TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode>.PAVLCacheMemData): Integer;
+begin
+  if ALeft.data.identify<ARight.data.identify then Result := -1
+  else if ALeft.data.identify>ARight.data.identify then Result := 1
+  else Result := 0;
+end;
+
 procedure TAbstractMemBTree.CheckInitialized;
 begin
   if (FInitialZone.position=0) then raise EAbstractMemBTree.Create(Format('%s initial position not initialized',[ClassName]));
@@ -218,26 +259,32 @@ begin
     if (((FrootPosition=0) and (FCount>0))) then raise EAbstractMemBTree.Create(Format('Invalid initial root %d vs count %d',[FrootPosition,FCount]));
   finally
   end;
+  //
+  {$IFDEF FPC}
+  //    Ref: 20211126-2  -- TODO
+  //    FPC (Tested on 3.2.0) does not allow use "CacheCompareBTree" for problems withs generics...
+  //    Nedd to deeply search why or to test on futures releases...
+  FBTreeCache := Nil;
+  {$ELSE}
+  FBTreeCache :=  TAVLABTreeCache.Create(100000,CacheCompareBTree);
+  {$ENDIF}
 end;
 
 destructor TAbstractMemBTree.Destroy;
 begin
   //
+  FreeAndNil(FBTreeCache);
   inherited;
 end;
 
-procedure TAbstractMemBTree.DisposeData(var AData: TAbstractMemPosition);
-begin
-  inherited;
-  // Will be called on EraseTreeEx
-  FAbstractMem.Dispose(AData);
-end;
-
 procedure TAbstractMemBTree.DisposeNode(var ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
 var LOld : TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
   LChildsCount : Integer;
   LChildsPosition : TAbstractMemPosition;
 begin
+  if Assigned(FBTreeCache) then begin
+    FBTreeCache.Remove(ANode);
+  end;
   LoadNodeHeader(ANode.identify,LOld,LChildsCount,LChildsPosition);
   FAbstractMem.Dispose( ANode.identify );
   ClearNode(ANode);
@@ -252,11 +299,20 @@ function TAbstractMemBTree.GetNode(AIdentify: TAbstractMemPosition): TAbstractBT
 var LBuff : TBytes;
   i, LChildsCount : Integer;
   LChildsPosition : TAbstractMemPosition;
+  LSearch,LFound : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
 begin
+  if Assigned(FBTreeCache) then begin
+    LSearch.identify := AIdentify;
+    if FBTreeCache.Find(LSearch,LFound) then begin
+      Result := LFound;
+      Exit;
+    end;
+  end;
   LoadNodeHeader(AIdentify,Result,LChildsCount,LChildsPosition);
   if LChildsCount>0 then begin
     SetLength(Result.childs,LChildsCount);
-    SetLength(LBuff,(LChildsCount*FAbstractMem.SizeOfAbstractMemPosition));
+    if (LChildsCount>MaxChildrenPerNode) then raise EAbstractMemBTree.Create(Format('Childrens in node %d out of range [0..%d]',[LChildsCount,MaxChildrenPerNode]));
+    SetLength(LBuff,(MaxChildrenPerNode*FAbstractMem.SizeOfAbstractMemPosition));
     FAbstractMem.Read(LChildsPosition,LBuff[0],Length(LBuff));
     for i := 0 to LChildsCount-1 do begin
       Move(LBuff[i*FAbstractMem.SizeOfAbstractMemPosition],Result.childs[i],FAbstractMem.SizeOfAbstractMemPosition);
@@ -275,6 +331,9 @@ begin
     if ((LChildsCount<>0) and (LChildsCount<>(Result.Count+1))) then
       raise EAbstractMemBTree.Create(Format('Node childrens %d not %d+1 in range [%d..%d]',[LChildsCount,Result.Count,MinChildrenPerNode,MaxChildrenPerNode]));
   end;
+  if Assigned(FBTreeCache) then begin
+    FBTreeCache.Add(Result);
+  end;
 end;
 
 function TAbstractMemBTree.GetNodeHeaderSize: Integer;
@@ -371,6 +430,15 @@ begin
   Result := '0x'+AIdentify.ToHexString;
 end;
 
+function TAbstractMemBTree.OnGetCopyDataMethod(
+  const AData: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode): TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+begin
+  Result.identify := AData.identify;
+  Result.parent := AData.parent;
+  Result.data := Copy(AData.data);
+  Result.childs := Copy(AData.childs);
+end;
+
 procedure TAbstractMemBTree.SaveHeader;
 var LBuff : TBytes;
  i : Integer;
@@ -396,6 +464,9 @@ var LBuff : TBytes;
   LZone : TAMZone;
 begin
   CheckInitialized;
+  if Assigned(FBTreeCache) then begin
+    FBTreeCache.Remove(ANode);
+  end;
   if ((ANode.Count)>MaxItemsPerNode) or (Length(ANode.childs)>MaxChildrenPerNode) then begin
     // Protection against saving temporal Node info with extra datas or childs
     Exit;
@@ -424,6 +495,9 @@ begin
     end;
     FAbstractMem.Write(LChildsPosition,LBuff[0],LChildsCount*FAbstractMem.SizeOfAbstractMemPosition);
   end;
+  if Assigned(FBTreeCache) then begin
+    FBTreeCache.Add(ANode);
+  end;
 end;
 
 procedure TAbstractMemBTree.SaveNodeHeader(
@@ -471,7 +545,7 @@ end;
 
 procedure TAbstractMemBTreeDataAbstract<TBTreeData>.Add;
 begin
-  raise EAbstractMemBTree.Create('Invalid use of Abstract function '+ClassName+'.Delete');
+  raise EAbstractMemBTree.Create('Invalid use of Abstract function '+ClassName+'.Add');
 end;
 
 function TAbstractMemBTreeDataAbstract<TBTreeData>.AddInherited(
@@ -502,6 +576,11 @@ begin
   Result := Inherited Delete(AAbstractMemPosition);
 end;
 
+destructor TAbstractMemBTreeDataAbstract<TBTreeData>.Destroy;
+begin
+  inherited;
+end;
+
 function TAbstractMemBTreeDataAbstract<TBTreeData>.DoCompareData(const ALefTBTreeData,
   ARighTBTreeData: TAbstractMemPosition): Integer;
 var Ltmp : TBTreeData;
@@ -519,7 +598,7 @@ begin
         Exit;
       end;
       FRight_Pos := ARighTBTreeData;
-      FRight_Data := LoadData(ARighTBTreeData);
+      FRight_Data := GetData(ARighTBTreeData);
     end;
     Result := FOnCompareAbstractMemData(FSearchTarget,FRight_Data);
   end else begin
@@ -529,17 +608,17 @@ begin
         if (FLeft_Pos<>ARighTBTreeData) then begin
           // Left is not right, reload
           FLeft_Pos := ARighTBTreeData;
-          FLeft_Data := LoadData(ARighTBTreeData);
+          FLeft_Data := GetData(ARighTBTreeData);
         end;
         Result := FOnCompareAbstractMemData(FRight_Data,FLeft_Data);
         Exit;
       end;
       FLeft_Pos := ALefTBTreeData;
-      FLeft_Data := LoadData(ALefTBTreeData);
+      FLeft_Data := GetData(ALefTBTreeData);
     end;
     if (FRight_Pos=0) or (FRight_Pos<>ARighTBTreeData) then begin
       FRight_Pos := ARighTBTreeData;
-      FRight_data := LoadData(ARighTBTreeData);
+      FRight_data := GetData(ARighTBTreeData);
     end;
     Result := FOnCompareAbstractMemData(FLeft_data,FRight_data);
   end;
@@ -560,14 +639,14 @@ begin
 end;
 
 function TAbstractMemBTreeDataAbstract<TBTreeData>.FindData(const AData: TBTreeData;
-  out APosition: TAbstractMemPosition; var AFoundData : TBTreeData): Boolean;
+  out ADataEqualOrPrecessorFound : TAbstractMemPosition; var AFoundData : TBTreeData): Boolean;
 begin
-  if FindDataPos(AData,APosition) then begin
+  if FindDataPos(AData,ADataEqualOrPrecessorFound) then begin
     Result := True;
-    AFoundData := LoadData(APosition);
+    AFoundData := GetData(ADataEqualOrPrecessorFound);
   end else begin
-    if IsNil(APosition) then FindDataLowest(AFoundData)
-    else AFoundData := LoadData(APosition);
+    if IsNil(ADataEqualOrPrecessorFound) then FindDataLowest(AFoundData)
+    else AFoundData := GetData(ADataEqualOrPrecessorFound);
     Result := False;
   end;
 end;
@@ -579,25 +658,13 @@ begin
   Result := FindData(AData,LPos,AFoundData);
 end;
 
-function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataPos(
-  const AData: TBTreeData; out APosition: TAbstractMemPosition): Boolean;
-begin
-  FAbstractBTreeLock.Acquire;
-  try
-    FSearchTarget := AData;
-    Result := FindExt(1,APosition);
-  finally
-    FAbstractBTreeLock.Release;
-  end;
-end;
-
 function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataHighest(
   out AHighest: TBTreeData): Boolean;
 var Lpos : TAbstractMemPosition;
 begin
   if FindHighest(Lpos) then begin
     Result := True;
-    AHighest := LoadData(Lpos);
+    AHighest := GetData(Lpos);
   end else Result := False;
 end;
 
@@ -607,27 +674,49 @@ var Lpos : TAbstractMemPosition;
 begin
   if FindLowest(Lpos) then begin
     Result := True;
-    ALowest := LoadData(Lpos);
+    ALowest := GetData(Lpos);
   end else Result := False;
 end;
 
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataPos(
+  const AData: TBTreeData; out ADataEqualOrPrecessorFound : TAbstractMemPosition): Boolean;
+var LNode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+  iPos : Integer;
+begin
+  Result := FindDataPos(AData,ADataEqualOrPrecessorFound,LNode,iPos);
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataPos(
+  const AData: TBTreeData; out ADataEqualOrPrecessorFound: TAbstractMemPosition;
+  out ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+  out iPos: Integer): Boolean;
+begin
+  Lock;
+  try
+    FSearchTarget := AData;
+    Result := FindExt(1,ADataEqualOrPrecessorFound,ANode,iPos);
+  finally
+    Unlock;
+  end;
+end;
+
 function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataPrecessor(
   const AData: TBTreeData; var APrecessor: TBTreeData): Boolean;
 var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
   LiPosNode : Integer;
   Lpos : TAbstractMemPosition;
 begin
-  FAbstractBTreeLock.Acquire;
+  Lock;
   try
   FSearchTarget := AData;
   if inherited Find(1,Lnode,LiPosNode) then begin
     if FindPrecessor(Lnode.data[LiPosNode],Lpos) then begin
       Result := True;
-      APrecessor := LoadData(Lpos);
+      APrecessor := GetData(Lpos);
     end else Result := False;
   end else Result := False;
   finally
-    FAbstractBTreeLock.Release;
+    Unlock;
   end;
 end;
 
@@ -637,35 +726,47 @@ var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractB
   LiPosNode : Integer;
   Lpos : TAbstractMemPosition;
 begin
-  FAbstractBTreeLock.Acquire;
+  Lock;
   try
   FSearchTarget := AData;
   if inherited Find(1,Lnode,LiPosNode) then begin
     if FindSuccessor(Lnode.data[LiPosNode],Lpos) then begin
       Result := True;
-      ASuccessor := LoadData(Lpos);
+      ASuccessor := GetData(Lpos);
     end else Result := False;
   end else Result := False;
   finally
-    FAbstractBTreeLock.Release;
+    Unlock;
   end;
 end;
 
+function TAbstractMemBTreeDataAbstract<TBTreeData>.GetCopyOfData(const AData: TBTreeData): TBTreeData;
+begin
+  Result := AData;
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.GetData(const APosition: TAbstractMemPosition): TBTreeData;
+begin
+  Result := GetCopyOfData(LoadData(APosition));
+end;
+
 { TAbstractMemBTreeData<TBTreeData> }
 
 function TAbstractMemBTreeData<TBTreeData>.AddData(const AData: TBTreeData): Boolean;
-var Lzone, LindexZone : TAMZone;
+var Lzone : TAMZone;
   i : Integer;
   LIndexPosition : TAbstractMemPosition;
   LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+  LCache : TAVLABTreeDataCacheData;
 begin
-  // Check in indexes
+  Lock;
+  Try
   Result := True;
   i := 0;
   while (Result) and (i<FIndexes.Count) do begin
     LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
     if (Not LBTreeIndex.AllowDuplicates) then begin
-      Result :=  Not (LBTreeIndex.FindDataPos(AData,LIndexPosition));
+      Result := Not LBTreeIndex.FindDataPos(AData,LIndexPosition);
     end;
     inc(i);
   end;
@@ -675,21 +776,40 @@ begin
       Result := AddInherited(Lzone.position);
       if Result then begin
         for i := 0 to FIndexes.Count-1 do begin
-          LindexZone := FAbstractMem.New(FAbstractMem.SizeOfAbstractMemPosition);
-          FAbstractMem.Write(LindexZone.position,Lzone.position,FAbstractMem.SizeOfAbstractMemPosition);
           LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
-          if Not LBTreeIndex.AddInherited(LindexZone.position) then
-            raise EAbstractMemBTree.Create(Format('Fatal error adding index %d/%d with data at %s and %s',
-              [i+1,FIndexes.Count,Lzone.ToString,LindexZone.ToString]));
+          Try
+            LBTreeIndex.FCompareModeInsertingOrDeleting := True;
+            if Not LBTreeIndex.AddInherited(LZone.position) then begin
+              raise EAbstractMemBTree.Create(Format('Fatal error adding index %d/%d with data at %s',
+                [i+1,FIndexes.Count,Lzone.ToString]));
+            end;
+          Finally
+            LBTreeIndex.FCompareModeInsertingOrDeleting := False;
+          End;
         end;
       end;
     Finally
       if Not Result then begin
         // Dispose
         FAbstractMem.Dispose(Lzone);
+        If Assigned(FBTreeDataCache) then begin
+          LCache.position := Lzone.position;
+          FBTreeDataCache.Remove(LCache);
+        end;
       end;
     End;
   end;
+  Finally
+    Unlock;
+  End;
+end;
+
+function TAbstractMemBTreeData<TBTreeData>.CacheCompareBTreeData(
+  const ALeft, ARight: TAVLCache<TAVLABTreeDataCacheData>.PAVLCacheMemData): Integer;
+begin
+  if ALeft.data.position<ARight.data.position then Result := -1
+  else if ALeft.data.position>ARight.data.position then Result := 1
+  else Result := 0;
 end;
 
 function TAbstractMemBTreeData<TBTreeData>.CanAddData(
@@ -714,13 +834,29 @@ begin
 end;
 
 procedure TAbstractMemBTreeData<TBTreeData>.CheckConsistency;
-var i : Integer;
+var i, nCount : Integer;
  LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+ LSearch,LFound : TBTreeData;
 begin
   inherited;
+  nCount := 0;
+  if FindDataLowest(LFound) then begin
+    inc(nCount);
+    for i := 0 to FIndexes.Count-1 do begin
+      LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+      if Not LBTreeIndex.FindData(LFound,LSearch) then raise EAbstractMemBTree.Create(Format('Consistency error data %d not found on index %d/%d',[nCount, i+1,FIndexes.Count]));
+    end;
+    while FindDataSuccessor(LSearch,LFound) do begin
+      inc(nCount);
+      for i := 0 to FIndexes.Count-1 do begin
+        LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+        if Not LBTreeIndex.FindData(LFound,LSearch) then raise EAbstractMemBTree.Create(Format('Consistency error data %d not found on index %d/%d',[nCount, i+1,FIndexes.Count]));
+      end;
+    end;
+  end;
   for i := 0 to FIndexes.Count-1 do begin
     LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
-    if (LBTreeIndex.Count <> Self.Count) then raise EAbstractMemBTree.Create(Format('Consistency error on index %d/%d count %d vs %d',[i+1,FIndexes.Count,LBTreeIndex.Count,Self.Count]));
+    if (LBTreeIndex.Count > Self.Count) then raise EAbstractMemBTree.Create(Format('Consistency error on index %d/%d count %d > %d',[i+1,FIndexes.Count,LBTreeIndex.Count,Self.Count]));
     LBTreeIndex.CheckConsistency;
   end;
 end;
@@ -735,20 +871,40 @@ begin
   FIndexes := TList< TAbstractMemBTreeDataIndex<TBTreeData> >.Create;
   {$ENDIF}
   inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder,AOnCompareAbstractMemDataMethod);
+  {$IFDEF FPC}
+  //    Ref: 20211126-1  -- TODO
+  //    FPC (Tested on 3.2.0) does not allow use "CacheCompareBTreeData" for problems withs generics...
+  //    Nedd to deeply search why or to test on futures releases...
+  FBTreeDataCache := Nil;
+  {$ELSE}
+  FBTreeDataCache :=  TAVLABTreeDataCache.Create(100000,CacheCompareBTreeData);
+  {$ENDIF}
 end;
 
 function TAbstractMemBTreeData<TBTreeData>.DeleteData(const AData: TBTreeData): Boolean;
 var LAbstractMemPos, LindexPosition : TAbstractMemPosition;
   i : Integer;
   LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+  LCache : TAVLABTreeDataCacheData;
 begin
+  Lock;
+  Try
   if FindDataPos(AData,LAbstractMemPos) then begin
     // Delete from indexes
     for i := 0 to FIndexes.Count-1 do begin
       LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
-      if Not LBTreeIndex.FindDataPos(AData,LindexPosition) then raise EAbstractMemBTree.Create(Format('Fatal error Data not found in index %d/%d to Delete from pos %s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString]));
-      if not LBTreeIndex.DeleteInherited(LindexPosition) then raise EAbstractMemBTree.Create(Format('Fatal error Data not deleted in index %d/%d from pos %s at pos %s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString,LindexPosition.ToHexString]));
-      FAbstractMem.Dispose(LindexPosition);
+      try
+        LBTreeIndex.FCompareModeInsertingOrDeleting := True;
+        if Not LBTreeIndex.FindExt(LAbstractMemPos,LIndexPosition) then begin
+          // Fatal error. Not found
+          raise EAbstractMemBTree.Create(Format('Fatal error Data not found in index %d/%d to Delete from pos 0x%s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString]));
+        end;
+        if not LBTreeIndex.DeleteInherited(LindexPosition) then begin
+          raise EAbstractMemBTree.Create(Format('Fatal error Data not deleted in index %d/%d from pos 0x%s at pos 0x%s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString,LindexPosition.ToHexString]));
+        end;
+      finally
+        LBTreeIndex.FCompareModeInsertingOrDeleting := False;
+      end;
     end;
     //
     DeleteInherited(LAbstractMemPos);
@@ -757,8 +913,16 @@ begin
     if FLeft_Pos=LAbstractMemPos then FLeft_Pos := 0;
     if FRight_Pos=LAbstractMemPos then FRight_Pos := 0;
     //
+    If Assigned(FBTreeDataCache) then begin
+      LCache.position := LAbstractMemPos;
+      FBTreeDataCache.Remove(LCache);
+    end;
+    //
     DeletedData(AData);
-  end else Result := False;
+  End else Result := False;
+  Finally
+    Unlock;
+  End;
 end;
 
 procedure TAbstractMemBTreeData<TBTreeData>.DeletedData(
@@ -776,9 +940,36 @@ begin
     LBTreeIndex.FIndexed := Nil;
   end;
   FreeAndNil(Findexes);
+  FreeAndNil(FBTreeDataCache);
   inherited;
 end;
 
+procedure TAbstractMemBTreeData<TBTreeData>.DisposeData(
+  var AData: TAbstractMemPosition);
+begin
+  inherited;
+  // Will be called on EraseTreeEx
+  FAbstractMem.Dispose(AData);
+end;
+
+function TAbstractMemBTreeData<TBTreeData>.GetData(
+  const APosition: TAbstractMemPosition): TBTreeData;
+var LSearch,LFound : TAVLABTreeDataCacheData;
+begin
+  if (Assigned(FBTreeDataCache)) then begin
+    LSearch.position := APosition;
+    if FBTreeDataCache.Find(LSearch,LFound) then begin
+      Result := GetCopyOfData( LFound.data );
+    end else begin
+      LSearch.data := LoadData(APosition);
+      FBTreeDataCache.Add(LSearch);
+      Result := GetCopyOfData( LSearch.data );
+    end;
+  end else begin
+    Result := inherited GetData(APosition);
+  end;
+end;
+
 {$IFDEF FPC}
 function TAbstractMemBTreeData<TBTreeData>.GetIndex(AIndex: Integer): TObject;
 begin
@@ -810,7 +1001,7 @@ begin
     while FindDataSuccessor(APreviousData,ACurrentData) do begin
       inc(nCount);
       i := FOnCompareAbstractMemData(APreviousData,ACurrentData);
-      if ((Not AllowDuplicates) and (i>=0)) or (i>0) then raise EAbstractMemBTree.Create(Format('Invalid consistency on Index comparing pos %d and %d result %d',[nCount-1,nCount,i]));
+      if ((Not AllowDuplicates) and (i>=0)) or (i>=0) then raise EAbstractMemBTree.Create(Format('Invalid consistency on Index comparing pos %d and %d result %d',[nCount-1,nCount,i]));
       APreviousData := ACurrentData;
     end;
   end;
@@ -824,8 +1015,9 @@ constructor TAbstractMemBTreeDataIndex<TBTreeData>.Create(
 begin
   FIndexed := AAbstractMemBTreeData;
   FIndexed.FIndexes.Add(Self);
-  inherited Create(FIndexed.FAbstractMem,AInitialZone,AAllowDuplicates,
-    AOrder,AOnCompareAbstractMemDataMethod)
+  FOnCompareAbstractMemData := AOnCompareAbstractMemDataMethod;
+  FCompareModeInsertingOrDeleting := False;
+  inherited Create(FIndexed.FAbstractMem,AInitialZone,AAllowDuplicates,AOrder,AOnCompareAbstractMemDataMethod);
 end;
 
 destructor TAbstractMemBTreeDataIndex<TBTreeData>.Destroy;
@@ -836,13 +1028,52 @@ begin
   inherited;
 end;
 
+function TAbstractMemBTreeDataIndex<TBTreeData>.DoCompareData(
+  const ALefTBTreeData, ARighTBTreeData: TAbstractMemPosition): Integer;
+begin
+  Result := inherited DoCompareData(ALeftBTreeData,ARightBTreeData);
+  if (FCompareModeInsertingOrDeleting) and (Result=0) then begin
+    if ALefTBTreeData<ARighTBTreeData then Result := -1
+    else if ALefTBTreeData>ARighTBTreeData then Result := 1
+    else Result := 0;
+  end;
+end;
+
 function TAbstractMemBTreeDataIndex<TBTreeData>.LoadData(const APosition: TAbstractMemPosition): TBTreeData;
-var LDataPosition : TAbstractMemPosition;
 begin
-  LDataPosition := 0;
-  if FAbstractMem.Read(APosition,LDataPosition,FAbstractMem.SizeOfAbstractMemPosition)<>FAbstractMem.SizeOfAbstractMemPosition then
-    raise EAbstractMemBTree.Create('Cannot load Data from Index at position '+APosition.ToHexString);
-  Result := FIndexed.LoadData(LDataPosition);
+  Result := FIndexed.GetData(APosition);
+end;
+
+procedure TAbstractMemBTreeDataIndex<TBTreeData>.Lock;
+begin
+  FIndexed.Lock;
+  Try
+    inherited;
+  Except
+    FIndexed.Unlock;
+    raise;
+  End;
+end;
+
+function TAbstractMemBTreeDataIndex<TBTreeData>.SaveData(const AData: TBTreeData): TAMZone;
+begin
+  // This is an index, never suposed to be called this function
+  raise EAbstractMemBTree.Create('ERROR DEV 20211130-01');
+end;
+
+procedure TAbstractMemBTreeDataIndex<TBTreeData>.Unlock;
+begin
+  inherited;
+  FIndexed.Unlock;
+end;
+
+{ TAbstractMemBTreeData<TBTreeData>.TAVLABTreeDataCache }
+
+function TAbstractMemBTreeData<TBTreeData>.TAVLABTreeDataCache.ToString(
+  const AData: TAVLABTreeDataCacheData): String;
+begin
+  inherited;
+  Result := Format('p:%d sizeof:%d',[AData.position,SizeOf(AData.data)]);
 end;
 
 initialization

src/libraries/abstractmem/UCacheMem.pas

@@ -106,11 +106,12 @@ type
     freememSize : Int64;
     freememBlocksCount : Int64;
     freememElaspedMillis : Int64;
-    maxUsedCacheSize : Integer;
-    reusedCacheMemDataCount : Integer;
-    reusedCacheMemDataBytes : Int64;
-    deletedBlocksReused : Integer;
-    deletedBlocksSaved : Integer;
+    needDataCallsCount : Integer;
+    needDataCallsBytes : Int64;
+    needDataCallsMillis : Int64;
+    saveDataCallsCount : Integer;
+    saveDataCallsBytes : Int64;
+    saveDataCallsMillis : Int64;
     deletedBlocksCount : Integer;
     procedure Clear;
     function ToString : String;
@@ -144,7 +145,8 @@ type
     procedure Delete(var APCacheMemData : PCacheMemData); overload;
     function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
     procedure CheckMaxMemUsage;
-    function LoadDataExt(var ABuffer; AStartPos : Int64; ASize : Integer) : Boolean;
+    function ForceCreatePCacheMemData(AStartPos : Int64; ASize : Integer; const ALoadIfDataNotFound : Boolean) : PCacheMemData;
+    function LoadDataExt(var ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
     procedure SaveToCacheExt(const ABuffer; ASize : Integer; AStartPos : Int64; AMarkAsPendingToSave : Boolean);
   public
     Constructor Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
@@ -427,6 +429,10 @@ begin
       if (PToCurrent^.pendingToSave) then begin
 
         if Not Assigned(FOnSaveDataProc) then Exit(False);
+        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+        Inc(FCacheMemStats.saveDataCallsCount);
+        Inc(FCacheMemStats.saveDataCallsBytes,PToCurrent^.GetSize);
+        {$ENDIF}
         if FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize)<>PToCurrent^.GetSize then begin
           Result := False;
           inc(LTotalBytesError,Int64(PToCurrent^.GetSize));
@@ -443,7 +449,8 @@ begin
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     Inc(FCacheMemStats.flushCount);
     Inc(FCacheMemStats.flushSize,LTotalBytesSaved);
-    Inc(FCacheMemStats.flushElapsedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
+    Inc(FCacheMemStats.flushElapsedMillis,Int64(TPlatform.GetElapsedMilliseconds(LTickCount)));
+    Inc(FCacheMemStats.saveDataCallsMillis,Int64(TPlatform.GetElapsedMilliseconds(LTickCount)));
     {$ENDIF}
   end;
   if (LTotalBytesError=0) and (Not Assigned(AFlushCacheList)) and (FPendingToSaveBytes<>0) then raise ECacheMem.Create(Format('Flush Inconsistency error Saved:%d Pending:%d',[LTotalBytesSaved,FPendingToSaveBytes]));
@@ -534,264 +541,265 @@ begin
 end;
 
 function TCacheMem.LoadData(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
-Var
-  LNewStartPos, LIndex, LLoadSize, LMoveSize : Int64;
-  Lpc : PByte;
-  LData : TBytes;
 begin
-  if (FGridCache) And (FDefaultCacheDataBlocksSize>0) then begin
-    Result := True;
-    SetLength(LData,FDefaultCacheDataBlocksSize);
-    Lpc := @(ABuffer);
-    LNewStartPos := (((AStartPos-1) DIV FDefaultCacheDataBlocksSize) + 0 ) * FDefaultCacheDataBlocksSize;
-    LIndex := AStartPos - LNewStartPos;
-    while (LNewStartPos < (AStartPos + ASize)) and (Result) do begin
-      if (LNewStartPos + FDefaultCacheDataBlocksSize) > (AStartPos + ASize) then begin
-        LLoadSize := (AStartPos + ASize) - LNewStartPos;
-      end else begin
-        LLoadSize := FDefaultCacheDataBlocksSize;
-      end;
-      LMoveSize := LLoadSize-LIndex;
-      Result := LoadDataExt(LData[0],LNewStartPos,LLoadSize);
-      Move(LData[LIndex],Lpc^,LMoveSize);
-      LIndex := 0;
-      inc(LNewStartPos,FDefaultCacheDataBlocksSize);
-      inc(Lpc,LMoveSize);
-    end;
-  end else begin
-    Result := LoadDataExt(ABuffer,AStartPos,ASize);
-  end;
+  Result := LoadDataExt(ABuffer,AStartPos,ASize) = ASize;
 end;
 
-function TCacheMem.LoadDataExt(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
-  // Will return a Pointer to AStartPos
-
-  function _CaptureDataFromOnNeedDataProc(ACapturePosStart : Int64; ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
+function TCacheMem.ForceCreatePCacheMemData(AStartPos : Int64; ASize : Integer; const ALoadIfDataNotFound : Boolean) : PCacheMemData;
+  function CreateFromOnNeedDataProc(ACapturePosStart : Int64; ACaptureSize : Integer; out ANewPCacheMemData : PCacheMemData) : Boolean;
   {$IFDEF ABSTRACTMEM_TESTING_MODE}var i : integer;{$ENDIF}
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}var LTC : TTickCount;{$ENDIF}
+  var LCapturedSize : Integer;
   begin
-    SetLength(ACapturedData,ACaptureSize);
-    if Not Assigned(FOnNeedDataProc) then begin
-      ACapturedSize := ACaptureSize;
-      FillChar(ACapturedData[0],Length(ACapturedData),0);
-      {$IFDEF ABSTRACTMEM_TESTING_MODE}
-      // TESTING PURPOSE TESTING ONLY
-      for i := 0 to High(ACapturedData) do begin
-        ACapturedData[i] := Byte(ACapturePosStart + i);
-      end;
-      // END TESTING PURPOSE
-      {$ENDIF}
-      Exit(False);
+    New(ANewPCacheMemData);
+    Try
+      ANewPCacheMemData.Clear;
+      ANewPCacheMemData.startPos := ACapturePosStart;
+      SetLength(ANewPCacheMemData.buffer,ACaptureSize);
+      ANewPCacheMemData.pendingToSave := False;
+      // Check if needs to be loaded based on ALoadIfDataNotFound and also
+      // if Position is a chunk BEFORE of AFTER the chunk searching for
+      // that we can know using AStartPos vs ACapturePosStart
+      // and ASize vs ACaptureSize
+      if (ALoadIfDataNotFound)
+         or (ACapturePosStart < AStartPos) // BEFORE
+         or (AStartPos+ASize  < ACapturePosStart + ACaptureSize) // AFTER
+      then begin
+        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+        Inc(Self.FCacheMemStats.needDataCallsCount);
+        inc(Self.FCacheMemStats.needDataCallsBytes,ACaptureSize);
+        LTC := TPlatform.GetTickCount;
+        {$ENDIF}
+        if Not Assigned(FOnNeedDataProc) then begin
+          FillChar(ANewPCacheMemData.buffer[0],Length(ANewPCacheMemData.buffer),0);
+          {$IFDEF ABSTRACTMEM_TESTING_MODE}
+          // TESTING PURPOSE TESTING ONLY
+          for i := 0 to High(ACapturedData) do begin
+            ACapturedData[i] := Byte(ACapturePosStart + i);
+          end;
+          // END TESTING PURPOSE
+          {$ENDIF}
+          Result := False;
+        end else begin
+          LCapturedSize := FOnNeedDataProc(ANewPCacheMemData.buffer[0],ACapturePosStart,ACaptureSize);
+          if LCapturedSize<ACaptureSize then begin
+            SetLength(ANewPCacheMemData.buffer,LCapturedSize);
+            Result := False;
+          end else begin
+            Result := True;
+          end;
+        end;
+        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+        Inc(Self.FCacheMemStats.needDataCallsMillis,Int64(TPlatform.GetElapsedMilliseconds(LTC)));
+        {$ENDIF}
+      end else Result := True;
+    Except
+      ANewPCacheMemData.Clear;
+      Dispose(ANewPCacheMemData);
+      ANewPCacheMemData := Nil;
+      raise;
+    End;
+    if (ANewPCacheMemData.GetSize>0) then  begin
+      // Save new
+      if Not FCacheData.Add( ANewPCacheMemData ) then raise ECacheMem.Create(Format('Inconsistent ForceLoadData CacheData duplicate for %s',[ANewPCacheMemData^.ToString]));
+      Inc(FCacheDataSize,Int64(ANewPCacheMemData.GetSize));
+      Inc(FCacheDataBlocks);
+    end else begin
+      ANewPCacheMemData.Clear;
+      Dispose(ANewPCacheMemData);
+      ANewPCacheMemData := Nil;
+      Result := False;
     end;
-    ACapturedSize := FOnNeedDataProc(ACapturedData[0],ACapturePosStart,ACaptureSize);
-    Result :=  ACapturedSize = ACaptureSize;
   end;
 
+  function GetNewPCacheMemData(ACapturePosStart : Int64; ACaptureSize : Integer; ARightPCacheMemData : PCacheMemData; out ANewPCacheMemData : PCacheMemData) : Boolean;
+  var LNewP : PCacheMemData;
+    LChunkSize : Integer;
+  begin
+    ANewPCacheMemData := Nil;
+    repeat
+      if (FDefaultCacheDataBlocksSize>0) then begin
+        if FGridCache then begin
+          // Small chunks
+          LChunkSize := FDefaultCacheDataBlocksSize - ((ACapturePosStart) MOD FDefaultCacheDataBlocksSize);
+        end else begin
+          //
+          LChunkSize := FDefaultCacheDataBlocksSize;
+        end;
+      end else begin
+        // Single chunk
+        LChunkSize := ACaptureSize;
+      end;
+
+      if (Assigned(ARightPCacheMemData)) and (ACapturePosStart + Int64(LChunkSize) >= ARightPCacheMemData.startPos) then begin
+        LChunkSize := Int64(Int64(ARightPCacheMemData.startPos) - Int64(ACapturePosStart))
+      end;
+
+      Result := CreateFromOnNeedDataProc(ACapturePosStart,LChunkSize,LNewP);
+      if ANewPCacheMemData=Nil then ANewPCacheMemData := LNewP; // First one
+      if (Assigned(LNewP)) then begin
+        Dec(ACaptureSize,LNewP.GetSize);
+        Inc(ACapturePosStart,LNewP.GetSize);
+      end else begin
+        // No PCacheMemData available...
+      end;
+    until (Not Result) or (ACaptureSize<=0) or
+      ( (Assigned(ARightPCacheMemData)) and (Assigned(LNewP)) and (ARightPCacheMemData.startPos <= (LNewP.GetEndPos+1)) ) ;
+    //
+    if (Not Result) and (Assigned(LNewP)) and (LNewP.GetEndPos>=(ACapturePosStart + ACaptureSize)) then Result := True;
+  end;
 
 var
-  LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Int64;
+  PCurrent, PRight : PCacheMemData;
+  LNewStartPos, LPendingSize : Int64;
+  LLastAddedPosition, LBytesCount, LSizeToStore, LSizeOfChunk, LOffset : Int64;
   LTempData : TBytes;
-  LTempCapturedSize : Integer;
-  LTmpResult : Boolean;
+  LTempCapturedSize, nLoop : Integer;
+  LContinue : Boolean;
 begin
+  Result := Nil;
+  PRight := Nil;
   if ASize<0 then raise ECacheMem.Create(Format('Invalid load size %d',[ASize]));
-  if ASize=0 then Exit(True);
+  if ASize=0 then Exit(0);
 
-  if (FDefaultCacheDataBlocksSize>0) then begin
-    LNewStartPos := (((AStartPos) DIV FDefaultCacheDataBlocksSize)) * FDefaultCacheDataBlocksSize;
-    LSizeToStore := (((ASize-1) DIV FDefaultCacheDataBlocksSize) + 1 ) * FDefaultCacheDataBlocksSize;
-    if (LNewStartPos + LSizeToStore) < (AStartPos + ASize) then begin
-      inc(LSizeToStore, FDefaultCacheDataBlocksSize);
-    end;
-  end else begin
-    LSizeToStore := ASize;
-    LNewStartPos := AStartPos;
-  end;
-
-  if (FindCacheMemDataByPosition(LNewStartPos,PCurrent)) then begin
+  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
     if (PCurrent^.GetEndPos >= (AStartPos + ASize -1)) then begin
       // PCurrent has all needed info
-      Move(PCurrent^.buffer[ AStartPos-PCurrent^.startPos ],ABuffer,ASize);
-      PCurrent^.MarkAsUsed(Self,PCurrent);
-      Result := True;
-      {$IFDEF ABSTRACTMEM_ENABLE_STATS}
-      inc(FCacheMemStats.reusedCacheMemDataCount);
-      inc(FCacheMemStats.reusedCacheMemDataBytes,ASize);
-      {$ENDIF}
+      Result := PCurrent;
       Exit;
     end;
   end else if Not Assigned(PCurrent) then begin
-    PCurrent := FCacheData.FindLowest;
+    PRight := FCacheData.FindLowest;
+    if Assigned(PRight) and (PRight.startPos<=AStartPos) then raise ECacheMem.Create('ERROR DEV 20211202-01');
   end;
 
-  // Will need to create a new "linar struct" because not found a linear struct previously
-  New( LNewP );
-  try
-    LNewP.Clear;
-    LNewP.startPos := LNewStartPos;
-    SetLength(LNewP^.buffer, LSizeToStore);
-
-    Result := True;
-
-    LLastAddedPosition := LNewP.startPos - 1;
-    while (Result) and (Assigned(PCurrent)) and ( (LLastAddedPosition) < (LNewP^.GetEndPos) ) do begin
-      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor(PCurrent)
-      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
-      else begin
-        // PCurrent will be used:
-        //
-        if (PCurrent^.startPos <= LLastAddedPosition) then begin
-          // PCurrent start before, increase buffer and set startPos
-          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
-          LNewP.startPos := PCurrent^.startPos;
-          LLastAddedPosition := PCurrent^.startPos-1;
-        end else if (PCurrent^.startPos > LLastAddedPosition+1) then begin
-          // Need data "between"
-          LBytesCount := PCurrent^.startPos - (LLastAddedPosition+1);
-          LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData,LTempCapturedSize);
-          Result := Result and LTmpResult;
-          Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LTempCapturedSize);
-          inc(LLastAddedPosition,LBytesCount);
-        end;
-        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
-        // Add available data
-        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
-          // Will need to increase buffer size:
-          SetLength( LNewP^.buffer , LNewP^.GetSize + (PCurrent^.GetEndPos - LNewP^.GetEndPos));
-        end;
-        LBytesCount := PCurrent^.GetEndPos - LLastAddedPosition;
-        Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
-        inc(LLastAddedPosition,LBytesCount);
 
-        // Has been used, delete
-        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
-        PToDelete := PCurrent;
-        PCurrent := FCacheData.FindSuccessor(PCurrent);
-        Delete( PToDelete );
-        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
-        inc(FCacheMemStats.deletedBlocksReused);
-        {$ENDIF}
+  if (FDefaultCacheDataBlocksSize>0) and (FGridCache) and (Not Assigned(PCurrent)) then begin
+    LNewStartPos := (((AStartPos) DIV FDefaultCacheDataBlocksSize)) * FDefaultCacheDataBlocksSize;
+  end else LNewStartPos := AStartPos;
+  LPendingSize := ASize;
+
+  while Assigned(PCurrent) And (PCurrent.GetEndPos < LNewStartPos) do PCurrent := FCacheData.FindSuccessor(PCurrent);
+  if Assigned(PCurrent) And (PCurrent.startPos>LNewStartPos) then begin
+    // PCurrent = PRight
+    if (Assigned(PRight) and (PCurrent<>PRight)) then raise ECacheMem.Create('ERROR DEV 20211202-02');
+    PRight := PCurrent;
+    PCurrent := Nil;
+  end;
+  // Pre: PCurrent = NIL or PCurrent.GetEndPos>=AStartPos
+  Result := PCurrent;
+
+  LContinue := True;
+  nLoop:=0;
+  repeat
+    inc(nLoop);
+    if Not Assigned(PCurrent) then begin
+      if nLoop=1 then begin
+        LContinue := GetNewPCacheMemData(LNewStartPos,LPendingSize + (AStartPos - LNewStartPos),PRight,PCurrent);
+      end else begin
+        LContinue := GetNewPCacheMemData(LNewStartPos,LPendingSize,PRight,PCurrent);
       end;
-    end;
-    if (Result) and ((LLastAddedPosition) < (LNewP^.GetEndPos)) then begin
-      // That means there is no data available at cache
-      LBytesCount := LNewP^.GetSize - (LLastAddedPosition - LNewP^.startPos +1);
-      LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData,LTempCapturedSize);
-      if (Not LTmpResult) then begin
-        if (LLastAddedPosition+1 + LTempCapturedSize) < (AStartPos + ASize) then begin
-          // Not enough data
-          Result := Result and LTmpResult;
-        end else begin
-          SetLength(LNewP^.buffer, (LLastAddedPosition+1) - LNewP^.startPos + LTempCapturedSize );
-        end;
+      //
+      if (Not Assigned(PCurrent)) then begin
+        Exit;
       end;
-      Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LTempCapturedSize);
     end;
-  Except
-    on E:Exception do begin
-      LNewP.Clear;
-      Dispose(LNewP);
-      Raise;
+    if Not Assigned(Result) then Result := PCurrent; // This was the first block
+
+    Dec(LPendingSize,PCurrent.GetSize - (LNewStartPos - PCurrent.startPos));
+
+    LNewStartPos := PCurrent.GetEndPos + 1;
+
+    if (LContinue) And (LPendingSize>0) then begin
+      if Assigned(PRight) and (PRight.startPos = LNewStartPos) then begin
+        PCurrent := PRight;
+        PRight := FCacheData.FindSuccessor(PCurrent);
+      end else begin
+        PCurrent := FCacheData.FindSuccessor(PCurrent);
+      end;
+
+      if Assigned(PCurrent) And (PCurrent.startPos>LNewStartPos) then begin
+        PRight := PCurrent;
+        PCurrent := Nil;
+      end;
     end;
-  end;
+  until (Not LContinue) or (LPendingSize<=0);
+end;
 
-  // Save new
-  LNewP^.MarkAsUsed(Self,LNewP);
-  if Not FCacheData.Add( LNewP ) then raise ECacheMem.Create(Format('Inconsistent LoadData CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
-  Inc(FCacheDataBlocks);
-  //
-  if (LNewP^.pendingToSave) then begin
-    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
+function TCacheMem.LoadDataExt(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
+var
+  PCurrent : PCacheMemData;
+  LNextStartPos, i64, LNextSize : Int64;
+  nBufferOffset : Int64;
+  PToBuffer : PByte;
+  nLoops : Integer;
+begin
+  Result := 0;
+
+  PToBuffer := @ABuffer;
+  PCurrent := ForceCreatePCacheMemData(AStartPos,ASize,True);
+  if Not Assigned(PCurrent) then begin
+    Exit;
   end;
+  // PCurrent
+  nLoops := 0;
+  LNextStartPos := AStartPos;
+  repeat
+    inc(nLoops);
 
-  Move(LNewP^.buffer[ AStartPos-LNewP^.startPos ],ABuffer,ASize);
+    nBufferOffset := (LNextStartPos - PCurrent.startPos);
+    LNextSize := PCurrent.GetSize - nBufferOffset;
+    if (LNextStartPos + LNextSize)>(AStartPos + ASize) then begin
+      LNextSize :=  (AStartPos + ASize) - LNextStartPos;
+    end;
 
+    Move(PCurrent.buffer[nBufferOffset],PToBuffer^,LNextSize);
+    PCurrent.MarkAsUsed(Self,PCurrent);
+    inc(Result,Integer(LNextSize));
+    inc(LNextStartPos,PCurrent.GetSize - nBufferOffset);
+    inc(PToBuffer,LNextSize);
+    if (PCurrent.GetEndPos<(AStartPos + Int64(ASize) -1)) then begin
+      PCurrent := FCacheData.FindSuccessor(PCurrent);
+    end else PCurrent := Nil; // End
+  until (Not Assigned(PCurrent));
   CheckMaxMemUsage;
 end;
 
 procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave : Boolean);
 var
-  LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount : Int64;
+  PCurrent : PCacheMemData;
+  LNextStartPos, i64, LNextSize : Int64;
+  nBufferOffset : Int64;
+  PToBuffer : PByte;
+  nLoops : Integer;
 begin
-  if ASize<0 then raise ECacheMem.Create(Format('Invalid save size %d',[ASize]));
-  if ASize=0 then Exit;
+  PToBuffer := @ABuffer;
+  PCurrent := ForceCreatePCacheMemData(AStartPos,ASize,False);
+  if Not Assigned(PCurrent) then raise ECacheMem.Create('ERROR DEV 20211208-01');
+  // PCurrent
+  nLoops := 0;
+  LNextStartPos := AStartPos;
+  repeat
+    inc(nLoops);
 
-  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
-    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
-      // PStart has all needed info
-      Move(ABuffer,PCurrent^.buffer[ AStartPos - PCurrent^.startPos ], ASize);
-      if (Not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
-        PCurrent^.pendingToSave := True;
-        FPendingToSaveBytes := FPendingToSaveBytes + Int64(PCurrent^.GetSize);
-      end;
-      PCurrent^.MarkAsUsed(Self,PCurrent);
-      Exit;
+    nBufferOffset := (LNextStartPos - PCurrent.startPos);
+    LNextSize := PCurrent.GetSize - nBufferOffset;
+    if (LNextStartPos + LNextSize)>(AStartPos + ASize) then begin
+      LNextSize :=  (AStartPos + ASize) - LNextStartPos;
     end;
-  end else if Not Assigned(PCurrent) then begin
-    PCurrent := FCacheData.FindLowest;
-  end;
 
-  // Will need to create a new "linar struct" because not found a linear struct previously
-  New( LNewP );
-  try
-    LNewP.Clear;
-    LNewP.startPos := AStartPos;
-    SetLength(LNewP^.buffer, ASize);
-    LNewP^.pendingToSave := AMarkAsPendingToSave;
-
-    LLastAddedPosition := LNewP.startPos - 1;
-    while (Assigned(PCurrent)) and ( (LLastAddedPosition+1) < (LNewP^.GetEndPos) ) do begin
-      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor( PCurrent )
-      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
-      else begin
-        // PCurrent will be used:
-        if (PCurrent^.startPos <= LLastAddedPosition) then begin
-          // PCurrent start before, increase buffer and set startPos
-          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
-          LNewP.startPos := PCurrent^.startPos;
-          Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ 0 ], (LLastAddedPosition - PCurrent^.startPos +1));
-        end;
-        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
-        // Add available data
-        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
-          // Will need to increase buffer size:
-          LBytesCount := (PCurrent^.GetEndPos - LNewP^.GetEndPos);
-          SetLength( LNewP^.buffer , LNewP^.GetSize + LBytesCount );
-          Move(PCurrent^.buffer[ PCurrent^.GetSize - LBytesCount ],LNewP^.buffer[ LNewP^.GetSize - LBytesCount ], LBytesCount);
-        end;
-
-        // Has been used, delete
-        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
-        PToDelete := PCurrent;
-        PCurrent := FCacheData.FindSuccessor(PCurrent);
-        Delete( PToDelete );
-        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
-        inc(FCacheMemStats.deletedBlocksSaved);
-        {$ENDIF}
-      end;
-    end;
-    // At this point LNewP^.buffer startPos <= AStartPos and LNewP^.buffer Size >= ASize
-    Move( ABuffer, LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], ASize );
-  Except
-    on E:Exception do begin
-      LNewP.Clear;
-      Dispose(LNewP);
-      Raise;
+    Move(PToBuffer^,PCurrent.buffer[nBufferOffset],LNextSize);
+    PCurrent.MarkAsUsed(Self,PCurrent);
+    if (not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
+      PCurrent^.pendingToSave := True;
+      FPendingToSaveBytes := FPendingToSaveBytes + Int64(PCurrent^.GetSize);
     end;
-  end;
-
-  // Save new
-  LNewP^.MarkAsUsed(Self,LNewP);
-  if Not FCacheData.Add(LNewP) then raise ECacheMem.Create(Format('Inconsistent SaveToCache CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
-  Inc(FCacheDataBlocks);
-  //
-  if (LNewP^.pendingToSave) then begin
-    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
-  end;
-
+    inc(LNextStartPos,PCurrent.GetSize - nBufferOffset);
+    inc(PToBuffer,LNextSize);
+    if (PCurrent.GetEndPos<(AStartPos + Int64(ASize) -1)) then begin
+      PCurrent := FCacheData.FindSuccessor(PCurrent);
+    end else PCurrent := Nil; // End
+  until (Not Assigned(PCurrent));
   CheckMaxMemUsage;
 end;
 
@@ -801,44 +809,8 @@ begin
 end;
 
 procedure TCacheMem.SaveToCache(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave: Boolean);
-Var
-  LNewStartPos, LSizeToStore : Int64;
-  Lpc : PByte;
-  LLeftBuff : TBytes;
 begin
-  if (FDefaultCacheDataBlocksSize>0) then begin
-    Lpc := @(ABuffer);
-
-    LNewStartPos := (((AStartPos) DIV FDefaultCacheDataBlocksSize)) * FDefaultCacheDataBlocksSize;
-    // Left chunk:
-    if (LNewStartPos < AStartPos) then begin
-      if LNewStartPos + FDefaultCacheDataBlocksSize <= AStartPos+ASize then LSizeToStore := FDefaultCacheDataBlocksSize
-      else LSizeToStore := (AStartPos+ASize) - (LNewStartPos);
-      SetLength(LLeftBuff,LSizeToStore);
-      LoadDataExt(LLeftBuff[0],LNewStartPos,AStartPos - LNewStartPos);
-      Move(Lpc^,LLeftBuff[ AStartPos - LNewStartPos ],LSizeToStore - (AStartPos - LNewStartPos));
-      SaveToCacheExt(LLeftBuff[0],LSizeToStore,LNewStartPos,AMarkAsPendingToSave);
-      inc(Lpc,LSizeToStore - (AStartPos - LNewStartPos));  // LSizeToStore);
-      inc(LNewStartPos,LSizeToStore);
-    end;
-
-    while (LNewStartPos < (AStartPos + ASize)) do begin
-      LSizeToStore := FDefaultCacheDataBlocksSize;
-      if (FGridCache) then begin
-      end else begin
-        while (LNewStartPos+LSizeToStore+FDefaultCacheDataBlocksSize) <= (AStartPos + ASize) do inc(LSizeToStore,FDefaultCacheDataBlocksSize);
-      end;
-      if (LNewStartPos + LSizeToStore) > (AStartPos + ASize) then begin
-        // Right chunk does not fit on block size
-        LSizeToStore := (AStartPos + ASize) - (LNewStartPos);
-      end;
-      SaveToCacheExt(Lpc^,LSizeToStore,LNewStartPos,AMarkAsPendingToSave);
-      inc(Lpc,LSizeToStore);
-      inc(LNewStartPos,LSizeToStore);
-    end;
-  end else begin
-    SaveToCacheExt(ABuffer,ASize,AStartPos,AMarkAsPendingToSave);
-  end;
+  SaveToCacheExt(ABuffer,ASize,AStartPos,AMarkAsPendingToSave);
 end;
 
 function TCacheMem.ToString: String;
@@ -1004,18 +976,21 @@ begin
   freememSize := 0;
   freememBlocksCount := 0;
   freememElaspedMillis := 0;
-  reusedCacheMemDataCount := 0;
-  reusedCacheMemDataBytes := 0;
-  deletedBlocksReused := 0;
-  deletedBlocksSaved := 0;
+  needDataCallsCount := 0;
+  needDataCallsBytes := 0;
+  needDataCallsMillis := 0;
+  saveDataCallsCount := 0;
+  saveDataCallsBytes := 0;
+  saveDataCallsMillis := 0;
   deletedBlocksCount := 0;
 end;
 
 function TCacheMemStats.ToString: String;
 begin
-  Result := Format('CacheMemStats Reused:%d (%d bytes) - Deleteds:%d (Saved:%d - reused:%d) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes %d blocks) %d millis',
-     [Self.reusedCacheMemDataCount,Self.reusedCacheMemDataBytes,
-      Self.deletedBlocksCount,Self.deletedBlocksSaved,Self.deletedBlocksReused,
+  Result := Format('CacheMemStats Reads:%d (%d bytes in %d millis) Writes:%d (%d bytes in %d millis) Deleteds:%d - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes %d blocks) %d millis',
+     [Self.needDataCallsCount, Self.needDataCallsBytes, Self.needDataCallsMillis,
+      Self.saveDataCallsCount, Self.saveDataCallsBytes, Self.saveDataCallsMillis,
+      Self.deletedBlocksCount,
       Self.flushCount,Self.flushSize,Self.flushElapsedMillis,
       Self.freememCount,Self.freememSize,Self.freememBlocksCount,
       Self.freememElaspedMillis]);

src/libraries/abstractmem/UFileMem.pas

@@ -67,14 +67,18 @@ type
     {$ENDIF}
     function OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
     function OnCacheSaveDataProc(const ABuffer; AStartPos : Int64; ASize: Integer): Integer;
-    procedure SetMaxCacheSize(const Value: Integer);
-    function GetMaxCacheSize: Integer;
-    function GetMaxCacheDataBlocks: Integer;
-    procedure SetMaxCacheDataBlocks(const Value: Integer);
+    procedure SetMaxCacheSize(const Value: Int64);
+    function GetMaxCacheSize: Int64;
+    function GetMaxCacheDataBlocks: Int64;
+    procedure SetMaxCacheDataBlocks(const Value: Int64);
     procedure CacheIsNOTStable; inline;
     function GetUseCache: Boolean;
     procedure SetUseCache(const Value: Boolean);
     procedure SetIncreaseFileBytes(const Value: Int64);
+    function GetGridCache: Boolean;
+    procedure SetDefaultCacheDataBlocksSize(const Value: Int64);
+    procedure SetGridCache(const Value: Boolean);
+    function GetDefaultCacheDataBlocksSize: Int64;
   protected
     function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
     function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
@@ -90,8 +94,11 @@ type
     // Warning: Accessing Cache is not Safe Thread protected, use LockCache/UnlockCache instead
     property Cache : TCacheMem read FCache;
     {$ENDIF}
-    property MaxCacheSize : Integer read GetMaxCacheSize write SetMaxCacheSize;
-    property MaxCacheDataBlocks : Integer read GetMaxCacheDataBlocks write SetMaxCacheDataBlocks;
+    procedure SetCachePerformance(AGridCache : Boolean; ADefaultCacheDataBlocksSize, AMaxCacheSize, AMaxCacheDataBlocks : Int64);
+    property GridCache : Boolean read GetGridCache write SetGridCache;
+    property DefaultCacheDataBlocksSize : Int64 read GetDefaultCacheDataBlocksSize write SetDefaultCacheDataBlocksSize;
+    property MaxCacheSize : Int64 read GetMaxCacheSize write SetMaxCacheSize;
+    property MaxCacheDataBlocks : Int64 read GetMaxCacheDataBlocks write SetMaxCacheDataBlocks;
     Function FlushCache : Boolean;
     //
     function LockCache : TCacheMem;
@@ -265,13 +272,25 @@ begin
   end;
 end;
 
-function TFileMem.GetMaxCacheDataBlocks: Integer;
+function TFileMem.GetDefaultCacheDataBlocksSize: Int64;
+begin
+  if Not Assigned(FCache) then Exit(0);
+  Result := FCache.DefaultCacheDataBlocksSize;
+end;
+
+function TFileMem.GetGridCache: Boolean;
+begin
+  if Not Assigned(FCache) then Exit(False);
+  Result := FCache.GridCache;
+end;
+
+function TFileMem.GetMaxCacheDataBlocks: Int64;
 begin
   if Not Assigned(FCache) then Exit(0);
   Result := FCache.MaxCacheDataBlocks;
 end;
 
-function TFileMem.GetMaxCacheSize: Integer;
+function TFileMem.GetMaxCacheSize: Int64;
 begin
   if Not Assigned(FCache) then Exit(0);
   Result := FCache.MaxCacheSize;
@@ -319,7 +338,11 @@ begin
 end;
 
 function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
+var LFileSize : Int64;
 begin
+  LFileSize := FFileStream.Size;
+  // Allowing Cache to ask for "out of range" data
+  if (LFileSize < (AStartPos + ASize)) then ASize := LFileSize-AStartPos;
   Result := inherited Read(AStartPos,ABuffer,ASize);
 end;
 
@@ -344,13 +367,40 @@ begin
   end;
 end;
 
+procedure TFileMem.SetCachePerformance(AGridCache: Boolean;
+  ADefaultCacheDataBlocksSize, AMaxCacheSize, AMaxCacheDataBlocks: Int64);
+begin
+  FLock.Acquire;
+  Try
+    UseCache := True;
+    FCache.GridCache := AGridCache;
+    FCache.DefaultCacheDataBlocksSize := ADefaultCacheDataBlocksSize;
+    FCache.MaxCacheSize := AMaxCacheSize;
+    FCache.MaxCacheDataBlocks := AMaxCacheDataBlocks;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TFileMem.SetDefaultCacheDataBlocksSize(const Value: Int64);
+begin
+  if Not Assigned(FCache) then Exit;
+  FCache.DefaultCacheDataBlocksSize := Value;
+end;
+
+procedure TFileMem.SetGridCache(const Value: Boolean);
+begin
+  if Not Assigned(FCache) then Exit;
+  FCache.GridCache := Value;
+end;
+
 procedure TFileMem.SetIncreaseFileBytes(const Value: Int64);
 begin
   if (Value<0) or (Value>(1024*1024*100)) then FIncreaseFileBytes := 0
   else FIncreaseFileBytes := Value;
 end;
 
-procedure TFileMem.SetMaxCacheDataBlocks(const Value: Integer);
+procedure TFileMem.SetMaxCacheDataBlocks(const Value: Int64);
 begin
   if Not Assigned(FCache) then Exit;
   FLock.Acquire;
@@ -361,7 +411,7 @@ begin
   End;
 end;
 
-procedure TFileMem.SetMaxCacheSize(const Value: Integer);
+procedure TFileMem.SetMaxCacheSize(const Value: Int64);
 begin
   if Not Assigned(FCache) then Exit;
   FLock.Acquire;

src/libraries/abstractmem/tests/src/UAbstractMemBTree.Tests.pas

@@ -21,7 +21,6 @@ type
    TAbstractMemBTreeExampleInteger = Class(TAbstractMemBTree)
    protected
      procedure DisposeData(var AData : TAbstractMemPosition); override;
-     function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
    public
      function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
    End;
@@ -30,6 +29,7 @@ type
    protected
      function LoadData(const APosition : TAbstractMemPosition) : String; override;
      function SaveData(const AData : String) : TAMZone; override;
+     function GetCopyOfData(Const AData : String) : String;  override;
    public
      function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
    End;
@@ -66,11 +66,6 @@ begin
   // NOTE: Nothing to do NEITHER to inherit from ancestor
 end;
 
-function TAbstractMemBTreeExampleInteger.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
-begin
-  Result := Integer( ALeftData - ARightData );
-end;
-
 function TAbstractMemBTreeExampleInteger.NodeDataToString(const AData: TAbstractMemPosition): String;
 begin
   Result := IntToStr(AData);
@@ -78,6 +73,11 @@ end;
 
 { TAbstractMemBTreeExampleString }
 
+function TAbstractMemBTreeExampleString.GetCopyOfData(const AData: String): String;
+begin
+  Result := Copy(AData,0,Length(AData));
+end;
+
 function TAbstractMemBTreeExampleString.LoadData(const APosition: TAbstractMemPosition): String;
 var i : Integer;
   wLength : Word;
@@ -184,6 +184,7 @@ var LOrder, LMemUnitsSize, LInitialRandSeed : Integer;
   L64Bits, LAllowDuplicates : Boolean;
   s64Bits, sAllowDuplicates : String;
 begin
+  RandSeed := 0;
   LInitialRandSeed := RandSeed;
   LOrder := 3;
   LMemUnitsSize := 4;
@@ -397,6 +398,28 @@ procedure TestTAbstractMemBTree.TestInfiniteExt(AMemUnitsSize, AOrder: Integer;
 var
   Lbt : TAbstractMemBTreeExampleString;
 
+  procedure AddN(ATotalRounds : Integer);
+  var nRounds, intValue : Integer;
+    LFound : String;
+  begin
+    nRounds := 0; intValue := 0;
+    repeat
+      inc(intValue);// := Random(AOrder * 100);
+      if (Lbt.AddData(intValue.ToString)) then inc(nRounds);
+      Lbt.CheckConsistency;
+    until (nRounds>=ATotalRounds);
+    try
+      if not Lbt.FindDataHighest(LFound) then exit;
+      repeat
+        if not Lbt.DeleteData(LFound) then raise Exception.Create('ERR 20211129-01');
+        dec(nRounds);
+        Lbt.CheckConsistency;
+      until Not Lbt.FindDataHighest(LFound) ;
+      Assert(nRounds=0,'No valid rounds values');
+    finally
+    end;
+  end;
+
   procedure ProcessTree(ATotalRounds : Integer);
   var LzoneIndex : TAMZone;
   j : TAbstractMemPosition;
@@ -436,7 +459,6 @@ var
         end;
       end;
       If Not Lbt.DeleteData(LCurr) then raise Exception.Create(Format('"%s" Not Found to delete! %d',[LCurr,Lbt.Count]));
-      Lbt.CheckConsistency;
     end;
     Lbt.CheckConsistency;
     // Try to re-use
@@ -488,13 +510,18 @@ begin
     try
       Lbt := TAbstractMemBTreeExampleString.Create(Lmem,LzoneData,AAllowDuplicates,AOrder,TComparison_String);
       try
+
         TAbstractMemBTreeDataIndex<String>.Create(Lbt,
           Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem)),False,
           AOrder+1,TComparison_SumChars);
         TAbstractMemBTreeDataIndex<String>.Create(Lbt,
           Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem)),True,
           AOrder+1,TComparison_HashCode);
+
         ProcessTree(AOrder * 1000);
+        //AddN(100);
+
+        Lbt.CheckConsistency;
       finally
         // Dispose indexes
         for i := Lbt.IndexesCount-1 downto 0 do begin

src/libraries/abstractmem/tests/src/UCacheMem.Tests.pas

@@ -5,7 +5,7 @@ unit UCacheMem.Tests;
 {$ENDIF}
 
 interface
- 
+
  uses
    SysUtils,
    {$IFDEF FPC}
@@ -29,7 +29,10 @@ interface
    public
      procedure SetUp; override;
      procedure TearDown; override;
+     procedure TestCacheMem_Randomly(ASeed : Integer; ARounds : Integer; AMaxCacheSize : Int64; AMaxCacheDataBlocks : Int64; ADefaultCacheDataBlocksSize : Int64; AGridCache : Boolean);
+     class function PosData(APosition : Int64) : Byte;
    published
+     procedure TestCacheMem_1;
      procedure TestCacheMem;
      procedure TestCacheMem_64bits;
    end;
@@ -43,8 +46,8 @@ begin
   else if ASize > Length(ABytes) then ASize := Length(ABytes);
 
   for i := 0 to ASize-1 do begin
-    if (ABytes[i] <> ((ALoadedStartPos+i+1) MOD 89)) then begin
-      raise {$IFDEF FPC}Exception{$ELSE}ETestFailure{$ENDIF}.Create(Format('Value at pos %d (item %d) should be %d instead of %d',[ALoadedStartPos+i,i,((ALoadedStartPos+i) MOD 89),ABytes[i]]));
+    if (ABytes[i] <> (PosData(ALoadedStartPos+i))) then begin
+      raise {$IFDEF FPC}Exception{$ELSE}ETestFailure{$ENDIF}.Create(Format('Value at pos %d (item %d) should be %d instead of %d',[ALoadedStartPos+i,i,PosData(ALoadedStartPos+i),ABytes[i]]));
     end;
 
   end;
@@ -56,7 +59,7 @@ var i : Integer;
 begin
   SetLength(FCurrentMem,ASize);
   for i :=0 to High(FCurrentMem) do begin
-    FCurrentMem[i] := ((i+1) MOD 89);
+    FCurrentMem[i] := PosData(i)
   end;
   FReadCount := 0;
   FSaveCount := 0;
@@ -113,6 +116,11 @@ begin
   Result := ASize;
 end;
 
+class function TestTCacheMem.PosData(APosition: Int64): Byte;
+begin
+  Result := 10+((APosition+1) MOD 89);
+end;
+
 procedure TestTCacheMem.SetUp;
 begin
   SetLength(FCurrentMem,0);
@@ -177,7 +185,7 @@ begin
     LCMem.GridCache := False;
     LCMem.SaveToCache(LBuff[2],5,2,True);
     LCMem.SaveToCache(LBuff[1],15,1,True);
-    CheckTrue( LCMem.CacheDataBlocks=3, Format('3 Cache blocks: %d',[LCMem.CacheDataBlocks]));
+    CheckTrue( LCMem.CacheDataBlocks=4, Format('3 Cache blocks: %d',[LCMem.CacheDataBlocks]));
     LCMem.Clear;
     LCMem.GridCache := True;
     LCMem.SaveToCache(LBuff[2],5,2,True);
@@ -203,6 +211,8 @@ begin
     LCMem.SaveToCache(LBuff[0], 2*LCMem.DefaultCacheDataBlocksSize , 2,True);
     CheckTrue( LCMem.CacheDataBlocks=3, '3 Cache blocks');
 
+    LCMem.ConsistencyCheck;
+
     CheckTrue( LCMem.LoadData(LBuff[0],1,98) );
     // Incremental round
     i := 1;
@@ -219,6 +229,15 @@ begin
   End;
 end;
 
+procedure TestTCacheMem.TestCacheMem_1;
+Var
+  iPos, nSize, nRounds, i : Integer;
+begin
+  TestCacheMem_Randomly(0,20000,1024*1024*100,5000,0,False);
+  TestCacheMem_Randomly(0,20000,1024*1024*100,5000,500,False);
+  TestCacheMem_Randomly(0,20000,1024*1024*100,5000,50,True);
+end;
+
 procedure TestTCacheMem.TestCacheMem_64bits;
 Var LCMem : TCacheMem;
   LBuff : TBytes;
@@ -260,6 +279,59 @@ begin
   End;
 end;
 
+procedure TestTCacheMem.TestCacheMem_Randomly(ASeed, ARounds: Integer;
+  AMaxCacheSize, AMaxCacheDataBlocks, ADefaultCacheDataBlocksSize: Int64;
+  AGridCache: Boolean);
+Var LCMem : TCacheMem;
+  LBuff : TBytes;
+  iPos, nSize, nRounds, i : Integer;
+begin
+  if ASeed>=0 then RandSeed := ASeed;
+
+  LCMem := TCacheMem.Create(OnNeedDataProc,OnSaveDataProc);
+  Try
+    LCMem.MaxCacheSize := AMaxCacheSize;
+    LCMem.MaxCacheDataBlocks := AMaxCacheDataBlocks;
+    LCMem.DefaultCacheDataBlocksSize := ADefaultCacheDataBlocksSize;
+    LCMem.GridCache := AGridCache;
+    //
+    InitCurrentMem(10000000);
+    SetLength(LBuff,Length(FCurrentMem));
+    nRounds := 0;
+    //
+    repeat
+      inc(nRounds);
+      iPos := Random(Length(FCurrentMem) - 1000);
+      nSize := Random( (Length(FCurrentMem)-iPos) DIV 100000 )+1;
+      if (Random(2)=0) then begin
+        Assert(LCMem.LoadData(LBuff[0],iPos,nSize),Format('(Round %d) Cannot load data ad Pos %d size %d',[nRounds,iPos,nSize]));
+        for i := 0 to nSize-1 do begin
+          Assert(LBuff[i]=PosData(i+iPos),Format('(Round %d) Pos data %d (%d + %d) is %d not %d',[nRounds,i+iPos,i,iPos,LBuff[i],PosData(i+iPos)]));
+          LBuff[i] := 0; // For future use
+        end;
+      end else begin
+        // SAVE DATA TEST
+        for i := 0 to nSize-1 do begin
+          LBuff[i]:=PosData(i+iPos);
+        end;
+        LCMem.SaveToCache(LBuff[0],nSize,iPos,Random(2)=0);
+
+        // CHECK this saved data
+        Assert(LCMem.LoadData(LBuff[0],iPos,nSize),Format('(Round %d) Cannot load saved data ad Pos %d size %d',[nRounds,iPos,nSize]));
+        for i := 0 to nSize-1 do begin
+          Assert(LBuff[i]=PosData(i+iPos),Format('(Round %d) Pos saved data %d (%d + %d) is %d not %d',[nRounds,i+iPos,i,iPos,LBuff[i],PosData(i+iPos)]));
+          LBuff[i] := 0; // For future use
+        end;
+      end;
+      // Check
+      if (Random(100)=0) then LCMem.ConsistencyCheck;
+    until (nRounds>ARounds);
+    LCMem.ConsistencyCheck;
+  Finally
+    LCMem.Free;
+  End;
+end;
+
 initialization
   RegisterTest(TestTCacheMem{$IFNDEF FPC}.Suite{$ENDIF});
 end.

src/libraries/abstractmem/tests/src/UFileMem.Tests.pas

@@ -174,7 +174,7 @@ begin
   Lfs := TStringList.Create;
   try
     Lfm.ClearContent(False,4);
-//    Lfm.UseCache := AUseCache;
+    Lfm.UseCache := AUseCache;
     if AUseCache then begin
       Lfm.MaxCacheSize := 1024 * 1024 * 2; // 2 Mb
       Lfm.MaxCacheDataBlocks := 10000; // 10 K