Merge pull request #40 from PascalCoinDev/master

Update PascalCoin with AbstractMemLib 1.2

CHANGELOG.md

@@ -1,9 +1,12 @@
 # Changelog
 
 ## Build 5.4 - (PENDING RELEASE)
-- Added "DATAFOLDER" configuration option at pascalcoin_daemon.ini file (daemon/service) in order to allow customize data folder
 - Added usage of AbstractMem library to allow build a PascalCoin version using virtual memory and efficient caching mechanism
   - Must activate {$DEFINE USE_ABSTRACTMEM} at config.inc file
+- Changes to `pascalcoin_daemon.ini` file:
+  - Added "DATAFOLDER" configuration option at pascalcoin_daemon.ini file (daemon/service) in order to allow customize data folder
+  - Added "ABSTRACTMEM_MAX_CACHE_MB" to customize Maximum megabytes in memory as a cache
+  - Added "ABSTRACTMEM_USE_CACHE_ON_LISTS","ABSTRACTMEM_CACHE_MAX_ACCOUNTS","ABSTRACTMEM_CACHE_MAX_PUBKEYS" in order to customize cache values
 - Improved performance when downloading Safebox (Fresh installation)
 - JSON-RPC changes:  
   - Updated "findaccounts": 

src/core/UAccounts.pas

@@ -320,6 +320,7 @@ Type
     procedure UpdateSafeboxFileName(const ANewSafeboxFileName : String);
     procedure ClearSafeboxfile;
     class Function CopyAbstractMemToSafeBoxStream(ASource : TPCAbstractMem; ADestStream : TStream; AFromBlock, AToBlock : Cardinal; var AErrors : String) : Boolean;
+    property PCAbstractMem : TPCAbstractMem read FPCAbstractMem;
     {$ENDIF}
   End;
 
@@ -3394,6 +3395,9 @@ begin
   tc := TPlatform.GetTickCount;
   StartThreadSafe;
   try
+    {$IFDEF USE_ABSTRACTMEM}
+    FPCAbstractMem.SavingNewSafeboxMode := True;
+    {$ENDIF}
     LStartTickCount := tc;
     // Read Header info
     If not LoadSafeBoxStreamHeader(Stream,sbHeader) then begin
@@ -3694,6 +3698,9 @@ begin
       if Not Result then Clear else errors := '';
     End;
   Finally
+    {$IFDEF USE_ABSTRACTMEM}
+    FPCAbstractMem.SavingNewSafeboxMode := False;
+    {$ENDIF}
     EndThreadSave;
   end;
   TLog.NewLog(ltdebug,ClassName,Format('Finalized read Safebox from blocks %d to %d (total %d blocks) in %.2f seconds',

src/core/UBaseTypes.pas

@@ -635,7 +635,7 @@ end;
 procedure TBytesBuffer.SetDefaultIncrement(AValue: Integer);
 begin
   if AValue<=0 then FDefaultIncrement:=1024
-  else if AValue>(1024*1024) then FDefaultIncrement := 1024*1024
+  else if AValue>(100*1024*1024) then FDefaultIncrement := (100*1024*1024)
   else FDefaultIncrement:=AValue;
 end;
 

src/core/UBlockChain.pas

@@ -1050,8 +1050,9 @@ begin
         TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
       end;
     end;
-
-
+    {$IFDEF USE_ABSTRACTMEM}
+    SafeBox.PCAbstractMem.FlushCache;
+    {$ENDIF}
   finally
     FBankLock.Release;
   end;
@@ -1249,12 +1250,20 @@ function TPCBank.LoadBankFromStream(Stream: TStream; useSecureLoad : Boolean; ch
 Var LastReadBlock : TBlockAccount;
   i : Integer;
   auxSB : TPCSafeBox;
+  Lucoaml : boolean;
+  Lmmu : Integer;
 begin
   auxSB := Nil;
   Try
     If useSecureLoad then begin
       // When on secure load will load Stream in a separate SafeBox, changing only real SafeBox if successfully
       auxSB := TPCSafeBox.Create;
+      {$IFDEF USE_ABSTRACTMEM}
+      Lucoaml := Self.SafeBox.PCAbstractMem.UseCacheOnAbstractMemLists;
+      Lmmu := Self.SafeBox.PCAbstractMem.MaxMemUsage;
+      auxSB.PCAbstractMem.UseCacheOnAbstractMemLists := False;
+      auxSB.PCAbstractMem.MaxMemUsage := 100 * 1024 * 1024; // 100 Mb
+      {$ENDIF}
       Result := auxSB.LoadSafeBoxFromStream(Stream,true,checkSafeboxHash,progressNotify,previousCheckedSafebox,LastReadBlock,errors);
       If Not Result then Exit;
     end;
@@ -1262,6 +1271,10 @@ begin
     try
       If Assigned(auxSB) then begin
         SafeBox.CopyFrom(auxSB);
+        {$IFDEF USE_ABSTRACTMEM}
+        Self.SafeBox.PCAbstractMem.UseCacheOnAbstractMemLists := Lucoaml;
+        Self.SafeBox.PCAbstractMem.MaxMemUsage := Lmmu;
+        {$ENDIF}
       end else begin
         Result := SafeBox.LoadSafeBoxFromStream(Stream,False,checkSafeboxHash,progressNotify,previousCheckedSafebox,LastReadBlock,errors);
       end;

src/core/UEPasa.pas

@@ -104,7 +104,7 @@ type
       function IsPayToKey: Boolean; inline;
       function GetRawPayloadBytes(): TArray<Byte>; inline;
       function ToString(): String; overload;
-      function ToString(AOmitExtendedChecksum: Boolean): String; reintroduce; overload;
+      function ToString(AOmitExtendedChecksum: Boolean): String; overload;
 
       property Account: TNullable<UInt32> read GetAccount write SetAccount;
       property AccountChecksum: TNullable<UInt32> read GetAccountChecksum write SetAccountChecksum;

src/core/UNetProtocol.pas

@@ -3038,6 +3038,10 @@ begin
         end;
         sleep(1);
       end;
+      {$IFDEF USE_ABSTRACTMEM}
+      TNode.Node.Bank.SafeBox.PCAbstractMem.FlushCache;
+      {$ENDIF}
+
       FIsDownloadingBlocks := false;
       if ((LOpCount>0) And (FRemoteOperationBlock.block>=TNode.Node.Bank.BlocksCount)) then begin
         Send_GetBlocks(TNode.Node.Bank.BlocksCount,100,c);

src/core/UNode.pas

@@ -258,6 +258,9 @@ begin
       // Does not need to save a FOperations backup because is Sanitized by "TNode.OnBankNewBlock"
       Result := Bank.AddNewBlockChainBlock(NewBlockOperations,TNetData.NetData.NetworkAdjustedTime.GetMaxAllowedTimestampForNewBlock,errors);
       if Result then begin
+        {$IFDEF USE_ABSTRACTMEM}
+        Bank.SafeBox.PCAbstractMem.FlushCache;
+        {$ENDIF}
         if Assigned(SenderConnection) then begin
           FNodeLog.NotifyNewLog(ltupdate,SenderConnection.ClassName,Format(';%d;%s;%s;;%d;%d;%d;%s',[OpBlock.block,sClientRemoteAddr,OpBlock.block_payload.ToPrintable,
             OpBlock.timestamp,UnivDateTimeToUnix(DateTime2UnivDateTime(Now)),UnivDateTimeToUnix(DateTime2UnivDateTime(Now)) - OpBlock.timestamp,IntToHex(OpBlock.compact_target,8)]));
@@ -932,7 +935,7 @@ procedure TNode.GetStoredOperationsFromAccount(AOwnerThread : TPCThread; const O
           last_block_number := block_number;
           l.Clear;
           If not Bank.Storage.LoadBlockChainBlock(opc,block_number) then begin
-            TLog.NewLog(ltdebug,ClassName,'Block '+inttostr(block_number)+' not found. Cannot read operations');
+            {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,'Block '+inttostr(block_number)+' not found. Cannot read operations');{$ENDIF}
             exit;
           end;
           opc.OperationsHashTree.GetOperationsAffectingAccount(account_number,l);

src/core/UPCAbstractMem.pas

@@ -7,7 +7,7 @@ interface
 {$ENDIF}
 
 uses Classes, SysUtils, SyncObjs,
-  UAbstractMem, UFileMem, UAbstractMemTList,
+  UAbstractMem, UFileMem, UAbstractMemTList, UCacheMem,
   UAbstractBTree, UThread,
   UAVLCache, ULog, UCrypto,
   UPCAbstractMemAccountKeys,
@@ -77,7 +77,7 @@ type
     FSaveBufferPosition : TAbstractMemPosition;
   protected
   public
-    Constructor Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer);
+    Constructor Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer); reintroduce;
     procedure Flush;
   end;
 
@@ -90,7 +90,7 @@ type
     procedure BCExecute; override;
   public
     Constructor Create(APCAbstractMem : TPCAbstractMem);
-    Destructor Destroy;
+    Destructor Destroy; override;
     procedure Restart;
     property Errors : TStrings read FErrors;
   End;
@@ -98,6 +98,13 @@ type
   TAccountCache = Class(TAVLCache<TAccount>)
   End;
 
+  TPCAbstractMemStats = Record
+    FlushesCount : Integer;
+    FlushesMillis : TTickCount;
+    function ToString : String;
+    procedure Clear;
+  end;
+
   TPCAbstractMem = class
   private
     FFileName : String;
@@ -105,6 +112,8 @@ type
     FCheckingThread : TPCAbstractMemCheckThread;
     FLockAbstractMem : TPCCriticalSection;
 
+    FStats : TPCAbstractMemStats;
+
     FBlocks: TPCAbstractMemListBlocks;
     FAccounts: TPCAbstractMemListAccounts;
     FAccountsNames: TPCAbstractMemListAccountNames;
@@ -113,6 +122,12 @@ type
     FBufferBlocksHash: TPCAbstractMemBytesBuffer32Safebox;
     FAggregatedHashrate : TBigNum;
     FZoneAggregatedHashrate : TAMZone;
+    FUseCacheOnAbstractMemLists: Boolean;
+    FMaxMemUsage: Integer;
+    FSavingNewSafeboxMode: Boolean;
+
+    FSavingOldGridCache : Boolean;
+    FSavingOldDefaultCacheDataBlocksSize : Integer;
 
     function IsChecking : Boolean;
     procedure DoCheck;
@@ -121,6 +136,13 @@ type
     procedure AddBlockInfo(const ABlock : TOperationBlockExt);
     procedure SetBlockInfo(const ABlock : TOperationBlockExt);
     function DoInit(out AIsNewStructure : Boolean) : Boolean;
+    procedure SetMaxMemUsage(const Value: Integer);
+    procedure SetUseCacheOnAbstractMemLists(const Value: Boolean);
+    procedure SetMaxAccountsCache(const Value: Integer);
+    function GetMaxAccountsCache: Integer;
+    function GetMaxAccountKeysCache: Integer;
+    procedure SetMaxAccountKeysCache(const Value: Integer);
+    procedure SetSavingNewSafeboxMode(const Value: Boolean);
   protected
     procedure UpgradeAbstractMemVersion(const ACurrentHeaderVersion : Integer);
   public
@@ -156,6 +178,13 @@ type
     property AccountCache : TAccountCache read FAccountCache;
     property FileName : String read FFileName;
     procedure EraseData;
+    function GetStatsReport(AClearStats : Boolean) : String;
+    //
+    Property UseCacheOnAbstractMemLists : Boolean read FUseCacheOnAbstractMemLists write SetUseCacheOnAbstractMemLists;
+    Property MaxMemUsage : Integer read FMaxMemUsage write SetMaxMemUsage;
+    Property MaxAccountsCache : Integer read GetMaxAccountsCache write SetMaxAccountsCache;
+    Property MaxAccountKeysCache : Integer read GetMaxAccountKeysCache write SetMaxAccountKeysCache;
+    Property SavingNewSafeboxMode : Boolean read FSavingNewSafeboxMode write SetSavingNewSafeboxMode;
   end;
 
 implementation
@@ -180,7 +209,7 @@ var LZone : TAMZone;
   LCachedSafeboxHash : TBytes;
 begin
   FCachedSafeboxHash := Nil;
-  inherited Create(1000*32);
+  inherited Create(100000*32);
   FAbstractMem := AAbstractMem;
   FSaveBufferPosition:=APosition;
   if (APosition>0) then begin
@@ -403,6 +432,8 @@ var LIsNew : Boolean;
 begin
   ASource.FlushCache;
   FAbstractMem.CopyFrom(ASource.FAbstractMem);
+  FUseCacheOnAbstractMemLists := ASource.FUseCacheOnAbstractMemLists;
+  FMaxMemUsage := ASource.FMaxMemUsage;
   DoInit(LIsNew);
 end;
 
@@ -514,13 +545,17 @@ begin
   // Free
   FreeAndNil(FBlocks);
   //
-  FBlocks := TPCAbstractMemListBlocks.Create( FAbstractMem, LZoneBlocks, 10000 );
+  FBlocks := TPCAbstractMemListBlocks.Create( FAbstractMem, LZoneBlocks, 20000, Self.UseCacheOnAbstractMemLists);
   FBlocks.FPCAbstractMem := Self;
-  FAccounts := TPCAbstractMemListAccounts.Create( FAbstractMem, LZoneAccounts, 50000);
+
+  FAccounts := TPCAbstractMemListAccounts.Create( FAbstractMem, LZoneAccounts, 100000, Self.UseCacheOnAbstractMemLists);
   FAccounts.FPCAbstractMem := Self;
-  FAccountsNames := TPCAbstractMemListAccountNames.Create( FAbstractMem, LZoneAccountsNames, 5000 , False);
+
+  FAccountsNames := TPCAbstractMemListAccountNames.Create( FAbstractMem, LZoneAccountsNames, 5000 , False, Self.UseCacheOnAbstractMemLists);
   FAccountsNames.FPCAbstractMem := Self;
-  FAccountKeys := TPCAbstractMemAccountKeys.Create( FAbstractMem, LZoneAccountKeys.position );
+
+  FAccountKeys := TPCAbstractMemAccountKeys.Create( FAbstractMem, LZoneAccountKeys.position, Self.UseCacheOnAbstractMemLists);
+
   // Read AggregatedHashrate
   SetLength(LBuffer,100);
   FAbstractMem.Read(FZoneAggregatedHashrate.position,LBuffer[0],Length(LBuffer));
@@ -554,19 +589,31 @@ constructor TPCAbstractMem.Create(const ASafeboxFileName: string; AReadOnly: boo
 var
   LIsNewStructure : Boolean;
 begin
+  FStats.Clear;
+
+  FUseCacheOnAbstractMemLists := False;
+  FMaxMemUsage := 100 * 1024 * 1024;
+
+  FBlocks := Nil;
+  FAccounts:= Nil;
+  FAccountsNames:= Nil;
+  FAccountKeys:= Nil;
+  FBufferBlocksHash:= Nil;
+
   FCheckingThread := Nil;
   FLockAbstractMem := TPCCriticalSection.Create(Self.ClassName);
   FAccountCache := TAccountCache.Create(10000,_AccountCache_Comparision);
+  FSavingNewSafeboxMode := False;
 
   FAggregatedHashrate := TBigNum.Create(0);
   FFileName := ASafeboxFileName;
-  if (FFileName<>'') {and (FileExists(ASafeboxFileName))} then begin
+  if (FFileName<>'') then begin
     FAbstractMem := TFileMem.Create( ASafeboxFileName , AReadOnly);
   end else begin
     FAbstractMem := TMem.Create(0,AReadOnly);
   end;
   if FAbstractMem is TFileMem then begin
-    TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
+    TFileMem(FAbstractMem).MaxCacheSize := FMaxMemUsage;
     TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
   end;
 
@@ -631,8 +678,10 @@ end;
 
 procedure TPCAbstractMem.FlushCache;
 var LBigNum : TBytes;
+  Ltc : TTickCount;
 begin
   if FAbstractMem.ReadOnly then Exit;
+  Ltc := TPlatform.GetTickCount;
   FBlocks.FlushCache;
   FAccounts.FlushCache;
   FAccountsNames.FlushCache;
@@ -643,6 +692,8 @@ begin
   if FAbstractMem is TFileMem then begin
     TFileMem(FAbstractMem).FlushCache;
   end;
+  Inc(FStats.FlushesCount);
+  Inc(Fstats.FlushesMillis, TPlatform.GetElapsedMilliseconds(Ltc) );
 end;
 
 Procedure DoCopyFile(const ASource, ADest : String);
@@ -773,6 +824,57 @@ begin
   end else raise EPCAbstractMem.Create(Format('Cannot set block info %d (current %d blocks)',[ABlock.operationBlock.block,LCount]));
 end;
 
+procedure TPCAbstractMem.SetMaxAccountKeysCache(const Value: Integer);
+begin
+  FAccountKeys.AccountKeyByPositionCache.MaxRegisters := Value;
+end;
+
+procedure TPCAbstractMem.SetMaxAccountsCache(const Value: Integer);
+begin
+  FAccountCache.MaxRegisters := Value;
+end;
+
+procedure TPCAbstractMem.SetMaxMemUsage(const Value: Integer);
+begin
+  FMaxMemUsage := Value;
+  if FAbstractMem is TFileMem then begin
+    TFileMem(FAbstractMem).MaxCacheSize := FMaxMemUsage;
+    TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
+  end;
+end;
+
+procedure TPCAbstractMem.SetSavingNewSafeboxMode(const Value: Boolean);
+var Lcm : TCacheMem;
+begin
+  FSavingNewSafeboxMode := Value;
+  // Will set in optimized state (cache and others) for maximum performance and minimum impact
+  TLog.NewLog(ltinfo,ClassName,Format('Seting AbstractMem is Saving mode:%s',[Value.ToString]));
+  if FAbstractMem is TFileMem then begin
+    Lcm := TFileMem(FAbstractMem).LockCache;
+    try
+      if Value then begin
+        FSavingOldGridCache := Lcm.GridCache;
+        FSavingOldDefaultCacheDataBlocksSize := Lcm.DefaultCacheDataBlocksSize;
+        Lcm.GridCache := False;
+        Lcm.DefaultCacheDataBlocksSize := -1;
+      end else begin
+        Lcm.GridCache := FSavingOldGridCache;
+        Lcm.DefaultCacheDataBlocksSize := FSavingOldDefaultCacheDataBlocksSize;
+      end;
+    finally
+      TFileMem(FAbstractMem).UnlockCache;
+    end;
+  end;
+end;
+
+procedure TPCAbstractMem.SetUseCacheOnAbstractMemLists(const Value: Boolean);
+var Lins : Boolean;
+begin
+  if Value=FUseCacheOnAbstractMemLists then Exit;
+  FUseCacheOnAbstractMemLists := Value;
+  DoInit(Lins);
+end;
+
 procedure TPCAbstractMem.UpdateSafeboxFileName(const ANewSafeboxFileName: String);
 var LReadOnly, Ltmp : Boolean;
 begin
@@ -791,7 +893,7 @@ begin
     FAbstractMem := TMem.Create(0,LReadOnly);
   end;
   if FAbstractMem is TFileMem then begin
-    TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
+    TFileMem(FAbstractMem).MaxCacheSize := FMaxMemUsage;
     TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
   end;
   DoInit(Ltmp);
@@ -864,6 +966,22 @@ begin
   Result := FBlocks.GetItem( ABlockNumber );
 end;
 
+function TPCAbstractMem.GetMaxAccountKeysCache: Integer;
+begin
+  Result := FAccountKeys.AccountKeyByPositionCache.MaxRegisters;
+end;
+
+function TPCAbstractMem.GetMaxAccountsCache: Integer;
+begin
+  Result := FAccountCache.MaxRegisters;
+end;
+
+function TPCAbstractMem.GetStatsReport(AClearStats: Boolean): String;
+begin
+  Result := AbstractMem.GetStatsReport(AClearStats) + #10 + FStats.ToString;
+  if AClearStats then FStats.Clear;
+end;
+
 function TPCAbstractMem.IsChecking: Boolean;
 begin
   Result := Assigned(TPCThread.GetThreadByClass(TPCAbstractMemCheckThread,Nil));
@@ -1168,6 +1286,7 @@ begin
     FPCAbstractMem.FLockAbstractMem.Release;
   end;
   FErrors.Free;
+  inherited Destroy;
 end;
 
 procedure TPCAbstractMemCheckThread.Restart;
@@ -1177,4 +1296,17 @@ begin
 end;
 
 
+{ TPCAbstractMemStats }
+
+procedure TPCAbstractMemStats.Clear;
+begin
+  Self.FlushesCount := 0;
+  Self.FlushesMillis := 0;
+end;
+
+function TPCAbstractMemStats.ToString: String;
+begin
+  Result := Format('PCAbstractMem flushes:%d in %d millis',[Self.FlushesCount,Self.FlushesMillis]);
+end;
+
 end.

src/core/UPCAbstractMemAccountKeys.pas

@@ -9,7 +9,7 @@ interface
 uses Classes, SysUtils,
   SyncObjs,
   UAbstractMem, UFileMem, UAbstractMemTList,
-  UAbstractBTree,
+  UAbstractBTree, UAbstractAVLTree,
   UPCDataTypes, UBaseTypes, UAVLCache,
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
 
@@ -38,7 +38,7 @@ type
     procedure SaveTo(const AItem : Cardinal; AIsAddingItem : Boolean; var ABytes : TBytes); override;
     function Compare(const ALeft, ARight : Cardinal) : Integer; override;
   public
-    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone); reintroduce;
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; AUseCache : Boolean); reintroduce;
     Function Add(const AItem : Cardinal) : Integer; reintroduce;
     procedure Delete(index : Integer); reintroduce;
   End;
@@ -64,6 +64,7 @@ type
     FPointerToRootPosition : TAbstractMemPosition;
     FRootPosition : TAbstractMemPosition;
     FAccountKeyByPositionCache : TPCAccountKeyByPositionCache;
+    FUseCacheOnAbstractMemLists: Boolean;
   protected
     function GetRoot: TAbstractMemAccountKeyNode; override;
     procedure SetRoot(const Value: TAbstractMemAccountKeyNode); override;
@@ -79,7 +80,7 @@ type
   public
     function IsNil(const ANode : TAbstractMemAccountKeyNode) : Boolean; override;
     function ToString(const ANode: TAbstractMemAccountKeyNode) : String; override;
-    constructor Create(AAbstractMem : TAbstractMem; APointerToRootPosition : TAbstractMemPosition); reintroduce;
+    constructor Create(AAbstractMem : TAbstractMem; APointerToRootPosition : TAbstractMemPosition; AUseCacheOnAbstractMemLists : Boolean); reintroduce;
     destructor Destroy; override;
     //
     function GetKeyAtPosition(APosition : TAbstractMemPosition) : TAccountKey;
@@ -89,6 +90,8 @@ type
     procedure GetAccountsUsingKey(const AAccountKey : TAccountKey; const AList : TList<Cardinal>);
     function GetAccountsUsingThisKey(const AAccountKey : TAccountKey) : TAccountsUsingThisKey;
     procedure FlushCache;
+    property UseCacheOnAbstractMemLists : Boolean read FUseCacheOnAbstractMemLists write FUseCacheOnAbstractMemLists;
+    property AccountKeyByPositionCache : TPCAccountKeyByPositionCache read FAccountKeyByPositionCache;
   end;
 
 
@@ -113,7 +116,7 @@ begin
       _BlackHoleAbstractMem := TMem.Create(0,True);
     end;
     LZone.Clear;
-    _TAccountsUsingThisKey_BlackHole := TAccountsUsingThisKey_BlackHole.Create(_BlackHoleAbstractMem,LZone);
+    _TAccountsUsingThisKey_BlackHole := TAccountsUsingThisKey_BlackHole.Create(_BlackHoleAbstractMem,LZone,True);
   end;
   Result :=  _TAccountsUsingThisKey_BlackHole;
 end;
@@ -225,12 +228,13 @@ begin
   Result := Left.data.position - Right.data.position;
 end;
 
-constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointerToRootPosition : TAbstractMemPosition);
+constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointerToRootPosition : TAbstractMemPosition; AUseCacheOnAbstractMemLists : Boolean);
 begin
   FAccountKeysLock := TCriticalSection.Create;
   FAbstractMem := AAbstractMem;
   FPointerToRootPosition := APointerToRootPosition;
   FRootPosition := 0;
+  FUseCacheOnAbstractMemLists := AUseCacheOnAbstractMemLists;
   // Read Root position
   FAbstractMem.Read(FPointerToRootPosition,FRootPosition,4);
   FAccountKeyByPositionCache := TPCAccountKeyByPositionCache.Create(5000,_AccountKeyByPositionCache_Comparision);
@@ -239,8 +243,8 @@ end;
 
 destructor TPCAbstractMemAccountKeys.Destroy;
 begin
-  FAccountKeyByPositionCache.Free;
-  FAccountKeysLock.Free;
+  FreeAndNil(FAccountKeyByPositionCache);
+  FreeAndNil(FAccountKeysLock);
   inherited;
 end;
 
@@ -297,7 +301,7 @@ begin
     LP.Clear;
     LP.position := LNode.myPosition;
     LP.accountKey := AAccountKey;
-    LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
     FAccountKeyByPositionCache.Add(LP); // Add to cache!
   end;
   Result := LP.accountsUsingThisKey;
@@ -330,7 +334,7 @@ begin
     if LNode.accounts_using_this_key_position>0 then begin
       LAccZone.Clear;
       LAccZone.position := LNode.accounts_using_this_key_position;
-      LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LAccZone);
+      LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LAccZone,Self.UseCacheOnAbstractMemLists);
     end else LP.accountsUsingThisKey := Nil;
     FAccountKeyByPositionCache.Add(LP); // Add to cache!
   end;
@@ -392,7 +396,7 @@ begin
       LNode.accounts_using_this_key_position := LZone.position;
       LNode.WriteToMem( FAbstractMem ); // Save update:
     end else LZone.position := LNode.accounts_using_this_key_position;
-    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
     // Add to cache
     FAccountKeyByPositionCache.Add( LAccKeyByPos );
   end;
@@ -435,7 +439,7 @@ begin
     LAccKeyByPos.accountKey := AAccountKey;
     LZone.Clear;
     LZone.position := LNode.accounts_using_this_key_position;
-    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone,Self.UseCacheOnAbstractMemLists);
     // Add to cache
     FAccountKeyByPositionCache.Add( LAccKeyByPos );
   end;
@@ -554,9 +558,9 @@ begin
   Result := ALeft - ARight;
 end;
 
-constructor TAccountsUsingThisKey.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone);
+constructor TAccountsUsingThisKey.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; AUseCache : Boolean);
 begin
-  inherited Create(AAbstractMem,AInitialZone,1000,False);
+  inherited Create(AAbstractMem,AInitialZone,1000,False, AUseCache);
 end;
 
 procedure TAccountsUsingThisKey.Delete(index: Integer);

src/core/UPCSafeBoxRootHash.pas

@@ -428,7 +428,7 @@ begin
     FreeAndNil(FNextLevelBytesBuffer);
   end else if Not Assigned(FNextLevelBytesBuffer) then begin
     // First time must "Redo"
-    RedoNextLevelsForMerkleRootHash;
+    // "RedoNextLevelsForMerkleRootHash" will be called when need to access next level value
   end else begin
     LLevelItemIndex := AStartPos DIV 32;
     LLevelItemsCount := Self.Length DIV 32;

src/core/UThread.pas

@@ -81,6 +81,7 @@ Type
     constructor Create(CreateSuspended: Boolean);
     destructor Destroy; override;
     Property DebugStep : String read FDebugStep write FDebugStep;
+    Property StartTickCount : TTickCount read FStartTickCount;
     property Terminated;
   End;
 

src/core/upcdaemon.pas

@@ -1,6 +1,6 @@
 unit upcdaemon;
 
-{ Copyright (c) 2016 by Albert Molina
+{ Copyright (c) 2016-2020 by Albert Molina
 
   Distributed under the MIT software license, see the accompanying file LICENSE
   or visit http://www.opensource.org/licenses/mit-license.php.
@@ -48,6 +48,12 @@ Const
   CT_INI_IDENT_MINPENDINGBLOCKSTODOWNLOADCHECKPOINT = 'MINPENDINGBLOCKSTODOWNLOADCHECKPOINT';
   CT_INI_IDENT_PEERCACHE = 'PEERCACHE';
   CT_INI_IDENT_DATA_FOLDER = 'DATAFOLDER';
+  {$IFDEF USE_ABSTRACTMEM}
+  CT_INI_IDENT_ABSTRACTMEM_MAX_CACHE_MB = 'ABSTRACTMEM_MAX_CACHE_MB';
+  CT_INI_IDENT_ABSTRACTMEM_USE_CACHE_ON_LISTS = 'ABSTRACTMEM_USE_CACHE_ON_LISTS';
+  CT_INI_IDENT_ABSTRACTMEM_CACHE_MAX_ACCOUNTS = 'ABSTRACTMEM_CACHE_MAX_ACCOUNTS';
+  CT_INI_IDENT_ABSTRACTMEM_CACHE_MAX_PUBKEYS = 'ABSTRACTMEM_CACHE_MAX_PUBKEYS';
+  {$ENDIF}
 
 Type
   { TPCDaemonThread }
@@ -238,7 +244,11 @@ var
       TLog.NewLog(ltinfo,ClassName,'RPC Miner Server NOT ACTIVE (Ini file is '+CT_INI_IDENT_RPC_SERVERMINER_PORT+'=0)');
     end;
   end;
-
+  {$IFDEF USE_ABSTRACTMEM}
+  var LMaxMemMb : Integer;
+    LUseCacheOnMemLists : Boolean;
+    LCacheMaxAccounts, LCacheMaxPubKeys : Integer;
+  {$ENDIF}
 begin
   FMInerServer := Nil;
   TLog.NewLog(ltinfo,Classname,'START PascalCoin Server');
@@ -254,6 +264,18 @@ begin
       FWalletKeys.WalletFileName := GetDataFolder+PathDelim+'WalletKeys.dat';
       // Creating Node:
       FNode := TNode.Node;
+      {$IFDEF USE_ABSTRACTMEM}
+      LMaxMemMb := FIniFile.ReadInteger(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_ABSTRACTMEM_MAX_CACHE_MB,100);
+      LUseCacheOnMemLists:= FIniFile.ReadBool(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_ABSTRACTMEM_USE_CACHE_ON_LISTS,True);
+      LCacheMaxAccounts := FIniFile.ReadInteger(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_ABSTRACTMEM_CACHE_MAX_ACCOUNTS,10000);
+      LCacheMaxPubKeys := FIniFile.ReadInteger(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_ABSTRACTMEM_CACHE_MAX_PUBKEYS,5000);
+
+      TLog.NewLog(ltinfo,ClassName,Format('Init abstract mem library to %d mb %d accounts and %d Pubkeys and use cache lists: %s',[LMaxMemMb,LCacheMaxAccounts,LCacheMaxPubKeys,LUseCacheOnMemLists.ToString]));
+      FNode.Bank.SafeBox.PCAbstractMem.MaxMemUsage := LMaxMemMb * 1024 * 1024;
+      FNode.Bank.SafeBox.PCAbstractMem.UseCacheOnAbstractMemLists := LUseCacheOnMemLists;
+      FNode.Bank.SafeBox.PCAbstractMem.MaxAccountsCache := LCacheMaxAccounts;
+      FNode.Bank.SafeBox.PCAbstractMem.MaxAccountKeysCache := LCacheMaxPubKeys;
+      {$ENDIF}
       {$IFDEF TESTNET}
       TPCTNetDataExtraMessages.InitNetDataExtraMessages(FNode,TNetData.NetData,FWalletKeys);
       {$ENDIF}

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -1,7 +1,7 @@
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
   
   https://github.com/PascalCoinDev/  
 
@@ -27,6 +27,9 @@
 {.$define ABSTRACTMEM_ENABLE_STATS}
 // define this to activate some stats on objects usefull for testing
 
+{.$define ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
+// define this to prevent circular search on tree nodes
+
 {$if (defined(ABSTRACTMEM_TESTING_MODE)) or (defined(ABSTRACTMEM_USE_TLOG))}{$define ABSTRACTMEM_ENABLE_STATS}{$endif}
 
 { 
@@ -45,7 +48,11 @@
   - Added tests
   - Fixed bug on CacheMem when replacing initial position of buffer
 
+  Version 1.2 - Jan 2021
+  - Added TAbstractBTree - Standard B-Tree implementation for use on AbstractMem Library
+  - Added ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION compiler directive to prevent circular structures on Tree nodes
+
 }
 
 const
-  CT_ABSTRACTMEM_VERSION = 1.1; // Each revision should increase this version...
+  CT_ABSTRACTMEM_VERSION = 1.2; // Each revision should increase this version...

src/libraries/abstractmem/UAVLCache.pas

@@ -3,7 +3,7 @@ unit UAVLCache;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -33,7 +33,7 @@ interface
 
 uses Classes, SysUtils,
   SyncObjs,
-  UAbstractBTree, UOrderedList,
+  UAbstractAVLTree, UOrderedList,
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
 
 type
@@ -87,13 +87,13 @@ type
       function ConsistencyCheck(const AErrors : TStrings): integer; override;
     end;
     var FAVLCacheMem : TAVLCacheMem;
-    FDefaultMax : Integer;
+    FMaxRegisters : Integer;
     FAVLCacheLock : TCriticalSection;
   protected
     procedure BeforeDelete(var AData : T); virtual;
     procedure ConsistencyCheck;
   public
-    Constructor Create(ADefaultMax : Integer; const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+    Constructor Create(ADefaultMaxRegisters : Integer; const AOnCompareMethod: TComparison<PAVLCacheMemData>);
     Destructor Destroy; override;
     //
     function Find(const AData : T; out AFound : T) : Boolean;
@@ -103,6 +103,7 @@ type
     procedure Clear;
     function TreeToString: String;
     function ToString(const AData : T) : String; overload; virtual;
+    property MaxRegisters : Integer read FMaxRegisters write FMaxRegisters;
   End;
 
 implementation
@@ -339,7 +340,7 @@ begin
   P^.data := AData;
   FAVLCacheMem.Add(P);
   FAVLCacheMem.DoMark(P,True);
-  if (FDefaultMax > 0) And (FAVLCacheMem.FCount>FDefaultMax) then begin
+  if (FMaxRegisters > 0) And (FAVLCacheMem.FCount>FMaxRegisters) then begin
     // Dispose cache
     LnToRemove := FAVLCacheMem.FCount SHR 1;
     i := 1;
@@ -395,10 +396,10 @@ begin
   End;
 end;
 
-constructor TAVLCache<T>.Create(ADefaultMax: Integer;  const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+constructor TAVLCache<T>.Create(ADefaultMaxRegisters: Integer;  const AOnCompareMethod: TComparison<PAVLCacheMemData>);
 begin
   FAVLCacheMem := TAVLCacheMem.Create(AOnCompareMethod,False);
-  FDefaultMax := ADefaultMax;
+  FMaxRegisters := ADefaultMaxRegisters;
   FAVLCacheLock := TCriticalSection.Create;
 end;
 

src/libraries/abstractmem/UAbstractAVLTree.pas

@@ -0,0 +1,1011 @@
+unit UAbstractAVLTree;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  SPECIAL CONTRIBUTOR:
+  This unit contains TAVLAbstractTree component that
+  is created based on work previously made
+  by Mattias Gaertner at unit AVL_Tree for Free Component Library (FCL)
+  and Lazarus: lazarus\components\lazutils\laz_avl_tree.pp
+  Code object has been fully redo but algo is based on it... and on
+  initial algo of AVL Tree created by Adelson-Velsky and Landis
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // 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}
+  UOrderedList, UAbstractBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+{$IFDEF ABSTRACTMEM_TESTING_MODE}
+  {$DEFINE ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
+{$ENDIF}
+
+type
+  TAVLTreePosition = (poParent, poLeft, poRight);
+
+  EAVLAbstractTree = Class(Exception);
+
+  { TAVLAbstractTree }
+
+  TAVLAbstractTree<T> = class
+  private
+    FOnCompare: TComparison<T>;
+    FDisabledsCount : Integer;
+    FAllowDuplicates: Boolean;
+    procedure BalanceAfterInsert(ANode: T);
+    procedure BalanceAfterDelete(ANode: T);
+    procedure CheckNode(const ANode: T); overload;
+    function CheckNode(const ANode: T; ACheckedList:TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer; overload;
+    procedure RotateLeft(var ANode: T);
+    procedure RotateRight(var ANode: T);
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure SwitchPositionWithSuccessor(aNode, aSuccessor: T);
+  protected
+    FCount: integer;
+    FCircularProtection : Boolean;
+    function GetRoot: T; virtual; abstract;
+    procedure SetRoot(const Value: T); virtual; abstract;
+    function HasPosition(const ANode : T; APosition : TAVLTreePosition) : Boolean; virtual; abstract;
+    function GetPosition(const ANode : T; APosition : TAVLTreePosition) : T; virtual; abstract;
+    procedure SetPosition(var ANode : T; APosition : TAVLTreePosition; const ANewValue : T); virtual; abstract;
+    procedure ClearPosition(var ANode : T; APosition : TAVLTreePosition); virtual; abstract;
+    function GetBalance(const ANode : T) : Integer; virtual; abstract;
+    procedure SetBalance(var ANode : T; ANewBalance : Integer); virtual; abstract;
+    function AreEquals(const ANode1, ANode2 : T) : Boolean; virtual; abstract;
+    procedure ClearNode(var ANode : T); virtual; abstract;
+    procedure DisposeNode(var ANode : T); virtual; abstract;
+    //
+    procedure UpdateFinished; virtual;
+  public
+    property AllowDuplicates : Boolean read FAllowDuplicates write FAllowDuplicates;
+    property DisabledsCount:Integer read FDisabledsCount;
+    function IsNil(const ANode : T) : Boolean; virtual; abstract;
+    //
+    property Root: T read GetRoot;
+    function FindInsertPos(const AData: T): T;
+    function Find(const AData: T): T;
+    function FindSuccessor(const ANode: T): T;
+    function FindPrecessor(const ANode: T): T;
+    function FindLowest: T;
+    function FindHighest: T;
+    function Add(var ANode: T) : Boolean;
+    procedure Delete(var ANode: T);
+    constructor Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean); virtual;
+    function ConsistencyCheck(const AErrors : TStrings): integer; virtual;
+    function ToString(const ANode:T) : String; reintroduce; overload; virtual;
+    function ToString : String; reintroduce; overload;
+    property OnCompareMethod: TComparison<T> read FOnCompare;
+    property CircularProtection : Boolean read FCircularProtection write FCircularProtection;
+  end;
+
+  //
+
+  PAVLPointerTreeNode = ^TAVLPointerTreeNode;
+  TAVLPointerTreeNode = Record
+    parent : PAVLPointerTreeNode;
+    left : PAVLPointerTreeNode;
+    right : PAVLPointerTreeNode;
+    balance : Integer;
+    data : Pointer;
+  End;
+
+  TPAVLPointerTree = Class( TAVLAbstractTree<PAVLPointerTreeNode> )
+  private
+    FRoot : PAVLPointerTreeNode;
+  protected
+    function GetRoot: PAVLPointerTreeNode; override;
+    procedure SetRoot(const Value: PAVLPointerTreeNode); override;
+    function HasPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : Boolean; override;
+    procedure SetPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition; const ANewValue : PAVLPointerTreeNode); override;
+    procedure ClearPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : PAVLPointerTreeNode) : Integer; override;
+    procedure SetBalance(var ANode : PAVLPointerTreeNode; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : PAVLPointerTreeNode) : Boolean; override;
+    procedure ClearNode(var ANode : PAVLPointerTreeNode); override;
+    procedure DisposeNode(var ANode : PAVLPointerTreeNode); override;
+  public
+    function IsNil(const ANode : PAVLPointerTreeNode) : Boolean; override;
+    function ToString(const ANode: PAVLPointerTreeNode) : String; override;
+    constructor Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean); override;
+    //
+    function GetPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : PAVLPointerTreeNode; override;
+  End;
+
+const
+  CT_TAVLPointerTreeNode_NULL : TAVLPointerTreeNode = (parent:Nil;left:Nil;right:Nil;balance:0;data:Nil);
+
+implementation
+
+{ TAVLAbstractTree }
+
+function TAVLAbstractTree<T>.Add(var ANode : T) : Boolean;
+var LInsertPos: T;
+  LInsertComp: integer;
+begin
+  BeginUpdate;
+  Try
+    // Init T
+    ClearPosition(ANode,poLeft);
+    ClearPosition(ANode,poRight);
+    SetBalance(ANode,0); // Init Balance to 0
+    if Not IsNil(Root) then begin
+      LInsertPos:=FindInsertPos(ANode);
+      LInsertComp:=fOnCompare(ANode,LInsertPos);
+      SetPosition(ANode,poParent,LInsertPos);
+      if LInsertComp<0 then begin
+        // insert to the left
+        SetPosition(LInsertPos,poLeft,ANode);
+      end else if (AllowDuplicates) Or (LInsertComp>0) then begin
+        // insert to the right
+        SetPosition(LInsertPos,poRight,ANode);
+      end else begin
+        Exit(False);
+      end;
+      BalanceAfterInsert(ANode);
+    end else begin
+      SetRoot( ANode );
+      ClearPosition(ANode,poParent);
+    end;
+    inc(FCount);
+    Result := True;
+  Finally
+    EndUpdate;
+  End;
+end;
+
+function TAVLAbstractTree<T>.FindLowest: T;
+begin
+  Result:=Root;
+  if Not IsNil(Result) then
+    while HasPosition(Result,poLeft) do Result := GetPosition(Result,poLeft);
+end;
+
+function TAVLAbstractTree<T>.FindHighest: T;
+begin
+  Result:=Root;
+  if Not IsNil(Result) then
+    while HasPosition(Result,poRight) do Result := GetPosition(Result,poRight);
+end;
+
+procedure TAVLAbstractTree<T>.BalanceAfterDelete(ANode: T);
+var
+  OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight: T;
+begin
+  while Not IsNil(ANode) do begin
+    if ((GetBalance(ANode)=+1) or (GetBalance(ANode)=-1)) then exit;
+    OldParent:=GetPosition(ANode,poParent);
+    if (GetBalance(ANode)=0) then begin
+      // Treeheight has decreased by one
+      if IsNil(OldParent) then
+        exit;
+      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then
+        SetBalance(OldParent,GetBalance(OldParent)+1)
+      else
+      SetBalance(OldParent,GetBalance(OldParent)-1);
+      ANode:=OldParent;
+    end else if (GetBalance(ANode)=+2) then begin
+      // Node is overweighted to the right
+      OldRight:=GetPosition(ANode,poRight);
+      if (GetBalance(OldRight)>=0) then begin
+        // OldRight.Balance is 0 or +1
+        // rotate ANode,OldRight left
+        RotateLeft(ANode);
+        SetBalance(ANode,(1-GetBalance(OldRight))); // toggle 0 and 1
+        SetBalance(OldRight,GetBalance(OldRight)-1);
+        ANode:=OldRight;
+      end else begin
+        // OldRight.Balance=-1
+        { double rotate
+          = rotate OldRightLeft,OldRight right
+            and then rotate ANode,OldRightLeft left
+                  OldParent                           OldParent
+                      |                                  |
+                    ANode                           OldRightLeft
+                       \                               /      \
+                    OldRight             =>          ANode    OldRight
+                      /                                \         /
+               OldRightLeft                OldRightLeftLeft OldRightLeftRight
+                   /     \
+        OldRightLeftLeft OldRightLeftRight
+        }
+        OldRightLeft:=GetPosition(OldRight,poLeft);
+        RotateRight(OldRight);
+        RotateLeft(ANode);
+        if (GetBalance(OldRightLeft)<=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,-1);
+        if (GetBalance(OldRightLeft)>=0) then
+          SetBalance(OldRight,0)
+        else
+          SetBalance(OldRight,+1);
+        SetBalance(OldRightLeft,0);
+        ANode:=OldRightLeft;
+      end;
+    end else begin
+      // Node.Balance=-2
+      // Node is overweighted to the left
+      OldLeft:=GetPosition(ANode,poLeft);
+      if (GetBalance(OldLeft)<=0) then begin
+        // rotate OldLeft,ANode right
+        RotateRight(ANode);
+        SetBalance(ANode,(-1-GetBalance(OldLeft))); // toggle 0 and -1
+        SetBalance(OldLeft,GetBalance(OldLeft)+1);
+        ANode:=OldLeft;
+      end else begin
+        // OldLeft.Balance = 1
+        { double rotate left right
+          = rotate OldLeft,OldLeftRight left
+            and then rotate OldLeft,ANode right
+                    OldParent                           OldParent
+                        |                                  |
+                      ANode                            OldLeftRight
+                       /                               /         \
+                    OldLeft             =>          OldLeft    ANode
+                       \                                \         /
+                   OldLeftRight               OldLeftRightLeft OldLeftRightRight
+                     /     \
+          OldLeftRightLeft OldLeftRightRight
+        }
+        OldLeftRight:=GetPosition(OldLeft,poRight);
+        RotateLeft(OldLeft);
+        RotateRight(ANode);
+        if (GetBalance(OldLeftRight)>=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,+1);
+        if (GetBalance(OldLeftRight)<=0) then
+          SetBalance(OldLeft,0)
+        else
+          SetBalance(OldLeft,-1);
+        SetBalance(OldLeftRight,0);
+        ANode:=OldLeftRight;
+      end;
+    end;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.BalanceAfterInsert(ANode : T);
+var
+  OldParent, OldRight, OldLeft: T;
+begin
+  OldParent:=GetPosition(ANode,poParent);
+  while Not IsNil(OldParent) do begin
+    if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
+      // Node is left child
+      SetBalance(OldParent,GetBalance(OldParent)-1);
+      if (GetBalance(OldParent)=0) then exit;
+      if (GetBalance(OldParent)=-1) then begin
+        ANode:=OldParent;
+        OldParent:=GetPosition(ANode,poParent);
+        continue;
+      end;
+      // OldParent.Balance=-2
+      if (GetBalance(ANode)=-1) then begin
+        { rotate ANode,ANode.Parent right
+             OldParentParent        OldParentParent
+                   |                     |
+               OldParent        =>     ANode
+                 /                        \
+              ANode                     OldParent
+                \                        /
+              OldRight               OldRight      }
+        RotateRight(OldParent);
+        SetBalance(ANode,0);
+        SetBalance(OldParent,0);
+      end else begin
+        // Node.Balance = +1
+        { double rotate
+          = rotate ANode,OldRight left and then rotate OldRight,OldParent right
+             OldParentParent             OldParentParent
+                    |                           |
+                OldParent                    OldRight
+                   /            =>          /        \
+                 ANode                   ANode      OldParent
+                    \                       \          /
+                   OldRight          OldRightLeft  OldRightRight
+                     / \
+          OldRightLeft OldRightRight
+        }
+        OldRight:=GetPosition(ANode,poRight);
+        RotateLeft(ANode);
+        RotateRight(OldParent);
+        if (GetBalance(OldRight)<=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,-1);
+        if (GetBalance(OldRight)=-1) then
+          SetBalance(OldParent,1)
+        else
+          SetBalance(OldParent,0);
+        SetBalance(OldRight,0);
+      end;
+      exit;
+    end else begin
+      // Node is right child
+      SetBalance(OldParent, GetBalance(OldParent)+1);
+      if (GetBalance(OldParent)=0) then exit;
+      if (GetBalance(OldParent)=+1) then begin
+        ANode:=OldParent;
+        OldParent:=GetPosition(ANode,poParent);
+        continue;
+      end;
+      // OldParent.Balance = +2
+      if (GetBalance(ANode)=+1) then begin
+        { rotate OldParent,ANode left
+             OldParentParent        OldParentParent
+                   |                     |
+               OldParent        =>     ANode
+                    \                   /
+                  ANode               OldParent
+                   /                      \
+                OldLeft                 OldLeft      }
+        RotateLeft(OldParent);
+        SetBalance(ANode,0);
+        SetBalance(OldParent,0);
+      end else begin
+        // Node.Balance = -1
+        { double rotate
+          = rotate OldLeft,ANode right and then rotate OldParent,OldLeft right
+             OldParentParent             OldParentParent
+                    |                           |
+                OldParent                    OldLeft
+                     \            =>        /       \
+                    ANode               OldParent   ANode
+                     /                     \          /
+                  OldLeft          OldLeftLeft  OldLeftRight
+                    / \
+         OldLeftLeft OldLeftRight
+        }
+        OldLeft:=GetPosition(ANode,poLeft);
+        RotateRight(ANode);
+        RotateLeft(OldParent);
+        if (GetBalance(OldLeft)>=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,+1);
+        if (GetBalance(OldLeft)=+1) then
+          SetBalance(OldParent,-1)
+        else
+          SetBalance(OldParent,0);
+        SetBalance(OldLeft,0);
+      end;
+      exit;
+    end;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.BeginUpdate;
+begin
+  inc(FDisabledsCount);
+end;
+
+constructor TAVLAbstractTree<T>.Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean);
+begin
+  inherited Create;
+  FOnCompare:=OnCompareMethod;
+  FCount:=0;
+  FDisabledsCount := 0;
+  FAllowDuplicates := AAllowDuplicates;
+  {$IFDEF ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
+  FCircularProtection := True;
+  {$ELSE}
+  FCircularProtection := False;
+  {$ENDIF}
+end;
+
+procedure TAVLAbstractTree<T>.Delete(var ANode: T);
+var OldParent, Child, LSuccessor: T;
+begin
+  BeginUpdate;
+  try
+    if (Not IsNil(GetPosition(ANode,poLeft))) and (Not IsNil(GetPosition(ANode,poRight))) then begin
+      // ANode has both: Left and Right
+      // Switch ANode position with Successor
+      // Because ANode.Right<>nil the Successor is a child of ANode
+      LSuccessor := FindSuccessor(ANode);
+      SwitchPositionWithSuccessor(ANode,LSuccessor);
+    end;
+    // left or right is nil
+    OldParent:=GetPosition(ANode,poParent);
+    ClearPosition(ANode,poParent);
+    if Not IsNil(GetPosition(ANode,poLeft)) then
+      Child:=GetPosition(ANode,poLeft)
+    else
+      Child:=GetPosition(ANode,poRight);
+    if Not IsNil(Child) then
+      SetPosition(Child,poParent,OldParent);
+    if Not IsNil(OldParent) then begin
+      // Node has parent
+      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
+        // Node is left child of OldParent
+        SetPosition(OldParent,poLeft,Child);
+        SetBalance(OldParent, GetBalance(OldParent)+1);
+      end else begin
+        // Node is right child of OldParent
+        SetPosition(OldParent,poRight,Child);
+        SetBalance(OldParent, GetBalance(OldParent)-1);
+      end;
+      BalanceAfterDelete(OldParent);
+    end else begin
+      // Node was Root
+      SetRoot( Child );
+    end;
+    dec(FCount);
+
+    DisposeNode(ANode);
+
+  finally
+    EndUpdate;
+  end;
+end;
+
+
+procedure TAVLAbstractTree<T>.EndUpdate;
+begin
+  if FDisabledsCount<=0 then Raise EAVLAbstractTree.Create('EndUpdate invalid');
+  Dec(FDisabledsCount);
+  if FDisabledsCount=0 then UpdateFinished;
+end;
+
+procedure TAVLAbstractTree<T>.SwitchPositionWithSuccessor(aNode, aSuccessor: T);
+{ called by delete, when aNode.Left<>nil and aNode.Right<>nil
+  Switch ANode position with Successor
+  Because ANode.Right<>nil the Successor is a child of ANode }
+var
+  OldBalance: Integer;
+  OldParent, OldLeft, OldRight,
+  OldSuccParent, OldSuccLeft, OldSuccRight: T;
+begin
+  OldBalance:=GetBalance(aNode);
+  SetBalance(aNode, GetBalance(aSuccessor));
+  SetBalance(aSuccessor, OldBalance);
+
+  OldParent:=GetPosition(aNode,poParent);
+  OldLeft:=GetPosition(aNode,poLeft);
+  OldRight:=GetPosition(aNode,poRight);
+  OldSuccParent:=GetPosition(aSuccessor,poParent);
+  OldSuccLeft:=GetPosition(aSuccessor,poLeft);
+  OldSuccRight:=GetPosition(aSuccessor,poRight);
+
+  if Not IsNil(OldParent) then begin
+    if AreEquals(GetPosition(OldParent,poLeft),aNode) then
+      SetPosition(OldParent,poLeft,aSuccessor)
+    else
+      SetPosition(OldParent,poRight,aSuccessor);
+  end else
+    SetRoot(aSuccessor);
+  SetPosition(aSuccessor,poParent,OldParent);
+
+  if Not AreEquals(OldSuccParent,aNode) then begin
+    if AreEquals(GetPosition(OldSuccParent,poLeft),aSuccessor) then
+      SetPosition(OldSuccParent,poLeft,aNode)
+    else
+      SetPosition(OldSuccParent,poRight,aNode);
+    SetPosition(aSuccessor,poRight,OldRight);
+    SetPosition(aNode,poParent,OldSuccParent);
+    if Not IsNil(OldRight) then
+      SetPosition(OldRight,poParent,aSuccessor);
+  end else begin
+    {  aNode            aSuccessor
+         \          =>    \
+         aSuccessor       aNode  }
+    SetPosition(aSuccessor,poRight,aNode);
+    SetPosition(aNode,poParent,aSuccessor);
+  end;
+
+  SetPosition(aNode,poLeft,OldSuccLeft);
+  if Not IsNil(OldSuccLeft) then
+    SetPosition(OldSuccLeft,poParent,aNode);
+  SetPosition(aNode,poRight,OldSuccRight);
+  if Not IsNil(OldSuccRight) then
+    SetPosition(OldSuccRight,poParent,aNode);
+  SetPosition(aSuccessor,poLeft,OldLeft);
+  if Not IsNil(OldLeft) then
+    SetPosition(OldLeft,poParent,aSuccessor);
+end;
+
+function TAVLAbstractTree<T>.Find(const AData: T): T;
+var Comp: integer;
+  LPreviousSearch : TNoDuplicateData<T>;
+begin
+  if FCircularProtection then begin
+    LPreviousSearch := TNoDuplicateData<T>.Create(FOnCompare); // Protection against circular "malformed" structure
+  end else LPreviousSearch := Nil;
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if FCircularProtection then begin
+        if Not LPreviousSearch.Add(Result) then raise EAVLAbstractTree.Create('Circular T structure at Find for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      end;
+      Comp:=fOnCompare(AData,Result);
+      if Comp=0 then exit;
+      if Comp<0 then begin
+        Result:=GetPosition(Result,poLeft);
+      end else begin
+        Result:=GetPosition(Result,poRight);
+      end;
+    end;
+  finally
+    if FCircularProtection then begin
+      LPreviousSearch.Free;
+    end;
+  end;
+end;
+
+function TAVLAbstractTree<T>.FindInsertPos(const AData: T): T;
+var Comp: integer;
+  LPreviousSearch : TNoDuplicateData<T>;
+begin
+  if FCircularProtection then begin
+    LPreviousSearch := TNoDuplicateData<T>.Create(FOnCompare); // Protection against circular "malformed" structure
+  end else LPreviousSearch := Nil;
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if FCircularProtection then begin
+        if Not LPreviousSearch.Add(Result) then raise EAVLAbstractTree.Create('Circular T structure at FindInsertPos for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      end;
+      Comp:=fOnCompare(AData,Result);
+      if Comp<0 then begin
+        if (HasPosition(Result,poLeft)) then begin
+          Result:=GetPosition(Result,poLeft);
+        end else begin
+          Exit;
+        end;
+      end else begin
+        if (HasPosition(Result,poRight)) then begin
+          Result:=GetPosition(Result,poRight);
+        end else begin
+          Exit;
+        end;
+      end;
+    end;
+  finally
+    if FCircularProtection then begin
+      LPreviousSearch.Free;
+    end;
+  end;
+end;
+
+function TAVLAbstractTree<T>.FindSuccessor(const ANode: T): T;
+begin
+  if HasPosition(ANode,poRight) then begin
+    Result := GetPosition(ANode,poRight);
+    while (HasPosition(Result,poLeft)) do Result:=GetPosition(Result,poLeft);
+  end else begin
+    Result := ANode;
+    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poRight),Result)) do
+      Result:=GetPosition(Result,poParent);
+    Result := GetPosition(Result,poParent);
+  end;
+end;
+
+function TAVLAbstractTree<T>.ToString: String;
+var i : Integer;
+  LStrings : TStringList;
+  LNode : T;
+begin
+  LStrings := TStringList.Create;
+  try
+    i := 0;
+    LNode := FindLowest;
+    while (Not IsNil(LNode)) do begin
+      inc(i);
+      LStrings.Add(Format('Pos:%d - %s',[i,ToString(LNode)]));
+      LNode := FindSuccessor(LNode);
+    end;
+    LStrings.Add(Format('Total:%d',[i]));
+    Result := LStrings.Text;
+  finally
+    LStrings.Free;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.UpdateFinished;
+{$IFDEF ABSTRACTMEM_TESTING_MODE}
+var LErrors : TStrings;
+{$ENDIF}
+begin
+  // Nothing to do here. Used in inheritance classes
+  {$IFDEF ABSTRACTMEM_TESTING_MODE}
+  LErrors := TStringList.Create;
+  Try
+    if ConsistencyCheck(LErrors)<>0 then begin
+      raise EAVLAbstractTree.Create('CONSISTENCY ERRORS'+#10+LErrors.Text);
+    end;
+  Finally
+    LErrors.Free;
+  End;
+  {$ENDIF}
+end;
+
+function TAVLAbstractTree<T>.ToString(const ANode: T): String;
+begin
+  Result := Format('Abstract T %d bytes',[SizeOf(T)]);
+end;
+
+function TAVLAbstractTree<T>.FindPrecessor(const ANode: T): T;
+begin
+  if HasPosition(ANode,poLeft) then begin
+    Result := GetPosition(ANode,poLeft);
+    while (HasPosition(Result,poRight)) do Result:=GetPosition(Result,poRight);
+  end else begin
+    Result := ANode;
+    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poLeft),Result)) do
+      Result:=GetPosition(Result,poParent);
+    Result := GetPosition(Result,poParent);
+  end;
+end;
+
+function TAVLAbstractTree<T>.CheckNode(const ANode: T; ACheckedList : TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer;
+var i : Integer;
+  LLeftDepth, LRightDepth : Integer;
+  LParent, LLeft, LRight : T;
+begin
+  Result := 0;
+
+  LLeftDepth := 0;
+  LRightDepth := 0;
+
+  ALeftDepth := 0;
+  ARightDepth := 0;
+
+  if IsNil(ANode) then begin
+    exit(0);
+  end;
+  if Assigned(ACheckedList) then begin
+    if ACheckedList.Find(ANode,i) then begin
+      // Found in previous searchs...
+      Result := -1;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency circular found at %d of %d -> %s',[i,ACheckedList.Count,ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    ACheckedList.Add(ANode);
+  end;
+
+  // test left son
+  if HasPosition(ANode,poLeft) then begin
+    LLeft := GetPosition(ANode,poLeft);
+    if Not AreEquals(GetPosition(GetPosition(ANode,poLeft),poParent),ANode) then begin
+      Result:=-2;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency not equals in left for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    if fOnCompare(GetPosition(ANode,poLeft),ANode)>0 then begin
+      Result:=-3;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency compare>0 in left for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    Result:=CheckNode(GetPosition(ANode,poLeft),ACheckedList,LLeftDepth,LRightDepth,AErrors);
+    if LLeftDepth>LRightDepth then inc(ALeftDepth,LLeftDepth+1)
+    else inc(ALeftDepth,LRightDepth+1);
+    if Result<>0 then Exit;
+  end else ClearNode(LLeft);
+  // test right son
+  if HasPosition(ANode,poRight) then begin
+    LRight := GetPosition(ANode,poRight);
+    if Not AreEquals(GetPosition(GetPosition(ANode,poRight),poParent),ANode) then begin
+      Result:=-4;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency not equals in right for %s found %s at right.parent',[ToString(ANode),ToString(GetPosition(GetPosition(ANode,poRight),poParent))]));
+      end;
+      Exit;
+    end;
+    if fOnCompare(GetPosition(ANode,poRight),ANode)<0 then begin
+      Result:=-5;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency compare>0 in right for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    Result:=CheckNode(GetPosition(ANode,poRight),ACheckedList,LLeftDepth,LRightDepth,AErrors);
+    if LLeftDepth>LRightDepth then inc(ARightDepth,LLeftDepth+1)
+    else inc(ARightDepth,LRightDepth+1);
+    if Result<>0 then Exit;
+  end else ClearNode(LRight);
+
+  if (HasPosition(ANode,poParent)) then begin
+    LParent := GetPosition(ANode,poParent);
+  end else ClearNode(LParent);
+
+  if Not IsNil(LParent) then begin
+    if AreEquals(ANode,LParent) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Parent for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -7;
+    end;
+  end;
+  if Not IsNil(LLeft) then begin
+    if AreEquals(ANode,LLeft) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Left for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
+      end;
+      Result := -8;
+    end;
+  end;
+  if Not IsNil(LRight) then begin
+    if AreEquals(ANode,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Right for %s (Right %s)',[ToString(ANode),ToString(LRight)]));
+      end;
+      Result := -9;
+    end;
+  end;
+  if (Not IsNil(LParent)) and (Not IsNil(LLeft)) then begin
+    if AreEquals(LParent,LLeft) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Parent=Left for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -10;
+    end;
+  end;
+  if (Not IsNil(LParent)) and (Not IsNil(LRight)) then begin
+    if AreEquals(LParent,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Parent=Right for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -11;
+    end;
+  end;
+  if (Not IsNil(LLeft)) and (Not IsNil(LRight)) then begin
+    if AreEquals(LLeft,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Left=Right for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
+      end;
+      Result := -12;
+    end;
+  end;
+
+  // Check balance
+  if GetBalance(ANode)<>(ARightDepth - ALeftDepth) then begin
+    if Assigned(AErrors) then begin
+      AErrors.Add(Format('Error Consistency balance (%d <> Right(%d) - Left(%d)) at %s',[GetBalance(ANode),ARightDepth,ALeftDepth,ToString(ANode)]));
+    end;
+    Result := -15;
+    Exit;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.RotateLeft(var ANode: T);
+{    Parent                Parent
+       |                     |
+      Node        =>       OldRight
+      /  \                  /
+   Left OldRight          Node
+          /               /  \
+     OldRightLeft      Left OldRightLeft  }
+var
+  AParent, OldRight, OldRightLeft: T;
+begin
+  OldRight:=GetPosition(aNode,poRight);
+  OldRightLeft:=GetPosition(OldRight,poLeft);
+  AParent:=GetPosition(aNode,poParent);
+  if Not IsNil(AParent) then begin
+    if AreEquals(GetPosition(AParent,poLeft),aNode) then
+      SetPosition(AParent,poLeft,OldRight)
+    else
+      SetPosition(AParent,poRight,OldRight);
+  end else
+    SetRoot( OldRight );
+  SetPosition(OldRight,poParent,AParent);
+  SetPosition(aNode,poParent,OldRight);
+  SetPosition(aNode,poRight,OldRightLeft);
+  if Not IsNil(OldRightLeft) then
+    SetPosition(OldRightLeft,poParent,aNode);
+  SetPosition(OldRight,poLeft,aNode);
+end;
+
+procedure TAVLAbstractTree<T>.RotateRight(var ANode: T);
+{       Parent              Parent
+          |                   |
+         Node        =>     OldLeft
+         /   \                 \
+    OldLeft  Right            Node
+        \                     /  \
+   OldLeftRight      OldLeftRight Right  }
+var
+  AParent, OldLeft, OldLeftRight: T;
+begin
+  OldLeft:=GetPosition(ANode,poLeft);
+  OldLeftRight:=GetPosition(OldLeft,poRight);
+  AParent:=GetPosition(ANode,poParent);
+  if Not IsNil(AParent) then begin
+    if AreEquals(GetPosition(AParent,poLeft),aNode) then
+      SetPosition(AParent,poLeft,OldLeft)
+    else
+      SetPosition(AParent,poRight,OldLeft);
+  end else
+    SetRoot( OldLeft );
+  SetPosition(OldLeft,poParent,AParent);
+  SetPosition(aNode,poParent,OldLeft);
+  SetPosition(aNode,poLeft,OldLeftRight);
+  if Not IsNil(OldLeftRight) then
+    SetPosition(OldLeftRight,poParent,aNode);
+  SetPosition(OldLeft,poRight,aNode);
+end;
+
+procedure TAVLAbstractTree<T>.CheckNode(const ANode: T);
+var LLeft,LRight : Integer;
+  LErrors : TStrings;
+begin
+  LErrors := TStringList.Create;
+  try
+    if CheckNode(ANode,Nil,LLeft,LRight,LErrors)<>0 then
+      raise EAVLAbstractTree.Create('CHECK CONSISTENCY ERROR'+#10+LErrors.Text);
+  finally
+    LErrors.Free;
+  end;
+end;
+
+function TAVLAbstractTree<T>.ConsistencyCheck(const AErrors : TStrings): integer;
+var LCheckedList : TOrderedList<T>;
+var LLeftDepth, LRightDepth : Integer;
+begin
+  LCheckedList := TOrderedList<T>.Create(False,FOnCompare);
+  try
+    LLeftDepth := 0;
+    LRightDepth := 0;
+    Result:=CheckNode(Root,LCheckedList,LLeftDepth,LRightDepth,AErrors);
+  finally
+    LCheckedList.Free;
+  end;
+end;
+
+{ TPAVLPointerTree }
+
+function TPAVLPointerTree.AreEquals(const ANode1, ANode2: PAVLPointerTreeNode): Boolean;
+begin
+  Result := ANode1 = ANode2;
+end;
+
+procedure TPAVLPointerTree.ClearNode(var ANode: PAVLPointerTreeNode);
+begin
+  ANode := Nil;
+end;
+
+procedure TPAVLPointerTree.ClearPosition(var ANode: PAVLPointerTreeNode; APosition: TAVLTreePosition);
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot ClearPosition of a Nil node');
+  case APosition of
+    poParent: ANode.parent := Nil;
+    poLeft: ANode.left := Nil;
+    poRight: ANode.right := Nil;
+  end;
+end;
+
+constructor TPAVLPointerTree.Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean);
+begin
+  FRoot := Nil;
+  inherited;
+end;
+
+procedure TPAVLPointerTree.DisposeNode(var ANode: PAVLPointerTreeNode);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+function TPAVLPointerTree.GetBalance(const ANode: PAVLPointerTreeNode): Integer;
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot GetBalance of a Nil node');
+  Result := ANode^.balance;
+end;
+
+function TPAVLPointerTree.GetPosition(const ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition): PAVLPointerTreeNode;
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot GetPosition of a Nil node');
+  case APosition of
+    poParent: Result := ANode.parent;
+    poLeft: Result := ANode.left;
+    poRight: Result := ANode.right;
+  else raise EAVLAbstractTree.Create('Undefined 20200310-1');
+  end;
+end;
+
+function TPAVLPointerTree.GetRoot: PAVLPointerTreeNode;
+begin
+  Result := FRoot;
+end;
+
+function TPAVLPointerTree.HasPosition(const ANode: PAVLPointerTreeNode; APosition: TAVLTreePosition): Boolean;
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot answer HasPosition of a Nil node');
+  case APosition of
+    poParent: Result := Assigned( ANode.parent );
+    poLeft: Result := Assigned( ANode.left );
+    poRight: Result := Assigned( ANode.right );
+  else raise EAVLAbstractTree.Create('Undefined 20200310-2');
+  end;
+end;
+
+function TPAVLPointerTree.IsNil(const ANode: PAVLPointerTreeNode): Boolean;
+begin
+  Result := ANode = Nil;
+end;
+
+procedure TPAVLPointerTree.SetBalance(var ANode: PAVLPointerTreeNode; ANewBalance: Integer);
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot SetBalance of a Nil node');
+  ANode^.balance := ANewBalance;
+end;
+
+procedure TPAVLPointerTree.SetPosition(var ANode: PAVLPointerTreeNode; APosition: TAVLTreePosition; const ANewValue: PAVLPointerTreeNode);
+begin
+  if Not Assigned(ANode) then raise EAVLAbstractTree.Create('Cannot SetPosition of a Nil node');
+  case APosition of
+    poParent: ANode.parent := ANewValue;
+    poLeft: ANode.left := ANewValue;
+    poRight: ANode.right := ANewValue;
+  end;
+end;
+
+procedure TPAVLPointerTree.SetRoot(const Value: PAVLPointerTreeNode);
+begin
+  FRoot := Value;
+end;
+
+function TPAVLPointerTree.ToString(const ANode: PAVLPointerTreeNode): String;
+var LParent, LLeft, LRight : String;
+begin
+  if Assigned(ANode) then begin
+    if Assigned(ANode.parent) then LParent := IntToStr(Integer(ANode.parent.data)) else LParent := 'NIL';
+    if Assigned(ANode.left) then LLeft := IntToStr(Integer(ANode.left.data)) else LLeft := 'NIL';
+    if Assigned(ANode.right) then LRight := IntToStr(Integer(ANode.right.data)) else LRight := 'NIL';
+
+    Result := Format('%d (Parent:%s Left:%s Right:%s Balance:%d)',[Integer(ANode.data),LParent,LLeft,LRight,ANode.balance]);
+  end else begin
+    Result := 'NIL';
+  end;
+end;
+
+initialization
+
+finalization
+
+end.

src/libraries/abstractmem/UAbstractBTree.pas

@@ -3,7 +3,7 @@ unit UAbstractBTree;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -22,14 +22,6 @@ unit UAbstractBTree;
 
   See ConfigAbstractMem.inc file for more info
 
-  SPECIAL CONTRIBUTOR:
-  This unit contains TAVLAbstractTree component that
-  is created based on work previously made
-  by Mattias Gaertner at unit AVL_Tree for Free Component Library (FCL)
-  and Lazarus: lazarus\components\lazutils\laz_avl_tree.pp
-  Code object has been fully redo but algo is based on it... and on
-  initial algo of AVL Tree created by Adelson-Velsky and Landis
-
   ***** END LICENSE BLOCK *****
 }
 
@@ -52,951 +44,1195 @@ uses
 {$I ./ConfigAbstractMem.inc }
 
 {$IFDEF ABSTRACTMEM_TESTING_MODE}
-  {$DEFINE ABSTRACTMEM_CHECK}
+  {$DEFINE ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
 {$ENDIF}
 
 type
-  TAVLTreePosition = (poParent, poLeft, poRight);
-
-  EAVLAbstractTree = Class(Exception);
-
-  { TAVLAbstractTree }
+  EAbstractBTree = Class(Exception);
 
-  TAVLAbstractTree<T> = class
+  TAbstractBTree<TIdentify, TData> = Class
+  public
+    type
+      TIdentifyArray = Array of TIdentify;
+      TDataArray = Array of TData;
+      TAbstractBTreeNode = record
+        identify : TIdentify;
+        parent : TIdentify;
+        data : TDataArray;
+        childs : TIdentifyArray;
+        function IsLeaf : Boolean;
+        procedure InsertData(const AData : TData; AIndex : Integer);
+        procedure InsertChild(const AChild : TIdentify; AIndex : Integer);
+        procedure RemoveInNode(AIndex : Integer);
+        procedure DeleteData(AIndex : Integer);
+        procedure DeleteChild(AChildIndex : Integer);
+        function Count : Integer;
+      end;
   private
-    FOnCompare: TComparison<T>;
-    FDisabledsCount : Integer;
+    FOnCompareIdentify: TComparison<TIdentify>;
+    FOnCompareData: TComparison<TData>;
     FAllowDuplicates: Boolean;
-    procedure BalanceAfterInsert(ANode: T);
-    procedure BalanceAfterDelete(ANode: T);
-    procedure CheckNode(const ANode: T); overload;
-    function CheckNode(const ANode: T; ACheckedList:TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer; overload;
-    procedure RotateLeft(var ANode: T);
-    procedure RotateRight(var ANode: T);
-    procedure BeginUpdate;
-    procedure EndUpdate;
-    procedure SwitchPositionWithSuccessor(aNode, aSuccessor: T);
+    FOrder: Integer;
+    FCircularProtection : Boolean;
+    procedure SplitAfterInsert(var ANode : TAbstractBTreeNode);
+    procedure MoveRange(var ASourceNode, ADestNode : TAbstractBTreeNode; AFromSource, ACount, AToDest : Integer);
+    procedure MoveRangeBetweenSiblings(var ASourceNode, ADestNode : TAbstractBTreeNode);
+    procedure BTreeNodeToString(const ANode : TAbstractBTreeNode; ALevel, ALevelIndex : Integer; const AStrings : TStrings);
+    procedure CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft,AParentDataIndexRight : Integer; ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
+    function FindPrecessorExt(var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
+    function FindSuccessorExt(var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
+    procedure EraseTreeExt(var ANode : TAbstractBTreeNode);
   protected
     FCount: integer;
-    function GetRoot: T; virtual; abstract;
-    procedure SetRoot(const Value: T); virtual; abstract;
-    function HasPosition(const ANode : T; APosition : TAVLTreePosition) : Boolean; virtual; abstract;
-    function GetPosition(const ANode : T; APosition : TAVLTreePosition) : T; virtual; abstract;
-    procedure SetPosition(var ANode : T; APosition : TAVLTreePosition; const ANewValue : T); virtual; abstract;
-    procedure ClearPosition(var ANode : T; APosition : TAVLTreePosition); virtual; abstract;
-    function GetBalance(const ANode : T) : Integer; virtual; abstract;
-    procedure SetBalance(var ANode : T; ANewBalance : Integer); virtual; abstract;
-    function AreEquals(const ANode1, ANode2 : T) : Boolean; virtual; abstract;
-    procedure ClearNode(var ANode : T); virtual; abstract;
-    procedure DisposeNode(var ANode : T); virtual; abstract;
-    //
-    procedure UpdateFinished; virtual;
+    function GetRoot: TAbstractBTreeNode; virtual; abstract;
+    procedure SetRoot(var Value: TAbstractBTreeNode); virtual; abstract;
+
+    procedure ClearNode(var ANode : TAbstractBTreeNode); virtual;
+    function NewNode : TAbstractBTreeNode; virtual; abstract;
+    procedure DisposeNode(var ANode : TAbstractBTreeNode); virtual; abstract;
+    procedure SetNil(var AIdentify : TIdentify); virtual; abstract;
+    function BinarySearch(const AData : TData; const ADataArray : TDataArray; out AIndex : Integer) : Boolean; virtual;
+    function AreEquals(const AIdentify1, AIdentify2 : TIdentify) : Boolean;
+    procedure SaveNode(var ANode : TAbstractBTreeNode); virtual; abstract;
+    function GetCount : Integer; virtual;
+    procedure SetCount(const ANewCount : Integer); virtual;
+    function GetHeight: Integer; virtual;
+    property Count : Integer read GetCount;
+    procedure CheckConsistencyFinalized(ADatas : TList<TData>; AIdents : TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount : Integer); virtual;
+    function FindChildPos(const AIdent : TIdentify; const AParent : TAbstractBTreeNode) : Integer;
+    procedure DisposeData(var AData : TData); virtual;
+    function DoCompareData(const ALeftData, ARightData: TData): Integer; virtual;
   public
     property AllowDuplicates : Boolean read FAllowDuplicates write FAllowDuplicates;
-    property DisabledsCount:Integer read FDisabledsCount;
-    function IsNil(const ANode : T) : Boolean; virtual; abstract;
+    function IsNil(const AIdentify : TIdentify) : Boolean; virtual; abstract;
+    function ToString(const ANode : TAbstractBTreeNode) : String; overload;
+    procedure EraseTree;
     //
-    property Root: T read GetRoot;
-    function FindInsertPos(const AData: T): T;
-    function Find(const AData: T): T;
-    function FindSuccessor(const ANode: T): T;
-    function FindPrecessor(const ANode: T): T;
-    function FindLowest: T;
-    function FindHighest: T;
-    function Add(var ANode: T) : Boolean;
-    procedure Delete(var ANode: T);
-    constructor Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean); virtual;
-    function ConsistencyCheck(const AErrors : TStrings): integer; virtual;
-    function ToString(const ANode:T) : String; reintroduce; overload; virtual;
-    function ToString : String; reintroduce; overload;
-    property OnCompareMethod: TComparison<T> read FOnCompare;
-  end;
-
-  //
-
-  PAVLPointerTreeNode = ^TAVLPointerTreeNode;
-  TAVLPointerTreeNode = Record
-    parent : PAVLPointerTreeNode;
-    left : PAVLPointerTreeNode;
-    right : PAVLPointerTreeNode;
-    balance : Integer;
-    data : Pointer;
+    property Root: TAbstractBTreeNode read GetRoot;
+    function Find(const AData: TData; out ANode : TAbstractBTreeNode; out iPos : Integer): Boolean;
+    function GetNode(AIdentify : TIdentify) : TAbstractBTreeNode; virtual; abstract;
+    function FindPrecessor(const AData : TData; out APrecessor : TData) : Boolean;
+    function FindSuccessor(const AData : TData; out ASuccessor : TData) : Boolean;
+    function FindLowestNode: TAbstractBTreeNode;
+    function FindLowest(out ALowest : TData) : Boolean;
+    function FindHighestNode: TAbstractBTreeNode;
+    function FindHighest(out AHighest : TData) : Boolean;
+    function Add(const AData: TData) : Boolean;
+    function Delete(const AData: TData) : Boolean;
+    function NodeDataToString(const AData : TData) : String; virtual;
+    constructor Create(const AOnCompareIdentifyMethod: TComparison<TIdentify>; const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder: Integer);
+    property OnCompareIdentifyMethod: TComparison<TIdentify> read FOnCompareIdentify;
+    property OnCompareDataMethod: TComparison<TData> read FOnCompareData;
+    function BTreeToString : String;
+    property Order : Integer  read FOrder;
+    function MaxItemsPerNode : Integer;
+    function MinItemsPerNode : Integer;
+    function MinChildrenPerNode : Integer;
+    function MaxChildrenPerNode : Integer;
+    procedure CheckConsistency; virtual;
+    property Height : Integer read GetHeight;
+    property CircularProtection : Boolean read FCircularProtection write FCircularProtection;
   End;
 
-  TPAVLPointerTree = Class( TAVLAbstractTree<PAVLPointerTreeNode> )
+  TMemoryBTree<TData> = Class( TAbstractBTree<Integer,TData> )
   private
-    FRoot : PAVLPointerTreeNode;
+    FBuffer : TList<TAbstractBTree<Integer,TData>.TAbstractBTreeNode> ;
+    Froot : Integer;
+    FDisposed : Integer;
+    FDisposedMinPos : Integer;
   protected
-    function GetRoot: PAVLPointerTreeNode; override;
-    procedure SetRoot(const Value: PAVLPointerTreeNode); override;
-    function HasPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : Boolean; override;
-    procedure SetPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition; const ANewValue : PAVLPointerTreeNode); override;
-    procedure ClearPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition); override;
-    function GetBalance(const ANode : PAVLPointerTreeNode) : Integer; override;
-    procedure SetBalance(var ANode : PAVLPointerTreeNode; ANewBalance : Integer); override;
-    function AreEquals(const ANode1, ANode2 : PAVLPointerTreeNode) : Boolean; override;
-    procedure ClearNode(var ANode : PAVLPointerTreeNode); override;
-    procedure DisposeNode(var ANode : PAVLPointerTreeNode); override;
+    function GetRoot: TAbstractBTree<Integer,TData>.TAbstractBTreeNode; override;
+    procedure SetRoot(var Value: TAbstractBTree<Integer,TData>.TAbstractBTreeNode); override;
+    function NewNode : TAbstractBTree<Integer,TData>.TAbstractBTreeNode; override;
+    procedure DisposeNode(var ANode : TAbstractBTree<Integer,TData>.TAbstractBTreeNode); override;
+    procedure SetNil(var AIdentify : Integer); override;
+    procedure SaveNode(var ANode : TAbstractBTree<Integer,TData>.TAbstractBTreeNode); override;
+    procedure CheckConsistencyFinalized(ADatas : TList<TData>; AIdents : TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount : Integer); override;
   public
-    function IsNil(const ANode : PAVLPointerTreeNode) : Boolean; override;
-    function ToString(const ANode: PAVLPointerTreeNode) : String; override;
-    constructor Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean); override;
-    //
-    function GetPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : PAVLPointerTreeNode; override;
+    function IsNil(const AIdentify : Integer) : Boolean; override;
+    constructor Create(const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder : Integer);
+    destructor Destroy; override;
+    function GetNode(AIdentify : Integer) : TAbstractBTree<Integer,TData>.TAbstractBTreeNode; override;
+    property Count;
   End;
 
+  TNoDuplicateData<TData> = Class
+  private
+    FBTree : TMemoryBTree<TData>;
+  public
+    function Add(const AData : TData) : Boolean;
+    constructor Create(const AOnCompareDataMethod: TComparison<TData>);
+    destructor Destroy; override;
+  End;
 
-const
-  CT_TAVLPointerTreeNode_NULL : TAVLPointerTreeNode = (parent:Nil;left:Nil;right:Nil;balance:0;data:Nil);
+  TIntegerBTree = Class( TMemoryBTree<Integer> )
+  private
+  protected
+  public
+    constructor Create(AAllowDuplicates : Boolean; AOrder : Integer);
+    function NodeDataToString(const AData : Integer) : String; override;
+  End;
 
 implementation
 
-{ TAVLAbstractTree }
-
-function TAVLAbstractTree<T>.Add(var ANode : T) : Boolean;
-var LInsertPos: T;
-  LInsertComp: integer;
-begin
-  BeginUpdate;
-  Try
-    // Init T
-    ClearPosition(ANode,poLeft);
-    ClearPosition(ANode,poRight);
-    SetBalance(ANode,0); // Init Balance to 0
-    if Not IsNil(Root) then begin
-      LInsertPos:=FindInsertPos(ANode);
-      LInsertComp:=fOnCompare(ANode,LInsertPos);
-      SetPosition(ANode,poParent,LInsertPos);
-      if LInsertComp<0 then begin
-        // insert to the left
-        SetPosition(LInsertPos,poLeft,ANode);
-      end else if (AllowDuplicates) Or (LInsertComp>0) then begin
-        // insert to the right
-        SetPosition(LInsertPos,poRight,ANode);
-      end else begin
-        Exit(False);
+{ TAbstractBTree<TIdentify, TData> }
+
+function TAbstractBTree<TIdentify, TData>.Add(const AData: TData): Boolean;
+var Lnode  : TAbstractBTreeNode;
+  iDataPos : Integer;
+begin
+  if (Find(AData,Lnode,iDataPos)) then begin
+    if (Not FAllowDuplicates) then Exit(False);
+    // Follow childs until leaf node
+    while (Not Lnode.IsLeaf) do begin
+      Lnode := GetNode(Lnode.childs[iDataPos]); // Insert at right position
+      if (BinarySearch(AData,Lnode.data,iDataPos)) then begin
+        //
       end;
-      BalanceAfterInsert(ANode);
+    end;
+  end else if (IsNil(Lnode.identify)) then begin
+    Lnode := NewNode;
+    SetRoot(Lnode);
+  end;
+  Assert(Lnode.IsLeaf,'Node must be a leaf');
+  // Lnode is a leaf and iDataPos is position to insert
+  Lnode.InsertData(Adata,iDataPos);
+  SaveNode(Lnode);
+  if Lnode.Count>MaxItemsPerNode then begin
+    // Split and up
+    SplitAfterInsert(Lnode);
+  end;
+  Result := True;
+  if (FCount>=0) then begin
+    SetCount(FCount+1);
+  end;
+end;
+
+function TAbstractBTree<TIdentify, TData>.AreEquals(const AIdentify1, AIdentify2: TIdentify): Boolean;
+begin
+  Result := FOnCompareIdentify(AIdentify1,AIdentify2)=0;
+end;
+
+function TAbstractBTree<TIdentify, TData>.BinarySearch(const AData : TData; const ADataArray: TDataArray; out AIndex: Integer): Boolean;
+  // AIndex will be a value between 0..Count and will be the position to do a Insert if needed
+var i, j, mid, cmp : integer;
+begin
+  Result := False;
+  i := 0;
+  j := Length(ADataArray)-1;
+  while (i <= j) do begin
+    mid := (i + j) shr 1;
+    cmp := DoCompareData(AData,ADataArray[mid]);
+    if (cmp<0) then begin
+      j := mid - 1;
+    end else if (cmp>0) then begin
+      i := mid + 1;
     end else begin
-      SetRoot( ANode );
-      ClearPosition(ANode,poParent);
+      AIndex := mid;
+      Exit(True);
     end;
-    inc(FCount);
-    Result := True;
-  Finally
-    EndUpdate;
-  End;
+  end;
+  AIndex := i;
 end;
 
-function TAVLAbstractTree<T>.FindLowest: T;
+procedure TAbstractBTree<TIdentify, TData>.BTreeNodeToString(const ANode: TAbstractBTreeNode; ALevel, ALevelIndex : Integer; const AStrings: TStrings);
+var i : Integer;
+  s : String;
 begin
-  Result:=Root;
-  if Not IsNil(Result) then
-    while HasPosition(Result,poLeft) do Result := GetPosition(Result,poLeft);
+  while (AStrings.Count<=ALevel) do AStrings.Add('');
+  s := '';
+  for i := 0 to ANode.Count-1 do begin
+    if (s<>'') then s := s + ',';
+    s := s + NodeDataToString(ANode.data[i]);
+  end;
+  if (AStrings.Strings[ALevel]<>'') then AStrings.Strings[ALevel] := AStrings.Strings[ALevel]+' ';
+  AStrings.Strings[ALevel] := AStrings.Strings[ALevel] + '['+s+']';
+  for i := 0 to High(ANode.childs) do begin
+    BTreeNodeToString( GetNode(ANode.childs[i]), ALevel+1, ALevelIndex+i, AStrings);
+  end;
 end;
 
-function TAVLAbstractTree<T>.FindHighest: T;
+function TAbstractBTree<TIdentify, TData>.BTreeToString: String;
+var Lsl : TStrings;
+  Lnode : TAbstractBTreeNode;
 begin
-  Result:=Root;
-  if Not IsNil(Result) then
-    while HasPosition(Result,poRight) do Result := GetPosition(Result,poRight);
+  Lsl := TStringList.Create;
+  try
+    Lnode := GetRoot;
+    if Not IsNil(Lnode.identify) then BTreeNodeToString(Lnode,0,0,Lsl);
+    Result := Lsl.Text;
+  finally
+    Lsl.Free;
+  end;
 end;
 
-procedure TAVLAbstractTree<T>.BalanceAfterDelete(ANode: T);
+procedure TAbstractBTree<TIdentify, TData>.CheckConsistency;
 var
-  OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight: T;
-begin
-  while Not IsNil(ANode) do begin
-    if ((GetBalance(ANode)=+1) or (GetBalance(ANode)=-1)) then exit;
-    OldParent:=GetPosition(ANode,poParent);
-    if (GetBalance(ANode)=0) then begin
-      // Treeheight has decreased by one
-      if IsNil(OldParent) then
-        exit;
-      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then
-        SetBalance(OldParent,GetBalance(OldParent)+1)
-      else
-      SetBalance(OldParent,GetBalance(OldParent)-1);
-      ANode:=OldParent;
-    end else if (GetBalance(ANode)=+2) then begin
-      // Node is overweighted to the right
-      OldRight:=GetPosition(ANode,poRight);
-      if (GetBalance(OldRight)>=0) then begin
-        // OldRight.Balance is 0 or +1
-        // rotate ANode,OldRight left
-        RotateLeft(ANode);
-        SetBalance(ANode,(1-GetBalance(OldRight))); // toggle 0 and 1
-        SetBalance(OldRight,GetBalance(OldRight)-1);
-        ANode:=OldRight;
-      end else begin
-        // OldRight.Balance=-1
-        { double rotate
-          = rotate OldRightLeft,OldRight right
-            and then rotate ANode,OldRightLeft left
-                  OldParent                           OldParent
-                      |                                  |
-                    ANode                           OldRightLeft
-                       \                               /      \
-                    OldRight             =>          ANode    OldRight
-                      /                                \         /
-               OldRightLeft                OldRightLeftLeft OldRightLeftRight
-                   /     \
-        OldRightLeftLeft OldRightLeftRight
-        }
-        OldRightLeft:=GetPosition(OldRight,poLeft);
-        RotateRight(OldRight);
-        RotateLeft(ANode);
-        if (GetBalance(OldRightLeft)<=0) then
-          SetBalance(ANode,0)
-        else
-          SetBalance(ANode,-1);
-        if (GetBalance(OldRightLeft)>=0) then
-          SetBalance(OldRight,0)
-        else
-          SetBalance(OldRight,+1);
-        SetBalance(OldRightLeft,0);
-        ANode:=OldRightLeft;
-      end;
+  FDatas : TList<TData>;
+  FIdents : TOrderedList<TIdentify>;
+  Lnode : TAbstractBTreeNode;
+  Llevels, LnodesCount, LItemsCount : Integer;
+begin
+  FIdents := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
+  FDatas := TList<TData>.Create;
+  try
+    Llevels := 0;
+    LnodesCount := 0;
+    LItemsCount := 0;
+    Lnode := GetRoot;
+    if Not IsNil(Lnode.identify) then begin
+      CheckConsistencyEx(Lnode,True,-1,-1,FDatas,FIdents,1,Llevels,LnodesCount,LItemsCount);
+    end;
+    if (FCount>=0) then begin
+      if LItemsCount<>FCount then raise EAbstractBTree.Create(Format('Inconsistent items count %d vs register %d',[LItemsCount,FCount]));
+    end;
+    CheckConsistencyFinalized(FDatas,FIdents,Llevels,LnodesCount,LItemsCount);
+  finally
+    FDatas.Free;
+    FIdents.Free;
+  end;
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft, AParentDataIndexRight : Integer; ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
+var Lchild : TAbstractBTreeNode;
+  i, Lcmp, iLeft, iRight : Integer;
+begin
+  if (assigned(AIdents)) then begin
+    if (AIdents.Add(ANode.identify)<0) then raise EAbstractBTree.Create(Format('Inconsistent Identify',[]));
+  end;
+  Inc(ANodesCount);
+  Inc(AItemsCount,ANode.Count);
+  if AIsGoingDown then begin
+    inc(ALevels);
+  end;
+  if (ALevels < ACurrentLevel) then raise EAbstractBTree.Create(Format('Inconsistent level %d < %d',[ALevels,ACurrentLevel]));
+  if (ACurrentLevel>1) then begin
+    if (ANode.Count=0) then raise EAbstractBTree.Create(Format('Inconsistent NIL node at level %d',[ACurrentLevel]));
+    if (AParentDataIndexLeft>=0) then begin
+      // Right must be < than parent
+      Lcmp := DoCompareData(ADatas.Items[AParentDataIndexLeft], ANode.data[0]);
+      if Lcmp>0 then raise EAbstractBTree.Create(Format('Inconsistent %d data [%s] vs parent left [%s] at level %d',
+        [Lcmp,NodeDataToString(ANode.data[0]),NodeDataToString(ADatas.Items[AParentDataIndexLeft]), ACurrentLevel]));
+    end;
+    if (AParentDataIndexRight>=0) then begin
+      // Right must be < than parent
+      Lcmp := DoCompareData(ANode.data[ANode.Count-1],ADatas.Items[AParentDataIndexRight]);
+      if Lcmp>0 then raise EAbstractBTree.Create(Format('Inconsistent %d data [%s] vs parent right [%s] at level %d',
+        [Lcmp,NodeDataToString(ANode.data[ANode.Count-1]),NodeDataToString(ADatas.Items[AParentDataIndexRight]), ACurrentLevel]));
+    end;
+  end;
+  if (MinItemsPerNode>ANode.Count) or (MaxItemsPerNode<ANode.Count) then begin
+    if Not (IsNil(ANode.parent)) then begin
+      raise EAbstractBTree.Create(Format('Inconsistent Items in Node (%d..%d) %s at level %d for order %d',[MinItemsPerNode,MaxItemsPerNode,ToString(ANode),ACurrentLevel,FOrder]));
+    end;
+  end;
+
+  for i := 1 to ANode.Count-1 do begin
+    if DoCompareData(ANode.data[i-1],ANode.data[i])>0 then raise EAbstractBTree.Create(Format('Inconsistent data (%d..%d)/%d [%s] > [%s] at level %d',
+      [i-1,i,ANode.Count,NodeDataToString(ANode.data[i-1]),NodeDataToString(ANode.data[i]), ACurrentLevel]));
+  end;
+
+  if ANode.IsLeaf then begin
+    if (ALevels<>ACurrentLevel) then raise EAbstractBTree.Create('Inconsistency error not balanced');
+    Exit;
+  end;
+  if (Length(ANode.childs)<>(ANode.Count+1)) then raise EAbstractBTree.Create(Format('Inconsistency error %d childs vs %d items',[Length(ANode.childs),ANode.Count]));
+  if (ACurrentLevel>1) and ((MinChildrenPerNode>Length(ANode.childs)) or (MaxChildrenPerNode<Length(ANode.childs))) then begin
+    raise EAbstractBTree.Create(Format('Inconsistent %d Childs in Node (%d..%d) %s at level %d',[Length(ANode.childs),MinChildrenPerNode,MaxChildrenPerNode,ToString(ANode),ACurrentLevel]));
+  end;
+
+  iLeft := -1;
+  iRight := -1;
+  for i := 0 to High(ANode.childs) do begin
+    if (i<High(ANode.childs)) then begin
+      iLeft := iRight;
+      iRight := ADatas.Add(ANode.data[i]);
     end else begin
-      // Node.Balance=-2
-      // Node is overweighted to the left
-      OldLeft:=GetPosition(ANode,poLeft);
-      if (GetBalance(OldLeft)<=0) then begin
-        // rotate OldLeft,ANode right
-        RotateRight(ANode);
-        SetBalance(ANode,(-1-GetBalance(OldLeft))); // toggle 0 and -1
-        SetBalance(OldLeft,GetBalance(OldLeft)+1);
-        ANode:=OldLeft;
-      end else begin
-        // OldLeft.Balance = 1
-        { double rotate left right
-          = rotate OldLeft,OldLeftRight left
-            and then rotate OldLeft,ANode right
-                    OldParent                           OldParent
-                        |                                  |
-                      ANode                            OldLeftRight
-                       /                               /         \
-                    OldLeft             =>          OldLeft    ANode
-                       \                                \         /
-                   OldLeftRight               OldLeftRightLeft OldLeftRightRight
-                     /     \
-          OldLeftRightLeft OldLeftRightRight
-        }
-        OldLeftRight:=GetPosition(OldLeft,poRight);
-        RotateLeft(OldLeft);
-        RotateRight(ANode);
-        if (GetBalance(OldLeftRight)>=0) then
-          SetBalance(ANode,0)
-        else
-          SetBalance(ANode,+1);
-        if (GetBalance(OldLeftRight)<=0) then
-          SetBalance(OldLeft,0)
-        else
-          SetBalance(OldLeft,-1);
-        SetBalance(OldLeftRight,0);
-        ANode:=OldLeftRight;
-      end;
+      iLeft := iRight;
+      iRight := -1;
     end;
+    Lchild := GetNode(ANode.childs[i]);
+    if Not AreEquals(Lchild.parent,ANode.identify) then raise EAbstractBTree.Create(Format('Inconsistent Identify child %d/%d %s invalid pointer to parent at %s',[i+1,Length(ANode.childs),ToString(Lchild),ToString(ANode)]));
+    CheckConsistencyEx(Lchild,
+      ((AIsGoingDown) and (i=0)),iLeft,iRight,
+      ADatas,AIdents,
+      ACurrentLevel+1,
+      ALevels,ANodesCount,AItemsCount);
   end;
+
 end;
 
-procedure TAVLAbstractTree<T>.BalanceAfterInsert(ANode : T);
-var
-  OldParent, OldRight, OldLeft: T;
-begin
-  OldParent:=GetPosition(ANode,poParent);
-  while Not IsNil(OldParent) do begin
-    if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
-      // Node is left child
-      SetBalance(OldParent,GetBalance(OldParent)-1);
-      if (GetBalance(OldParent)=0) then exit;
-      if (GetBalance(OldParent)=-1) then begin
-        ANode:=OldParent;
-        OldParent:=GetPosition(ANode,poParent);
-        continue;
+procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyFinalized(ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount: Integer);
+begin
+  //
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.ClearNode(var ANode: TAbstractBTreeNode);
+begin
+  SetLength(ANode.data,0);
+  SetLength(ANode.childs,0);
+  SetNil(ANode.identify);
+  SetNil(ANode.parent);
+end;
+
+constructor TAbstractBTree<TIdentify, TData>.Create(const AOnCompareIdentifyMethod: TComparison<TIdentify>; const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder: Integer);
+begin
+  FOnCompareIdentify := AOnCompareIdentifyMethod;
+  FOnCompareData := AOnCompareDataMethod;
+  FAllowDuplicates := AAllowDuplicates;
+  FOrder := AOrder;
+  if FOrder<3 then FOrder := 3 // Minimum order for a BTree is 3. Order = Max childs
+  else if FOrder>32 then FOrder := 32; // Maximum order will be established to 32
+  FCount := -1;                 // -1 Means there is no control
+  {$IFDEF ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION}
+  FCircularProtection := True;
+  {$ELSE}
+  FCircularProtection := False;
+  {$ENDIF}
+end;
+
+function TAbstractBTree<TIdentify, TData>.Delete(const AData: TData) : Boolean;
+var Lnode, Lparent, Lparentparent : TAbstractBTreeNode;
+  iPos, iPosParent, iPosParentParent, j : Integer;
+  LmovingUp : Boolean;
+  Lleft, Lright : TAbstractBTreeNode;
+begin
+  if Not Find(AData,Lnode,iPos) then Exit(False);
+
+  Assert(FCount<>0,'Cannot Delete when FCount = 0');
+
+  if (FCount>0) then begin
+    SetCount(FCount-1);
+  end;
+
+  LmovingUp := False;
+
+  if (Lnode.IsLeaf) then begin
+    Lnode.DeleteData(iPos);
+  end;
+
+  repeat
+    if (Lnode.IsLeaf) or (LmovingUp) then begin
+      if (IsNil(Lnode.parent)) and (Length(Lnode.childs)=1) then begin
+        // child will be root
+        Lleft := GetNode(Lnode.childs[0]);
+        DisposeNode(Lnode);
+        SetNil(Lleft.parent);
+        SaveNode(Lleft);
+        SetRoot(Lleft);
+        Exit(True);
+      end;
+
+      if (IsNil(Lnode.parent)) or (Lnode.Count>=MinItemsPerNode) then begin
+        // Deleting from root where root is single node
+        // or Node has more than minimum datas
+        SaveNode(Lnode);
+        Exit(True);
+      end;
+      // Can borrow from left or right?
+      Lparent := GetNode( Lnode.parent );
+      if (Not LmovingUp) then begin
+        BinarySearch(AData,Lparent.data,iPosParent);
+      end;
+      if (iPosParent>0) then begin
+        Lleft := GetNode(Lparent.childs[iPosParent-1]);
+        // Use Left?
+        if Lleft.Count>MinItemsPerNode then begin
+
+          // Move Tri From Left To Right=Lnode
+          if (Not Lleft.IsLeaf) then begin
+            Lright := GetNode(Lleft.childs[High(Lleft.childs)]); // Right = left sibling last child (right child)
+            Lright.parent := Lnode.identify;
+            SaveNode(Lright);
+            //
+            Lnode.InsertChild(Lright.identify,0);
+            Lleft.DeleteChild(High(Lleft.childs));
+          end else Assert(Lnode.IsLeaf,'node must be a leaf because left sibling is a leaf');
+          Lnode.InsertData(Lparent.data[iPosParent-1],0);
+          Lparent.DeleteData(iPosParent-1);
+          Lparent.InsertData(Lleft.data[Lleft.Count-1],iPosParent-1);
+          Lleft.DeleteData(Lleft.Count-1);
+
+          SaveNode(Lnode);
+          SaveNode(Lparent);
+          SaveNode(Lleft);
+          Exit(True);
+        end;
+      end else ClearNode(Lleft);
+      if (iPosParent<Lparent.Count) then begin
+        Lright := GetNode(Lparent.childs[iPosParent+1]);
+        // Use right?
+        if (Lright.Count>MinItemsPerNode) then begin
+          // Move Tri From Right To left=Lnode
+          if (Not Lright.IsLeaf) then begin
+            Lleft := GetNode(Lright.childs[0]); // Left = right sibling first child (left child)
+            Lleft.parent := Lnode.identify;
+            SaveNode(Lleft);
+            //
+            Lnode.InsertChild(Lleft.identify,Length(Lnode.childs));
+            Lright.DeleteChild(0);
+          end else Assert(Lnode.IsLeaf,'node must be a leaf because right sibling is a leaf');
+          Lnode.InsertData(Lparent.data[iPosParent],Lnode.Count);
+          Lparent.DeleteData(iPosParent);
+          Lparent.InsertData(Lright.data[0],iPosParent);
+          Lright.DeleteData(0);
+
+          SaveNode(Lnode);
+          SaveNode(Lparent);
+          SaveNode(Lright);
+          Exit(True);
+        end;
+      end;
+      // Leaf but neither left or right > MinItemsPerNode
+      // Parent can remove 1 item and move others to childs?
+      if (Lnode.IsLeaf)
+        and
+        (Lparent.Count>MinItemsPerNode)
+         then begin
+        // Yes. Use parent
+        if (iPosParent>0) then begin
+          // Use Left Sibling as destination and remove Lnode
+          Lleft := GetNode(Lparent.childs[iPosParent-1]);
+          Lleft.InsertData(Lparent.data[iPosParent-1],Lleft.Count);
+          Lparent.DeleteData(iPosParent-1);
+          Lparent.DeleteChild(iPosParent);
+          MoveRangeBetweenSiblings(Lnode,Lleft);
+          DisposeNode(Lnode);
+          SaveNode(Lparent);
+          SaveNode(Lleft);
+          Exit(True);
+        end else begin
+          // Use right sibling (loaded before)
+          Lnode.InsertData(Lparent.data[iPosParent],Lnode.Count);
+          Lparent.DeleteData(0);
+          Lparent.DeleteChild(1); // 1 = Lright
+          SaveNode(Lparent);
+          for j := 0 to Lright.Count-1 do begin
+            Lnode.InsertData(Lright.data[j],Lnode.Count);
+          end;
+          DisposeNode(Lright);
+          SaveNode(Lnode);
+          Exit(True);
+        end;
+      end;
+      // Neither siblings neither parent are > MinItemsPernode
+      // in this case, go up in the tree using Parent as node
+      {
+                [a,c]  MinItemsPerNode=2 Order=3,4
+        [a1] [b1] [c1]
+
+      }
+
+      if (Not IsNil(Lparent.parent)) then begin
+        Lparentparent := GetNode(Lparent.parent);
+        iPosParentParent := FindChildPos(Lparent.identify,Lparentparent);
       end;
-      // OldParent.Balance=-2
-      if (GetBalance(ANode)=-1) then begin
-        { rotate ANode,ANode.Parent right
-             OldParentParent        OldParentParent
-                   |                     |
-               OldParent        =>     ANode
-                 /                        \
-              ANode                     OldParent
-                \                        /
-              OldRight               OldRight      }
-        RotateRight(OldParent);
-        SetBalance(ANode,0);
-        SetBalance(OldParent,0);
+
+      // Lnode is empty
+      if (iPosParent>0) then begin
+        // Deleting  [b1] or [c1]
+        // Move to Left sibling and dispose Lnode
+
+        Lleft := GetNode(Lparent.childs[iPosParent-1]);
+        Lleft.InsertData(Lparent.data[iPosParent-1],Lleft.Count);
+
+        if (not AreEquals(Lnode.identify,Lleft.identify)) then begin
+          MoveRangeBetweenSiblings(Lnode,Lleft);
+        end;
+        if (iPosParent<=Lparent.Count) and (not AreEquals(Lnode.identify,Lparent.childs[iPosParent])) then begin
+          Lright := GetNode(Lparent.childs[iPosParent]);
+          MoveRangeBetweenSiblings(Lright,Lleft);
+          DisposeNode(Lright);
+        end;
+
+        Lparent.DeleteData(iPosParent-1);
+        Lparent.DeleteChild(iPosParent);
+
+        if (not AreEquals(Lnode.identify,Lleft.identify)) then begin
+          DisposeNode(Lnode);
+        end;
+        SaveNode(Lparent);
+        SaveNode(Lleft);
+        Lnode := Lparent;
       end else begin
-        // Node.Balance = +1
-        { double rotate
-          = rotate ANode,OldRight left and then rotate OldRight,OldParent right
-             OldParentParent             OldParentParent
-                    |                           |
-                OldParent                    OldRight
-                   /            =>          /        \
-                 ANode                   ANode      OldParent
-                    \                       \          /
-                   OldRight          OldRightLeft  OldRightRight
-                     / \
-          OldRightLeft OldRightRight
-        }
-        OldRight:=GetPosition(ANode,poRight);
-        RotateLeft(ANode);
-        RotateRight(OldParent);
-        if (GetBalance(OldRight)<=0) then
-          SetBalance(ANode,0)
-        else
-          SetBalance(ANode,-1);
-        if (GetBalance(OldRight)=-1) then
-          SetBalance(OldParent,1)
-        else
-          SetBalance(OldParent,0);
-        SetBalance(OldRight,0);
+        // Move from right and dispose Lright
+        // Lright was loaded before
+        Lnode.InsertData(Lparent.data[iPosParent],Lnode.Count);
+
+        Lparent.DeleteData(iPosParent);
+        Lparent.DeleteChild(iPosParent+1);
+
+        MoveRangeBetweenSiblings(Lright,Lnode);
+
+        DisposeNode(Lright);
+        SaveNode(Lparent);
+        SaveNode(Lnode);
+        Lnode := Lparent;
       end;
-      exit;
+
+      iPosParent := iPosParentParent;
+
     end else begin
-      // Node is right child
-      SetBalance(OldParent, GetBalance(OldParent)+1);
-      if (GetBalance(OldParent)=0) then exit;
-      if (GetBalance(OldParent)=+1) then begin
-        ANode:=OldParent;
-        OldParent:=GetPosition(ANode,poParent);
-        continue;
+      // Internal node
+      // Lnode[iPos] has not been deleted neither updated
+      //
+      // Search Indorder predecessor:
+      Lleft := GetNode(Lnode.childs[iPos]);
+      while (Not Lleft.IsLeaf) do Lleft := GetNode(Lleft.childs[Lleft.Count]);
+      if (Lleft.Count>MinItemsPerNode) then begin
+        // Inorder predecessor
+        Lnode.data[iPos] := Lleft.data[Lleft.Count-1];
+        SaveNode(Lnode);
+        Lleft.RemoveInNode(Lleft.Count-1);
+        SaveNode(Lleft);
+        Exit(True);
+      end;
+      // Search Indorder successor:
+      Lright := GetNode(Lnode.childs[iPos+1]);
+      while (Not Lright.IsLeaf) do Lright := GetNode(Lright.childs[0]);
+      if (Lright.Count>MinItemsPerNode) then begin
+        // Inorder successor
+        Lnode.data[iPos] := Lright.data[0];
+        SaveNode(Lnode);
+        Lright.RemoveInNode(0);
+        SaveNode(Lright);
+        Exit(True);
       end;
-      // OldParent.Balance = +2
-      if (GetBalance(ANode)=+1) then begin
-        { rotate OldParent,ANode left
-             OldParentParent        OldParentParent
-                   |                     |
-               OldParent        =>     ANode
-                    \                   /
-                  ANode               OldParent
-                   /                      \
-                OldLeft                 OldLeft      }
-        RotateLeft(OldParent);
-        SetBalance(ANode,0);
-        SetBalance(OldParent,0);
+      // Neither predecessor neither successor
+      Assert((Lleft.IsLeaf),'Left must be leaf');
+      Assert((Lright.IsLeaf),'Right must be leaf');
+      if (Lnode.Count>MinItemsPerNode) and (AreEquals(Lnode.identify,Lleft.parent)) then begin
+        // Both childs are = MinItemsPerNode and Lnode > MinItemsPerNode . Remove from Lnode
+        {
+                [a,b,c]  <-  Remove "b"
+        [a1,a2] [b1,b2] [c1,c2]  <- MinItemsPerNode=2
+
+                 [a,c]
+        [a1,a2,b1,b2] [c1,c2]
+        }
+
+        Lnode.DeleteData(iPos);
+        Lnode.DeleteChild(iPos+1); //iPos+1 = Right sibling
+        MoveRangeBetweenSiblings(Lright,Lleft);
+        SaveNode(Lnode);
+        SaveNode(Lleft);
+        DisposeNode(Lright);
+        Exit(True);
       end else begin
-        // Node.Balance = -1
-        { double rotate
-          = rotate OldLeft,ANode right and then rotate OldParent,OldLeft right
-             OldParentParent             OldParentParent
-                    |                           |
-                OldParent                    OldLeft
-                     \            =>        /       \
-                    ANode               OldParent   ANode
-                     /                     \          /
-                  OldLeft          OldLeftLeft  OldLeftRight
-                    / \
-         OldLeftLeft OldLeftRight
+        {
+                [a,e]  <-  Remove "a" or "e" - MinItemsPerNode=2 Order=3
+        [a1,a2] [b1,b2] [f1,f2]
+
+                [a2,e]
+        [a1] [b1,b2] [f1,f2]  <- Can remove "a2" or "b2", never "f1" or "f2"
         }
-        OldLeft:=GetPosition(ANode,poLeft);
-        RotateRight(ANode);
-        RotateLeft(OldParent);
-        if (GetBalance(OldLeft)>=0) then
-          SetBalance(ANode,0)
-        else
-          SetBalance(ANode,+1);
-        if (GetBalance(OldLeft)=+1) then
-          SetBalance(OldParent,-1)
-        else
-          SetBalance(OldParent,0);
-        SetBalance(OldLeft,0);
+        // Set predecessor
+        Lnode.data[iPos] := Lleft.data[Lleft.Count-1];
+        SaveNode(Lnode);
+
+        if (Not IsNil(Lleft.parent)) then begin
+          Lparent := GetNode(Lleft.parent);
+          iPosParent := FindChildPos(Lleft.identify,Lparent);
+        end;
+
+        Lleft.DeleteData(Lleft.Count-1);
+        SaveNode(Lleft);
+        Lnode := Lleft;
       end;
-      exit;
+
     end;
-  end;
+
+    LmovingUp := True;
+  until (False);
 end;
 
-procedure TAVLAbstractTree<T>.BeginUpdate;
+procedure TAbstractBTree<TIdentify, TData>.DisposeData(var AData: TData);
 begin
-  inc(FDisabledsCount);
+  // Nothing to do
 end;
 
-constructor TAVLAbstractTree<T>.Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean);
+function TAbstractBTree<TIdentify, TData>.DoCompareData(const ALeftData, ARightData: TData): Integer;
 begin
-  inherited Create;
-  FOnCompare:=OnCompareMethod;
-  FCount:=0;
-  FDisabledsCount := 0;
-  FAllowDuplicates := AAllowDuplicates;
+  Result := FOnCompareData(ALeftData,ARightData);
 end;
 
-procedure TAVLAbstractTree<T>.Delete(var ANode: T);
-var OldParent, Child, LSuccessor: T;
+procedure TAbstractBTree<TIdentify, TData>.EraseTree;
+var Lnode : TAbstractBTreeNode;
 begin
-  BeginUpdate;
-  try
-    if (Not IsNil(GetPosition(ANode,poLeft))) and (Not IsNil(GetPosition(ANode,poRight))) then begin
-      // ANode has both: Left and Right
-      // Switch ANode position with Successor
-      // Because ANode.Right<>nil the Successor is a child of ANode
-      LSuccessor := FindSuccessor(ANode);
-      SwitchPositionWithSuccessor(ANode,LSuccessor);
+  Lnode := GetRoot;
+  if Not IsNil(Lnode.identify) then EraseTreeExt(Lnode);
+  ClearNode(Lnode);
+  if Fcount>0 then SetCount(0);
+  SetRoot(Lnode);
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.EraseTreeExt(var ANode: TAbstractBTreeNode);
+var i : Integer;
+  Lchild : TAbstractBTreeNode;
+begin
+  if Not (ANode.IsLeaf) then begin
+    for i:=0 to Length(ANode.childs)-1 do begin
+      Lchild := GetNode(ANode.childs[i]);
+      EraseTreeExt(Lchild);
     end;
-    // left or right is nil
-    OldParent:=GetPosition(ANode,poParent);
-    ClearPosition(ANode,poParent);
-    if Not IsNil(GetPosition(ANode,poLeft)) then
-      Child:=GetPosition(ANode,poLeft)
-    else
-      Child:=GetPosition(ANode,poRight);
-    if Not IsNil(Child) then
-      SetPosition(Child,poParent,OldParent);
-    if Not IsNil(OldParent) then begin
-      // Node has parent
-      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
-        // Node is left child of OldParent
-        SetPosition(OldParent,poLeft,Child);
-        SetBalance(OldParent, GetBalance(OldParent)+1);
-      end else begin
-        // Node is right child of OldParent
-        SetPosition(OldParent,poRight,Child);
-        SetBalance(OldParent, GetBalance(OldParent)-1);
+  end;
+  for i:=0 to Length(ANode.data)-1 do begin
+    DisposeData(ANode.data[i]);
+  end;
+  DisposeNode(ANode);
+  ClearNode(ANode);
+end;
+
+function TAbstractBTree<TIdentify, TData>.Find(const AData: TData; out ANode: TAbstractBTreeNode; out iPos: Integer): Boolean;
+var LCircularPreviousSearchProtection : TNoDuplicateData<TIdentify>;
+begin
+  if FCircularProtection then begin
+    LCircularPreviousSearchProtection := TNoDuplicateData<TIdentify>.Create(FOnCompareIdentify);
+  end else LCircularPreviousSearchProtection := Nil;
+  try
+    ANode := GetRoot;
+    iPos := 0;
+    repeat
+      if FCircularProtection then begin
+        if Not LCircularPreviousSearchProtection.Add(ANode.identify) then raise EAbstractBTree.Create('Circular T structure at Find for T='+ToString(ANode)+ ' searching for '+NodeDataToString(AData));
       end;
-      BalanceAfterDelete(OldParent);
-    end else begin
-      // Node was Root
-      SetRoot( Child );
+      if (BinarySearch(AData,ANode.data,iPos)) then Exit(True)
+      else if (Not ANode.IsLeaf) then ANode := GetNode( ANode.childs[ iPos ] )
+      else Exit(False);
+    until False;
+  finally
+    if FCircularProtection then begin
+      LCircularPreviousSearchProtection.Free;
     end;
-    dec(FCount);
-
-    DisposeNode(ANode);
+  end;
+end;
 
-  finally
-    EndUpdate;
+function TAbstractBTree<TIdentify, TData>.FindChildPos(const AIdent: TIdentify; const AParent: TAbstractBTreeNode): Integer;
+begin
+  for Result := 0 to High(AParent.childs) do begin
+    if AreEquals(AIdent,AParent.childs[Result]) then Exit;
   end;
+  raise EAbstractBTree.Create(Format('Child not found at %s',[ToString(AParent)]));
 end;
 
+function TAbstractBTree<TIdentify, TData>.FindHighest(out AHighest : TData) : Boolean;
+var Lnode : TAbstractBTreeNode;
+begin
+  Lnode := FindHighestNode;
+  if Lnode.Count>0 then begin
+     AHighest := Lnode.data[Lnode.Count-1];
+     Result := True;
+  end else Result := False;
+end;
 
-procedure TAVLAbstractTree<T>.EndUpdate;
+function TAbstractBTree<TIdentify, TData>.FindHighestNode: TAbstractBTreeNode;
 begin
-  if FDisabledsCount<=0 then Raise EAVLAbstractTree.Create('EndUpdate invalid');
-  Dec(FDisabledsCount);
-  if FDisabledsCount=0 then UpdateFinished;
+  Result := GetRoot;
+  while (Not Result.IsLeaf) do Result := GetNode(Result.childs[Result.Count]);
 end;
 
-procedure TAVLAbstractTree<T>.SwitchPositionWithSuccessor(aNode, aSuccessor: T);
-{ called by delete, when aNode.Left<>nil and aNode.Right<>nil
-  Switch ANode position with Successor
-  Because ANode.Right<>nil the Successor is a child of ANode }
-var
-  OldBalance: Integer;
-  OldParent, OldLeft, OldRight,
-  OldSuccParent, OldSuccLeft, OldSuccRight: T;
-begin
-  OldBalance:=GetBalance(aNode);
-  SetBalance(aNode, GetBalance(aSuccessor));
-  SetBalance(aSuccessor, OldBalance);
-
-  OldParent:=GetPosition(aNode,poParent);
-  OldLeft:=GetPosition(aNode,poLeft);
-  OldRight:=GetPosition(aNode,poRight);
-  OldSuccParent:=GetPosition(aSuccessor,poParent);
-  OldSuccLeft:=GetPosition(aSuccessor,poLeft);
-  OldSuccRight:=GetPosition(aSuccessor,poRight);
-
-  if Not IsNil(OldParent) then begin
-    if AreEquals(GetPosition(OldParent,poLeft),aNode) then
-      SetPosition(OldParent,poLeft,aSuccessor)
-    else
-      SetPosition(OldParent,poRight,aSuccessor);
-  end else
-    SetRoot(aSuccessor);
-  SetPosition(aSuccessor,poParent,OldParent);
-
-  if Not AreEquals(OldSuccParent,aNode) then begin
-    if AreEquals(GetPosition(OldSuccParent,poLeft),aSuccessor) then
-      SetPosition(OldSuccParent,poLeft,aNode)
-    else
-      SetPosition(OldSuccParent,poRight,aNode);
-    SetPosition(aSuccessor,poRight,OldRight);
-    SetPosition(aNode,poParent,OldSuccParent);
-    if Not IsNil(OldRight) then
-      SetPosition(OldRight,poParent,aSuccessor);
-  end else begin
-    {  aNode            aSuccessor
-         \          =>    \
-         aSuccessor       aNode  }
-    SetPosition(aSuccessor,poRight,aNode);
-    SetPosition(aNode,poParent,aSuccessor);
-  end;
-
-  SetPosition(aNode,poLeft,OldSuccLeft);
-  if Not IsNil(OldSuccLeft) then
-    SetPosition(OldSuccLeft,poParent,aNode);
-  SetPosition(aNode,poRight,OldSuccRight);
-  if Not IsNil(OldSuccRight) then
-    SetPosition(OldSuccRight,poParent,aNode);
-  SetPosition(aSuccessor,poLeft,OldLeft);
-  if Not IsNil(OldLeft) then
-    SetPosition(OldLeft,poParent,aSuccessor);
-end;
-
-function TAVLAbstractTree<T>.Find(const AData: T): T;
-var Comp: integer;
-  {$IFDEF ABSTRACTMEM_CHECK}
-  LPreviousSearch : TOrderedList<T>;
-  {$ENDIF}
+function TAbstractBTree<TIdentify, TData>.FindLowest(out ALowest : TData) : Boolean;
+var Lnode : TAbstractBTreeNode;
 begin
-  {$IFDEF ABSTRACTMEM_CHECK}
-  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
-  try
-  {$ENDIF}
-    Result:=Root;
-    while (Not IsNil(Result)) do begin
-      {$IFDEF ABSTRACTMEM_CHECK}
-      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at Find for T='+ToString(Result)+ ' searching for '+ToString(AData));
-      {$ENDIF}
-      Comp:=fOnCompare(AData,Result);
-      if Comp=0 then exit;
-      if Comp<0 then begin
-        Result:=GetPosition(Result,poLeft);
-      end else begin
-        Result:=GetPosition(Result,poRight);
-      end;
+  Lnode := FindLowestNode;
+  if Lnode.Count>0 then begin
+    ALowest := Lnode.data[0];
+    Result := True;
+  end else Result := False;
+end;
+
+function TAbstractBTree<TIdentify, TData>.FindLowestNode: TAbstractBTreeNode;
+begin
+  Result := GetRoot;
+  while (Not Result.IsLeaf) do Result := GetNode(Result.childs[0]);
+end;
+
+function TAbstractBTree<TIdentify, TData>.FindPrecessor(const AData : TData; out APrecessor : TData) : Boolean;
+var Lnode : TAbstractBTreeNode;
+  iPos : Integer;
+begin
+  Result := False;
+  if Not Find(AData,Lnode,iPos) then Exit(False);
+  repeat
+    Result := FindPrecessorExt(Lnode,iPos);
+    if Result then begin
+      APrecessor := Lnode.data[iPos];
     end;
-  {$IFDEF ABSTRACTMEM_CHECK}
-  finally
-    LPreviousSearch.Free;
-  end;
-  {$ENDIF}
+  until (Not Result) or (Not FAllowDuplicates) or (DoCompareData(AData,APrecessor)>0);
 end;
 
-function TAVLAbstractTree<T>.FindInsertPos(const AData: T): T;
-var Comp: integer;
-  {$IFDEF ABSTRACTMEM_CHECK}
-  LPreviousSearch : TOrderedList<T>;
-  {$ENDIF}
+function TAbstractBTree<TIdentify, TData>.FindPrecessorExt(var ANode: TAbstractBTreeNode; var iPos: Integer): Boolean;
+var Lparent : TAbstractBTreeNode;
 begin
-  {$IFDEF ABSTRACTMEM_CHECK}
-  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
-  try
-  {$ENDIF}
-    Result:=Root;
-    while (Not IsNil(Result)) do begin
-      {$IFDEF ABSTRACTMEM_CHECK}
-      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at FindInsertPos for T='+ToString(Result)+ ' searching for '+ToString(AData));
-      {$ENDIF}
-      Comp:=fOnCompare(AData,Result);
-      if Comp<0 then begin
-        if (HasPosition(Result,poLeft)) then begin
-          Result:=GetPosition(Result,poLeft);
-        end else begin
-          Exit;
-        end;
+  Result := False;
+  if (Not ANode.IsLeaf) then begin
+    ANode := GetNode(ANode.childs[iPos]);
+    while (Not ANode.IsLeaf) do ANode := GetNode(ANode.childs[ANode.Count]);
+    iPos := ANode.Count-1;
+    Exit(True);
+  end else begin
+    if iPos>0 then begin
+      Dec(iPos);
+      Exit(True);
+    end else if (Not IsNil(ANode.parent)) then begin
+      // Left sibling
+      Lparent := GetNode(ANode.parent);
+      iPos := FindChildPos(ANode.identify,Lparent);
+      if iPos>0 then begin
+        Dec(iPos);
+        ANode := Lparent;
+        Exit(True);
       end else begin
-        if (HasPosition(Result,poRight)) then begin
-          Result:=GetPosition(Result,poRight);
-        end else begin
-          Exit;
+        // Search parents until parent iPos>0
+        while (iPos=0) and (Not IsNil(Lparent.parent)) do begin
+          ANode := Lparent;
+          Lparent := GetNode(ANode.parent);
+          iPos := FindChildPos(ANode.identify,Lparent);
+        end;
+        if iPos>0 then begin
+          Dec(iPos);
+          ANode := Lparent;
+          Exit(True);
         end;
       end;
     end;
-  {$IFDEF ABSTRACTMEM_CHECK}
-  finally
-    LPreviousSearch.Free;
   end;
-  {$ENDIF}
 end;
 
-function TAVLAbstractTree<T>.FindSuccessor(const ANode: T): T;
+function TAbstractBTree<TIdentify, TData>.FindSuccessor(const AData : TData; out ASuccessor : TData) : Boolean;
+var Lnode : TAbstractBTreeNode;
+  iPos : Integer;
 begin
-  if HasPosition(ANode,poRight) then begin
-    Result := GetPosition(ANode,poRight);
-    while (HasPosition(Result,poLeft)) do Result:=GetPosition(Result,poLeft);
-  end else begin
-    Result := ANode;
-    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poRight),Result)) do
-      Result:=GetPosition(Result,poParent);
-    Result := GetPosition(Result,poParent);
-  end;
+  Result := False;
+  if Not Find(AData,Lnode,iPos) then Exit(False);
+  repeat
+    Result := FindSuccessorExt(Lnode,iPos);
+    if Result then begin
+      ASuccessor := Lnode.data[iPos];
+    end;
+  until (Not Result) or (Not FAllowDuplicates) or (DoCompareData(AData,ASuccessor)<0);
 end;
 
-function TAVLAbstractTree<T>.ToString: String;
-var i : Integer;
-  LStrings : TStringList;
-  LNode : T;
+function TAbstractBTree<TIdentify, TData>.FindSuccessorExt(var ANode: TAbstractBTreeNode; var iPos: Integer): Boolean;
+var Lparent : TAbstractBTreeNode;
 begin
-  LStrings := TStringList.Create;
-  try
-    i := 0;
-    LNode := FindLowest;
-    while (Not IsNil(LNode)) do begin
-      inc(i);
-      LStrings.Add(Format('Pos:%d - %s',[i,ToString(LNode)]));
-      LNode := FindSuccessor(LNode);
+  Result := False;
+  if (Not ANode.IsLeaf) then begin
+    ANode := GetNode(ANode.childs[iPos+1]);
+    iPos := 0;
+    while (Not ANode.IsLeaf) do ANode := GetNode(ANode.childs[0]);
+    Exit(True);
+  end else begin
+    if iPos+1<ANode.Count then begin
+      inc(iPos);
+      Exit(True);
+    end else if (Not IsNil(ANode.parent)) then begin
+      // right sibling
+      Lparent := GetNode(ANode.parent);
+      iPos := FindChildPos(ANode.identify,Lparent);
+      if iPos<Lparent.Count then begin
+        ANode := Lparent;
+        Exit(True);
+      end else begin
+        // Search parents until parent iPos>0
+        while (iPos=Lparent.Count) and (Not IsNil(Lparent.parent)) do begin
+          ANode := Lparent;
+          Lparent := GetNode(ANode.parent);
+          iPos := FindChildPos(ANode.identify,Lparent);
+        end;
+        if iPos<Lparent.Count then begin
+          ANode := Lparent;
+          Exit(True);
+        end;
+      end;
     end;
-    LStrings.Add(Format('Total:%d',[i]));
-    Result := LStrings.Text;
-  finally
-    LStrings.Free;
   end;
 end;
 
-procedure TAVLAbstractTree<T>.UpdateFinished;
-{$IFDEF ABSTRACTMEM_TESTING_MODE}
-var LErrors : TStrings;
-{$ENDIF}
+function TAbstractBTree<TIdentify, TData>.GetCount: Integer;
 begin
-  // Nothing to do here. Used in inheritance classes
-  {$IFDEF ABSTRACTMEM_TESTING_MODE}
-  LErrors := TStringList.Create;
-  Try
-    if ConsistencyCheck(LErrors)<>0 then begin
-      raise EAVLAbstractTree.Create('CONSISTENCY ERRORS'+#10+LErrors.Text);
-    end;
-  Finally
-    LErrors.Free;
-  End;
-  {$ENDIF}
+  Result := FCount;
 end;
 
-function TAVLAbstractTree<T>.ToString(const ANode: T): String;
+function TAbstractBTree<TIdentify, TData>.GetHeight: Integer;
+var Lnode : TAbstractBTreeNode;
 begin
-  Result := Format('Abstract T %d bytes',[SizeOf(T)]);
+  Lnode := GetRoot;
+  if (Lnode.Count=0) or (IsNil(Lnode.identify)) then Exit(0);
+  Result := 1;
+  while (Not Lnode.IsLeaf) do begin
+    Lnode := GetNode(Lnode.childs[0]);
+    inc(Result);
+  end;
 end;
 
-function TAVLAbstractTree<T>.FindPrecessor(const ANode: T): T;
+function TAbstractBTree<TIdentify, TData>.MaxChildrenPerNode: Integer;
 begin
-  if HasPosition(ANode,poLeft) then begin
-    Result := GetPosition(ANode,poLeft);
-    while (HasPosition(Result,poRight)) do Result:=GetPosition(Result,poRight);
-  end else begin
-    Result := ANode;
-    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poLeft),Result)) do
-      Result:=GetPosition(Result,poParent);
-    Result := GetPosition(Result,poParent);
-  end;
+  Result := FOrder;
 end;
 
-function TAVLAbstractTree<T>.CheckNode(const ANode: T; ACheckedList : TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer;
-var i : Integer;
-  LLeftDepth, LRightDepth : Integer;
-  LParent, LLeft, LRight : T;
+function TAbstractBTree<TIdentify, TData>.MaxItemsPerNode: Integer;
 begin
-  Result := 0;
+  Result := FOrder-1;
+end;
 
-  LLeftDepth := 0;
-  LRightDepth := 0;
+function TAbstractBTree<TIdentify, TData>.MinChildrenPerNode: Integer;
+begin
+  // Order 3 -> 1-2 items 2-3 childrens
+  // Order 4 -> 1-3 items 2-4 childrens
+  // Order 5 -> 2-4 items 3-5 childrens
+  // Order 6 -> 2-5 items 3-6 childrens
+  // Order 7 -> 3-6 items 4-7 childrens
+  // ...
+  Result := ((FOrder+1) DIV 2);
+end;
 
-  ALeftDepth := 0;
-  ARightDepth := 0;
+function TAbstractBTree<TIdentify, TData>.MinItemsPerNode: Integer;
+begin
+  Result := ((FOrder+1) DIV 2)-1;
+end;
 
-  if IsNil(ANode) then begin
-    exit(0);
-  end;
-  if Assigned(ACheckedList) then begin
-    if ACheckedList.Find(ANode,i) then begin
-      // Found in previous searchs...
-      Result := -1;
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency circular found at %d of %d -> %s',[i,ACheckedList.Count,ToString(ANode)]));
-      end;
-      Exit;
+procedure TAbstractBTree<TIdentify, TData>.MoveRange(var ASourceNode, ADestNode: TAbstractBTreeNode; AFromSource, ACount, AToDest: Integer);
+var i : Integer;
+  Lchild : TAbstractBTreeNode;
+begin
+  // Will NOT save nodes because are passed as a variable, BUT will save child nodes!
+  if (ACount<=0) then Exit; // Nothing to move...
+
+  Assert(ACount>0,'Invalid move range count');
+  Assert((AFromSource>=0) and (AFromSource<Length(ASourceNode.data)),'Invalid move range from source');
+  Assert((AToDest>=0) and (AToDest<=Length(ADestNode.data)),'Invalid move range to dest');
+  // MoveRange is only available to move LEFT or RIGHT of ASourceNode, never MIDDLE positions
+  Assert((AFromSource=0) or ((AFromSource+ACount)=ASourceNode.Count),'Invalid MIDDLE positions of node');
+  Assert(((AFromSource=0) and (AToDest=ADestNode.Count)) or
+         ((AtoDest=0) and (AFromSource+ACount=ASourceNode.Count))
+           ,Format('Invalid middle MoveRange from %d count %d to %d  source.count=%d dest.count=%d',[AFromSource,ACount,AToDest,ASourceNode.Count,ADestNode.Count]));
+
+  for i := 0 to ACount-1 do begin
+    ADestNode.InsertData(ASourceNode.data[AFromSource + i],AToDest+i);
+    if Not ASourceNode.IsLeaf then begin
+      Lchild := GetNode( ASourceNode.childs[AFromSource + i] );
+      Lchild.parent := ADestNode.identify;
+      SaveNode(Lchild);
+      ADestNode.InsertChild( ASourceNode.childs[AFromSource + i], AToDest + i);
     end;
-    ACheckedList.Add(ANode);
+  end;
+  if Not ASourceNode.IsLeaf then begin
+    Lchild := GetNode( ASourceNode.childs[(AFromSource + ACount)] );
+    Lchild.parent := ADestNode.identify;
+    SaveNode(Lchild);
+    ADestNode.InsertChild( ASourceNode.childs[AFromSource + ACount], AToDest + ACount );
   end;
 
-  // test left son
-  if HasPosition(ANode,poLeft) then begin
-    LLeft := GetPosition(ANode,poLeft);
-    if Not AreEquals(GetPosition(GetPosition(ANode,poLeft),poParent),ANode) then begin
-      Result:=-2;
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency not equals in left for %s',[ToString(ANode)]));
-      end;
-      Exit;
-    end;
-    if fOnCompare(GetPosition(ANode,poLeft),ANode)>0 then begin
-      Result:=-3;
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency compare>0 in left for %s',[ToString(ANode)]));
-      end;
-      Exit;
-    end;
-    Result:=CheckNode(GetPosition(ANode,poLeft),ACheckedList,LLeftDepth,LRightDepth,AErrors);
-    if LLeftDepth>LRightDepth then inc(ALeftDepth,LLeftDepth+1)
-    else inc(ALeftDepth,LRightDepth+1);
-    if Result<>0 then Exit;
-  end else ClearNode(LLeft);
-  // test right son
-  if HasPosition(ANode,poRight) then begin
-    LRight := GetPosition(ANode,poRight);
-    if Not AreEquals(GetPosition(GetPosition(ANode,poRight),poParent),ANode) then begin
-      Result:=-4;
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency not equals in right for %s found %s at right.parent',[ToString(ANode),ToString(GetPosition(GetPosition(ANode,poRight),poParent))]));
-      end;
-      Exit;
-    end;
-    if fOnCompare(GetPosition(ANode,poRight),ANode)<0 then begin
-      Result:=-5;
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency compare>0 in right for %s',[ToString(ANode)]));
-      end;
-      Exit;
-    end;
-    Result:=CheckNode(GetPosition(ANode,poRight),ACheckedList,LLeftDepth,LRightDepth,AErrors);
-    if LLeftDepth>LRightDepth then inc(ARightDepth,LLeftDepth+1)
-    else inc(ARightDepth,LRightDepth+1);
-    if Result<>0 then Exit;
-  end else ClearNode(LRight);
-
-  if (HasPosition(ANode,poParent)) then begin
-    LParent := GetPosition(ANode,poParent);
-  end else ClearNode(LParent);
-
-  if Not IsNil(LParent) then begin
-    if AreEquals(ANode,LParent) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Self=Parent for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
-      end;
-      Result := -7;
+  for i := 0 to ACount-1 do begin
+    ASourceNode.DeleteData(AFromSource + i);
+    if Not ASourceNode.IsLeaf then begin
+      ASourceNode.DeleteChild(AFromSource + i);
     end;
   end;
-  if Not IsNil(LLeft) then begin
-    if AreEquals(ANode,LLeft) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Self=Left for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
-      end;
-      Result := -8;
-    end;
+  if Not ASourceNode.IsLeaf then begin
+    ASourceNode.DeleteChild(AFromSource + ACount);
   end;
-  if Not IsNil(LRight) then begin
-    if AreEquals(ANode,LRight) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Self=Right for %s (Right %s)',[ToString(ANode),ToString(LRight)]));
-      end;
-      Result := -9;
-    end;
+
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.MoveRangeBetweenSiblings(var ASourceNode, ADestNode: TAbstractBTreeNode);
+var i, LdestStart : Integer;
+  Lchild : TAbstractBTreeNode;
+begin
+  LdestStart := Length(ADestNode.data);
+  SetLength(ADestNode.data,Length(ADestNode.data)+Length(ASourceNode.data));
+  for i := 0 to Length(ASourceNode.data)-1 do begin
+    ADestNode.data[LdestStart + i] := ASourceNode.data[i];
   end;
-  if (Not IsNil(LParent)) and (Not IsNil(LLeft)) then begin
-    if AreEquals(LParent,LLeft) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Parent=Left for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
-      end;
-      Result := -10;
-    end;
+
+  LdestStart := Length(ADestNode.childs);
+  SetLength(ADestNode.childs,Length(ADestNode.childs)+Length(ASourceNode.childs));
+  for i := 0 to Length(ASourceNode.childs)-1 do begin
+    ADestNode.childs[LdestStart + i] := ASourceNode.childs[i];
+    Lchild := GetNode( ASourceNode.childs[i] );
+    Lchild.parent := ADestNode.identify;
+    SaveNode(Lchild);
   end;
-  if (Not IsNil(LParent)) and (Not IsNil(LRight)) then begin
-    if AreEquals(LParent,LRight) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Parent=Right for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
-      end;
-      Result := -11;
-    end;
+end;
+
+function TAbstractBTree<TIdentify, TData>.NodeDataToString(const AData: TData): String;
+begin
+  Result := IntToStr(SizeOf(AData));
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.SetCount(const ANewCount: Integer);
+begin
+  FCount := ANewCount;
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.SplitAfterInsert(var ANode: TAbstractBTreeNode);
+var iDataInsertPos : Integer;
+  LnewNode, Lup : TAbstractBTreeNode;
+begin
+  Assert(ANode.Count>MaxItemsPerNode);
+  LnewNode := NewNode;
+  MoveRange(ANode,LnewNode,MinItemsPerNode+1,ANode.Count - (MinItemsPerNode+1),0);
+  // Put ANode[MinItemsPerNode+1] up
+  if IsNil(ANode.parent) then begin
+    // Lup will be a new root
+    Lup := NewNode;
+  end else begin
+    Lup := GetNode(ANode.parent);
   end;
-  if (Not IsNil(LLeft)) and (Not IsNil(LRight)) then begin
-    if AreEquals(LLeft,LRight) then begin
-      if Assigned(AErrors) then begin
-        AErrors.Add(Format('Error Consistency Left=Right for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
-      end;
-      Result := -12;
-    end;
+  if Lup.Count=0 then begin
+    Lup.InsertData(ANode.data[MinItemsPerNode], 0 );
+    // Insert both childs because is a new root
+    Lup.InsertChild(ANode.identify,0);
+    SaveNode(LnewNode); // We need a valid identify value
+    Lup.InsertChild(LnewNode.identify,1);
+    SaveNode(Lup);
+    SetRoot(Lup);
+  end else begin
+    iDataInsertPos := FindChildPos(ANode.identify,Lup);
+    Lup.InsertData(ANode.data[MinItemsPerNode], iDataInsertPos );
+    SaveNode(LnewNode); // We need a valid identify value
+    Lup.InsertChild(LnewNode.identify, iDataInsertPos +1 );
+    SaveNode(Lup);
   end;
+  LnewNode.parent := Lup.identify;
+  SaveNode(LnewNode);
+  ANode.parent := Lup.identify;
+  // Remove data&child
+  ANode.DeleteData(MinItemsPerNode);
+  SaveNode(ANode);
+  if Lup.Count>MaxItemsPerNode then SplitAfterInsert(Lup);
+end;
 
-  // Check balance
-  if GetBalance(ANode)<>(ARightDepth - ALeftDepth) then begin
-    if Assigned(AErrors) then begin
-      AErrors.Add(Format('Error Consistency balance (%d <> Right(%d) - Left(%d)) at %s',[GetBalance(ANode),ARightDepth,ALeftDepth,ToString(ANode)]));
-    end;
-    Result := -15;
-    Exit;
+function TAbstractBTree<TIdentify, TData>.ToString(const ANode: TAbstractBTreeNode): String;
+var i : Integer;
+begin
+  Result := '';
+  for i := 0 to ANode.Count-1 do begin
+    if Result<>'' then Result := Result + ',';
+    Result := Result + NodeDataToString(ANode.data[i]);
   end;
+  Result := '['+Result+']';
 end;
 
-procedure TAVLAbstractTree<T>.RotateLeft(var ANode: T);
-{    Parent                Parent
-       |                     |
-      Node        =>       OldRight
-      /  \                  /
-   Left OldRight          Node
-          /               /  \
-     OldRightLeft      Left OldRightLeft  }
-var
-  AParent, OldRight, OldRightLeft: T;
-begin
-  OldRight:=GetPosition(aNode,poRight);
-  OldRightLeft:=GetPosition(OldRight,poLeft);
-  AParent:=GetPosition(aNode,poParent);
-  if Not IsNil(AParent) then begin
-    if AreEquals(GetPosition(AParent,poLeft),aNode) then
-      SetPosition(AParent,poLeft,OldRight)
-    else
-      SetPosition(AParent,poRight,OldRight);
-  end else
-    SetRoot( OldRight );
-  SetPosition(OldRight,poParent,AParent);
-  SetPosition(aNode,poParent,OldRight);
-  SetPosition(aNode,poRight,OldRightLeft);
-  if Not IsNil(OldRightLeft) then
-    SetPosition(OldRightLeft,poParent,aNode);
-  SetPosition(OldRight,poLeft,aNode);
-end;
-
-procedure TAVLAbstractTree<T>.RotateRight(var ANode: T);
-{       Parent              Parent
-          |                   |
-         Node        =>     OldLeft
-         /   \                 \
-    OldLeft  Right            Node
-        \                     /  \
-   OldLeftRight      OldLeftRight Right  }
-var
-  AParent, OldLeft, OldLeftRight: T;
-begin
-  OldLeft:=GetPosition(ANode,poLeft);
-  OldLeftRight:=GetPosition(OldLeft,poRight);
-  AParent:=GetPosition(ANode,poParent);
-  if Not IsNil(AParent) then begin
-    if AreEquals(GetPosition(AParent,poLeft),aNode) then
-      SetPosition(AParent,poLeft,OldLeft)
-    else
-      SetPosition(AParent,poRight,OldLeft);
-  end else
-    SetRoot( OldLeft );
-  SetPosition(OldLeft,poParent,AParent);
-  SetPosition(aNode,poParent,OldLeft);
-  SetPosition(aNode,poLeft,OldLeftRight);
-  if Not IsNil(OldLeftRight) then
-    SetPosition(OldLeftRight,poParent,aNode);
-  SetPosition(OldLeft,poRight,aNode);
-end;
-
-procedure TAVLAbstractTree<T>.CheckNode(const ANode: T);
-var LLeft,LRight : Integer;
-  LErrors : TStrings;
-begin
-  LErrors := TStringList.Create;
-  try
-    if CheckNode(ANode,Nil,LLeft,LRight,LErrors)<>0 then
-      raise EAVLAbstractTree.Create('CHECK CONSISTENCY ERROR'+#10+LErrors.Text);
-  finally
-    LErrors.Free;
+{ TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode }
+
+function TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.Count: Integer;
+begin
+  Result := Length(Self.data);
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.DeleteChild(AChildIndex: Integer);
+var i : Integer;
+begin
+  for i := AChildIndex to (High(Self.childs)-1) do begin
+    Self.childs[i] := Self.childs[i+1];
   end;
+  SetLength(Self.childs,Length(Self.childs)-1);
 end;
 
-function TAVLAbstractTree<T>.ConsistencyCheck(const AErrors : TStrings): integer;
-var LCheckedList : TOrderedList<T>;
-var LLeftDepth, LRightDepth : Integer;
+procedure TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.DeleteData(AIndex: Integer);
+var i : Integer;
 begin
-  LCheckedList := TOrderedList<T>.Create(False,FOnCompare);
-  try
-    LLeftDepth := 0;
-    LRightDepth := 0;
-    Result:=CheckNode(Root,LCheckedList,LLeftDepth,LRightDepth,AErrors);
-  finally
-    LCheckedList.Free;
+  for i := AIndex to (High(Self.data)-1) do begin
+    Self.data[i] := Self.data[i+1];
+  end;
+  SetLength(Self.data,Length(Self.data)-1);
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.InsertChild(const AChild: TIdentify; AIndex: Integer);
+var i : Integer;
+begin
+  if (AIndex<0) or (AIndex>Length(Self.childs)) then raise EAbstractBTree.Create('Error 20201215-3');
+  SetLength(Self.childs,Length(Self.childs)+1);
+  for i := Length(Self.childs)-1 downto AIndex+1 do begin
+    Self.childs[i] := Self.childs[i-1];
   end;
+  Self.childs[AIndex] := AChild;
 end;
 
-{ TPAVLPointerTree }
+procedure TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.InsertData(const AData: TData; AIndex: Integer);
+var i : Integer;
+begin
+  if (AIndex<0) or (AIndex>Length(Self.data)) then raise EAbstractBTree.Create('Error 20201215-4');
+  SetLength(Self.data,Length(Self.data)+1);
+  for i := Length(Self.data)-1 downto AIndex+1 do begin
+    Self.data[i] := Self.data[i-1];
+  end;
+  Self.data[AIndex] := AData;
+end;
 
-function TPAVLPointerTree.AreEquals(const ANode1, ANode2: PAVLPointerTreeNode): Boolean;
+function TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.IsLeaf: Boolean;
 begin
-  Result := ANode1 = ANode2;
+  Result := Length(Self.childs)=0;
 end;
 
-procedure TPAVLPointerTree.ClearNode(var ANode: PAVLPointerTreeNode);
+procedure TAbstractBTree<TIdentify, TData>.TAbstractBTreeNode.RemoveInNode(AIndex: Integer);
+var i : Integer;
 begin
-  ANode := Nil;
+  {
+  Can only remove LEFT or RIGHT. Not Middle positions
+  }
+  if (AIndex<0) or (AIndex>=Length(Self.data)) then raise EAbstractBTree.Create('Error 20201215-5');
+  Assert((AIndex=0) or (AIndex=High(Self.data)),'Must remove first or last position');
+  for i := AIndex to (High(Self.data)-1) do begin
+    Self.data[i] := Self.data[i+1];
+  end;
+  SetLength(Self.data,Length(Self.data)-1);
+  if (Not Self.IsLeaf) then begin
+    if (AIndex>=Length(Self.childs)) then raise EAbstractBTree.Create('Error 20201215-6');
+    if (Aindex=0) and (Length(Self.childs)>2)  then begin
+      for i := AIndex+1 to (High(Self.childs)) do begin
+        Self.childs[i-1] := Self.childs[i];
+      end;
+    end;
+    SetLength(Self.childs,Length(Self.childs)-1);
+  end;
 end;
 
-procedure TPAVLPointerTree.ClearPosition(var ANode: PAVLPointerTreeNode; APosition: TAVLTreePosition);
+{ TMemoryBTree<TData> }
+
+procedure TMemoryBTree<TData>.CheckConsistencyFinalized(ADatas: TList<TData>; AIdents: TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount: Integer);
+var i,iPos,nDisposed, LDisposedMinPos : Integer;
 begin
-  case APosition of
-    poParent: ANode.parent := Nil;
-    poLeft: ANode.left := Nil;
-    poRight: ANode.right := Nil;
+  inherited;
+  nDisposed := 0;
+  LDisposedMinPos := -1;
+  for i := 0 to FBuffer.Count-1 do begin
+    if (FBuffer.Items[i].identify=i) then begin
+      if Assigned(AIdents) then begin
+        if not AIdents.Find(i,iPos) then begin
+          raise EAbstractBTree.Create(Format('CheckConsistency ident %d not found (%d idents)',[i,FBuffer.Count]));
+        end;
+      end;
+    end else begin
+      inc(nDisposed);
+      if (LDisposedMinPos<0) then LDisposedMinPos := i;
+    end;
   end;
+  if FDisposed<>nDisposed then raise EAbstractBTree.Create(Format('CheckConsistency Disposed %d <> %d',[FDisposed,nDisposed]));
+  if FDisposedMinPos>LDisposedMinPos then raise EAbstractBTree.Create(Format('CheckConsistency DisposedMinPos %d > %d',[FDisposedMinPos,LDisposedMinPos]));
+end;
+
+constructor TMemoryBTree<TData>.Create(const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder : Integer);
+begin
+  FBuffer := TList<TAbstractBTreeNode>.Create;
+  Froot := -1;
+  inherited Create(TComparison_Integer,AOnCompareDataMethod,AAllowDuplicates,AOrder);
+  FCount := 0;
+  FDisposed := 0;
+  FDisposedMinPos := -1;
 end;
 
-constructor TPAVLPointerTree.Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean);
+destructor TMemoryBTree<TData>.Destroy;
 begin
-  FRoot := Nil;
+  EraseTree;
+  FreeAndNil(FBuffer);
   inherited;
 end;
 
-procedure TPAVLPointerTree.DisposeNode(var ANode: PAVLPointerTreeNode);
+procedure TMemoryBTree<TData>.DisposeNode(var ANode: TAbstractBTree<Integer, TData>.TAbstractBTreeNode);
+var Lpos : Integer;
 begin
-  if Not Assigned(ANode) then Exit;
-  Dispose( ANode );
-  ANode := Nil;
+  Lpos := ANode.identify;
+  Assert((Lpos>=0) and (Lpos<FBuffer.Count),Format('Dispose %d out of range [0..%d]',[Lpos,FBuffer.Count-1]));
+  ClearNode(ANode);
+  FBuffer[Lpos] := ANode;
+  inc(FDisposed);
+  if (FDisposedMinPos<0) or (FDisposedMinPos>Lpos) then FDisposedMinPos := Lpos;
 end;
 
-function TPAVLPointerTree.GetBalance(const ANode: PAVLPointerTreeNode): Integer;
+function TMemoryBTree<TData>.GetNode(AIdentify: Integer): TAbstractBTree<Integer, TData>.TAbstractBTreeNode;
 begin
-  Result := ANode^.balance;
+  Result := FBuffer[AIdentify];
+  if (Result.identify<>AIdentify) then raise EAbstractBTree.Create(Format('Found %d Identify instead of %d',[Result.identify,AIdentify]));
 end;
 
-function TPAVLPointerTree.GetPosition(const ANode: PAVLPointerTreeNode;
-  APosition: TAVLTreePosition): PAVLPointerTreeNode;
+function TMemoryBTree<TData>.GetRoot: TAbstractBTree<Integer, TData>.TAbstractBTreeNode;
 begin
-  case APosition of
-    poParent: Result := ANode.parent;
-    poLeft: Result := ANode.left;
-    poRight: Result := ANode.right;
-  else raise EAVLAbstractTree.Create('Undefined 20200310-1');
+  if (Froot<0) then begin
+    ClearNode(Result);
+    Exit;
   end;
+  Result := GetNode(Froot);
 end;
 
-function TPAVLPointerTree.GetRoot: PAVLPointerTreeNode;
+function TMemoryBTree<TData>.IsNil(const AIdentify: Integer): Boolean;
 begin
-  Result := FRoot;
+  Result := AIdentify<0;
 end;
 
-function TPAVLPointerTree.HasPosition(const ANode: PAVLPointerTreeNode;
-  APosition: TAVLTreePosition): Boolean;
+function TMemoryBTree<TData>.NewNode: TAbstractBTree<Integer, TData>.TAbstractBTreeNode;
 begin
-  case APosition of
-    poParent: Result := Assigned( ANode.parent );
-    poLeft: Result := Assigned( ANode.left );
-    poRight: Result := Assigned( ANode.right );
-  else raise EAVLAbstractTree.Create('Undefined 20200310-2');
+  ClearNode(Result);
+  if (FDisposed > 0) And (FDisposed > (Count DIV 5)) then begin // 20% max disposed nodes
+    // Reuse disposed node:
+    if (FDisposedMinPos<0) then FDisposedMinPos := 0;
+    while (FDisposedMinPos<FBuffer.Count) and (FBuffer.Items[FDisposedMinPos].identify = FDisposedMinPos) do inc(FDisposedMinPos);
+    if (FDisposedMinPos>=0) and (FDisposedMinPos<FBuffer.Count) then begin
+      Assert(FBuffer.Items[FDisposedMinPos].identify<0);
+      Result.identify := FDisposedMinPos;
+      inc(FDisposedMinPos);
+      Dec(FDisposed);
+      FBuffer.Items[Result.identify] := Result;
+      Exit;
+    end else raise EAbstractBTree.Create('Cannot reuse NewNode');
   end;
+  Result.identify := FBuffer.Count;
+  FBuffer.Insert(Result.identify,Result);
 end;
 
-function TPAVLPointerTree.IsNil(const ANode: PAVLPointerTreeNode): Boolean;
+procedure TMemoryBTree<TData>.SaveNode(var ANode: TAbstractBTree<Integer, TData>.TAbstractBTreeNode);
 begin
-  Result := ANode = Nil;
+  if (ANode.identify<0) then begin
+    raise EAbstractBTree.Create('Save undefined node '+ToString(ANode));
+    // New
+    ANode.identify := FBuffer.Count;
+    FBuffer.Insert(ANode.identify,ANode);
+  end else begin
+    FBuffer[ANode.identify] := ANode;
+  end;
 end;
 
-procedure TPAVLPointerTree.SetBalance(var ANode: PAVLPointerTreeNode;
-  ANewBalance: Integer);
+procedure TMemoryBTree<TData>.SetNil(var AIdentify: Integer);
 begin
-  ANode^.balance := ANewBalance;
+  AIdentify := -1;
 end;
 
-procedure TPAVLPointerTree.SetPosition(var ANode: PAVLPointerTreeNode;
-  APosition: TAVLTreePosition; const ANewValue: PAVLPointerTreeNode);
+procedure TMemoryBTree<TData>.SetRoot(var Value: TAbstractBTree<Integer, TData>.TAbstractBTreeNode);
 begin
-  case APosition of
-    poParent: ANode.parent := ANewValue;
-    poLeft: ANode.left := ANewValue;
-    poRight: ANode.right := ANewValue;
-  end;
+  Froot := Value.identify;
 end;
 
-procedure TPAVLPointerTree.SetRoot(const Value: PAVLPointerTreeNode);
+{ TIntegerBTree }
+
+constructor TIntegerBTree.Create(AAllowDuplicates: Boolean; AOrder: Integer);
 begin
-  FRoot := Value;
+  inherited Create(TComparison_Integer,AAllowDuplicates,AOrder);
 end;
 
-function TPAVLPointerTree.ToString(const ANode: PAVLPointerTreeNode): String;
-var LParent, LLeft, LRight : String;
+function TIntegerBTree.NodeDataToString(const AData: Integer): String;
 begin
-  if Assigned(ANode) then begin
-    if Assigned(ANode.parent) then LParent := IntToStr(Integer(ANode.parent.data)) else LParent := 'NIL';
-    if Assigned(ANode.left) then LLeft := IntToStr(Integer(ANode.left.data)) else LLeft := 'NIL';
-    if Assigned(ANode.right) then LRight := IntToStr(Integer(ANode.right.data)) else LRight := 'NIL';
+  Result := AData.ToString;
+end;
 
-    Result := Format('%d (Parent:%s Left:%s Right:%s Balance:%d)',[Integer(ANode.data),LParent,LLeft,LRight,ANode.balance]);
-  end else begin
-    Result := 'NIL';
-  end;
+{ TNoDuplicateData<TData> }
+
+function TNoDuplicateData<TData>.Add(const AData: TData): Boolean;
+begin
+  Result := FBTree.Add(AData);
+end;
+
+constructor TNoDuplicateData<TData>.Create(const AOnCompareDataMethod: TComparison<TData>);
+begin
+  FBTree := TMemoryBTree<TData>.Create(AOnCompareDataMethod,False,7);
+  FBTree.FCircularProtection := False;
+end;
+
+destructor TNoDuplicateData<TData>.Destroy;
+begin
+  FreeAndNil(FBTree);
+  inherited;
 end;
 
 initialization

src/libraries/abstractmem/UAbstractMem.pas

@@ -3,7 +3,7 @@ unit UAbstractMem;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -34,7 +34,7 @@ interface
 uses
   Classes, SysUtils,
   SyncObjs,
-  UAbstractBTree;
+  UAbstractAVLTree;
 
 {$I ./ConfigAbstractMem.inc }
 
@@ -142,6 +142,7 @@ Type
     procedure SaveToStream(AStream : TStream);
     procedure CopyFrom(ASource : TAbstractMem);
     function GetStatsReport(AClearStats : Boolean) : String; virtual;
+    class function SizeOfPosition : Integer;
   End;
 
   TMem = Class(TAbstractMem)
@@ -542,6 +543,11 @@ begin
   End;
 end;
 
+class function TAbstractMem.SizeOfPosition: Integer;
+begin
+  Result := 4; // 4 Bytes
+end;
+
 function TAbstractMem.ToString: String;
 var LAnalize : TStrings;
   LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;

src/libraries/abstractmem/UAbstractMemBTree.pas

@@ -0,0 +1,434 @@
+unit UAbstractMemBTree;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // 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}
+  UOrderedList, UAbstractMem, UAbstractBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EAbstractMemBTree = Class(Exception);
+
+  TAbstractMemBTree = Class( TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition> )
+    // 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
+  private
+    const CT_MIN_INITIAL_POSITION_SIZE = 16;
+          CT_AbstractMemBTree_Magic = 'AMBT'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
+    var
+    FInitialZone : TAMZone;
+    FrootPosition : TAbstractMemPosition;
+    procedure SaveHeader;
+    function GetNodeSize : Integer;
+  protected
+    FAbstractMem : TAbstractMem;
+    function GetRoot: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    procedure SetRoot(var Value: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
+    function NewNode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    procedure DisposeNode(var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
+    procedure SetNil(var AIdentify : TAbstractMemPosition); override;
+    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;
+    //
+  public
+    function IsNil(const AIdentify : TAbstractMemPosition) : Boolean; override;
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer); virtual;
+    destructor Destroy; override;
+    function GetNode(AIdentify : TAbstractMemPosition) : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    class function MinAbstractMemInitialPositionSize : Integer;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+  End;
+
+  TAbstractMemBTreeData<TData> = Class(TAbstractMemBTree)
+  private
+    // FLeft_ and FRight_ will be used as a cache for improvement calls on DoCompareData
+    FLeft_Pos, FRight_Pos : TAbstractMemPosition;
+    FLeft_Data, FRight_Data : TData;
+    FSearchTarget : TData;
+    FOnCompareAbstractMemData: TComparison<TData>;
+  protected
+    function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+    //
+    function LoadData(const APosition : TAbstractMemPosition) : TData; virtual; abstract;
+    function SaveData(const AData : TData) : TAMZone; virtual; abstract;
+  public
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer; const AOnCompareAbstractMemDataMethod: TComparison<TData>);
+    function AddData(const AData: TData) : Boolean;
+    function FindData(const AData: TData; var APosition : TAbstractMemPosition) : Boolean;
+    function DeleteData(const AData: TData) : Boolean;
+  End;
+
+
+
+implementation
+
+{ TAbstractMemBTree<TData> }
+
+constructor TAbstractMemBTree.Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates: Boolean;  AOrder: Integer);
+var LBuff : TBytes;
+ i : Integer;
+ LOrder : Integer;
+
+begin
+  FAbstractMem := AAbstractMem;
+  FrootPosition := 0;
+  inherited Create(TComparison_Integer,TComparison_Integer,AAllowDuplicates,AOrder);
+  FCount := 0;
+  //
+  if Not FAbstractMem.GetUsedZoneInfo(AInitialZone.position,False,FInitialZone) then raise EAbstractMemBTree.Create('Cannot capture zone info for initialize');
+  if (FInitialZone.size<MinAbstractMemInitialPositionSize) then raise EAbstractMemBTree.Create(Format('Invalid size %d for initialize',[FInitialZone.size]));
+  SetLength(LBuff,CT_MIN_INITIAL_POSITION_SIZE);
+  FAbstractMem.Read(FInitialZone.position,LBuff[0],Length(LBuff));
+  try
+    // Check magic
+    for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+      if LBuff[i]<>Ord(CT_AbstractMemBTree_Magic.Chars[i]) then Exit;
+    end;
+    Move(LBuff[4],FrootPosition,4);
+    Move(LBuff[8],FCount,4);
+    LOrder := 0;
+    Move(LBuff[12],LOrder,4);
+    if LOrder<>Order then raise EAbstractMemBTree.Create(Format('Invalid Order %d expected %d',[LOrder,Order]));
+    if ( Not ((FrootPosition=0) and (FCount=0))) then raise EAbstractMemBTree.Create(Format('Invalid initial root %d vs count %d',[FrootPosition,FCount]));
+  finally
+    if FrootPosition<=0 then begin
+      FrootPosition := 0;
+      FCount := 0;
+      for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+        LBuff[i] := Byte(Ord(CT_AbstractMemBTree_Magic.Chars[i]));
+      end;
+      Move(FrootPosition,LBuff[4],4);
+      Move(FCount,LBuff[8],4);
+      LOrder := Order;
+      Move(LOrder,LBuff[12],4);
+      FAbstractMem.Write(FInitialZone.position,LBuff[0],16);
+      SaveHeader;
+    end;
+  end;
+end;
+
+destructor TAbstractMemBTree.Destroy;
+begin
+  //
+  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);
+begin
+  FAbstractMem.Dispose( ANode.identify );
+  ClearNode(ANode);
+end;
+
+function TAbstractMemBTree.GetNode(AIdentify: TAbstractMemPosition): TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+var LBuff : TBytes;
+  LStream : TStream;
+  LByte : Byte;
+  i, LItemsCount, LChildsCount : Integer;
+begin
+  // For each node:
+  // Size = (4+2+2)+(4*MaxItemsPerNode)+(4*MaxChildrenPerNode) = GetNodeSize
+  // 4 Bytes [0..3] : Parent
+  // 1 Byte  [4] : Used items (0..32)
+  // 1 Byte  [5] : Used childs (0 (leaf) or Used Items+1)
+  // 2 Bytes [6..7] : 0 (unusued)
+  // For each item:
+  //   4 Bytes : data (AbstractMemPosition or Data using 4 bytes)
+  // For each children:
+  //   4 Bytes : Children AbstractMem position
+  ClearNode(Result);
+  Result.identify := AIdentify;
+  SetLength(LBuff, GetNodeSize );
+  FAbstractMem.Read(AIdentify,LBuff[0],Length(LBuff));
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Write(LBuff[0],Length(LBuff));
+    LStream.Position := 0;
+    //
+    LStream.Read(Result.parent,4); // Read parent position
+    LStream.Read(LByte,1);
+    LItemsCount := LByte;
+    LStream.Read(LByte,1);
+    LChildsCount := LByte;
+    LStream.Read(LByte,1);
+    Assert(LByte=0);
+    LStream.Read(LByte,1);
+    Assert(LByte=0);
+    if ((LItemsCount=0) and (Result.parent=0) and (LChildsCount=0)) then begin
+      // root without data
+    end else begin
+      if (Result.parent=0) then begin
+        if ((LItemsCount<1) or (LItemsCount>MaxItemsPerNode)) then
+          raise EAbstractMemBTree.Create(Format('Root Node items %d not in range [%d..%d]',[LItemsCount,MinItemsPerNode,MaxItemsPerNode]));
+      end else begin
+        if ((LItemsCount<MinItemsPerNode) or (LItemsCount>MaxItemsPerNode)) then
+          raise EAbstractMemBTree.Create(Format('Node items %d not in range [%d..%d]',[LItemsCount,MinItemsPerNode,MaxItemsPerNode]));
+      end;
+      if ((LChildsCount<>0) and (LChildsCount<>(LItemsCount+1))) then
+        raise EAbstractMemBTree.Create(Format('Node childrens %d not %d+1 in range [%d..%d]',[LChildsCount,LItemsCount,MinChildrenPerNode,MaxChildrenPerNode]));
+    end;
+    // Read items
+    SetLength(Result.data,LItemsCount);
+    SetLength(Result.childs,LChildsCount);
+    for i := 0 to LItemsCount-1 do begin
+      LStream.Read(Result.data[i],4);
+    end;
+    // Read childrens
+    for i := 0 to LChildsCount-1 do begin
+      LStream.Read(Result.childs[i],4);
+    end;
+  finally
+    LStream.Free;
+  end;
+end;
+
+function TAbstractMemBTree.GetNodeSize: Integer;
+begin
+  Result := 8 + (4 * MaxItemsPerNode) + (4 * MaxChildrenPerNode);
+end;
+
+function TAbstractMemBTree.GetRoot: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+begin
+  if FrootPosition>0 then begin
+    Result := GetNode(FrootPosition);
+  end else ClearNode(Result);
+end;
+
+function TAbstractMemBTree.IsNil(const AIdentify: TAbstractMemPosition): Boolean;
+begin
+  Result := AIdentify=0;
+end;
+
+class function TAbstractMemBTree.MinAbstractMemInitialPositionSize: Integer;
+begin
+  Result := CT_MIN_INITIAL_POSITION_SIZE;
+end;
+
+function TAbstractMemBTree.NewNode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+begin
+  ClearNode(Result);
+  Result.identify := FAbstractMem.New(GetNodeSize).position;
+end;
+
+procedure TAbstractMemBTree.SaveHeader;
+var LBuff : TBytes;
+ i : Integer;
+ LOrder : Integer;
+begin
+  SetLength(LBuff,16);
+  for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+    LBuff[i] := Byte(Ord(CT_AbstractMemBTree_Magic.Chars[i]));
+  end;
+  Move(FrootPosition,LBuff[4],4);
+  Move(FCount,LBuff[8],4);
+  LOrder := Order;
+  Move(LOrder,LBuff[12],4);
+  FAbstractMem.Write(FInitialZone.position,LBuff[0],16);
+end;
+
+procedure TAbstractMemBTree.SaveNode(var ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
+var LBuff : TBytes;
+  LStream : TStream;
+  LByte : Byte;
+  i, LItemsCount, LChildsCount : Integer;
+begin
+  if ((ANode.Count)>MaxItemsPerNode) or (Length(ANode.childs)>MaxChildrenPerNode) then begin
+    // Protection agains saving temporal Node info with extra datas or childs
+    Exit;
+  end;
+
+  // See GetNode info
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Write(ANode.parent,4);
+    LItemsCount := Length(ANode.data);
+    LStream.Write(LItemsCount,1);
+    LChildsCount := Length(ANode.childs);
+    LStream.Write(LChildsCount,1);
+    LByte := 0;
+    LStream.Write(LByte,1);
+    LStream.Write(LByte,1);
+    for i := 0 to LItemsCount-1 do begin
+      LStream.Write(ANode.data[i],4)
+    end;
+    // Read childrens
+    for i := 0 to LChildsCount-1 do begin
+      LStream.Write(ANode.childs[i],4);
+    end;
+    SetLength(LBuff,LStream.Size);
+    LStream.Position := 0;
+    LStream.Read(LBuff[0],LStream.Size);
+    FAbstractMem.Write(ANode.identify,LBuff[0],Length(LBuff));
+  finally
+    LStream.Free;
+  end;
+end;
+
+procedure TAbstractMemBTree.SetCount(const ANewCount: Integer);
+begin
+  inherited;
+  SaveHeader;
+end;
+
+procedure TAbstractMemBTree.SetNil(var AIdentify: TAbstractMemPosition);
+begin
+  inherited;
+  AIdentify := 0;
+end;
+
+procedure TAbstractMemBTree.SetRoot(var Value: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
+begin
+  inherited;
+  FrootPosition := Value.identify;
+  SaveHeader;
+end;
+
+{ TAbstractMemBTreeData<TData> }
+
+function TAbstractMemBTreeData<TData>.AddData(const AData: TData): Boolean;
+var Lzone : TAMZone;
+begin
+  Lzone := SaveData(AData);
+  Result := inherited Add(Lzone.position);
+  if Not Result then begin
+    // Dispose
+    FAbstractMem.Dispose(Lzone);
+  end;
+end;
+
+constructor TAbstractMemBTreeData<TData>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TData>);
+begin
+  inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder);
+  FOnCompareAbstractMemData := AOnCompareAbstractMemDataMethod;
+  FLeft_Pos  := 0;
+  FRight_Pos := 0;
+end;
+
+function TAbstractMemBTreeData<TData>.DeleteData(const AData: TData): Boolean;
+var LAbstractMemPos : TAbstractMemPosition;
+begin
+  if FindData(AData,LAbstractMemPos) then begin
+    Delete(LAbstractMemPos);
+    FAbstractMem.Dispose(LAbstractMemPos);
+    Result := True;
+    if FLeft_Pos=LAbstractMemPos then FLeft_Pos := 0;
+    if FRight_Pos=LAbstractMemPos then FRight_Pos := 0;
+  end else Result := False;
+end;
+
+function TAbstractMemBTreeData<TData>.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
+var Ltmp : TData;
+begin
+  Assert((ALeftData<>0) and (ARightData<>0) and (ARightData<>1),Format('DoCompareData: Invalid Left %d or Right %d (data cannot be 0 neither 1)',[ALeftData,ARightData]));
+  if (ALeftData=ARightData) then begin
+    // Comparing same data because stored on same position
+    Exit(0);
+  end;
+  Assert(ALeftData<>ARightData,Format('DoCompareData: Left (%d) and Right (%d) are equals',[ALeftData,ARightData]));
+  if (ALeftData=1) then begin
+    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
+      if (FLeft_Pos=ARightData) then begin
+        Result := FOnCompareAbstractMemData(FSearchTarget,FLeft_Data);
+        Exit;
+      end;
+      FRight_Pos := ARightData;
+      FRight_Data := LoadData(ARightData);
+    end;
+    Result := FOnCompareAbstractMemData(FSearchTarget,FRight_Data);
+  end else begin
+    if (FLeft_Pos=0) or (FLeft_Pos<>ALeftData) then begin
+      if (FRight_Pos=ALeftData) then begin
+        // Use right as left
+        if (FLeft_Pos<>ARightData) then begin
+          // Left is not right, reload
+          FLeft_Pos := ARightData;
+          FLeft_Data := LoadData(ARightData);
+        end;
+        Result := FOnCompareAbstractMemData(FRight_Data,FLeft_Data);
+        Exit;
+      end;
+      FLeft_Pos := ALeftData;
+      FLeft_Data := LoadData(ALeftData);
+    end;
+    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
+      FRight_Pos := ARightData;
+      FRight_data := LoadData(ARightData);
+    end;
+    Result := FOnCompareAbstractMemData(FLeft_data,FRight_data);
+  end;
+end;
+
+function TAbstractMemBTreeData<TData>.FindData(const AData: TData;
+  var APosition: TAbstractMemPosition): Boolean;
+var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
+  LiPosNode : Integer;
+begin
+  // NOTE: This is not multithread protected
+  FSearchTarget := AData;
+  if Find(1,Lnode,LiPosNode) then begin
+    APosition := Lnode.data[LiPosNode];
+    Result := True;
+  end else begin
+    APosition := 0;
+    Result := False;
+  end;
+end;
+
+initialization
+
+finalization
+
+end.

src/libraries/abstractmem/UAbstractMemTList.pas

@@ -3,7 +3,7 @@ unit UAbstractMemTList;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -57,35 +57,38 @@ type
     FNextElementPosition : Integer;
 
     FUseCache : Boolean;
+    FUseCacheAuto : Boolean;
     FCacheData : TBytes;
     FCacheUpdated : Boolean;
+    FCacheDataLoaded : Boolean;
+    FCacheDataUsedBytes : Integer;
 
     function GetPosition(AIndex: Integer): TAbstractMemPosition;
     procedure SetPosition(AIndex: Integer; const Value: TAbstractMemPosition);
 
+    function UseCacheData(AWillUpdateData : Boolean) : Boolean;
     Procedure CheckInitialized;
     procedure GetPointerTo(AIndex : Integer; AAllowIncrease : Boolean; out APreviousBlockPointer, ABlockPointer : TAbstractMemPosition; out AIndexInBlock : Integer);
     procedure AddRange(AIndexStart, AInsertCount : Integer);
     procedure RemoveRange(AIndexStart, ARemoveCount : Integer);
     procedure LoadElements(AIndexStart : Integer; var AElements : TBytes);
     procedure SetUseCache(const Value: Boolean);
+    procedure Initialize(const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer);
   protected
     FAbstractMemTListLock : TCriticalSection;
   public
-    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer); virtual;
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AUseCache : Boolean); virtual;
     destructor Destroy; override;
 
     procedure FlushCache;
 
-    procedure Initialize(const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer);
-
-    Function Add(const APosition : TAbstractMemPosition) : Integer; //virtual;
+    Function Add(const APosition : TAbstractMemPosition) : Integer;
 
-    Procedure Clear; //virtual;
+    Procedure Clear;
     Procedure Dispose;
 
-    Procedure Delete(index : Integer); //virtual;
-    Procedure Insert(AIndex : Integer; const APosition : TAbstractMemPosition); //virtual;
+    Procedure Delete(index : Integer);
+    Procedure Insert(AIndex : Integer; const APosition : TAbstractMemPosition);
 
     property Position[AIndex : Integer] : TAbstractMemPosition read GetPosition write SetPosition;
 
@@ -93,6 +96,7 @@ type
     property AbstractMem : TAbstractMem read FAbstractMem;
     property InitialiZone : TAMZone read FInitialZone;
     property UseCache : Boolean read FUseCache write SetUseCache;
+    property UseCacheAuto : Boolean read FUseCacheAuto write FUseCacheAuto;
     procedure LockList;
     procedure UnlockList;
   End;
@@ -101,6 +105,8 @@ type
   private
     FAbstractMem: TAbstractMem;
     function GetInitialZone: TAMZone;
+    function GetUseCache : Boolean;
+    procedure SetUseCache(const Value: Boolean);
   protected
     FList : TAbstractMemTList;
     // POSSIBLE OVERRIDE METHODS
@@ -111,7 +117,7 @@ type
     procedure LoadFrom(const ABytes : TBytes; var AItem : T); virtual; abstract;
     procedure SaveTo(const AItem : T; AIsAddingItem : Boolean; var ABytes : TBytes); virtual; abstract;
   public
-    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer); virtual;
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AUseCache : Boolean); virtual;
     Destructor Destroy; override;
 
     Function Add(const AItem : T) : Integer; virtual;
@@ -124,6 +130,7 @@ type
     Procedure Dispose;
     property AbstractMem : TAbstractMem read FAbstractMem;
     property InitialiZone : TAMZone read GetInitialZone;
+    property UseCache : Boolean read GetUseCache write SetUseCache;
   End;
 
 
@@ -141,7 +148,7 @@ type
     // ABSTRACT METHODS NEED TO OVERRIDE
     function Compare(const ALeft, ARight : T) : Integer; virtual; abstract;
   public
-    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AAllowDuplicates : Boolean); reintroduce;
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AAllowDuplicates, AUseCache : Boolean); reintroduce;
     function Find(const AItemToFind : T; out AIndex : Integer) : Boolean;
     Function Add(const AItem : T) : Integer; reintroduce;
     property Item[index : Integer] : T read GetItem;
@@ -182,10 +189,16 @@ var LElements : TBytes;
 begin
   CheckInitialized;
   if (AIndexStart<0) or (AInsertCount<=0) or (AIndexStart>FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s AddRange %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart+AInsertCount,FNextElementPosition-1]));
-  if (FUseCache) then begin
+  if (UseCacheData(True)) then begin
+    if (Length(FCacheData)-FCacheDataUsedBytes)< (AInsertCount*4) then begin
+      // Increase
+      if (FElementsOfEachBlock>AInsertCount) then i := FElementsOfEachBlock
+      else i := AInsertCount;
+      SetLength(FCacheData,Length(FCacheData) + (i * 4));
+    end;
     FCacheUpdated := True;
-    SetLength(FCacheData,Length(FCacheData)+(AInsertCount*4));
-    Move(FCacheData[AIndexStart*4],FCacheData[(AIndexStart+AInsertCount)*4],Length(FCacheData)-((AIndexStart+AInsertCount)*4));
+    Inc(FCacheDataUsedBytes,(AInsertCount*4));
+    Move(FCacheData[AIndexStart*4],FCacheData[(AIndexStart+AInsertCount)*4],FCacheDataUsedBytes-((AIndexStart+AInsertCount)*4));
     Inc(FNextElementPosition,AInsertCount);
     Exit;
   end;
@@ -233,6 +246,7 @@ begin
 
   SetLength(FCacheData,0);
   FCacheUpdated := False;
+  FCacheDataUsedBytes := 0;
   Finally
     FAbstractMemTListLock.Release;
   End;
@@ -243,11 +257,14 @@ begin
   Result := FNextElementPosition;
 end;
 
-constructor TAbstractMemTList.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; ADefaultElementsPerBlock : Integer);
+constructor TAbstractMemTList.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; ADefaultElementsPerBlock : Integer; AUseCache : Boolean);
 begin
   SetLength(FCacheData,0);
-  FUseCache := True;
+  FUseCache := AUseCache;
   FCacheUpdated := False;
+  FCacheDataLoaded := False;
+  FCacheDataUsedBytes := 0;
+  FUseCacheAuto := True;
 
   FAbstractMem := AAbstractMem;
   FInitialZone.Clear;
@@ -305,7 +322,7 @@ begin
   LNext := 0;
   // Save full:
   i := 0;
-  while ((i*4) < (Length(FCacheData))) do begin
+  while ((i*4) < (FCacheDataUsedBytes)) do begin
     GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
     if (i+FElementsOfEachBlock-1 >= FNextElementPosition) then begin
       LElements := FNextElementPosition - i;
@@ -393,7 +410,7 @@ begin
   Result := 0;
   FAbstractMemTListLock.Acquire;
   try
-  if FUseCache then begin
+  if (UseCacheData(False)) then begin
     if (AIndex<0) or (AIndex>=FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementPosition-1]));
     Move( FCacheData[AIndex*4], Result, 4);
   end else begin
@@ -450,12 +467,6 @@ begin
       FAbstractMem.Write( FInitialZone.position, LBytes[0], Length(LBytes) );
     end;
   end;
-  if (FUseCache) then begin
-    if (FElementsOfEachBlock>0) then begin
-      LoadElements(0,FCacheData);
-    end;
-    FCacheUpdated := False;
-  end;
 end;
 
 procedure TAbstractMemTList.Insert(AIndex: Integer; const APosition: TAbstractMemPosition);
@@ -465,7 +476,7 @@ begin
   FAbstractMemTListLock.Acquire;
   try
   AddRange(AIndex,1);
-  if FUseCache then begin
+  if (UseCacheData(True)) then begin
     Move(APosition, FCacheData[AIndex*4], 4);
     FCacheUpdated := True;
   end else begin
@@ -519,14 +530,13 @@ begin
     else raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range (NO ELEMENTS)',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1]))
   end;
 
-  if FUseCache then begin
+  if (UseCacheData(True)) then begin
     if (AIndexStart+ARemoveCount < FNextElementPosition) then begin
       Move(FCacheData[(AIndexStart + ARemoveCount) *4],
            FCacheData[(AIndexStart) *4],
-           Length(FCacheData)-((AIndexStart + ARemoveCount)*4));
-
+           FCacheDataUsedBytes-((AIndexStart + ARemoveCount)*4));
     end;
-    SetLength(FCacheData,Length(FCacheData) - (ARemoveCount*4));
+    Dec(FCacheDataUsedBytes,(ARemoveCount*4));
     FCacheUpdated := True;
     Dec(FNextElementPosition,ARemoveCount);
     Exit;
@@ -584,7 +594,7 @@ var LBlockPointer, LPreviousBlockPointer : TAbstractMemPosition;
 begin
   FAbstractMemTListLock.Acquire;
   try
-  if FUseCache then begin
+  if (UseCacheData(True)) then begin
     Move( Value, FCacheData[AIndex*4], 4);
     FCacheUpdated := True;
   end else begin
@@ -602,9 +612,12 @@ begin
   if (FUseCache) then begin
     FlushCache;
     SetLength(FCacheData,0);
+    FCacheDataUsedBytes := 0;
   end else begin
-    LoadElements(0,FCacheData);
+    SetLength(FCacheData,0);
+    FCacheDataLoaded := False;
     FCacheUpdated := False;
+    FCacheDataUsedBytes := 0;
   end;
   FUseCache := Value;
 end;
@@ -614,6 +627,19 @@ begin
   FAbstractMemTListLock.Release;
 end;
 
+function TAbstractMemTList.UseCacheData(AWillUpdateData : Boolean): Boolean;
+begin
+  if (FUseCache) or ((AWillUpdateData) and (FUseCacheAuto)) then begin
+    FUseCache := True;
+    Result := True;
+    if Not FCacheDataLoaded then begin
+      FCacheDataLoaded := True;
+      LoadElements(0,FCacheData);
+      FCacheDataUsedBytes := Length(FCacheData);
+    end;
+  end else Result := False;
+end;
+
 { TAbstractMemTListBaseAbstract<T> }
 
 function TAbstractMemTListBaseAbstract<T>.Add(const AItem: T): Integer;
@@ -657,10 +683,10 @@ begin
 end;
 
 constructor TAbstractMemTListBaseAbstract<T>.Create(AAbstractMem: TAbstractMem;
-  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer);
+  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer; AUseCache : Boolean);
 begin
   FAbstractMem := AAbstractMem;
-  FList := TAbstractMemTList.Create(AAbstractMem,AInitialZone,ADefaultElementsPerBlock);
+  FList := TAbstractMemTList.Create(AAbstractMem,AInitialZone,ADefaultElementsPerBlock,AUseCache);
 end;
 
 procedure TAbstractMemTListBaseAbstract<T>.Delete(index: Integer);
@@ -720,6 +746,16 @@ begin
   end;
 end;
 
+function TAbstractMemTListBaseAbstract<T>.GetUseCache: Boolean;
+begin
+  FList.LockList;
+  try
+    Result := FList.UseCache;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
 procedure TAbstractMemTListBaseAbstract<T>.SetItem(index: Integer;
   const AItem: T);
 var
@@ -765,6 +801,16 @@ begin
   end;
 end;
 
+procedure TAbstractMemTListBaseAbstract<T>.SetUseCache(const Value: Boolean);
+begin
+  FList.LockList;
+  try
+    FList.UseCache := Value;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
 function TAbstractMemTListBaseAbstract<T>.ToString(const AItem: T): String;
 begin
   Result := Self.ClassName+'.T '+IntToStr(SizeOf(AItem));
@@ -797,9 +843,9 @@ end;
 
 constructor TAbstractMemOrderedTList<T>.Create(AAbstractMem: TAbstractMem;
   const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer;
-  AAllowDuplicates: Boolean);
+  AAllowDuplicates, AUseCache: Boolean);
 begin
-  inherited Create(AAbstractMem, AInitialZone, ADefaultElementsPerBlock);
+  inherited Create(AAbstractMem, AInitialZone, ADefaultElementsPerBlock, AUseCache);
   FAllowDuplicates := AAllowDuplicates;
 end;
 

src/libraries/abstractmem/UCacheMem.pas

@@ -1,9 +1,9 @@
-unit UCacheMem;
+unit UCacheMem;
 
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -34,7 +34,7 @@ interface
 uses
   Classes, SysUtils,
   {$IFNDEF FPC}{$IFDEF MSWINDOWS}windows,{$ENDIF}{$ENDIF}
-  UAbstractBTree, UOrderedList;
+  UAbstractAVLTree, UOrderedList;
 
 {$I ./ConfigAbstractMem.inc }
 
@@ -108,6 +108,9 @@ type
     maxUsedCacheSize : Integer;
     reusedCacheMemDataCount : Integer;
     reusedCacheMemDataBytes : Int64;
+    deletedBlocksReused : Integer;
+    deletedBlocksSaved : Integer;
+    deletedBlocksCount : Integer;
     procedure Clear;
     function ToString : String;
   end;
@@ -135,10 +138,13 @@ type
     FMaxCacheSize: Integer;
     FMaxCacheDataBlocks: Integer;
     FDefaultCacheDataBlocksSize : Integer;
+    FGridCache : Boolean;
     function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
     procedure Delete(var APCacheMemData : PCacheMemData); overload;
     function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
     procedure CheckMaxMemUsage;
+    function LoadDataExt(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
+    procedure SaveToCacheExt(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean);
   public
     Constructor Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
     Destructor Destroy; override;
@@ -165,6 +171,7 @@ type
     property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
     property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
     property DefaultCacheDataBlocksSize : Integer read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
+    property GridCache : Boolean read FGridCache write FGridCache;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     procedure ClearStats;
     property CacheMemStats : TCacheMemStats read FCacheMemStats;
@@ -321,7 +328,8 @@ begin
   FCacheDataBlocks := 0;
   FPendingToSaveBytes := 0;
   FCacheDataSize := 0;
-  FDefaultCacheDataBlocksSize := 4000;
+  FDefaultCacheDataBlocksSize := 9000;
+  FGridCache := False;
   FOnNeedDataProc := AOnNeedDataProc;
   FOnSaveDataProc := AOnSaveDataProc;
   FOldestUsed := Nil;
@@ -340,6 +348,9 @@ begin
   APCacheMemData^.UnMark(Self,APCacheMemData);
   FCacheData.Delete(APCacheMemData);
   Dec(FCacheDataBlocks);
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  inc(FCacheMemStats.deletedBlocksCount);
+  {$ENDIF}
 end;
 
 destructor TCacheMem.Destroy;
@@ -512,6 +523,36 @@ begin
 end;
 
 function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+Var
+  LNewStartPos, LIndex, LLoadSize, LMoveSize : Integer;
+  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;
+end;
+
+function TCacheMem.LoadDataExt(var ABuffer; const AStartPos, ASize: Integer): Boolean;
   // Will return a Pointer to AStartPos
 
   function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
@@ -546,7 +587,7 @@ begin
   if ASize=0 then Exit(True);
 
   if (FDefaultCacheDataBlocksSize>0) then begin
-    LNewStartPos := (((AStartPos-1) DIV FDefaultCacheDataBlocksSize) + 0 ) * FDefaultCacheDataBlocksSize;
+    LNewStartPos := (((AStartPos) DIV FDefaultCacheDataBlocksSize)) * FDefaultCacheDataBlocksSize;
     LSizeToStore := (((ASize-1) DIV FDefaultCacheDataBlocksSize) + 1 ) * FDefaultCacheDataBlocksSize;
     if (LNewStartPos + LSizeToStore) < (AStartPos + ASize) then begin
       inc(LSizeToStore, FDefaultCacheDataBlocksSize);
@@ -557,7 +598,7 @@ begin
   end;
 
   if (FindCacheMemDataByPosition(LNewStartPos,PCurrent)) then begin
-    if (PCurrent^.GetEndPos >= (AStartPos + ASize)) 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);
@@ -616,6 +657,9 @@ begin
         PToDelete := PCurrent;
         PCurrent := FCacheData.FindSuccessor(PCurrent);
         Delete( PToDelete );
+        {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+        inc(FCacheMemStats.deletedBlocksReused);
+        {$ENDIF}
       end;
     end;
     if (Result) and ((LLastAddedPosition) < (LNewP^.GetEndPos)) then begin
@@ -655,35 +699,7 @@ begin
   CheckMaxMemUsage;
 end;
 
-procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Integer; AMarkAsPendingToSave : Boolean);
-begin
-  SaveToCache(ABuffer[0],Length(ABuffer),AStartPos,AMarkAsPendingToSave);
-end;
-
-function TCacheMem.ToString: String;
-var
-  LLines : TStrings;
-  LPct : Double;
-  PCurrent : PCacheMemData;
-begin
-  LLines := TStringList.Create;
-  try
-    LLines.Add(Format('%s.ToString',[ClassName]));
-    PCurrent := FCacheData.FindLowest;
-    while (Assigned(PCurrent)) do begin
-      LLines.Add( PCurrent^.ToString );
-      PCurrent := FCacheData.FindSuccessor(PCurrent);
-    end;
-    if FCacheDataSize>0 then LPct := (FPendingToSaveBytes / FCacheDataSize)*100
-    else LPct := 0.0;
-    LLines.Add(Format('Total size %d bytes in %d blocks - Pending to Save %d bytes (%.2n%%)',[FCacheDataSize,FCacheDataBlocks,FPendingToSaveBytes,LPct]));
-    Result := LLines.Text;
-  finally
-    LLines.Free;
-  end;
-end;
-
-procedure TCacheMem.SaveToCache(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave : Boolean);
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
   LLastAddedPosition, LBytesCount : Integer;
@@ -710,11 +726,11 @@ begin
   New( LNewP );
   try
     LNewP.Clear;
-    SetLength(LNewP^.buffer, ASize);
     LNewP.startPos := AStartPos;
+    SetLength(LNewP^.buffer, ASize);
     LNewP^.pendingToSave := AMarkAsPendingToSave;
 
-    LLastAddedPosition := AStartPos - 1;
+    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
@@ -740,6 +756,9 @@ begin
         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
@@ -765,6 +784,75 @@ begin
   CheckMaxMemUsage;
 end;
 
+procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+begin
+  SaveToCache(ABuffer[0],Length(ABuffer),AStartPos,AMarkAsPendingToSave);
+end;
+
+procedure TCacheMem.SaveToCache(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave: Boolean);
+Var
+  LNewStartPos, LSizeToStore : Integer;
+  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;
+end;
+
+function TCacheMem.ToString: String;
+var
+  LLines : TStrings;
+  LPct : Double;
+  PCurrent : PCacheMemData;
+begin
+  LLines := TStringList.Create;
+  try
+    LLines.Add(Format('%s.ToString',[ClassName]));
+    PCurrent := FCacheData.FindLowest;
+    while (Assigned(PCurrent)) do begin
+      LLines.Add( PCurrent^.ToString );
+      PCurrent := FCacheData.FindSuccessor(PCurrent);
+    end;
+    if FCacheDataSize>0 then LPct := (FPendingToSaveBytes / FCacheDataSize)*100
+    else LPct := 0.0;
+    LLines.Add(Format('Total size %d bytes in %d blocks - Pending to Save %d bytes (%.2n%%)',[FCacheDataSize,FCacheDataBlocks,FPendingToSaveBytes,LPct]));
+    Result := LLines.Text;
+  finally
+    LLines.Free;
+  end;
+end;
+
 { TCacheMemData }
 
 procedure TCacheMemData.Clear;
@@ -906,12 +994,16 @@ begin
   freememElaspedMillis := 0;
   reusedCacheMemDataCount := 0;
   reusedCacheMemDataBytes := 0;
+  deletedBlocksReused := 0;
+  deletedBlocksSaved := 0;
+  deletedBlocksCount := 0;
 end;
 
 function TCacheMemStats.ToString: String;
 begin
-  Result := Format('CacheMemStats Reused:%d (%d bytes) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes) %d millis',
+  Result := Format('CacheMemStats Reused:%d (%d bytes) - Deleteds:%d (Saved:%d - reused:%d) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes) %d millis',
      [Self.reusedCacheMemDataCount,Self.reusedCacheMemDataBytes,
+      Self.deletedBlocksCount,Self.deletedBlocksSaved,Self.deletedBlocksReused,
       Self.flushCount,Self.flushSize,Self.flushElapsedMillis,
       Self.freememCount,Self.freememSize,
       Self.freememElaspedMillis]);

src/libraries/abstractmem/UFileMem.pas

@@ -3,7 +3,7 @@ unit UFileMem;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 
@@ -34,7 +34,7 @@ interface
 uses
   Classes, SysUtils,
   SyncObjs,
-  UAbstractBTree, UAbstractMem, UCacheMem;
+  UAbstractMem, UCacheMem;
 
 {$I ./ConfigAbstractMem.inc }
 

src/libraries/abstractmem/UOrderedList.pas

@@ -3,7 +3,7 @@ unit UOrderedList;
 {
   This file is part of AbstractMem framework
 
-  Copyright (C) 2020 Albert Molina - [email protected]
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
 
   https://github.com/PascalCoinDev/
 

src/libraries/abstractmem/tests/AbstractMem.Tests.dpr

@@ -26,14 +26,19 @@ uses
   GUITestRunner,
   TextTestRunner,
   {$ENDIF }
+  UAbstractAVLTree in '..\UAbstractAVLTree.pas',
   UAbstractBTree in '..\UAbstractBTree.pas',
   UAbstractMem in '..\UAbstractMem.pas',
+  UAbstractMemBTree in '..\UAbstractMemBTree.pas',
   UAbstractMemTList in '..\UAbstractMemTList.pas',
   UAVLCache in '..\UAVLCache.pas',
   UCacheMem in '..\UCacheMem.pas',
   UFileMem in '..\UFileMem.pas',
   UOrderedList in '..\UOrderedList.pas',
-  UCacheMem.Tests in 'src\UCacheMem.Tests.pas';
+  UCacheMem.Tests in 'src\UCacheMem.Tests.pas',
+  UAbstractMem.Tests in 'src\UAbstractMem.Tests.pas',
+  UAbstractBTree.Tests in 'src\UAbstractBTree.Tests.pas',
+  UAbstractMemBTree.Tests in 'src\UAbstractMemBTree.Tests.pas';
 
 {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
 type
@@ -45,6 +50,10 @@ var
 {$ENDIF}
 
 begin
+  {$IFNDEF FPC}
+  System.ReportMemoryLeaksOnShutdown := True;
+  {$ENDIF}
+
   {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
   Application := TFreePascalConsoleRunner.Create(nil);
   {$ENDIF}

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

@@ -0,0 +1,383 @@
+unit UAbstractBTree.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   UAbstractBTree, UOrderedList;
+
+type
+   TestTAbstractBTree = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+     procedure TestInfinite(AOrder : Integer);
+   published
+     procedure Test_duplicate;
+     procedure TestInsert;
+     procedure TestDelete;
+     procedure TestInfiniteOrder_3;
+     procedure TestInfiniteOrder_4;
+     procedure TestInfiniteOrder_5;
+     procedure TestInfiniteOrder_6;
+     procedure TestInfiniteOrder_7;
+     procedure TestPrecessorSuccessor;
+     procedure TestPrecessorSuccessor_Duplicates;
+   end;
+
+implementation
+
+function TComparison_XX_Integer(const ALeft, ARight: Integer): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+
+procedure TestTAbstractBTree.SetUp;
+begin
+end;
+
+procedure TestTAbstractBTree.TearDown;
+begin
+end;
+
+procedure TestTAbstractBTree.TestInfinite(AOrder : Integer);
+var Lbt : TIntegerBTree;
+  intValue, nRounds, nAdds, nDeletes, i : Integer;
+  Lnode : TIntegerBTree.TAbstractBTreeNode;
+begin
+  {$IFDEF FPC}
+  Randomize;
+  {$ELSE}
+  RandomizeProc(0);
+  {$ENDIF}
+  nRounds := 0;
+  nAdds := 0;
+  nDeletes := 0;
+  Lbt := TIntegerBTree.Create(True,AOrder);
+  try
+    repeat
+      inc(nRounds);
+      intValue := Random(AOrder * 100);
+      if Random(2)=0 then begin
+        if (Lbt.Add(intValue)) then begin
+          inc(nAdds);
+        end;
+      end else begin
+        if Lbt.Delete(intValue) then begin
+          inc(nDeletes);
+        end;
+      end;
+      if Random(100)=0 then begin
+        Lbt.CheckConsistency;
+      end;
+    until (nRounds>=AOrder * 10000);
+    Lbt.CheckConsistency;
+    // Delete mode
+    while Lbt.Count>0 do begin
+      Lnode := Lbt.Root;
+      while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
+        Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
+      end;
+      Lbt.Delete(Lnode.data[Random(Lnode.Count)]);
+      if Random(100)=0 then begin
+        Lbt.CheckConsistency;
+      end;
+    end;
+    Lbt.CheckConsistency;
+    // Try to re-use
+    for i := 1 to AOrder do begin
+      intValue := Random(AOrder * 100);
+      Assert(Lbt.Add(intValue),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
+      Lbt.CheckConsistency;
+    end;
+  finally
+    Lbt.Free;
+  end;
+
+end;
+
+procedure TestTAbstractBTree.TestInfiniteOrder_3;
+begin
+  TestInfinite(3);
+end;
+
+procedure TestTAbstractBTree.TestInfiniteOrder_4;
+begin
+  TestInfinite(4);
+end;
+
+procedure TestTAbstractBTree.TestInfiniteOrder_5;
+begin
+  TestInfinite(5);
+end;
+
+procedure TestTAbstractBTree.TestInfiniteOrder_6;
+begin
+  TestInfinite(6);
+end;
+
+procedure TestTAbstractBTree.TestInfiniteOrder_7;
+begin
+  TestInfinite(7);
+end;
+
+procedure TestTAbstractBTree.TestInsert;
+var Lbt : TIntegerBTree;
+  Lorder, i, intValue : Integer;
+begin
+  for Lorder := 3 to 5 do begin
+    Lbt := TIntegerBTree.Create(False,Lorder);
+    try
+      i := 1;
+      repeat
+        intValue := i;
+        inc(i);
+        Lbt.Add(intValue);
+        Lbt.CheckConsistency;
+      until Lbt.Height>6;
+    finally
+      Lbt.Free;
+    end;
+  end;
+  for Lorder := 3 to 5 do begin
+    Lbt := TIntegerBTree.Create(False,Lorder);
+    try
+      i := 10000;
+      repeat
+        intValue := i;
+        dec(i);
+        Lbt.Add(intValue);
+        Lbt.CheckConsistency;
+      until Lbt.Height>6;
+    finally
+      Lbt.Free;
+    end;
+  end;
+  for Lorder := 3 to 5 do begin
+    Lbt := TIntegerBTree.Create(False,Lorder);
+    try
+      repeat
+        intValue := Random(50000);
+        Lbt.Add(intValue);
+        Lbt.CheckConsistency;
+      until Lbt.Height>6;
+    finally
+      Lbt.Free;
+    end;
+  end;
+end;
+
+procedure TestTAbstractBTree.TestPrecessorSuccessor;
+var Lbt : TIntegerBTree;
+  Lorder, i, intValue, valMin, valMax, Lregs : Integer;
+begin
+  for Lorder := 3 to 7 do begin
+    Lbt := TIntegerBTree.Create(False,Lorder);
+    try
+      valMin := 1;
+      intValue :=valMin;
+      Lregs := 0;
+      while Lbt.Height<Lorder+1 do begin
+        Lbt.Add(intValue);
+        valMax := intValue;
+        inc(intValue);
+        inc(Lregs);
+      end;
+      Assert(Lbt.FindLowest(i),'Find lowest');
+      Assert(i=valMin,Format('Lowest <> %d',[valMin]));
+      Assert(Lbt.FindHighest(i),'Find highest');
+      Assert(i=valMax,Format('Highest <> %d',[valMax]));
+      Lbt.FindLowest(intValue);
+      i := 1;
+      while (Lbt.FindSuccessor(intValue,intValue)) do begin
+        inc(i);
+      end;
+      Assert(intValue=valMax,Format('Successor %d<>%d',[intValue,valMax]));
+      Assert(i=Lregs,Format('Succcessor count %d %d',[i,Lregs]));
+      Lbt.FindHighest(intValue);
+      i := 1;
+      while (Lbt.FindPrecessor(intValue,intValue)) do begin
+        inc(i);
+      end;
+      Assert(intValue=valMin,Format('Precessor %d<>%d',[intValue,valMin]));
+      Assert(i=Lregs,Format('Precessor count %d %d',[i,Lregs]));
+
+    finally
+      Lbt.Free;
+    end;
+
+  end;
+end;
+
+procedure TestTAbstractBTree.TestPrecessorSuccessor_Duplicates;
+var Lbt : TIntegerBTree;
+  Lorder, i, intValue, valMin, valMax, Lregs : Integer;
+begin
+  for Lorder := 3 to 7 do begin
+    Lbt := TIntegerBTree.Create(True,Lorder);
+    try
+      valMin := 1;
+      intValue :=valMin;
+      Lregs := 0;
+      while Lbt.Height<Lorder+1 do begin
+        Lbt.Add(intValue);
+        valMax := intValue;
+        if (Lregs MOD Lorder)=0 then inc(intValue);
+        inc(Lregs);
+      end;
+      Assert(Lbt.FindLowest(i),'Find lowest');
+      Assert(i=valMin,Format('Lowest <> %d',[valMin]));
+      Assert(Lbt.FindHighest(i),'Find highest');
+      Assert(i=valMax,Format('Highest <> %d',[valMax]));
+      Lbt.FindLowest(intValue);
+      i := 1;
+      while (Lbt.FindSuccessor(intValue,intValue)) do begin
+        inc(i);
+      end;
+      Assert(intValue=valMax,Format('Successor %d<>%d',[intValue,valMax]));
+      Lbt.FindHighest(intValue);
+      i := 1;
+      while (Lbt.FindPrecessor(intValue,intValue)) do begin
+        inc(i);
+      end;
+      Assert(intValue=valMin,Format('Precessor %d<>%d',[intValue,valMin]));
+    finally
+      Lbt.Free;
+    end;
+
+  end;
+end;
+
+procedure TestTAbstractBTree.Test_duplicate;
+var Lbt : TIntegerBTree;
+  Lorder, i, intValue : Integer;
+  LLastTree, LCurrentTree : String;
+
+  procedure DoInsert(AValue : Integer);
+  begin
+    Lbt.Add(AValue);
+    {
+    LCurrentTree := Lbt.BTreeToString;
+    Lbt.CheckConsistency;
+    LLastTree := LCurrentTree;
+    }
+  end;
+
+  procedure DoDelete(AValue : Integer);
+  begin
+    Lbt.Delete(AValue);
+    {
+    LCurrentTree := Lbt.BTreeToString;
+    Lbt.CheckConsistency;
+    LLastTree := LCurrentTree;
+    }
+  end;
+
+begin
+  {$IFDEF FPC}
+  Randomize;
+  {$ELSE}
+  RandomizeProc(0);
+  {$ENDIF}
+  for Lorder := 3 to 7 do begin
+    Lbt := TIntegerBTree.Create(True,Lorder);
+    try
+      LLastTree := '';
+      LCurrentTree := '';
+      i :=1;
+      while Lbt.Height<Lorder+1 do begin
+        intValue := Random(100);
+        DoInsert(intValue);
+        inc(i);
+      end;
+
+      LCurrentTree := Lbt.BTreeToString;
+      Lbt.CheckConsistency;
+
+      i := 0;
+
+      // Tree is ready to delete
+      while (Lbt.Count>0) do begin
+        Lbt.FindHighest(i);
+        intValue := Random(i+1);
+        DoDelete(intValue);
+      end;
+      LCurrentTree := Lbt.BTreeToString;
+      Lbt.CheckConsistency;
+      if LLastTree = '' then Beep;
+    finally
+      Lbt.Free;
+    end;
+
+  end;
+end;
+
+procedure TestTAbstractBTree.TestDelete;
+var Lbt : TIntegerBTree;
+  Lorder, i, intValue : Integer;
+  LLastTree, LCurrentTree : String;
+
+  procedure DoDelete(AValue : Integer);
+  begin
+    Lbt.Delete(AValue);
+    LCurrentTree := Lbt.BTreeToString;
+    Lbt.CheckConsistency;
+    LLastTree := LCurrentTree;
+  end;
+
+begin
+  for Lorder := 3 to 6 do begin
+    Lbt := TIntegerBTree.Create(False,Lorder);
+    try
+      LLastTree := '';
+      LCurrentTree := '';
+      i :=1;
+      while Lbt.Height<Lorder+1 do begin
+        intValue := i;
+        Lbt.Add(intValue);
+        inc(i);
+      end;
+
+      LCurrentTree := Lbt.BTreeToString;
+      Lbt.CheckConsistency;
+      i := 0;
+
+      DoDelete(1);
+      DoDelete(13);
+      DoDelete(8);
+      DoDelete(4);
+      DoDelete(6);
+      DoDelete(5);
+      DoDelete(12);
+      DoDelete(14);
+      DoDelete(9);
+
+      // Tree is ready to delete
+      while (Lbt.Count>0) do begin
+        inc(i);
+        Lbt.FindHighest(intValue);
+        intValue := Random(intValue)+1;
+        DoDelete(intValue);
+      end;
+      if LLastTree = '' then Beep;
+    finally
+      Lbt.Free;
+    end;
+
+  end;
+end;
+
+
+initialization
+  RegisterTest(TestTAbstractBTree{$IFNDEF FPC}.Suite{$ENDIF});
+end.

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

@@ -0,0 +1,52 @@
+unit UAbstractMem.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+ uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   UCacheMem, UFileMem, UAbstractMem, UAbstractBTree, UAbstractMemTList;
+ type
+   // Test methods for class TCalc
+   TestTAbstractMem = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+   published
+     procedure Test1;
+   end;
+
+implementation
+
+procedure TestTAbstractMem.SetUp;
+begin
+end;
+
+procedure TestTAbstractMem.TearDown;
+begin
+end;
+
+procedure TestTAbstractMem.Test1;
+var Lfm : TFileMem;
+begin
+  Lfm := TFileMem.Create(ExtractFileDir(ParamStr(0))+PathDelim+'test1.am',False);
+  try
+    Lfm.ClearContent; // Init
+  finally
+    Lfm.Free;
+  end;
+end;
+
+
+initialization
+//  RegisterTest(TestTAbstractMem{$IFNDEF FPC}.Suite{$ENDIF});
+end.

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

@@ -0,0 +1,300 @@
+unit UAbstractMemBTree.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+   UAbstractMem,
+   UAbstractBTree, UOrderedList, UAbstractMemBTree;
+
+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;
+
+   TAbstractMemBTreeExampleString = Class(TAbstractMemBTreeData<String>)
+   protected
+     function LoadData(const APosition : TAbstractMemPosition) : String; override;
+     function SaveData(const AData : String) : TAMZone; override;
+   public
+     function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+   End;
+
+
+   TestTAbstractMemBTree = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+     procedure TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
+     procedure TestInfinite_String(AOrder : Integer; AAllowDuplicates : Boolean);
+     procedure TestInfinite(AOrder : Integer);
+     procedure DoCheckAbstractMem(AAbstractMem : TAbstractMem; AUsedBytes : Integer);
+   published
+     procedure TestInfiniteOrder_3;
+     procedure TestInfiniteOrder_4;
+     procedure TestInfiniteOrder_5;
+     procedure TestInfiniteOrder_6;
+     procedure TestInfiniteOrder_7;
+   end;
+
+implementation
+
+{ TAbstractMemBTreeExampleInteger }
+
+procedure TAbstractMemBTreeExampleInteger.DisposeData(var AData: TAbstractMemPosition);
+begin
+  // NOTE: Nothing to do NEITHER to inherit from ancestor
+end;
+
+function TAbstractMemBTreeExampleInteger.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
+begin
+  Result := ALeftData - ARightData;
+end;
+
+function TAbstractMemBTreeExampleInteger.NodeDataToString(const AData: TAbstractMemPosition): String;
+begin
+  Result := IntToStr(AData);
+end;
+
+{ TAbstractMemBTreeExampleString }
+
+function TAbstractMemBTreeExampleString.LoadData(const APosition: TAbstractMemPosition): String;
+var i : Integer;
+  wLength : Word;
+  Lbuff : TBytes;
+begin
+  Result := '';
+  wLength := 0;
+  FAbstractMem.Read(APosition,wLength,2);
+  if wLength<=0 then Exit;
+  SetLength(Lbuff,wLength);
+  FAbstractMem.Read(APosition+2,LBuff[0],wLength);
+  for i:=0 to wLength-1 do begin
+    Result := Result + Char(LBuff[i]);
+  end;
+end;
+
+function TAbstractMemBTreeExampleString.NodeDataToString(const AData: TAbstractMemPosition): String;
+begin
+  Result := LoadData(AData);
+end;
+
+function TAbstractMemBTreeExampleString.SaveData(const AData: String): TAMZone;
+var i : Integer;
+  wLength : Word;
+  Lbuff : TBytes;
+begin
+  wLength := Length(AData);
+  Result := FAbstractMem.New( wLength+2 );
+  SetLength(Lbuff,wLength+2);
+  Move(wLength,Lbuff[0],2);
+  for i:=0 to AData.Length-1 do begin
+    Lbuff[2 + i] := Byte(Char(AData.Chars[i]));
+  end;
+  FAbstractMem.Write(Result.position,Lbuff[0],Length(Lbuff));
+end;
+
+{ TestTAbstractMemBTree }
+
+procedure TestTAbstractMemBTree.DoCheckAbstractMem(AAbstractMem: TAbstractMem; AUsedBytes: Integer);
+var
+  LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
+begin
+  Assert(AAbstractMem.CheckConsistency(Nil,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount));
+  Assert(LTotalUsedSize=AUsedBytes,Format('Total used %d bytes (%d blocks) different from expected %d bytes - Total free %d bytes (%d blocks)',[LTotalUsedSize, AUsedBytes, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
+end;
+
+procedure TestTAbstractMemBTree.SetUp;
+begin
+end;
+
+procedure TestTAbstractMemBTree.TearDown;
+begin
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite(AOrder: Integer);
+begin
+  TestInfinite_Integer(AOrder,(AOrder MOD 2)=0);
+  TestInfinite_String(AOrder,(AOrder MOD 2)=0);
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
+var Lbt : TAbstractMemBTreeExampleInteger;
+  Lbts : TAbstractMemBTreeExampleString;
+  Lzone : TAMZone;
+  intValue, nRounds, nAdds, nDeletes, i : Integer;
+  Lnode : TIntegerBTree.TAbstractBTreeNode;
+  Lmem : TAbstractMem;
+  LCurr : String;
+begin
+  Lmem := TMem.Create(0,False);
+  Try
+    {$IFDEF FPC}
+    Randomize;
+    {$ELSE}
+    RandomizeProc(0);
+    {$ENDIF}
+    nRounds := 0;
+    nAdds := 0;
+    nDeletes := 0;
+    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
+    try
+      repeat
+        inc(nRounds);
+        intValue := Random(AOrder * 100);
+        if Random(2)=0 then begin
+          if (Lbt.Add(intValue)) then begin
+            inc(nAdds);
+          end;
+        end else begin
+          if Lbt.Delete(intValue) then begin
+            inc(nDeletes);
+          end;
+        end;
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      until (nRounds>=AOrder * 10000);
+      Lbt.CheckConsistency;
+      // Delete mode
+      while Lbt.Count>0 do begin
+        Lnode := Lbt.Root;
+        while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
+          Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
+        end;
+        If Not Lbt.Delete(Lnode.data[Random(Lnode.Count)]) then raise Exception.Create('Not Found to delete!');
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      end;
+      Lbt.CheckConsistency;
+      // Try to re-use
+      for i := 1 to AOrder do begin
+        intValue := Random(AOrder * 100);
+        Assert(Lbt.Add(intValue),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
+        Lbt.CheckConsistency;
+      end;
+      Lbt.EraseTree;
+    finally
+      Lbt.Free;
+    end;
+    Lmem.Dispose(Lzone);
+    DoCheckAbstractMem(Lmem,0);
+  Finally
+    Lmem.Free;
+  End;
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_String(AOrder: Integer; AAllowDuplicates : Boolean);
+var Lbt : TAbstractMemBTreeExampleString;
+  Lzone : TAMZone;
+  intValue, nRounds, nAdds, nDeletes, i : Integer;
+  Lnode : TIntegerBTree.TAbstractBTreeNode;
+  Lmem : TAbstractMem;
+  LCurr : String;
+  LCurrData : String;
+begin
+  Lmem := TMem.Create(0,False);
+  Try
+    {$IFDEF FPC}
+    Randomize;
+    {$ELSE}
+    RandomizeProc(0);
+    {$ENDIF}
+    nRounds := 0;
+    nAdds := 0;
+    nDeletes := 0;
+    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
+    try
+      repeat
+        inc(nRounds);
+        intValue := Random(AOrder * 100);
+        if Random(2)=0 then begin
+          if (Lbt.AddData(intValue.ToString)) then begin
+            inc(nAdds);
+          end;
+        end else begin
+          if Lbt.DeleteData(intValue.ToString) then begin
+            inc(nDeletes);
+          end;
+        end;
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      until (nRounds>=AOrder * 10000);
+      Lbt.CheckConsistency;
+      // Delete mode
+      while Lbt.Count>0 do begin
+        Lnode := Lbt.Root;
+        while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
+          Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
+        end;
+        LCurrData := Lbt.LoadData(Lnode.data[Random(Lnode.Count)]);
+        if Not Lbt.DeleteData(LCurrData) then raise EAbstractMemBTree.Create('Not found to delete!');
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      end;
+      Lbt.CheckConsistency;
+      // Try to re-use
+      for i := 1 to AOrder do begin
+        intValue := Random(AOrder * 100);
+        Assert(Lbt.AddData(intValue.ToString),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
+        Lbt.CheckConsistency;
+      end;
+      Lbt.EraseTree;
+    finally
+      Lbt.Free;
+    end;
+    Lmem.Dispose(Lzone);
+    DoCheckAbstractMem(Lmem,0);
+  Finally
+    Lmem.Free;
+  End;
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_3;
+begin
+  TestInfinite(3);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_4;
+begin
+  TestInfinite(4);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_5;
+begin
+  TestInfinite(5);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_6;
+begin
+  TestInfinite(6);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_7;
+begin
+  TestInfinite(7);
+end;
+
+initialization
+  RegisterTest(TestTAbstractMemBTree{$IFNDEF FPC}.Suite{$ENDIF});
+end.

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

@@ -40,7 +40,7 @@ begin
 
   for i := 0 to ASize-1 do begin
     if (ABytes[i] <> ((ALoadedStartPos+i+1) MOD 89)) then begin
-      raise ETestFailure.Create(Format('Value at pos %d (item %d) should be %d instead of %d',[ALoadedStartPos+i,i,((ALoadedStartPos+i) MOD 89),ABytes[i]]));
+      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]]));
     end;
 
   end;
@@ -58,11 +58,11 @@ end;
 
 function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
 begin
-  if (High(FCurrentMem) >= AStartPos + ASize) then begin
+  if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(FCurrentMem[AStartPos],ABuffer,ASize);
   end else begin
-    Result := High(FCurrentMem) - AStartPos;
+    Result := Length(FCurrentMem) - AStartPos;
     if Result>0 then begin
       Move(FCurrentMem[AStartPos],ABuffer,Result);
     end;
@@ -71,11 +71,11 @@ end;
 
 function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
 begin
-  if (High(FCurrentMem) >= AStartPos + ASize) then begin
+  if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(ABuffer,FCurrentMem[AStartPos],ASize);
   end else begin
-    Result := High(FCurrentMem) - AStartPos;
+    Result := Length(FCurrentMem) - AStartPos;
     if Result>0 then begin
       Move(ABuffer,FCurrentMem[AStartPos],Result);
     end;
@@ -99,36 +99,84 @@ Var LCMem : TCacheMem;
 begin
   LCMem := TCacheMem.Create(OnNeedDataProc,OnSaveDataProc);
   Try
-    InitCurrentMem(11);
+    InitCurrentMem(22);
     SetLength(LBuff,Length(FCurrentMem));
 
-    LCMem.DefaultCacheDataBlocksSize :=10;
+    LCMem.DefaultCacheDataBlocksSize :=5;
+    LCMem.GridCache := True;
     // Check replacing initial position of buffer on Load
     LCMem.Clear;
-    LCMem.LoadData(LBuff[0],3,3);
+
+    FillChar(LBuff[0],Length(LBuff),0);
+    CheckTrue( LCMem.LoadData(LBuff[0],3,3) );
     CheckBytes(LBuff,3,3);
-    LCMem.LoadData(LBuff[0],1,9);
+
+    FillChar(LBuff[0],Length(LBuff),0);
+    CheckTrue( LCMem.LoadData(LBuff[0],1,9) );
     CheckBytes(LBuff,1,9);
+
+    FillChar(LBuff[0],Length(LBuff),0);
+    CheckTrue( LCMem.LoadData(LBuff[0],9,2) );
+    CheckBytes(LBuff,9,2);
+
+    FillChar(LBuff[0],Length(LBuff),0);
+    CheckTrue( LCMem.LoadData(LBuff[0],8,3) );
+    CheckBytes(LBuff,8,3);
+
+    // Check false and load final data
+    FillChar(LBuff[0],Length(LBuff),0);
+    CheckFalse( LCMem.LoadData(LBuff[0],Length(FCurrentMem)-3,4) );
+    CheckBytes(LBuff,Length(FCurrentMem)-3,3);
     LCMem.ConsistencyCheck;
 
+    // Load all to LBuff
+    CheckTrue( LCMem.LoadData(LBuff[0],0,Length(LBuff)) );
     // Check replacing initial position of buffer on Save
     LCMem.Clear;
     LCMem.SaveToCache(LBuff[0],3,3,True);
     LCMem.SaveToCache(LBuff[0],7,0,True);
+
+    // Check saving chunks
+    LCMem.Clear;
+    LCMem.DefaultCacheDataBlocksSize := 5;
+    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]));
+    LCMem.Clear;
+    LCMem.GridCache := True;
+    LCMem.SaveToCache(LBuff[2],5,2,True);
+    LCMem.SaveToCache(LBuff[1],15,1,True);
+    CheckTrue( LCMem.CacheDataBlocks=4, Format('4 Cache blocks: %d',[LCMem.CacheDataBlocks]));
+    LCMem.Clear;
+
+    // Clear FCurrentMem
+    LCMem.Clear;
+    FillChar(FCurrentMem[0],Length(FCurrentMem),0);
+    // Save from LBuff
+    LCMem.SaveToCache(LBuff,0,True);
+    LCMem.FlushCache;
     LCMem.ConsistencyCheck;
 
     LCMem.Clear;
-    InitCurrentMem(100000);
+    InitCurrentMem(100);
     SetLength(LBuff,Length(FCurrentMem));
 
-    CheckTrue( LCMem.LoadData(LBuff[0],0,100) );
+    // Save 3 blocks
+    LCMem.LoadData(LBuff[0],2,2*LCMem.DefaultCacheDataBlocksSize);
+    LCMem.Clear;
+    LCMem.SaveToCache(LBuff[0], 2*LCMem.DefaultCacheDataBlocksSize , 2,True);
+    CheckTrue( LCMem.CacheDataBlocks=3, '3 Cache blocks');
+
+    CheckTrue( LCMem.LoadData(LBuff[0],1,98) );
     // Incremental round
     i := 1;
     while (i+i < High(FCurrentMem)) do begin
-      CheckTrue( LCMem.LoadData(LBuff[0],i,i) );
+      CheckTrue( LCMem.LoadData(LBuff[0],i-1,i) );
+      CheckBytes(LBuff,i-1,i);
       inc(i);
     end;
-    CheckFalse( LCMem.LoadData( LBuff[0],i,i) );
+    CheckFalse( LCMem.LoadData( LBuff[0],i+1,i) );
 
     LCMem.ConsistencyCheck;
   Finally

src/libraries/sphere10/UMemory.pas

@@ -20,6 +20,7 @@ unit UMemory;
   {$MODESWITCH ADVANCEDRECORDS}
 {$ENDIF}
 
+{$I ./../../config.inc}
 interface
 
 type
@@ -50,8 +51,10 @@ type
       FGuardian: IInterface;
       FPointers: array of TDisposablePointer;
       FLastIndex: Integer;
+      {$IFNDEF DELPHI_SYDNEY_PLUS}
       class procedure Initialize(var ADisposables: TDisposables); static;
       class procedure Finalize(var ADisposables: TDisposables); static;
+      {$ENDIF}
       procedure RegisterPointer(Ptr: Pointer; ADisposePolicy: TDisposePolicy);
       procedure UnregisterPointer(Ptr: Pointer);
     public
@@ -62,6 +65,10 @@ type
       procedure AddMem(const P: Pointer);
       procedure ReallocMem(var P: Pointer; Size: Integer);
       procedure RemoveMem(const P: Pointer);
+      {$IFDEF DELPHI_SYDNEY_PLUS}
+      class operator Initialize (out Dest: TDisposables);
+      class operator Finalize (var Dest: TDisposables);
+      {$ENDIF}
       /// <summary>A syntax sugar for the AddObject method.</summary>
       property Objects[const AnObject: TObject]: TObject read AddObject; default;
   end;
@@ -76,20 +83,64 @@ uses sysutils;
 constructor TDisposables.TGuard.Create(ADisposablesRec: PDisposables);
 begin
   FDispoablesRec := ADisposablesRec;
+  {$IFNDEF DELPHI_SYDNEY_PLUS}
   TDisposables.Initialize(FDispoablesRec^);
+  {$ENDIF}
 end;
 
 destructor TDisposables.TGuard.Destroy;
 begin
   inherited;
   try
+    {$IFNDEF DELPHI_SYDNEY_PLUS}
     TDisposables.Finalize(FDispoablesRec^);
+    {$ENDIF}
   except
     FreeInstance;
     raise;
   end;
 end;
 
+{$IFDEF DELPHI_SYDNEY_PLUS}
+class operator TDisposables.Initialize (out Dest: TDisposables);
+begin
+  Dest.FLastIndex := -1;
+  SetLength(Dest.FPointers, 16);
+end;
+
+class operator TDisposables.Finalize (var Dest: TDisposables);
+var
+  FirstException: Pointer;
+  i, x: Integer;
+begin
+  FirstException := nil;
+  for i := Dest.FLastIndex downto 0 do
+  try
+    case Dest.FPointers[i].DisposePolicy of
+      idpNone: ;
+      idpNil: Dest.FPointers[i].Ptr := nil;
+      idpFree, idpFreeAndNil: if Assigned(Dest.FPointers[i].Ptr) then begin
+        FreeAndNil(Dest.FPointers[i].Ptr);
+        Dest.FPointers[i].Ptr := nil;
+      end;
+      idpRelease: begin
+        raise ENotSupportedException.Create('Dispose policy idoRelease not supported');
+      end;
+      idpFreeMem: if Assigned(Dest.FPointers[i].Ptr) then System.FreeMem(Dest.FPointers[i].Ptr);
+      else raise ENotSupportedException.Create('Dispose policy not supported');
+    end;
+  except
+    if not Assigned(FirstException) then
+      FirstException := AcquireExceptionObject;
+  end;
+
+  if Assigned(FirstException) then
+  begin
+    SetLength(Dest.FPointers, 0);
+    raise TObject(FirstException);
+  end;
+end;
+{$ELSE}
 class procedure TDisposables.Initialize(var ADisposables: TDisposables);
 begin
   ADisposables.FLastIndex := -1;
@@ -99,10 +150,9 @@ end;
 class procedure TDisposables.Finalize(var ADisposables: TDisposables);
 var
   FirstException: Pointer;
-  i: Integer;
+  i, x: Integer;
 begin
   FirstException := nil;
-
   for i := ADisposables.FLastIndex downto 0 do
   try
     case ADisposables.FPointers[i].DisposePolicy of
@@ -116,7 +166,7 @@ begin
         raise ENotSupportedException.Create('Dispose policy idoRelease not supported');
       end;
       idpFreeMem: if Assigned(ADisposables.FPointers[i].Ptr) then System.FreeMem(ADisposables.FPointers[i].Ptr);
-      else raise ENotSupportedException.Create('Dispose policy not supported');;
+      else raise ENotSupportedException.Create('Dispose policy not supported');
     end;
   except
     if not Assigned(FirstException) then
@@ -129,6 +179,7 @@ begin
     raise TObject(FirstException);
   end;
 end;
+{$ENDIF}
 
 procedure TDisposables.RegisterPointer(Ptr: Pointer; ADisposePolicy: TDisposePolicy);
 begin

src/pascalcoin_daemon.ini

@@ -1,13 +1,13 @@
 [GLOBAL]
 ;SAVELOGS : Boolean
 ;If 1 (true) logs will be saved to a file at $HOME/PascalCoin
-SAVELOGS=0
+SAVELOGS=1
 ;NODE_PORT : Integer (Default 4004)
 ;Port P2P of PascalCoin
 NODE_PORT=4004
 ;NODE_MAX_CONNECTIONS : Integer (Default 100)
 ;Max node connections P2P
-NODE_MAX_CONNECTIONS=100
+NODE_MAX_CONNECTIONS=200
 ;LOWMEMORY : Boolean
 ;If True, will read/write directly to file storage, using less memory but decreasing speed
 LOWMEMORY=0
@@ -49,3 +49,17 @@ RPC_SERVERMINER_MAX_ZERO_FEE_OPERATIONS=
 ;Allow define folder to store data of PascalCoin (Blockchain, Safebox, WalletKeys file, Temporal files ...)
 ;If empty will use default folder $HOME/PascalCoin (Each OS will assigna a different $HOME folder, AppData for Windows...)
 DATAFOLDER=
+
+;ABSTRACTMEM CACHE VALUES
+;ABSTRACTMEM_MAX_CACHE_MB : Integer
+;Maximum megabytes in memory as a cache - Default 100
+ABSTRACTMEM_MAX_CACHE_MB=
+;ABSTRACTMEM_USE_CACHE_ON_LISTS : Boolean
+;Set to true (1) to allow save lists on cache or false (0) - Default True
+ABSTRACTMEM_USE_CACHE_ON_LISTS=
+;ABSTRACTMEM_CACHE_MAX_ACCOUNTS : Integer
+;Max number of accounts to store at cache - Default 10000
+ABSTRACTMEM_CACHE_MAX_ACCOUNTS=
+;ABSTRACTMEM_CACHE_MAX_PUBKEYS : Integer
+;Max number of public keys to store at cache - Default 5000
+ABSTRACTMEM_CACHE_MAX_PUBKEYS=

src/pascalcoin_daemon.lpi

@@ -53,7 +53,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="core;libraries\synapse;libraries\pascalcoin;libraries\generics.collections;libraries\sphere10;libraries\hashlib4pascal;libraries\paszlib;libraries\cryptolib4pascal;libraries\simplebaselib4pascal;libraries\abstractmem"/>
+      <OtherUnitFiles Value="core;libraries\synapse;libraries\pascalcoin;libraries\generics.collections;libraries\sphere10;libraries\hashlib4pascal;libraries\paszlib;libraries\cryptolib4pascal;libraries\simplebaselib4pascal;libraries\abstractmem;libraries\regex"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <CodeGeneration>