abstractmem v1.0

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -0,0 +1,47 @@
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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.
+
+  ***** END LICENSE BLOCK *****
+}
+
+{.$define ABSTRACTMEM_TESTING_MODE}
+// define this if you want some testing mode capabilities
+
+{.$define ABSTRACTMEM_ENABLE_STATS}
+// define this to activate some stats on objects usefull for testing
+
+{$if (defined(ABSTRACTMEM_TESTING_MODE)) or (defined(ABSTRACTMEM_USE_TLOG))}{$define ABSTRACTMEM_ENABLE_STATS}{$endif}
+
+{ 
+  HISTORY
+  
+  Version 0.1 - January-April 2020
+  - First implementation for use in PascalCoin project as a File/Mem cached struct to store SafeBox
+  - Creation of TAbstractMem, TAVLAbstractTree and TCacheMem for use in TFileMem
+  - Initial tests
+
+  Version 1.0 - May 2020
+  - Integration with PascalCoin project and final tests
+  
+
+}
+
+const
+  CT_ABSTRACTMEM_VERSION = 1.0; // Each revision should increase this version...

src/libraries/abstractmem/UAVLCache.pas

@@ -0,0 +1,493 @@
+unit UAVLCache;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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}
+
+interface
+
+uses Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree, UOrderedList,
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+  EAVLCache = class(Exception);
+
+  { TAVLCache }
+
+  TAVLCache<T> = Class
+  public
+    type
+      PAVLCacheMemData = ^TAVLCacheMemData;
+      TAVLCacheMemData = record
+        parent : PAVLCacheMemData;
+        left : PAVLCacheMemData;
+        right : PAVLCacheMemData;
+        balance : ShortInt;
+        //
+        used_previous : PAVLCacheMemData;
+        used_next : PAVLCacheMemData;
+        pendingToSave : Boolean;
+        //
+        data : T;
+        procedure Clear;
+        function ToString : String;
+      end;
+  private
+    type
+    { TAVLCacheMem }
+    TAVLCacheMem = Class(TAVLAbstractTree<PAVLCacheMemData>)
+    private
+      FRoot : PAVLCacheMemData;
+      FOldestUsed, FNewestUsed : PAVLCacheMemData;
+    protected
+      function GetRoot: PAVLCacheMemData; override;
+      procedure SetRoot(const Value: PAVLCacheMemData); override;
+      function HasPosition(const ANode : PAVLCacheMemData; APosition : TAVLTreePosition) : Boolean; override;
+      function GetPosition(const ANode : PAVLCacheMemData; APosition : TAVLTreePosition) : PAVLCacheMemData; override;
+      procedure SetPosition(var ANode : PAVLCacheMemData; APosition : TAVLTreePosition; const ANewValue : PAVLCacheMemData); override;
+      procedure ClearPosition(var ANode : PAVLCacheMemData; APosition : TAVLTreePosition); override;
+      function GetBalance(const ANode : PAVLCacheMemData) : Integer; override;
+      procedure SetBalance(var ANode : PAVLCacheMemData; ANewBalance : Integer); override;
+      function AreEquals(const ANode1, ANode2 : PAVLCacheMemData) : Boolean; override;
+      procedure ClearNode(var ANode : PAVLCacheMemData); override;
+      procedure DisposeNode(var ANode : PAVLCacheMemData); override;
+
+      procedure DoMark(var ANode : PAVLCacheMemData; AAddToList : Boolean);
+
+    public
+      function IsNil(const ANode : PAVLCacheMemData) : Boolean; override;
+      Constructor Create(const OnCompareMethod: TComparison<PAVLCacheMemData>; AAllowDuplicates : Boolean); override;
+      function ConsistencyCheck(const AErrors : TStrings): integer; override;
+    end;
+    var FAVLCacheMem : TAVLCacheMem;
+    FDefaultMax : Integer;
+    FAVLCacheLock : TCriticalSection;
+  protected
+    procedure BeforeDelete(var AData : T); virtual;
+    procedure ConsistencyCheck;
+  public
+    Constructor Create(ADefaultMax : Integer; const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+    Destructor Destroy; override;
+    //
+    function Find(const AData : T; out AFound : T) : Boolean;
+    procedure Add(const AData : T);
+    procedure Remove(const AData : T);
+    function Exists(const AData : T) : Boolean;
+    procedure Clear;
+    function TreeToString: String;
+    function ToString(const AData : T) : String; overload; virtual;
+  End;
+
+implementation
+
+{ TAVLCache.TAVLCacheMem }
+
+function TAVLCache<T>.TAVLCacheMem.GetRoot: PAVLCacheMemData;
+begin
+  Result := FRoot;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetRoot(const Value: PAVLCacheMemData);
+begin
+  FRoot := Value;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.HasPosition(const ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  case APosition of
+    poParent: Result := Assigned( ANode^.parent );
+    poLeft: Result := Assigned( ANode^.left );
+    poRight: Result := Assigned( ANode^.right );
+  else raise EAVLAbstractTree.Create('Undefined 20200324-5');
+  end;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.GetPosition(const ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition): PAVLCacheMemData;
+begin
+  case APosition of
+    poParent: Result := ANode^.parent;
+    poLeft: Result := ANode^.left;
+    poRight: Result := ANode^.right;
+  else raise EAVLAbstractTree.Create('Undefined 20200324-4');
+  end;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetPosition(var ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition; const ANewValue: PAVLCacheMemData);
+begin
+  case APosition of
+    poParent: ANode^.parent := ANewValue;
+    poLeft: ANode^.left := ANewValue;
+    poRight: ANode^.right := ANewValue;
+  end;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.ClearPosition(var ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition);
+begin
+  case APosition of
+    poParent: ANode^.parent := Nil;
+    poLeft: ANode^.left := Nil;
+    poRight: ANode^.right := Nil;
+  end;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.ConsistencyCheck(const AErrors: TStrings): integer;
+var i, iLOrderPos : Integer;
+  PLast, PCurrent : PAVLCacheMemData;
+  LTotalNodes : Integer;
+  LOrder : TOrderedList<PAVLCacheMemData>;
+begin
+  if Assigned(AErrors) then begin
+    AErrors.Clear;
+  end;
+  Result := inherited ConsistencyCheck(AErrors);
+  if Assigned(AErrors) then begin
+    if (Result<>0) or (AErrors.Text<>'') then raise EAVLCache.Create(Format('Consistency error %d errors: %s',[Result,AErrors.Text]));
+
+  end else if (Result<>0) then raise EAVLCache.Create(Format('Consistency error %d',[Result]));
+
+  //
+  LTotalNodes := 0;
+  PCurrent := FindLowest;
+  while (Assigned(PCurrent)) do begin
+    inc(LTotalNodes);
+    PCurrent := FindSuccessor(PCurrent);
+  end;
+
+  LOrder := TOrderedList<PAVLCacheMemData>.Create(False,OnCompareMethod);
+  try
+    PLast := Nil;
+    PCurrent := FOldestUsed;
+    i := 0;
+    while (Assigned(PCurrent)) do begin
+      inc(i);
+      if PCurrent^.used_previous<>PLast then raise EAVLCache.Create(Format('Previous <> Last at %d for %s',[i,PCurrent^.ToString]));
+      if LOrder.Find( PCurrent, iLOrderPos ) then begin
+        raise EAVLCache.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      end;
+      if LOrder.Add(PCurrent)<0 then raise EAVLCache.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      PLast := PCurrent;
+      PCurrent := PCurrent^.used_next;
+    end;
+    // Check last
+    if (PLast<>FNewestUsed) then raise EAVLCache.Create(Format('Last <> Newest at %d/%d',[i,LTotalNodes]));
+    if (i<>LTotalNodes) then raise EAVLCache.Create(Format('Marked nodes %d <> CacheData nodes %d',[i,LTotalNodes]));
+
+  finally
+    LOrder.Free;
+  end;
+
+end;
+
+constructor TAVLCache<T>.TAVLCacheMem.Create(
+  const OnCompareMethod: TComparison<PAVLCacheMemData>;
+  AAllowDuplicates: Boolean);
+begin
+  inherited;
+  FRoot := Nil;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.GetBalance(const ANode: PAVLCacheMemData
+  ): Integer;
+begin
+  Result := ANode^.balance;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetBalance(var ANode: PAVLCacheMemData;
+  ANewBalance: Integer);
+begin
+  ANode^.balance := ANewBalance;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.AreEquals(const ANode1,
+  ANode2: PAVLCacheMemData): Boolean;
+begin
+  Result := ANode1 = ANode2;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.ClearNode(var ANode: PAVLCacheMemData);
+begin
+  ANode := Nil;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.DisposeNode(var ANode: PAVLCacheMemData);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.DoMark(var ANode: PAVLCacheMemData; AAddToList: Boolean);
+{
+    O = FOldestUsed
+    N = FNewestUsed
+
+    O       N
+    A - B - C   ( D = New CacheMem )
+}
+begin
+  if Assigned(ANode^.used_previous) then begin
+    // B or C
+    if (ANode^.used_previous^.used_next<>ANode) then raise EAVLCache.Create(Format('Inconsistent previous.next<>MySelf in %s',[ANode^.ToString]));
+    if (FOldestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent B,C Oldest = MySelf in %s',[ANode^.ToString]));
+    if Assigned(ANode^.used_next) then begin
+      // B only
+      if (ANode^.used_next^.used_previous<>ANode) then raise EAVLCache.Create(Format('Inconsistent B next.previous<>MySelf in %s',[ANode^.ToString]));
+      if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent B Newest = MySelf in %s',[ANode^.ToString]));
+      ANode^.used_previous^.used_next := ANode^.used_next;
+      ANode^.used_next^.used_previous := ANode^.used_previous;
+    end else begin
+      // C only
+      if (FNewestUsed <> ANode) then raise EAVLCache.Create(Format('Inconsistent Newest <> MySelf in %s',[ANode^.ToString]));
+      if (Not AAddToList) then begin
+        ANode^.used_previous^.used_next := Nil;
+      end;
+    end;
+  end else if assigned(ANode^.used_next) then begin
+    // A
+    if (ANode^.used_next^.used_previous<>ANode) then raise EAVLCache.Create(Format('Inconsistent A next.previous<>MySelf in %s',[ANode^.ToString]));
+    if (FOldestUsed <> ANode) then raise EAVLCache.Create(Format('Inconsistent Oldest <> MySelf in %s',[ANode^.ToString]));
+    if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent A Newest = MySelf in %s',[ANode^.ToString]));
+    ANode^.used_next^.used_previous := ANode^.used_previous; // = NIL
+    FOldestUsed:=ANode^.used_next; // Set oldest
+  end else begin
+    // D
+    if (FOldestUsed = ANode) and (FNewestUsed = ANode) then begin
+      // D is the "only one", no previous, no next, but added or removed
+      if (Not AAddToList) then begin
+        FOldestUsed := Nil;
+      end;
+    end else begin
+      if (FOldestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent D Oldest = MySelf in %s',[ANode^.ToString]));
+      if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent D Newest = MySelf in %s',[ANode^.ToString]));
+    end;
+    if Not Assigned(FOldestUsed) and (AAddToList) then begin
+      // D is first one to be added
+      FOldestUsed := ANode; // Set oldest
+    end;
+  end;
+  if Assigned(FNewestUsed) then begin
+    if Assigned(FNewestUsed^.used_next) then raise EAVLCache.Create(Format('Inconsistent Newest.next <> Nil in %s',[ANode^.ToString]));
+  end;
+  // Update ANode^.used_previous and ANode^.used_next
+  if AAddToList then begin
+    // Adding to list
+    if (FNewestUsed<>ANode) then begin
+      // Link to previous if newest <> MySelf
+      ANode^.used_previous := FNewestUsed;
+    end;
+    if Assigned(FNewestUsed) then begin
+      FNewestUsed^.used_next:= ANode;
+    end;
+    FNewestUsed:=ANode;
+  end else begin
+    // Removing from list
+    if FNewestUsed = ANode then begin
+      if (Assigned(ANode^.used_next)) then raise EAVLCache.Create(Format('Inconsistent next <> Nil when Self = Newest in %s',[ANode^.ToString]));
+      FNewestUsed := ANode^.used_previous;
+    end;
+    ANode^.used_previous := Nil;
+  end;
+  ANode^.used_next := Nil;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.IsNil(const ANode: PAVLCacheMemData): Boolean;
+begin
+  Result := Not Assigned(ANode);
+end;
+
+procedure TAVLCache<T>.Add(const AData: T);
+var P, PToDelete : PAVLCacheMemData;
+  i,LnToRemove : Integer;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  P^.Clear;
+  P^.data := AData;
+  FAVLCacheMem.Add(P);
+  FAVLCacheMem.DoMark(P,True);
+  if (FDefaultMax > 0) And (FAVLCacheMem.FCount>FDefaultMax) then begin
+    // Dispose cache
+    LnToRemove := FAVLCacheMem.FCount SHR 1;
+    i := 1;
+    P := FAVLCacheMem.FOldestUsed;
+    while (Assigned(P)) And (i <= LnToRemove) do begin
+      PToDelete := P;
+      P := P^.used_next;
+
+      FAVLCacheMem.DoMark(PToDelete,False);
+      BeforeDelete(PToDelete^.data);
+      FAVLCacheMem.Delete(PToDelete);
+
+      inc(i);
+    end;
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.BeforeDelete(var AData: T);
+begin
+//
+end;
+
+procedure TAVLCache<T>.Clear;
+var P, PCurr : PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  PCurr := FAVLCacheMem.FindLowest;
+  while (Assigned(PCurr)) do begin
+    P := PCurr;
+    PCurr := FAVLCacheMem.FindSuccessor(P);
+    BeforeDelete(P^.data);
+    FAVLCacheMem.DoMark(P,False);
+    FAVLCacheMem.Delete(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.ConsistencyCheck;
+var LErrors : TStrings;
+  LResult : Integer;
+begin
+  LErrors := TStringList.Create;
+  Try
+    LResult := FAVLCacheMem.ConsistencyCheck(LErrors);
+  Finally
+    LErrors.Free;
+  End;
+end;
+
+constructor TAVLCache<T>.Create(ADefaultMax: Integer;  const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+begin
+  FAVLCacheMem := TAVLCacheMem.Create(AOnCompareMethod,False);
+  FDefaultMax := ADefaultMax;
+  FAVLCacheLock := TCriticalSection.Create;
+end;
+
+destructor TAVLCache<T>.Destroy;
+begin
+  Clear;
+  FAVLCacheMem.Free;
+  FAVLCacheLock.Free;
+  inherited Destroy;
+end;
+
+function TAVLCache<T>.Exists(const AData: T): Boolean;
+var LFound : T;
+begin
+  Result := Find(AData,LFound);
+end;
+
+function TAVLCache<T>.Find(const AData: T; out AFound: T): Boolean;
+var P, PFound: PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  try
+    P^.Clear;
+    P^.data := AData;
+    PFound := FAVLCacheMem.Find(P);
+    if Assigned(PFound) then begin
+      AFound := PFound^.data;
+      Result := True;
+      FAVLCacheMem.DoMark(PFound,True);
+    end else Result := False;
+  finally
+    Dispose(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.Remove(const AData: T);
+var P, PFound: PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  try
+    P^.Clear;
+    P^.data := AData;
+    PFound := FAVLCacheMem.Find(P);
+    if Assigned(PFound) then begin
+      BeforeDelete(PFound^.data);
+      FAVLCacheMem.DoMark(PFound,False);
+      FAVLCacheMem.Delete(PFound);
+    end;
+  finally
+    Dispose(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+function TAVLCache<T>.ToString(const AData: T): String;
+begin
+  Result := Self.ClassName+'.T '+IntToStr(SizeOf(AData));
+end;
+
+function TAVLCache<T>.TreeToString: String;
+begin
+  Result := FAVLCacheMem.ToString;
+end;
+
+{ TAVLCache<T>.TAVLCacheMemData }
+
+procedure TAVLCache<T>.TAVLCacheMemData.Clear;
+begin
+  Self.parent := Nil;
+  Self.left := Nil;
+  Self.right := Nil;
+  Self.balance := 0;
+  Self.used_previous := Nil;
+  Self.used_next := Nil;
+  Self.pendingToSave := False;
+end;
+
+function TAVLCache<T>.TAVLCacheMemData.ToString: String;
+begin
+  Result := 'TAVLCache<T>.TAVLCacheMemData.'+IntToStr(SizeOf(Self.data));
+end;
+
+end.

src/libraries/abstractmem/UAbstractBTree.pas

@@ -0,0 +1,986 @@
+unit UAbstractBTree;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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;
+
+{$I ./ConfigAbstractMem.inc }
+
+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;
+    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;
+  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;
+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 : TOrderedList<T>;
+begin
+  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at Find for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      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
+    LPreviousSearch.Free;
+  end;
+end;
+
+function TAVLAbstractTree<T>.FindInsertPos(const AData: T): T;
+var Comp: integer;
+  LPreviousSearch : TOrderedList<T>;
+begin
+  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at FindInsertPos for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      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
+    LPreviousSearch.Free;
+  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
+  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
+  Result := ANode^.balance;
+end;
+
+function TPAVLPointerTree.GetPosition(const ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition): PAVLPointerTreeNode;
+begin
+  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
+  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
+  ANode^.balance := ANewBalance;
+end;
+
+procedure TPAVLPointerTree.SetPosition(var ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition; const ANewValue: PAVLPointerTreeNode);
+begin
+  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/UAbstractMem.pas

@@ -0,0 +1,949 @@
+unit UAbstractMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+Type
+  TAbstractMemPosition = Integer;
+
+  TAMZone = record
+    position : TAbstractMemPosition;
+    size : Integer;
+    procedure Clear;
+    function ToString : String;
+  end;
+
+  EAbstractMem = Class(Exception);
+
+  TAbstractMem = Class;
+
+  TAbstractMemMemoryLeaksComparer = function(const ABuffer1; ABufferSize1:Integer; const AData2: Integer): Integer;
+
+  TAbstractMemMemoryLeaksNode = record
+    myPosition,       // Position in the AbstractMem
+    parentPosition,
+    leftPosition,
+    rigthPosition : TAbstractMemPosition;
+    balance : ShortInt;
+    units : Integer; // units equals to "4 bytes packet", 1=4 bytes 2=8 bytes ...
+    function GetSize : Integer;
+    procedure SetSize(ABytesSize : Integer); // ABytesSize will be converted to units
+    function GetPosition(APosition : TAVLTreePosition) : TAbstractMemPosition;
+    procedure SetPosition(APosition : TAVLTreePosition; AMemPosition : TAbstractMemPosition);
+    procedure ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem);
+    procedure WriteToMem(AAbstractMem : TAbstractMem);
+    procedure Clear;
+    function ToString : String;
+  end;
+
+
+  TAbstractMemMemoryLeaks = Class( TAVLAbstractTree<TAbstractMemMemoryLeaksNode> )
+  private
+    FAbstractMem : TAbstractMem;
+    FRootPosition : TAbstractMemPosition;
+  protected
+    function GetRoot: TAbstractMemMemoryLeaksNode; override;
+    procedure SetRoot(const Value: TAbstractMemMemoryLeaksNode); override;
+    function HasPosition(const ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition) : Boolean; override;
+    function GetPosition(const ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition) : TAbstractMemMemoryLeaksNode; override;
+    procedure SetPosition(var ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition; const ANewValue : TAbstractMemMemoryLeaksNode); override;
+    procedure ClearPosition(var ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : TAbstractMemMemoryLeaksNode) : Integer; override;
+    procedure SetBalance(var ANode : TAbstractMemMemoryLeaksNode; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : TAbstractMemMemoryLeaksNode) : Boolean; override;
+    procedure ClearNode(var ANode : TAbstractMemMemoryLeaksNode); override;
+    procedure DisposeNode(var ANode : TAbstractMemMemoryLeaksNode); override;
+  public
+    function IsNil(const ANode : TAbstractMemMemoryLeaksNode) : Boolean; override;
+    function ToString(const ANode: TAbstractMemMemoryLeaksNode) : String; override;
+    constructor Create(AAbstractMem : TAbstractMem; ARootPosition : TAbstractMemPosition); reintroduce;
+    destructor Destroy; override;
+  End;
+
+  TAbstractMemZoneType = (amzt_unknown, amzt_memory_leak, amzt_used);
+
+  { TAbstractMem }
+
+  TAbstractMem = Class
+  private
+    FReadOnly : Boolean;
+    FHeaderInitialized : Boolean;
+    FInitialPosition : Integer;
+    FNextAvailablePos : Integer;
+    FMaxAvailablePos : Integer;
+    FMemLeaks : TAbstractMemMemoryLeaks;
+    //
+  protected
+    FLock : TCriticalSection;
+    function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; virtual; abstract;
+    function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; virtual; abstract;
+    procedure DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos : Integer; ANeedSize : Integer); virtual; abstract;
+    //
+    function PositionToAbsolute(const APosition : Integer) : Int64;
+    procedure IncreaseSize(ANeedSize : Integer);
+    //
+    function GetZoneType(APosition : TAbstractMemPosition; out AAMZone : TAMZone) : TAbstractMemZoneType;
+    procedure CheckInitialized(AWantsToWrite : Boolean);
+    function IsAbstractMemInfoStable : Boolean; virtual;
+    procedure SaveHeader;
+  public
+    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; virtual;
+    function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; virtual;
+
+    Constructor Create(AInitialPosition : Integer; AReadOnly : Boolean); virtual;
+    Destructor Destroy; override;
+    //
+    procedure ClearContent;
+    //
+    function New(AMemSize : Integer) : TAMZone; virtual;
+    procedure Dispose(const AAMZone : TAMZone); overload;
+    procedure Dispose(const APosition : TAbstractMemPosition); overload;
+    function GetUsedZoneInfo(const APosition : TAbstractMemPosition; ACheckForUsedZone : Boolean; out AAMZone : TAMZone) : Boolean;
+    function ToString : String; override;
+    function CheckConsistency(const AStructure : TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+    function ReadFirstData(var AFirstDataZone : TAMZone; var AFirstData : TBytes) : Boolean;
+    class function GetAbstractMemVersion : String;
+    property ReadOnly : Boolean read FReadOnly;
+    procedure SaveToStream(AStream : TStream);
+    procedure CopyFrom(ASource : TAbstractMem);
+  End;
+
+  TMem = Class(TAbstractMem)
+  private
+    FMem : TBytes;
+  protected
+    function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
+    function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
+    procedure DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos : Integer; ANeedSize : Integer); override;
+  public
+    Constructor Create(AInitialPosition : Integer; AReadOnly : Boolean); override;
+  End;
+
+  TAbstractMemAVLTreeNodeInfo = record
+    parentPosition,
+    leftPosition,
+    rigthPosition : TAbstractMemPosition;
+    balance : ShortInt;
+    procedure Clear;
+    function ToString : String;
+  end;
+    //
+  TAbstractMemAVLTreeNodeInfoClass = Class
+    class function ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem) : TAbstractMemAVLTreeNodeInfo;
+    class procedure WriteToMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; const ANodeInfo : TAbstractMemAVLTreeNodeInfo);
+    class procedure ClearPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition);
+    class function GetPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition) : TAbstractMemPosition;
+    class procedure SetPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition; ANewPosition : TAbstractMemPosition);
+    class function GetBalance(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem) : ShortInt;
+    class procedure SetBalance(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; ANewBalance : ShortInt);
+    class function GetSize : Integer;
+  end;
+
+
+implementation
+
+const
+  CT_Magic : Array[0..5] of byte = (7,6,5,4,3,2);
+  CT_IsStable = 1;
+  CT_Is_NOT_Stable = 0;
+  CT_Version = 1;
+  CT_HeaderSize = 16; // Magic(7) + Version(1) + MemLeak_root_position(4) + NextAvailable_position(4) = 16 bytes
+  CT_ExtraSizeForUsedZoneType = 4;
+
+{ TAbstractMem }
+
+function TAbstractMem.CheckConsistency(const AStructure: TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+var LPosition : TAbstractMemPosition;
+  LZone : TAMZone;
+begin
+  // Will check since first position:
+  FLock.Acquire;
+  Try
+    ATotalUsedSize := 0;
+    ATotalUsedBlocksCount := 0;
+    ATotalLeaksSize := 0;
+    ATotalLeaksBlocksCount := 0;
+    LPosition := CT_HeaderSize;
+    Result := True;
+    while (Result) and (LPosition < FNextAvailablePos) do begin
+      case GetZoneType(LPosition,LZone) of
+        amzt_memory_leak : begin
+          if Assigned(AStructure) then AStructure.Add( Format('%d to %d mem leak %d bytes',[LPosition,LZone.position + LZone.size,LZone.size]));
+          Inc(LPosition, LZone.size);
+          inc(ATotalLeaksSize,LZone.size);
+          inc(ATotalLeaksBlocksCount);
+        end;
+        amzt_used : begin
+          if Assigned(AStructure) then AStructure.Add( Format('%d to %d used %d bytes',[LPosition,LZone.position + LZone.size, LZone.size]));
+          inc(LPosition, LZone.size + CT_ExtraSizeForUsedZoneType);
+          inc(ATotalUsedSize,LZone.size + CT_ExtraSizeForUsedZoneType);
+          inc(ATotalUsedBlocksCount);
+        end;
+      else
+        if Assigned(AStructure) then AStructure.Add( Format('Consisteny error at %d (End position: %d)',[LPosition,FNextAvailablePos]));
+        Result := False;
+      end;
+    end;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TAbstractMem.CheckInitialized(AWantsToWrite : Boolean);
+begin
+  if (AWantsToWrite and FReadOnly) then raise EAbstractMem.Create('Cannot write to a ReadOnly AbstractMem');
+  if Not FHeaderInitialized then begin
+    // Needs to write
+    if FReadOnly then raise EAbstractMem.Create('Cannot initialize a ReadOnly AbstractMem');
+    //
+    IncreaseSize(CT_HeaderSize);
+    // Write Header:
+    SaveHeader;
+  end;
+end;
+
+procedure TAbstractMem.ClearContent;
+var LNewRoot : TAbstractMemMemoryLeaksNode;
+begin
+  // Will erase ALL content creating a new null header
+  if FReadOnly then raise EAbstractMem.Create('Cannot ClearContent on a ReadOnly AbstractMem');
+  CheckInitialized(True);
+  //
+  LNewRoot.Clear;
+  FMemLeaks.SetRoot( LNewRoot );
+  FNextAvailablePos := CT_HeaderSize;
+  SaveHeader;
+end;
+
+procedure TAbstractMem.CopyFrom(ASource: TAbstractMem);
+var LBuff : TBytes;
+  iPos, LBuffDataCount : Integer;
+  LMemLeakRelativeRootPos : TAbstractMemPosition;
+begin
+  ASource.FLock.Acquire;
+  Self.FLock.Acquire;
+  try
+    ClearContent;
+
+    CheckInitialized(True);
+    IncreaseSize(ASource.FNextAvailablePos);
+    FNextAvailablePos := ASource.FNextAvailablePos;
+
+    SetLength(LBuff,1024*1024);
+    iPos := 0;
+    while (iPos < ASource.FNextAvailablePos) do begin
+      LBuffDataCount := (ASource.FNextAvailablePos - iPos);
+      if LBuffDataCount>Length(LBuff) then LBuffDataCount := Length(LBuff);
+      ASource.Read(iPos,LBuff[0],LBuffDataCount);
+      Self.Write(iPos,LBuff[0],LBuffDataCount);
+      inc(iPos,LBuffDataCount);
+    end;
+
+    LMemLeakRelativeRootPos := ASource.FMemLeaks.FRootPosition;
+    FMemLeaks.Free;
+    FMemLeaks := TAbstractMemMemoryLeaks.Create(Self,LMemLeakRelativeRootPos);
+
+    SaveHeader;
+  finally
+    Self.FLock.Release;
+    ASource.FLock.Release;
+  end;
+end;
+
+constructor TAbstractMem.Create(AInitialPosition: Integer; AReadOnly : Boolean);
+var LBuffer : TBytes;
+  LMemLeakRelativeRootPos : TAbstractMemPosition;
+  LOk : Boolean;
+begin
+  FMemLeaks := Nil;
+  FReadOnly := AReadOnly;
+  LMemLeakRelativeRootPos := 0;
+  FInitialPosition := AInitialPosition;
+  //
+  FNextAvailablePos := CT_HeaderSize; // By Default
+
+  FMaxAvailablePos := 0;
+
+  FLock := TCriticalSection.Create;
+  // Try to initialize
+  // Magic: 7 bytes
+  // version: 1 byte
+  // START OF FIRST BLOCK 1 = Header info
+  FHeaderInitialized := True;
+  LOk := False;
+  Try
+    SetLength(LBuffer,CT_HeaderSize);
+    if Read(0,LBuffer[0],CT_HeaderSize)=CT_HeaderSize then begin
+      if CompareMem(@LBuffer[0],@CT_Magic[0],6) then begin
+        LOk := LBuffer[6] = CT_IsStable;
+        if (LOk) And (LBuffer[7] = CT_Version) then begin
+          Move(LBuffer[8],LMemLeakRelativeRootPos,4);
+          Move(LBuffer[12],FNextAvailablePos,4);
+          //
+          LOk := (FNextAvailablePos >= CT_HeaderSize) and (LMemLeakRelativeRootPos<FNextAvailablePos);
+        end;
+      end;
+    end;
+  Finally
+    FHeaderInitialized := LOk;
+  End;
+  FMemLeaks := TAbstractMemMemoryLeaks.Create(Self,LMemLeakRelativeRootPos);
+end;
+
+destructor TAbstractMem.Destroy;
+begin
+  FreeAndNil(FMemLeaks);
+  FreeAndNil(FLock);
+  inherited;
+end;
+
+procedure TAbstractMem.Dispose(const APosition: TAbstractMemPosition);
+var LZone : TAMZone;
+begin
+  if APosition<=CT_HeaderSize then raise EAbstractMem.Create('Dispose: Invalid position '+IntToStr(APosition));
+  // @[APosition] - 4 bytes = position to size
+  LZone.position := APosition;
+  if Read(APosition - 4,LZone.size,4) <> 4 then raise EAbstractMem.Create('Dispose: Cannot read size');
+  Dispose(LZone);
+end;
+
+procedure TAbstractMem.Dispose(const AAMZone: TAMZone);
+var LNewMemLeak : TAbstractMemMemoryLeaksNode;
+  LZoneSize : UInt32;
+begin
+  CheckInitialized(True);
+
+  LNewMemLeak.Clear;
+  LNewMemLeak.myPosition := AAMZone.position - 4;
+  LNewMemLeak.SetSize(AAMZone.size+4);
+
+  if Read(LNewMemLeak.myPosition,LZoneSize,4)<>4 then raise EAbstractMem.Create('Dispose: Cannot read size');
+  if Integer(LZoneSize)<>AAMZone.size then raise EAbstractMem.Create(Format('Dispose: Invalid size %d (expected %d) at position %d',[LZoneSize,AAMZone.size,AAMZone.position]));
+
+  // Check valid units based on size
+  if (LNewMemLeak.GetSize<>AAMZone.size+4) then raise EAbstractMem.Create(Format('Dispose: Invalid size %d at position %d',[AAMZone.size,AAMZone.position]));
+  FLock.Acquire;
+  Try
+    // Save mem leak to mem
+    LNewMemLeak.WriteToMem(Self);
+    // Add leak to BTree
+    FMemLeaks.Add( LNewMemLeak );
+  Finally
+    FLock.Release;
+  End;
+end;
+
+class function TAbstractMem.GetAbstractMemVersion: String;
+begin
+  Result := ClassName+' v'+FloatToStr(CT_ABSTRACTMEM_VERSION);
+end;
+
+function TAbstractMem.GetUsedZoneInfo(const APosition: TAbstractMemPosition; ACheckForUsedZone: Boolean; out AAMZone: TAMZone): Boolean;
+begin
+  if (ACheckForUsedZone) then begin
+    if GetZoneType(APosition - CT_ExtraSizeForUsedZoneType,AAMZone)<>amzt_used then Exit(False)
+    else Exit(True);
+  end else begin
+    AAMZone.position := APosition;
+    if Read(APosition - CT_ExtraSizeForUsedZoneType,AAMZone.size,4)<>4 then Exit(False); // This is the CT_ExtraSizeForUsedZoneType = 4 bytes for size indicator
+    Result := (AAMZone.position + AAMZone.size <= FNextAvailablePos)  And ( ((((AAMZone.size-1) DIV 4)+1)*4) = AAMZone.size );
+  end;
+end;
+
+function TAbstractMem.GetZoneType(APosition: TAbstractMemPosition; out AAMZone : TAMZone): TAbstractMemZoneType;
+var LZone : TAMZone;
+  LMemLeak, LSearchedMemLeak : TAbstractMemMemoryLeaksNode;
+begin
+  Result := amzt_unknown;
+  AAMZone.position := APosition;
+  AAMZone.size := 0;
+  LZone.position := (((APosition-1) DIV 4)+1)*4;
+  if (LZone.position <> APosition) or (LZone.position<CT_HeaderSize) or (LZone.position>=FNextAvailablePos) then Exit;
+  // Check if Memory leak
+  LMemLeak.myPosition := LZone.position;
+  LMemLeak.ReadFromMem(LMemLeak.myPosition,Self);
+  LSearchedMemLeak := FMemLeaks.Find(LMemLeak);
+  if FMemLeaks.IsNil(LSearchedMemLeak) then begin
+    if Read(APosition,LZone.size,4)<>4 then Exit; // This is the CT_ExtraSizeForUsedZoneType = 4 bytes for size indicator
+    if (LZone.position + CT_ExtraSizeForUsedZoneType + LZone.size <= FNextAvailablePos)
+      And ( ((((LZone.size-1) DIV 4)+1)*4) = LZone.size ) then begin
+      Result := amzt_used;
+      AAMZone.position := LZone.position + CT_ExtraSizeForUsedZoneType;
+      AAMZone.size := LZone.size;
+    end;
+  end else begin
+    AAMZone.size := LSearchedMemLeak.GetSize;
+    Result := amzt_memory_leak;
+  end;
+end;
+
+procedure TAbstractMem.IncreaseSize(ANeedSize: Integer);
+  // This will guarantee at the end that FMaxAvailablePos-FNextAvailablePos+1 >= ANeededSize
+var LTmpNextAvailablePos, LTmpMaxAvailablePos : Integer;
+begin
+  if FMaxAvailablePos-FNextAvailablePos+1 >= ANeedSize then Exit;
+  LTmpNextAvailablePos := FNextAvailablePos;
+  LTmpMaxAvailablePos := FMaxAvailablePos;
+  DoIncreaseSize(LTmpNextAvailablePos,LTmpMaxAvailablePos,ANeedSize);
+  // Check
+  if (LTmpNextAvailablePos + LTmpMaxAvailablePos + 1 < ANeedSize) then raise EAbstractMem.Create(FormaT('IncreaseSize error. Needed %d obtained from %d to %d = %d',
+    [ANeedSize,LTmpNextAvailablePos,LTmpMaxAvailablePos,(LTmpMaxAvailablePos-LTmpNextAvailablePos+1)]));
+  //
+  FNextAvailablePos := LTmpNextAvailablePos;
+  FMaxAvailablePos := LTmpMaxAvailablePos;
+  SaveHeader;
+end;
+
+function TAbstractMem.IsAbstractMemInfoStable: Boolean;
+begin
+  Result := True;
+end;
+
+function TAbstractMem.New(AMemSize: Integer): TAMZone;
+var LNeededMemSize : Integer;
+  LMemLeakToFind, LMemLeakFound : TAbstractMemMemoryLeaksNode;
+begin
+  CheckInitialized(True);
+  // AMemSize must be a value stored in 3 bytes (24 bits) where each value is a "unit" of 4 bytes, so:
+  // (AMemSize > 0) and (AMemSize <= ((((2^24)-1)*4) - 4) )
+  if (AMemSize<=0) or (AMemSize>=67108860) then raise EAbstractMem.Create('Invalid new size: '+IntToStr(AMemSize));
+
+  FLock.Acquire;
+  Try
+    // First 4 bytes will be "how many units"
+    LNeededMemSize := AMemSize + 4;
+    // Minimum size is always 16 bytes (Mem needed for a mem leak = 4 * 4 bytes)
+    if LNeededMemSize<16 then LNeededMemSize := 16
+    else LNeededMemSize := LNeededMemSize;
+    // Round LMemSize to a 4 bytes packet
+    LNeededMemSize := (((LNeededMemSize-1) DIV 4)+1)*4;
+
+    LMemLeakToFind.Clear;
+    LMemLeakToFind.SetSize(LNeededMemSize);
+
+    LMemLeakFound := FMemLeaks.Find( LMemLeakToFind );
+    if Not FMemLeaks.IsNil(LMemLeakFound) then begin
+      // Found a Memory leak with this size, REUSE
+      Result.position := LMemLeakFound.myPosition + 4;
+      Result.size := LMemLeakFound.GetSize - 4;
+      // Remove leak
+      FMemLeaks.Delete( LMemLeakFound );
+    end else begin
+      // Need a new available zone
+      IncreaseSize( LNeededMemSize );
+      //
+      Result.position := FNextAvailablePos + 4; // 4 = "units"
+      FNextAvailablePos := FNextAvailablePos + LNeededMemSize;
+      Result.size := LNeededMemSize - 4;
+      SaveHeader; // NextAvailablePos updated, save changes
+    end;
+    // Save "unit"
+    Write(Result.position - 4,Result.size,4);
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.PositionToAbsolute(const APosition: Integer): Int64;
+begin
+  Result := FInitialPosition + APosition;
+end;
+
+procedure TAbstractMem.SaveHeader;
+var LBuffer : TBytes;
+  LUInt32 : UInt32;
+begin
+  if FReadOnly then raise EAbstractMem.Create('Cannot save Haeder on a ReadOnly AbstractMem');
+  // Write Header:
+  SetLength(LBuffer,CT_HeaderSize);
+  Move(CT_Magic[0],LBuffer[0],6);
+  if IsAbstractMemInfoStable then begin
+    LBuffer[6] := CT_IsStable;
+  end else begin
+    LBuffer[6] := CT_Is_NOT_Stable;
+  end;
+  LBuffer[7] := CT_Version;
+  LUInt32 := FMemLeaks.Root.myPosition;
+  Move(LUInt32,LBuffer[8],4);  // position to memleak btree root
+  LUInt32 := FNextAvailablePos;
+  Move(LUInt32,LBuffer[12],4); // next available pos
+  //
+  FHeaderInitialized := True;  // Set before call to Write
+  //
+  Write(0,LBuffer[0],Length(LBuffer));
+end;
+
+procedure TAbstractMem.SaveToStream(AStream: TStream);
+var LBuffer : TBytes;
+  i : Integer;
+  LNextStart : Integer;
+begin
+  CheckInitialized(False);
+  LNextStart := 0;
+  SetLength(LBuffer,1024*1024);
+  FLock.Acquire;
+  Try
+    while (LNextStart < FNextAvailablePos) do begin
+      i := FNextAvailablePos - LNextStart;
+      if (i>Length(LBuffer)) then i := Length(LBuffer);
+      Read(LNextStart,LBuffer[0],i);
+      AStream.Write(LBuffer[0],i);
+      inc(LNextStart,i);
+    end;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.ToString: String;
+var LAnalize : TStrings;
+  LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
+begin
+  LAnalize := TStringList.Create;
+  try
+    if Not CheckConsistency(LAnalize,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then begin
+      LAnalize.Add('CONSISTENCY ERROR FOUND');
+    end else begin
+      LAnalize.Clear;
+    end;
+    LAnalize.Add(Format('%s Start position %d - Used %d bytes in %d blocks - Available %d bytes in %d blocks',[Self.GetAbstractMemVersion, FInitialPosition,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
+    Result := LAnalize.Text;
+  finally
+    LAnalize.Free;
+  end;
+end;
+
+function TAbstractMem.Read(const APosition: Integer; var ABuffer; ASize: Integer): Integer;
+begin
+  FLock.Acquire;
+  try
+    if Not FHeaderInitialized then Result := 0
+    else Result := AbsoluteRead(PositionToAbsolute(APosition),ABuffer,ASize);
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.ReadFirstData(var AFirstDataZone: TAMZone; var AFirstData: TBytes): Boolean;
+var LPosition : TAbstractMemPosition;
+begin
+  LPosition := CT_HeaderSize;
+  Result := False;
+  AFirstDataZone.Clear;
+  SetLength(AFirstData,0);
+  if (LPosition < FNextAvailablePos) then begin
+    case GetZoneType(LPosition,AFirstDataZone) of
+      amzt_used : begin
+        SetLength(AFirstData,AFirstDataZone.size);
+        Result := Read(AFirstDataZone.position,AFirstData[0],Length(AFirstData))=AFirstDataZone.size;
+      end;
+    end;
+  end;
+end;
+
+procedure TAbstractMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+begin
+  FLock.Acquire;
+  Try
+    CheckInitialized(True);
+    if AbsoluteWrite(PositionToAbsolute(APosition),ABuffer,ASize)<>ASize then raise EAbstractMem.Create('Cannot write expected size');
+  Finally
+    FLock.Release;
+  End;
+end;
+
+{ TAbstractMemMemoryLeaksNode }
+
+procedure TAbstractMemMemoryLeaksNode.Clear;
+begin
+  Self.myPosition := 0;
+  Self.parentPosition := 0;
+  Self.leftPosition := 0;
+  Self.rigthPosition := 0;
+  Self.balance := 0;
+  Self.units := 0;
+end;
+
+function TAbstractMemMemoryLeaksNode.GetPosition(APosition: TAVLTreePosition): TAbstractMemPosition;
+begin
+  case APosition of
+    poParent: Result := Self.parentPosition;
+    poLeft: Result := Self.leftPosition;
+    poRight: Result := Self.rigthPosition;
+  else raise EAbstractMem.Create('Undefined 20200310-3');
+  end;
+end;
+
+function TAbstractMemMemoryLeaksNode.GetSize: Integer;
+begin
+  Result := Self.units * 4;
+end;
+
+procedure TAbstractMemMemoryLeaksNode.ReadFromMem(AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem);
+var LBuff : TBytes;
+begin
+  Self.Clear;
+  Self.myPosition := AMyPosition;
+  if Self.myPosition<=0 then Exit;
+  SetLength(LBuff,16);
+  AAbstractMem.Read(AMyPosition,LBuff[0],16);
+  Move(LBuff[0],Self.parentPosition,4);
+  Move(LBuff[4],Self.leftPosition,4);
+  Move(LBuff[8],Self.rigthPosition,4);
+  Move(LBuff[12],Self.balance,1);
+  Move(LBuff[13],Self.units,3);
+end;
+
+procedure TAbstractMemMemoryLeaksNode.SetPosition(APosition: TAVLTreePosition; AMemPosition: TAbstractMemPosition);
+begin
+  case APosition of
+    poParent: Self.parentPosition := AMemPosition;
+    poLeft: Self.leftPosition := AMemPosition ;
+    poRight: Self.rigthPosition := AMemPosition;
+  else raise EAbstractMem.Create('Undefined 20200310-3');
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaksNode.SetSize(ABytesSize: Integer);
+begin
+  Self.units := (((ABytesSize-1) DIV 4)+1);
+end;
+
+function TAbstractMemMemoryLeaksNode.ToString: String;
+begin
+  Result := Format('%d Bytes at %d with p:%d l:%d r:%d b:%d u:%d',
+    [Self.GetSize,
+     Self.myPosition,Self.parentPosition,Self.leftPosition,Self.rigthPosition,
+     Self.balance,Self.units]);
+end;
+
+procedure TAbstractMemMemoryLeaksNode.WriteToMem(AAbstractMem: TAbstractMem);
+var LBuff : TBytes;
+begin
+  if Self.myPosition<=0 then Exit;
+  SetLength(LBuff,16);
+  Move(Self.parentPosition,LBuff[0],4);
+  Move(Self.leftPosition,LBuff[4],4);
+  Move(Self.rigthPosition,LBuff[8],4);
+  Move(Self.balance,LBuff[12],1);
+  Move(Self.units,LBuff[13],3);
+  AAbstractMem.Write(Self.myPosition,LBuff[0],16);
+end;
+
+{ TAbstractMemMemoryLeaks }
+
+function _TAbstractMemMemoryLeaksNode_CompareByUnits(const Left, Right: TAbstractMemMemoryLeaksNode): Integer;
+begin
+  Result := Left.units - Right.units;
+  if (Result=0) and (Left.myPosition>0) and (Right.myPosition>0) then begin
+    // This will allow to find exactly a node when both are real (otherwise is searching for a position)
+    Result := Left.myPosition - Right.myPosition;
+  end;
+end;
+
+function TAbstractMemMemoryLeaks.AreEquals(const ANode1, ANode2: TAbstractMemMemoryLeaksNode): Boolean;
+begin
+  Result := (ANode1.myPosition = ANode2.myPosition);
+end;
+
+procedure TAbstractMemMemoryLeaks.ClearNode(var ANode: TAbstractMemMemoryLeaksNode);
+begin
+  ANode.Clear;
+end;
+
+procedure TAbstractMemMemoryLeaks.ClearPosition(var ANode: TAbstractMemMemoryLeaksNode; APosition: TAVLTreePosition);
+begin
+  ANode.SetPosition(APosition,0);
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+constructor TAbstractMemMemoryLeaks.Create(AAbstractMem: TAbstractMem; ARootPosition: TAbstractMemPosition);
+begin
+  FRootPosition := ARootPosition;
+  FAbstractMem := AAbstractMem;
+  inherited Create(_TAbstractMemMemoryLeaksNode_CompareByUnits,False);
+end;
+
+destructor TAbstractMemMemoryLeaks.Destroy;
+var LTmp : TAbstractMemMemoryLeaksNode;
+begin
+  LTmp := Root;
+  DisposeNode(LTmp);
+  inherited;
+end;
+
+procedure TAbstractMemMemoryLeaks.DisposeNode(var ANode: TAbstractMemMemoryLeaksNode);
+begin
+  //
+  ANode.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.GetBalance(const ANode: TAbstractMemMemoryLeaksNode): Integer;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  Result := ANode.balance;
+end;
+
+function TAbstractMemMemoryLeaks.GetPosition(const ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition): TAbstractMemMemoryLeaksNode;
+var LPos : TAbstractMemPosition;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  LPos := ANode.GetPosition(APosition);
+  if LPos>0 then begin
+    Result.ReadFromMem(LPos,FAbstractMem);
+  end else Result.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.GetRoot: TAbstractMemMemoryLeaksNode;
+begin
+  if FRootPosition>0 then begin
+    Result.ReadFromMem(FRootPosition,FAbstractMem);
+  end else Result.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.HasPosition(const ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  Result := ANode.GetPosition(APosition) > 0;
+end;
+
+function TAbstractMemMemoryLeaks.IsNil(const ANode: TAbstractMemMemoryLeaksNode): Boolean;
+begin
+  Result := ANode.myPosition = 0;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetBalance(var ANode: TAbstractMemMemoryLeaksNode; ANewBalance: Integer);
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  ANode.balance := ANewBalance;
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetPosition(var ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition; const ANewValue: TAbstractMemMemoryLeaksNode);
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  ANode.SetPosition(APosition,ANewValue.myPosition);
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetRoot(const Value: TAbstractMemMemoryLeaksNode);
+begin
+  FRootPosition := Value.myPosition;
+  // Save to header info
+  FAbstractMem.SaveHeader;
+end;
+
+function TAbstractMemMemoryLeaks.ToString(const ANode: TAbstractMemMemoryLeaksNode): String;
+begin
+  Result := ANode.ToString;
+end;
+
+{ TMem }
+
+function TMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
+begin
+  if AAbsolutePosition>=Length(FMem) then Exit(0)
+  else begin
+    if AAbsolutePosition + ASize > Length(FMem) then Result := Length(FMem) - AAbsolutePosition
+    else Result := ASize;
+    Move(FMem[AAbsolutePosition],ABuffer,Result);
+  end;
+end;
+
+function TMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
+begin
+  if ASize=0 then Exit(0);
+  if (AAbsolutePosition + ASize > Length(FMem)) or (ASize<0) then
+    raise EAbstractMem.Create(Format('Write out of mem range from %d to %d (max %d)',
+    [AAbsolutePosition,AAbsolutePosition+ASize,High(FMem)]));
+  Move(ABuffer,FMem[AAbsolutePosition],ASize);
+  Result := ASize;
+end;
+
+constructor TMem.Create(AInitialPosition: Integer; AReadOnly: Boolean);
+begin
+  SetLength(FMem,0);
+  inherited;
+end;
+
+procedure TMem.DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos: Integer; ANeedSize: Integer);
+begin
+  AMaxAvailablePos := Length(FMem);
+
+  ANeedSize := (((ANeedSize-1) DIV 256)+1)*256;
+
+  SetLength(FMem, AMaxAvailablePos + ANeedSize);
+  Inc(AMaxAvailablePos,ANeedSize);
+  //
+end;
+
+{ TAMZone }
+
+procedure TAMZone.Clear;
+begin
+  Self.position := 0;
+  Self.size := 0;
+end;
+
+function TAMZone.ToString: String;
+begin
+  Result := Format('Pos:%d Size:%d bytes',[Self.position,Self.size]);
+end;
+
+{ TAbstractMemAVLTreeNodeInfo }
+
+procedure TAbstractMemAVLTreeNodeInfo.Clear;
+begin
+  Self.parentPosition := 0;
+  Self.leftPosition := 0;
+  Self.rigthPosition := 0;
+  Self.balance := 0;
+end;
+
+function TAbstractMemAVLTreeNodeInfo.ToString: String;
+begin
+  Result := Format('TreeBasicNode: Parent:%d Left:%d Right:%d Balance:%d',[Self.parentPosition,Self.leftPosition,Self.rigthPosition,Self.balance]);
+end;
+
+{ TAbstractMemAVLTreeNodeInfoClass }
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.ClearPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: L.parentPosition := 0;
+    poLeft:   L.leftPosition := 0;
+    poRight:  L.rigthPosition := 0;
+  end;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetBalance(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem): ShortInt;
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  Result := L.balance;
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition): TAbstractMemPosition;
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: Result := L.parentPosition;
+    poLeft:   Result := L.leftPosition;
+    poRight:  Result := L.rigthPosition;
+  end;
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetSize: Integer;
+begin
+  Result := 13; // 4*3 + 1 (balance)
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.ReadFromMem(
+  AMyPosition: TAbstractMemPosition;
+  AAbstractMem: TAbstractMem): TAbstractMemAVLTreeNodeInfo;
+var LBytes : TBytes;
+begin
+  if (AMyPosition>=CT_HeaderSize) then begin
+    Result.Clear;
+    SetLength(LBytes,Self.GetSize);
+    if AAbstractMem.Read(AMyPosition,LBytes[0],Length(LBytes))<>Length(LBytes) then raise EAbstractMem.Create(Format('Not enough data to read TreeNodeInfo at %d',[AMyPosition]));
+    Move(LBytes[0],Result.parentPosition,4);
+    Move(LBytes[4],Result.leftPosition,4);
+    Move(LBytes[8],Result.rigthPosition,4);
+    Move(LBytes[12],Result.balance,1);
+  end else raise EAbstractMem.Create(Format('Invalid position read TAbstractMemAVLTreeNodeInfo.ReadFromMem(%d)',[AMyPosition]));
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.SetBalance(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  ANewBalance: ShortInt);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  L.balance := ANewBalance;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.SetPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition; ANewPosition: TAbstractMemPosition);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: L.parentPosition := ANewPosition;
+    poLeft:   L.leftPosition := ANewPosition;
+    poRight:  L.rigthPosition := ANewPosition;
+  end;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.WriteToMem(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  const ANodeInfo: TAbstractMemAVLTreeNodeInfo);
+var LBytes : TBytes;
+begin
+  if (AMyPosition>=CT_HeaderSize) then begin
+    SetLength(LBytes,Self.GetSize);
+    Move(ANodeInfo.parentPosition,LBytes[0],4);
+    Move(ANodeInfo.leftPosition,LBytes[4],4);
+    Move(ANodeInfo.rigthPosition,LBytes[8],4);
+    Move(ANodeInfo.balance,LBytes[12],1);
+    AAbstractMem.Write(AMyPosition,LBytes[0],Length(LBytes));
+  end else raise EAbstractMem.Create(Format('Invalid position write TAbstractMemAVLTreeNodeInfo.WriteToMem(%d) for %s',[AMyPosition,ANodeInfo.ToString]));
+end;
+
+end.

src/libraries/abstractmem/UAbstractMemTList.pas

@@ -0,0 +1,863 @@
+unit UAbstractMemTList;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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,
+  SyncObjs,
+  UAbstractMem,
+  // 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};
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EAbstractMemTList = Class(Exception);
+
+  TAbstractMemTList = Class
+  private
+    FAbstractMem : TAbstractMem;
+    FInitialZone : TAMZone; // Initial zone contains "magic signature", "elements of each block" and "first block pointer", must be at least 16 bytes size
+
+    FElementsOfEachBlock : Integer;
+    FFirstBlockPointer : TAbstractMemPosition;
+    FNextElementPosition : Integer;
+
+    FUseCache : Boolean;
+    FCacheData : TBytes;
+    FCacheUpdated : Boolean;
+
+    function GetPosition(AIndex: Integer): TAbstractMemPosition;
+    procedure SetPosition(AIndex: Integer; const Value: TAbstractMemPosition);
+
+    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);
+  protected
+    FAbstractMemTListLock : TCriticalSection;
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer); virtual;
+    destructor Destroy; override;
+
+    procedure FlushCache;
+
+    procedure Initialize(const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer);
+
+    Function Add(const APosition : TAbstractMemPosition) : Integer; //virtual;
+
+    Procedure Clear; //virtual;
+    Procedure Dispose;
+
+    Procedure Delete(index : Integer); //virtual;
+    Procedure Insert(AIndex : Integer; const APosition : TAbstractMemPosition); //virtual;
+
+    property Position[AIndex : Integer] : TAbstractMemPosition read GetPosition write SetPosition;
+
+    Function Count : Integer;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+    property InitialiZone : TAMZone read FInitialZone;
+    property UseCache : Boolean read FUseCache write SetUseCache;
+    procedure LockList;
+    procedure UnlockList;
+  End;
+
+  TAbstractMemTListBaseAbstract<T> = Class
+  private
+    FAbstractMem: TAbstractMem;
+    function GetInitialZone: TAMZone;
+  protected
+    FList : TAbstractMemTList;
+    // POSSIBLE OVERRIDE METHODS
+    function GetItem(index : Integer) : T; virtual;
+    procedure SetItem(index : Integer; const AItem : T); virtual;
+    function ToString(const AItem : T) : String; overload; virtual;
+    // ABSTRACT METHODS NEED TO OVERRIDE
+    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;
+    Destructor Destroy; override;
+
+    Function Add(const AItem : T) : Integer; virtual;
+
+    function Count : Integer;
+    procedure Delete(index : Integer); virtual;
+
+    procedure FlushCache;
+    Procedure Clear;
+    Procedure Dispose;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+    property InitialiZone : TAMZone read GetInitialZone;
+  End;
+
+
+  TAbstractMemTList<T> = Class(TAbstractMemTListBaseAbstract<T>)
+  public
+    property Item[index : Integer] : T read GetItem write SetItem;
+  End;
+
+  { TAbstractMemOrderedTList }
+
+  TAbstractMemOrderedTList<T> = Class(TAbstractMemTListBaseAbstract<T>)
+  private
+    FAllowDuplicates : Boolean;
+  protected
+    // 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;
+    function Find(const AItemToFind : T; out AIndex : Integer) : Boolean;
+    Function Add(const AItem : T) : Integer; reintroduce;
+    property Item[index : Integer] : T read GetItem;
+    function IndexOf(const AItem : T) : Integer;
+    property AllowDuplicates : Boolean read FAllowDuplicates;
+    function Get(index : Integer) : T;
+  End;
+
+const
+  CT_AbstractMemTList_HeaderSize = 16;
+    // [0] 4 for magic
+    // [4] 4 for elements of each block
+    // [8] 4 for next element (counter)
+    // [12] 4 for first block position
+
+implementation
+
+{ TAbstractMemTList }
+
+const
+  CT_AbstractMemTList_Magic = 'ABML'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
+
+function TAbstractMemTList.Add(const APosition: TAbstractMemPosition): Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  Result := FNextElementPosition;
+  Insert(FNextElementPosition,APosition);
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+procedure TAbstractMemTList.AddRange(AIndexStart, AInsertCount: Integer);
+var LElements : TBytes;
+  LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock, i, j, n : Integer;
+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
+    FCacheUpdated := True;
+    SetLength(FCacheData,Length(FCacheData)+(AInsertCount*4));
+    Move(FCacheData[AIndexStart*4],FCacheData[(AIndexStart+AInsertCount)*4],Length(FCacheData)-((AIndexStart+AInsertCount)*4));
+    Inc(FNextElementPosition,AInsertCount);
+    Exit;
+  end;
+  //
+  LoadElements(AIndexStart,LElements);
+  n := 0; // n = Elements moved
+  // Increase
+  i := AIndexStart+AInsertCount;
+  // i = first position to move "right"
+  repeat
+    GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    // Move from LIndexInBlock to FElementsOfEachBlock-1 in this block
+    j := FElementsOfEachBlock - (LIndexInBlock); // j = Elements to move right on this block
+    if ((n+j)*4>Length(LElements)) then j := (Length(LElements) DIV 4)-n;
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), LElements[ n*4 ], j*4 );
+    inc(n,j);
+    inc(i,j);
+  until (i >= FNextElementPosition + AInsertCount) or (j=0);
+  Inc(FNextElementPosition,AInsertCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+end;
+
+procedure TAbstractMemTList.CheckInitialized;
+begin
+  if (FElementsOfEachBlock<=0) then raise EAbstractMemTList.Create(FormaT('%s not initialized',[ClassName]));
+end;
+
+procedure TAbstractMemTList.Clear;
+var LBlockPointer, LNext : TAbstractMemPosition;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  CheckInitialized;
+  // Free mem
+  LBlockPointer := FFirstBlockPointer;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+  FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+  while (LBlockPointer>0) do begin
+    // Read next
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Dispose(LBlockPointer);
+    LBlockPointer := LNext;
+  end;
+
+  SetLength(FCacheData,0);
+  FCacheUpdated := False;
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+function TAbstractMemTList.Count: Integer;
+begin
+  Result := FNextElementPosition;
+end;
+
+constructor TAbstractMemTList.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; ADefaultElementsPerBlock : Integer);
+begin
+  SetLength(FCacheData,0);
+  FUseCache := True;
+  FCacheUpdated := False;
+
+  FAbstractMem := AAbstractMem;
+  FInitialZone.Clear;
+
+  FElementsOfEachBlock := 0;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+
+  FAbstractMemTListLock := TCriticalSection.Create;
+
+  Initialize(AInitialZone,ADefaultElementsPerBlock);
+end;
+
+procedure TAbstractMemTList.Delete(index: Integer);
+begin
+  RemoveRange(index,1);
+end;
+
+destructor TAbstractMemTList.Destroy;
+begin
+  if FUseCache then FlushCache;
+  FAbstractMemTListLock.Free;
+  inherited;
+end;
+
+procedure TAbstractMemTList.Dispose;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  if FInitialZone.position<=0 then Exit; // Nothing to dispose
+  Clear;
+  Try
+    if FInitialZone.size=0 then FAbstractMem.Dispose(FInitialZone.position)
+    else FAbstractMem.Dispose(FInitialZone);
+  Finally
+    FInitialZone.Clear;
+  End;
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+procedure TAbstractMemTList.FlushCache;
+var i : Integer;
+  LPreviousBlockPointer,LBlockPointer, LNext, LZero : TAbstractMemPosition;
+  LIndexInBlock, LElements : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  if (Not FUseCache) or (Not FCacheUpdated) then Exit;
+  CheckInitialized;
+  LPreviousBlockPointer := 0;
+  LBlockPointer := 0;
+  LIndexInBlock := 0;
+  LNext := 0;
+  // Save full:
+  i := 0;
+  while ((i*4) < (Length(FCacheData))) do begin
+    GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    if (i+FElementsOfEachBlock-1 >= FNextElementPosition) then begin
+      LElements := FNextElementPosition - i;
+    end else LElements := FElementsOfEachBlock;
+    FAbstractMem.Write(LBlockPointer,FCacheData[i*4],(LElements*4));
+    inc(i,LElements);
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    LPreviousBlockPointer := LBlockPointer;
+  end;
+  // Save Header:
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  // Free unused blocks:
+  if (FNextElementPosition=0) And (FFirstBlockPointer>0) then begin
+    // This is first block pointer
+    LNext := FFirstBlockPointer;
+    FFirstBlockPointer := 0;
+    FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+    LPreviousBlockPointer := 0;
+  end;
+  while (LNext>0) do begin
+    if LPreviousBlockPointer>0 then begin
+      LZero := 0;
+      FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LZero, 4);
+    end;
+    LPreviousBlockPointer := LBlockPointer;
+    LBlockPointer := LNext;
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Dispose(LBlockPointer);
+  end;
+  //
+  FCacheUpdated := False;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.GetPointerTo(AIndex: Integer; AAllowIncrease : Boolean; out APreviousBlockPointer, ABlockPointer: TAbstractMemPosition; out AIndexInBlock: Integer);
+var LBlockIndex : Integer;
+  i : Integer;
+  LNewBlock : TAMZone;
+  LZero : Integer;
+begin
+  CheckInitialized;
+  if (AIndex<0) or ((Not AAllowIncrease) And (AIndex>=FNextElementPosition)) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementPosition-1]));
+
+  // Search ABlockPointer
+  LBlockIndex := AIndex DIV FElementsOfEachBlock;
+  AIndexInBlock := AIndex MOD FElementsOfEachBlock;
+
+  APreviousBlockPointer := 0;
+  ABlockPointer := FFirstBlockPointer;
+  i := 0;
+  repeat
+    if (ABlockPointer<=0) then begin
+      // Create
+      LNewBlock := FAbstractMem.New( 4 + (FElementsOfEachBlock * 4) );
+      ABlockPointer := LNewBlock.position;
+      // Save this pointer
+      if (i=0) then begin
+        // This is FFirstBlockPointer
+        FFirstBlockPointer := LNewBlock.position;
+        // Save header:
+        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+      end else begin
+        // This is previous block
+        FAbstractMem.Write( APreviousBlockPointer + (FElementsOfEachBlock*4), LNewBlock.position, 4 );
+      end;
+      // Clear next
+      LZero := 0;
+      FAbstractMem.Write( ABlockPointer + (FElementsOfEachBlock*4), LZero, 4 );
+    end;
+    if (i<LBlockIndex) then begin
+      APreviousBlockPointer := ABlockPointer;
+      // Read
+      FAbstractMem.Read( ABlockPointer + (FElementsOfEachBlock*4), ABlockPointer, 4 );
+    end;
+    inc(i);
+  until (i > LBlockIndex);
+end;
+
+function TAbstractMemTList.GetPosition(AIndex: Integer): TAbstractMemPosition;
+var LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  Result := 0;
+  FAbstractMemTListLock.Acquire;
+  try
+  if FUseCache 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
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Read( LBlockPointer + (LIndexInBlock*4), Result, 4);
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.Initialize(const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer);
+var LBytes : TBytes;
+  i : Integer;
+begin
+  FInitialZone := AInitialZone;
+  // Try to read
+  FElementsOfEachBlock := 0;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+  SetLength(LBytes,CT_AbstractMemTList_HeaderSize);
+  try
+    if (FInitialZone.position>0) And ((FInitialZone.size=0) or (FInitialZone.size>=CT_AbstractMemTList_HeaderSize)) then begin
+      FAbstractMem.Read(FInitialZone.position,LBytes[0],CT_AbstractMemTList_HeaderSize);
+      if Length(CT_AbstractMemTList_Magic)<>4 then raise EAbstractMemTList.Create('Invalid CT_AbstractMemTList_Magic size!');
+      // Check magic
+      for i := 0 to CT_AbstractMemTList_Magic.Length-1 do begin
+        if LBytes[i]<>Ord(CT_AbstractMemTList_Magic.Chars[i]) then Exit;
+      end;
+      // Capture Size
+      Move(LBytes[4],FElementsOfEachBlock,4);
+      Move(LBytes[8],FNextElementPosition,4);
+      Move(LBytes[12],FFirstBlockPointer,4);
+      if (FElementsOfEachBlock<=0) then begin
+        // Not valid
+        FElementsOfEachBlock := 0;
+        FFirstBlockPointer := 0;
+        FNextElementPosition := 0;
+      end;
+    end;
+  finally
+    if (FInitialZone.position>0) and (FElementsOfEachBlock<=0) and ((FInitialZone.size=0) or (FInitialZone.size>=CT_AbstractMemTList_HeaderSize))  then begin
+      // Need to initialize and save
+      FElementsOfEachBlock := ADefaultElementsPerBlock;
+      if FElementsOfEachBlock<=0 then raise EAbstractMemTList.Create('Invalid Default Elements per block');
+
+      for i := 0 to CT_AbstractMemTList_Magic.Length-1 do begin
+        LBytes[i] := Byte(Ord(CT_AbstractMemTList_Magic.Chars[i]));
+      end;
+      Move(FElementsOfEachBlock,LBytes[4],4);
+      Move(FNextElementPosition,LBytes[8],4);
+      Move(FFirstBlockPointer,LBytes[12],4);
+      // Save header
+      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);
+var LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  AddRange(AIndex,1);
+  if FUseCache then begin
+    Move(APosition, FCacheData[AIndex*4], 4);
+    FCacheUpdated := True;
+  end else begin
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), APosition, 4 );
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.LoadElements(AIndexStart: Integer; var AElements: TBytes);
+var LBlockPointer, LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock, i, j : Integer;
+begin
+  CheckInitialized;
+  if (AIndexStart<0) or (AIndexStart>FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s LoadElements out of range %d in 0..%d',[ClassName,AIndexStart,FNextElementPosition-1]));
+
+  SetLength(AElements, (FNextElementPosition - AIndexStart)*4);
+
+  i := AIndexStart;
+  while (i<FNextElementPosition) do begin
+    GetPointerTo( i ,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    // Load this
+    j := FElementsOfEachBlock - LIndexInBlock;
+    if (i + j -1) >= FNextElementPosition then j := FNextElementPosition - i;
+
+    FAbstractMem.Read(LBlockPointer + (LindexInBlock * 4), AElements[ (i-AIndexStart)*4 ], (j)*4  );
+
+    inc(i,j);
+  end;
+end;
+
+procedure TAbstractMemTList.LockList;
+begin
+  FAbstractMemTListLock.Acquire;
+end;
+
+procedure TAbstractMemTList.RemoveRange(AIndexStart, ARemoveCount: Integer);
+var LBlockPointer, LPreviousBlockPointer, LNext : TAbstractMemPosition;
+  LIndexInBlock, i, j, n : Integer;
+  LElements : TBytes;
+  LBlocksBefore, LBlocksAfter : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  if (ARemoveCount<=0) then raise EAbstractMemTList.Create(Format('%s remove count %d',[ClassName,ARemoveCount]));
+  if (AIndexStart+ARemoveCount-1>=FNextElementPosition) then begin
+    if (FNextElementPosition>0) then
+      raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1, FNextElementPosition-1]))
+    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 (AIndexStart+ARemoveCount < FNextElementPosition) then begin
+      Move(FCacheData[(AIndexStart + ARemoveCount) *4],
+           FCacheData[(AIndexStart) *4],
+           Length(FCacheData)-((AIndexStart + ARemoveCount)*4));
+
+    end;
+    SetLength(FCacheData,Length(FCacheData) - (ARemoveCount*4));
+    FCacheUpdated := True;
+    Dec(FNextElementPosition,ARemoveCount);
+    Exit;
+  end;
+
+  LoadElements(AIndexStart+ARemoveCount,LElements);
+  n := 0; // n = Elements moved
+  //
+  i := AIndexStart+ARemoveCount-1;
+  // i = first position to move "left"
+
+  repeat
+    GetPointerTo(i,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    // Move from LIndexInBlock to FElementsOfEachBlock-1 in this block
+    j := FElementsOfEachBlock - (LIndexInBlock);
+    if ((n+j)*4>Length(LElements)) then j := (Length(LElements) DIV 4)-n;
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), LElements[ n*4 ], j*4 );
+    inc(n,j);
+    inc(i,j);
+  until (i >= FNextElementPosition - ARemoveCount);// or (j=0);
+
+  LBlocksBefore := ((FNextElementPosition DIV FElementsOfEachBlock)+1);
+  LBlocksAfter := (((FNextElementPosition-ARemoveCount) DIV FElementsOfEachBlock)+1);
+
+  if (LBlocksBefore<LBlocksAfter) then begin
+    GetPointerTo(FNextElementPosition-ARemoveCount,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    while (LBlockPointer>0) do begin
+      FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+      FAbstractMem.Dispose(LBlockPointer);
+      LBlockPointer := LNext;
+      //
+      if LPreviousBlockPointer>0 then begin
+        LNext := 0;
+        FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+      end else begin
+        // This is first block pointer
+        FFirstBlockPointer := 0;
+        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+      end;
+    end;
+
+  end;
+
+  // Save to header
+  Dec(FNextElementPosition,ARemoveCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.SetPosition(AIndex: Integer; const Value: TAbstractMemPosition);
+var LBlockPointer, LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  if FUseCache then begin
+    Move( Value, FCacheData[AIndex*4], 4);
+    FCacheUpdated := True;
+  end else begin
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), Value, 4);
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.SetUseCache(const Value: Boolean);
+begin
+  if (Value=FUseCache) then Exit;
+  if (FUseCache) then begin
+    FlushCache;
+    SetLength(FCacheData,0);
+  end else begin
+    LoadElements(0,FCacheData);
+    FCacheUpdated := False;
+  end;
+  FUseCache := Value;
+end;
+
+procedure TAbstractMemTList.UnlockList;
+begin
+  FAbstractMemTListLock.Release;
+end;
+
+{ TAbstractMemTListBaseAbstract<T> }
+
+function TAbstractMemTListBaseAbstract<T>.Add(const AItem: T): Integer;
+var
+  LBytes : TBytes;
+  LZone : TAMZone;
+begin
+  FList.LockList;
+  try
+  SetLength(LBytes,0);
+  Self.SaveTo(AItem,True,LBytes);
+  if (Length(LBytes)>0) then begin
+    LZone := FList.AbstractMem.New( Length(LBytes) );
+    FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+  end else LZone.Clear;
+  Result := FList.Add( LZone.position );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Clear;
+var i : Integer;
+  LPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  for i := 0 to FList.Count-1 do begin
+    LPosition := FList.Position[ i ];
+    FList.AbstractMem.Dispose( LPosition );
+  end;
+  FList.Clear;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.Count: Integer;
+begin
+  Result := FList.Count;
+end;
+
+constructor TAbstractMemTListBaseAbstract<T>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer);
+begin
+  FAbstractMem := AAbstractMem;
+  FList := TAbstractMemTList.Create(AAbstractMem,AInitialZone,ADefaultElementsPerBlock);
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Delete(index: Integer);
+var LPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  LPosition := FList.Position[ index ];
+  FList.AbstractMem.Dispose( LPosition );
+  FList.Delete( index );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+destructor TAbstractMemTListBaseAbstract<T>.Destroy;
+begin
+  FList.Free;
+  inherited;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Dispose;
+begin
+  Clear;
+  FList.Dispose;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.FlushCache;
+begin
+  FList.FlushCache;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.GetInitialZone: TAMZone;
+begin
+  Result := FList.InitialiZone;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.GetItem(index: Integer): T;
+var
+  LPosition : TAbstractMemPosition;
+  LZone : TAMZone;
+  LBytes : TBytes;
+begin
+  FList.LockList;
+  try
+  LPosition := FList.Position[ index ];
+  if (LPosition>0) then begin
+    if Not FList.AbstractMem.GetUsedZoneInfo( LPosition, False, LZone) then
+      raise EAbstractMemTList.Create(Format('%s.GetItem Inconsistency error used zone info not found at index %d at pos %d',[Self.ClassName,index,LPosition]));
+    SetLength(LBytes,LZone.size);
+    if FList.AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+      raise EAbstractMemTList.Create(Format('%s.GetItem Inconsistency error cannot read %d bytes for index %d at pos %d',[Self.ClassName,LZone.size,index,LPosition]));
+  end else SetLength(LBytes,0);
+  LoadFrom(LBytes, Result );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.SetItem(index: Integer;
+  const AItem: T);
+var
+  LBytes : TBytes;
+  LZone : TAMZone;
+  LPreviousElementPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  LPreviousElementPosition := FList.Position[ index ];
+  if (LPreviousElementPosition>0) then begin
+    // Had value
+    if Not FList.AbstractMem.GetUsedZoneInfo( LPreviousElementPosition, False, LZone) then
+      raise EAbstractMemTList.Create(Format('%s.SetItem Inconsistency error used zone info not found at index %d at pos %d',[Self.ClassName,index,LPreviousElementPosition]));
+    SetLength(LBytes,LZone.size);
+    if FList.AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+      raise EAbstractMemTList.Create(Format('%s.SetItem Inconsistency error cannot read %d bytes for index %d at pos %d',[Self.ClassName,LZone.size,index,LPreviousElementPosition]));
+  end else begin
+    SetLength(LBytes,0);
+    LZone.Clear;
+  end;
+
+  Self.SaveTo(AItem,False,LBytes);
+
+  if (LPreviousElementPosition>0) and ((Length(LBytes)>LZone.size) or (Length(LBytes)=0)) then begin
+    // Dispose previous element
+    FList.AbstractMem.Dispose( LPreviousElementPosition );
+    LZone.Clear;
+  end;
+  if (Length(LBytes)>0) then begin
+    if (LZone.position=0) then begin
+      // Create new zone
+      LZone := FList.AbstractMem.New( Length(LBytes) );
+    end;
+    FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+    FList.Position[ index ] := LZone.position;
+  end else begin
+    // Save a 0 position
+    FList.Position[ index ] := 0;
+  end;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.ToString(const AItem: T): String;
+begin
+  Result := Self.ClassName+'.T '+IntToStr(SizeOf(AItem));
+end;
+
+{ TAbstractMemOrderedTList<T> }
+
+function TAbstractMemOrderedTList<T>.Add(const AItem: T): Integer;
+var
+  LFound : Boolean;
+  LBytes : TBytes;
+  LZone : TAMZone;
+begin
+  FList.LockList;
+  try
+  LFound := Find(AItem,Result);
+  if (LFound and FAllowDuplicates) or (Not LFound) then begin
+    SetLength(LBytes,0);
+    Self.SaveTo(AItem,True,LBytes);
+    if (Length(LBytes)>0) then begin
+      LZone := FList.AbstractMem.New( Length(LBytes) );
+      FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+    end else LZone.Clear;
+    FList.Insert( Result , LZone.position );
+  end else Result := -1;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+constructor TAbstractMemOrderedTList<T>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer;
+  AAllowDuplicates: Boolean);
+begin
+  inherited Create(AAbstractMem, AInitialZone, ADefaultElementsPerBlock);
+  FAllowDuplicates := AAllowDuplicates;
+end;
+
+function TAbstractMemOrderedTList<T>.Find(const AItemToFind: T; out AIndex: Integer): Boolean;
+var L, H, I: Integer;
+  C : Int64;
+  LLeft : T;
+begin
+  FList.LockList;
+  try
+  Result := False;
+  L := 0;
+  H := FList.Count - 1;
+  // Optimization when inserting always a ordered list
+  if (H>0) then begin
+    LLeft := GetItem( H );
+    C := Compare(LLeft, AItemToFind);
+    if (C<0) then begin
+      AIndex := H+1;
+      Exit;
+    end else if (C=0) then begin
+      AIndex := H; // When equals, insert to the left
+      Result := True;
+      Exit;
+    end;
+  end;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+
+    LLeft := GetItem( I );
+
+    C := Compare(LLeft, AItemToFind);
+
+    if C < 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        L := I;
+      end;
+    end;
+  end;
+  AIndex := L;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemOrderedTList<T>.Get(index: Integer): T;
+begin
+  Result := GetItem(index);
+end;
+
+function TAbstractMemOrderedTList<T>.IndexOf(const AItem: T): Integer;
+begin
+  If Not Find(AItem,Result) then Result := -1;
+end;
+
+end.

src/libraries/abstractmem/UCacheMem.pas

@@ -0,0 +1,967 @@
+unit UCacheMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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}
+
+interface
+
+uses
+  Classes, SysUtils,
+  {$IFNDEF FPC}{$IFDEF MSWINDOWS}windows,{$ENDIF}{$ENDIF}
+  UAbstractBTree, UOrderedList;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  TCacheMem = Class;
+
+  PCacheMemData = ^TCacheMemData;
+
+  { TCacheMemData }
+
+  TCacheMemData = record
+    parent : PCacheMemData;
+    left : PCacheMemData;
+    right : PCacheMemData;
+    balance : Integer;
+    //
+    buffer : TBytes;
+    startPos : Integer;
+    used_previous : PCacheMemData;
+    used_next : PCacheMemData;
+    pendingToSave : Boolean;
+    function GetSize : Integer;
+    function GetEndPos : Integer;
+    procedure Clear;
+    function ToString : String;
+    procedure DoMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData; AAddToList : Boolean);
+    procedure MarkAsUsed(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData);
+    procedure UnMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData);
+  end;
+
+  TCacheMemDataTree = Class( TAVLAbstractTree<PCacheMemData> )
+  private
+    FRoot : PCacheMemData;
+  protected
+    function GetRoot: PCacheMemData; override;
+    procedure SetRoot(const Value: PCacheMemData); override;
+    function HasPosition(const ANode : PCacheMemData; APosition : TAVLTreePosition) : Boolean; override;
+    procedure SetPosition(var ANode : PCacheMemData; APosition : TAVLTreePosition; const ANewValue : PCacheMemData); override;
+    procedure ClearPosition(var ANode : PCacheMemData; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : PCacheMemData) : Integer; override;
+    procedure SetBalance(var ANode : PCacheMemData; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : PCacheMemData) : Boolean; override;
+    procedure ClearNode(var ANode : PCacheMemData); override;
+    procedure DisposeNode(var ANode : PCacheMemData); override;
+  public
+    function IsNil(const ANode : PCacheMemData) : Boolean; override;
+    function ToString(const ANode: PCacheMemData) : String; override;
+    constructor Create; reintroduce;
+    //
+    function GetPosition(const ANode : PCacheMemData; APosition : TAVLTreePosition) : PCacheMemData; override;
+  End;
+
+
+  // TickCount is platform specific (32 or 64 bits)
+  TTickCount = {$IFDEF CPU64}QWord{$ELSE}Cardinal{$ENDIF};
+
+  TPlatform = Class
+  public
+    class function GetTickCount : TTickCount;
+    class function GetElapsedMilliseconds(Const previousTickCount : TTickCount) : Int64;
+  End;
+
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  TCacheMemStats = record
+    flushCount : Integer;
+    flushSize : Integer;
+    flushElapsedMillis : Int64;
+    freememCount : Integer;
+    freememSize : Integer;
+    freememElaspedMillis : Int64;
+    maxUsedCacheSize : Integer;
+    procedure Clear;
+    function ToString : String;
+  end;
+  {$ENDIF}
+
+  TOnNeedDataProc = function(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
+  TOnSaveDataProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
+
+  ECacheMem = Class(Exception);
+
+  TCacheMem = Class
+  private
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    FCacheMemStats : TCacheMemStats;
+    {$ENDIF}
+    FOldestUsed : PCacheMemData;
+    FNewestUsed : PCacheMemData;
+    FCacheData : TCacheMemDataTree;
+    FPendingToSaveBytes : Integer;
+    FCacheDataBlocks : Integer;
+    FCacheDataSize : Integer;
+    FOnNeedDataProc : TOnNeedDataProc;
+    FOnSaveDataProc : TOnSaveDataProc;
+    FMaxCacheSize: Integer;
+    FMaxCacheDataBlocks: Integer;
+    function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
+    procedure Delete(var APCacheMemData : PCacheMemData); overload;
+    function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
+    procedure CheckMaxMemUsage;
+  public
+    Constructor Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
+    Destructor Destroy; override;
+    //
+    procedure Clear;
+    procedure SaveToCache(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
+    procedure SaveToCache(const ABuffer : TBytes; AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
+    function LoadData(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
+    function ToString : String; reintroduce;
+    function FlushCache : Boolean; overload;
+    function FreeMem(const AMaxMemSize, AMaxBlocks : Integer) : Boolean;
+
+    procedure ConsistencyCheck;
+
+    property CacheDataSize : Integer read FCacheDataSize;
+    // Bytes in cache
+
+    property PendingToSaveSize : Integer read FPendingToSaveBytes;
+    // Bytes in cache pending to flush
+
+    property CacheDataBlocks : Integer read FCacheDataBlocks;
+    // Blocks in cache
+
+    property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
+    property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    procedure ClearStats;
+    property CacheMemStats : TCacheMemStats read FCacheMemStats;
+    {$ENDIF}
+  End;
+
+implementation
+
+{ TPlatform }
+
+class function TPlatform.GetElapsedMilliseconds(const previousTickCount: TTickCount): Int64;
+begin
+  Result := (Self.GetTickCount - previousTickCount);
+end;
+
+class function TPlatform.GetTickCount: TTickCount;
+begin
+  Result := {$IFDEF CPU64}GetTickCount64{$ELSE}
+   {$IFDEF FPC}SysUtils.GetTickCount{$ELSE}
+     {$IFDEF MSWINDOWS}Windows.GetTickCount{$ELSE}
+     TThread.GetTickCount;
+     {$ENDIF}
+   {$ENDIF}
+  {$ENDIF}
+end;
+
+type
+  TBytesHelper = record helper for TBytes
+    function ToString : String;
+  end;
+
+{ TBytesHelper }
+
+function TBytesHelper.ToString: String;
+var i : Integer;
+begin
+  Result := '';
+  for i := Low(Self) to High(Self) do begin
+    if Result<>'' then Result := Result + ',';
+    Result := Result + IntToStr(Self[i]);
+  end;
+  Result := '['+Result+']';
+end;
+
+{ TCacheMem }
+
+function _CacheMem_CacheData_Comparer(const Left, Right: PCacheMemData): Integer;
+begin
+  Result := Integer(Left^.startPos) - Integer(Right^.startPos);
+end;
+
+procedure TCacheMem.CheckMaxMemUsage;
+begin
+  if ((FMaxCacheSize < 0) or (FCacheDataSize<=FMaxCacheSize))
+     and
+     ((FMaxCacheDataBlocks < 0) or (FCacheDataBlocks<=FMaxCacheDataBlocks)) then Exit;
+  // When calling FreeMem will increase call in order to speed
+  FreeMem((FMaxCacheSize-1) SHR 1, (FMaxCacheDataBlocks-1) SHR 1);
+end;
+
+procedure TCacheMem.Clear;
+var P, PCurr : PCacheMemData;
+  i : Integer;
+begin
+  PCurr := FCacheData.FindLowest;
+  while (Assigned(PCurr)) do begin
+    P := PCurr;
+    PCurr := FCacheData.FindSuccessor(P);
+    FCacheData.Delete(P);
+  end;
+
+  FPendingToSaveBytes := 0;
+  FCacheDataSize := 0;
+  FCacheDataBlocks := 0;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+procedure TCacheMem.ClearStats;
+begin
+  FCacheMemStats.Clear;
+end;
+{$ENDIF}
+
+procedure TCacheMem.ConsistencyCheck;
+var i, iLOrderPos : Integer;
+  PLast, PCurrent : PCacheMemData;
+  LTotalSize, LTotalPendingSize, LTotalNodes : Integer;
+  LOrder : TOrderedList<PCacheMemData>;
+begin
+  //
+  PLast := Nil;
+  LTotalSize := 0;
+  LTotalPendingSize := 0;
+  LTotalNodes := 0;
+
+  PCurrent := FCacheData.FindLowest;
+  while (Assigned(PCurrent)) do begin
+    inc(LTotalNodes);
+    if PCurrent^.GetSize=0 then raise ECacheMem.Create(Format('Cache "%s" size 0',[PCurrent^.ToString]));
+
+    if Assigned(PLast) then begin
+      if PLast^.GetEndPos>=PCurrent^.startPos then raise ECacheMem.Create(Format('Cache "%s" end pos with previous "%s"',[PCurrent^.ToString,PLast^.ToString]));
+    end;
+    PLast := PCurrent;
+    inc(LTotalSize,PCurrent^.GetSize);
+    if PCurrent^.pendingToSave then begin
+      inc(LTotalPendingSize,PCurrent^.GetSize);
+    end;
+
+    PCurrent := FCacheData.FindSuccessor(PCurrent);
+  end;
+  if (LTotalNodes<>FCacheDataBlocks) then raise ECacheMem.Create(Format('Found cache blocks %d <> %d',[LTotalNodes,FCacheDataBlocks]));
+  if LTotalSize<>FCacheDataSize then raise ECacheMem.Create(Format('Cache size %d <> %d',[LTotalSize,FCacheDataSize]));
+  if LTotalPendingSize<>FPendingToSaveBytes then raise ECacheMem.Create(Format('Total pending size %d <> %d',[LTotalPendingSize,FPendingToSaveBytes]));
+
+  LOrder := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  try
+    PLast := Nil;
+    PCurrent := FOldestUsed;
+    i := 0;
+    while (Assigned(PCurrent)) do begin
+      inc(i);
+      if PCurrent^.used_previous<>PLast then raise ECacheMem.Create(Format('Previous <> Last at %d for %s',[i,PCurrent^.ToString]));
+      if LOrder.Find( PCurrent, iLOrderPos ) then begin
+        raise ECacheMem.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      end else if (iLOrderPos < LOrder.Count) then begin
+        if LOrder.Get(iLOrderPos)^.startPos<=PCurrent^.GetEndPos then begin
+          raise ECacheMem.Create(Format('Overused in mark at %d for %s vs (iLOrderPos=%d) %s',[i,PCurrent^.ToString, iLOrderPos, LOrder.Get(iLOrderPos)^.ToString]));
+        end;
+      end;
+      if LOrder.Add(PCurrent)<0 then raise ECacheMem.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      PLast := PCurrent;
+      PCurrent := PCurrent^.used_next;
+    end;
+    // Check last
+    if (PLast<>FNewestUsed) then raise ECacheMem.Create(Format('Last <> Newest at %d/%d',[i,LTotalNodes]));
+    if (i<>LTotalNodes) then raise ECacheMem.Create(Format('Marked nodes %d <> CacheData nodes %d',[i,LTotalNodes]));
+
+  finally
+    LOrder.Free;
+  end;
+end;
+
+constructor TCacheMem.Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
+begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  FCacheMemStats.Clear;
+  {$ENDIF}
+  FMaxCacheSize := -1; // No limit by default
+  FMaxCacheDataBlocks := -1; // No limit by default
+  FCacheData := TCacheMemDataTree.Create;
+  FCacheDataBlocks := 0;
+  FPendingToSaveBytes := 0;
+  FCacheDataSize := 0;
+  FOnNeedDataProc := AOnNeedDataProc;
+  FOnSaveDataProc := AOnSaveDataProc;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+procedure TCacheMem.Delete(var APCacheMemData : PCacheMemData);
+var LConsistency : PCacheMemData;
+begin
+  if not FindCacheMemDataByPosition(APCacheMemData^.startPos,LConsistency) then Raise ECacheMem.Create(Format('Delete not found for %s',[APCacheMemData^.ToString]));
+  Dec(FCacheDataSize,APCacheMemData.GetSize);
+  if APCacheMemData^.pendingToSave then begin
+    Dec(FPendingToSaveBytes,APCacheMemData^.GetSize);
+  end;
+  SetLength(APCacheMemData^.buffer,0);
+  APCacheMemData^.UnMark(Self,APCacheMemData);
+  FCacheData.Delete(APCacheMemData);
+  Dec(FCacheDataBlocks);
+end;
+
+destructor TCacheMem.Destroy;
+begin
+  FlushCache;
+  Clear;
+  FreeAndNil(FCacheData);
+  inherited;
+end;
+
+function TCacheMem.FindCacheMemDataByPosition(APosition: Integer; out APCacheMemData: PCacheMemData): Boolean;
+  // Will return FCacheData index at AiCacheDataPos that contains APosition
+  // When returning FALSE, AiCacheDataPos will be index of previous FCacheData position to use
+var PSearch : PCacheMemData;
+begin
+  APCacheMemData := Nil;
+  Result := False;
+
+  New(PSearch);
+  try
+    PSearch^.Clear;
+    SetLength(PSearch^.buffer,0);
+    PSearch^.startPos := APosition;
+    PSearch^.pendingToSave := False;
+    // Will search a value
+    APCacheMemData := FCacheData.FindInsertPos(PSearch);
+    if (Assigned(APCacheMemData)) then begin
+      // Watch if is contained in it
+      if (APCacheMemData^.startPos>APosition) then begin
+        APCacheMemData := FCacheData.FindPrecessor(APCacheMemData);
+      end;
+      if (Assigned(APCacheMemData)) then begin
+        Result := (APCacheMemData^.startPos<=APosition) and (APCacheMemData^.GetEndPos >= APosition);
+      end;
+    end;
+  finally
+    Dispose(PSearch);
+  end;
+end;
+
+function TCacheMem.FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean;
+var i : Integer;
+  PToCurrent, PToNext : PCacheMemData;
+  LTotalBytesSaved, LTotalBytesError : Integer;
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount : TTickCount;
+  {$ENDIF}
+begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount := TPlatform.GetTickCount;
+  {$ENDIF}
+  LTotalBytesSaved := 0;
+  LTotalBytesError := 0;
+  Result := True;
+
+  if (FPendingToSaveBytes<=0) then Exit;
+
+  i := 0;
+  PToNext := FOldestUsed;
+
+  repeat
+    if Assigned(AFlushCacheList) then begin
+      if i < AFlushCacheList.Count then PToCurrent:=AFlushCacheList.Get(i)
+      else PToCurrent := Nil;
+      inc(i);
+    end else PToCurrent := PToNext;
+
+    if Assigned(PToCurrent) then begin
+      if (PToCurrent^.pendingToSave) then begin
+
+        if Not Assigned(FOnSaveDataProc) then Exit(False);
+        if Not FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize) then begin
+          Result := False;
+          inc(LTotalBytesError,PToCurrent^.GetSize);
+        end else begin
+          inc(LTotalBytesSaved,PToCurrent^.GetSize);
+          PToCurrent^.pendingToSave := False;
+          Dec(FPendingToSaveBytes,PToCurrent^.GetSize);
+        end;
+      end;
+      PToNext := PToCurrent^.used_next;
+    end;
+  until Not Assigned(PToCurrent);
+  if (LTotalBytesSaved>0) or (LTotalBytesError>0) then begin
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    Inc(FCacheMemStats.flushCount);
+    Inc(FCacheMemStats.flushSize,LTotalBytesSaved);
+    Inc(FCacheMemStats.flushElapsedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
+    {$ENDIF}
+  end;
+  if (LTotalBytesError=0) and (Not Assigned(AFlushCacheList)) and (FPendingToSaveBytes<>0) then raise ECacheMem.Create(Format('Flush Inconsistency error Saved:%d Pending:%d',[LTotalBytesSaved,FPendingToSaveBytes]));
+
+end;
+
+function TCacheMem.FlushCache: Boolean;
+begin
+  Result := FlushCache(Nil); // FlushCache without a list, without order
+end;
+
+function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Integer) : Boolean;
+var
+  i, LPreviousCacheDataSize, LTempCacheDataSize,
+  LFinalMaxMemSize, LMaxPendingRounds : Integer;
+  PToRemove, PToNext : PCacheMemData;
+  LListToFlush : TOrderedList<PCacheMemData>;
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount : TTickCount;
+  {$ENDIF}
+begin
+  // Will delete FCacheData until AMaxMemSize >= FCacheDataSize
+  if ((AMaxMemSize < 0) or (FCacheDataSize<=AMaxMemSize))
+     and
+     ((AMaxBlocks < 0) or (FCacheDataBlocks<=AMaxBlocks)) then Exit(True);
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount := TPlatform.GetTickCount;
+  {$ENDIF}
+  LPreviousCacheDataSize := FCacheDataSize;
+
+  if (AMaxMemSize<0) then LFinalMaxMemSize := FCacheDataSize
+  else LFinalMaxMemSize := AMaxMemSize;
+  if (AMaxBlocks<0) then LMaxPendingRounds := 0
+  else LMaxPendingRounds := FCacheDataBlocks - AMaxBlocks;
+  //
+  PToRemove := FOldestUsed;
+  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  try
+    LTempCacheDataSize := FCacheDataSize;
+    while (Assigned(PToRemove)) and
+      // Both conditions must be true
+      ((LTempCacheDataSize > LFinalMaxMemSize) or (LMaxPendingRounds>0))
+      do begin
+      Dec(LMaxPendingRounds);
+      PToNext := PToRemove^.used_next; // Capture now to avoid future PToRemove updates
+      Dec(LTempCacheDataSize, PToRemove^.GetSize);
+      if (PToRemove^.pendingToSave) then begin
+        // Add to list to flush
+        LListToFlush.Add(PToRemove);
+      end else Delete(PToRemove);
+      PToRemove := PToNext; // Point to next used
+    end;
+    // LListToFlush will have pending to save
+    Result := FlushCache(LListToFlush);
+    // Delete not deleted previously
+    for i:=0 to LListToFlush.Count-1 do begin
+      PToRemove := LListToFlush.Get(i);
+      Delete( PToRemove );
+    end;
+  finally
+    LListToFlush.Free;
+  end;
+  if (Result) and (LTempCacheDataSize <> FCacheDataSize) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected size %d <> obtained %d',[LTempCacheDataSize,FCacheDataSize]));
+  if (Result) and (LMaxPendingRounds>0) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected Max Blocks %d <> obtained %d',[AMaxBlocks,FCacheDataBlocks]));
+
+  Result := (Result) And (FCacheDataSize <= AMaxMemSize);
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  Inc(FCacheMemStats.freememCount);
+  Inc(FCacheMemStats.freememSize,LPreviousCacheDataSize - FCacheDataSize);
+  Inc(FCacheMemStats.freememElaspedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
+  {$ENDIF}
+end;
+
+function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+  // Will return a Pointer to AStartPos
+
+  function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes) : Boolean;
+  {$IFDEF ABSTRACTMEM_TESTING_MODE}var i : integer;{$ENDIF}
+  begin
+    SetLength(ACapturedData,ACaptureSize);
+    if Not Assigned(FOnNeedDataProc) then begin
+      FillChar(ACapturedData[0],Length(ACapturedData),0);
+      {$IFDEF ABSTRACTMEM_TESTING_MODE}
+      // TESTING PURPOSE TESTING ONLY
+      for i := 0 to High(ACapturedData) do begin
+        ACapturedData[i] := Byte(ACapturePosStart + i);
+      end;
+      // END TESTING PURPOSE
+      {$ENDIF}
+      Exit(False);
+    end;
+    Result := FOnNeedDataProc(ACapturedData[0],ACapturePosStart,ACaptureSize);
+  end;
+
+
+var
+  LNewP, PCurrent, PToDelete : PCacheMemData;
+  LLastAddedPosition, LBytesCount, LSizeToStore : Integer;
+  LTempData : TBytes;
+  LTmpResult : Boolean;
+begin
+  if ASize<0 then raise ECacheMem.Create(Format('Invalid load size %d',[ASize]));
+  if ASize=0 then Exit(True);
+  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
+    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
+      // PStart has all needed info
+      Move(PCurrent^.buffer[ AStartPos-PCurrent^.startPos ],ABuffer,ASize);
+      PCurrent^.MarkAsUsed(Self,PCurrent);
+      Result := True;
+      Exit;
+    end;
+  end;
+
+  // Will need to create a new "linar struct" because not found a linear struct previously
+  New( LNewP );
+  try
+    LNewP.Clear;
+
+    LSizeToStore := ASize;
+    SetLength(LNewP^.buffer, LSizeToStore);
+
+    LNewP.startPos := AStartPos;
+
+    Result := True;
+
+    LLastAddedPosition := AStartPos - 1;
+    while (Assigned(PCurrent)) and ( (LLastAddedPosition) < (LNewP^.GetEndPos) ) do begin
+      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor(PCurrent)
+      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
+      else begin
+        // PCurrent will be used:
+        //
+        if (PCurrent^.startPos <= LLastAddedPosition) then begin
+          // PCurrent start before, increase buffer and set startPos
+          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
+          LNewP.startPos := PCurrent^.startPos;
+          LLastAddedPosition := PCurrent^.startPos-1;
+        end else if (PCurrent^.startPos > LLastAddedPosition+1) then begin
+          // Need data "between"
+          LBytesCount := PCurrent^.startPos - (LLastAddedPosition+1);
+          LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
+          Result := Result and LTmpResult;
+          Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+          inc(LLastAddedPosition,LBytesCount);
+        end;
+        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
+        // Add available data
+        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
+          // Will need to increase buffer size:
+          SetLength( LNewP^.buffer , LNewP^.GetSize + (PCurrent^.GetEndPos - LNewP^.GetEndPos));
+        end;
+        LBytesCount := PCurrent^.GetEndPos - LLastAddedPosition;
+        Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+        inc(LLastAddedPosition,LBytesCount);
+
+        // Has been used, delete
+        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
+        PToDelete := PCurrent;
+        PCurrent := FCacheData.FindSuccessor(PCurrent);
+        Delete( PToDelete );
+      end;
+    end;
+    if (LLastAddedPosition) < (LNewP^.GetEndPos) then begin
+      // That means there is no data available at cache
+      LBytesCount := LNewP^.GetSize - (LLastAddedPosition - LNewP^.startPos +1);
+      LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
+      Result := Result and LTmpResult;
+      Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+    end;
+  Except
+    on E:Exception do begin
+      LNewP.Clear;
+      Dispose(LNewP);
+      Raise;
+    end;
+  end;
+
+  // Save new
+  LNewP^.MarkAsUsed(Self,LNewP);
+  if Not FCacheData.Add( LNewP ) then raise ECacheMem.Create(Format('Inconsistent LoadData CacheData duplicate for %s',[LNewP^.ToString]));
+  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataBlocks);
+  //
+  if (LNewP^.pendingToSave) then begin
+    inc(FPendingToSaveBytes,LNewP^.GetSize);
+  end;
+
+  Move(LNewP^.buffer[ AStartPos-LNewP^.startPos ],ABuffer,ASize);
+
+  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 i : Integer;
+  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);
+var
+  LNewP, PCurrent, PToDelete : PCacheMemData;
+  LLastAddedPosition, LBytesCount : Integer;
+begin
+  if ASize<0 then raise ECacheMem.Create(Format('Invalid save size %d',[ASize]));
+  if ASize=0 then Exit;
+
+  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
+    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
+      // PStart has all needed info
+      Move(ABuffer,PCurrent^.buffer[ AStartPos - PCurrent^.startPos ], ASize);
+      if (Not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
+        PCurrent^.pendingToSave := True;
+        inc(FPendingToSaveBytes,PCurrent^.GetSize);
+      end;
+      PCurrent^.MarkAsUsed(Self,PCurrent);
+      Exit;
+    end;
+  end;
+
+  // Will need to create a new "linar struct" because not found a linear struct previously
+  New( LNewP );
+  try
+    LNewP.Clear;
+    SetLength(LNewP^.buffer, ASize);
+    LNewP.startPos := AStartPos;
+    LNewP^.pendingToSave := AMarkAsPendingToSave;
+
+    LLastAddedPosition := AStartPos - 1;
+    while (Assigned(PCurrent)) and ( (LLastAddedPosition+1) < (LNewP^.GetEndPos) ) do begin
+      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor( PCurrent )
+      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
+      else begin
+        // PCurrent will be used:
+        if (PCurrent^.startPos <= LLastAddedPosition) then begin
+          // PCurrent start before, increase buffer and set startPos
+          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
+          LNewP.startPos := PCurrent^.startPos;
+          Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ 0 ], (LLastAddedPosition - PCurrent^.startPos +1));
+        end;
+        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
+        // Add available data
+        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
+          // Will need to increase buffer size:
+          LBytesCount := (PCurrent^.GetEndPos - LNewP^.GetEndPos);
+          SetLength( LNewP^.buffer , LNewP^.GetSize + LBytesCount );
+          Move(PCurrent^.buffer[ PCurrent^.GetSize - LBytesCount ],LNewP^.buffer[ LNewP^.GetSize - LBytesCount ], LBytesCount);
+        end;
+
+        // Has been used, delete
+        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
+        PToDelete := PCurrent;
+        PCurrent := FCacheData.FindSuccessor(PCurrent);
+        Delete( PToDelete );
+      end;
+    end;
+    // At this point LNewP^.buffer startPos <= AStartPos and LNewP^.buffer Size >= ASize
+    Move( ABuffer, LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], ASize );
+  Except
+    on E:Exception do begin
+      LNewP.Clear;
+      Dispose(LNewP);
+      Raise;
+    end;
+  end;
+
+  // Save new
+  LNewP^.MarkAsUsed(Self,LNewP);
+  if Not FCacheData.Add(LNewP) then raise ECacheMem.Create(Format('Inconsistent SaveToCache CacheData duplicate for %s',[LNewP^.ToString]));
+  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataBlocks);
+  //
+  if (LNewP^.pendingToSave) then begin
+    inc(FPendingToSaveBytes,LNewP^.GetSize);
+  end;
+
+  CheckMaxMemUsage;
+end;
+
+{ TCacheMemData }
+
+procedure TCacheMemData.Clear;
+begin
+  SetLength(Self.buffer,0);
+  Self.parent := Nil;
+  Self.left := Nil;
+  Self.right := Nil;
+  Self.balance := 0;
+  //
+  Self.startPos := 0;
+  Self.pendingToSave := False;
+  Self.used_previous := Nil;
+  Self.used_next := Nil;
+end;
+
+procedure TCacheMemData.DoMark(const ACacheMem: TCacheMem; AMySelfPointer: PCacheMemData; AAddToList: Boolean);
+{
+    O = ACacheMem.FOldest
+    N = ACacheMem.FNewest
+
+    O       N
+    A - B - C   ( D = New CacheMem )
+}
+
+begin
+  if Assigned(Self.used_previous) then begin
+    // B or C
+    if (Self.used_previous^.used_next<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent previous.next<>MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FOldestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B,C Oldest = MySelf in %s',[Self.ToString]));
+    if Assigned(Self.used_next) then begin
+      // B only
+      if (Self.used_next^.used_previous<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B next.previous<>MySelf in %s',[Self.ToString]));
+      if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B Newest = MySelf in %s',[Self.ToString]));
+      Self.used_previous^.used_next := Self.used_next;
+      Self.used_next^.used_previous := Self.used_previous;
+    end else begin
+      // C only
+      if (ACacheMem.FNewestUsed <> AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent Newest <> MySelf in %s',[Self.ToString]));
+      if (Not AAddToList) then begin
+        Self.used_previous^.used_next := Nil;
+      end;
+    end;
+  end else if assigned(Self.used_next) then begin
+    // A
+    if (Self.used_next^.used_previous<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent A next.previous<>MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FOldestUsed <> AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent Oldest <> MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent A Newest = MySelf in %s',[Self.ToString]));
+    Self.used_next^.used_previous := Self.used_previous; // = NIL
+    ACacheMem.FOldestUsed:=Self.used_next; // Set oldest
+  end else begin
+    // D
+    if (ACacheMem.FOldestUsed = AMySelfPointer) and (ACacheMem.FNewestUsed = AMySelfPointer) then begin
+      // D is the "only one", no previous, no next, but added or removed
+      if (Not AAddToList) then begin
+        ACacheMem.FOldestUsed := Nil;
+      end;
+    end else begin
+      if (ACacheMem.FOldestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent D Oldest = MySelf in %s',[Self.ToString]));
+      if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent D Newest = MySelf in %s',[Self.ToString]));
+    end;
+    if Not Assigned(ACacheMem.FOldestUsed) and (AAddToList) then begin
+        // D is first one to be added
+        ACacheMem.FOldestUsed := AMySelfPointer; // Set oldest
+    end;
+  end;
+  if Assigned(ACacheMem.FNewestUsed) then begin
+    if Assigned(ACacheMem.FNewestUsed^.used_next) then raise ECacheMem.Create(Format('Inconsistent Newest.next <> Nil in %s',[Self.ToString]));
+  end;
+  // Update Self.used_previous and Self.used_next
+  if AAddToList then begin
+    // Adding to list
+    if (ACacheMem.FNewestUsed<>AMySelfPointer) then begin
+      // Link to previous if newest <> MySelf
+      Self.used_previous := ACacheMem.FNewestUsed;
+    end;
+    if Assigned(ACacheMem.FNewestUsed) then begin
+      ACacheMem.FNewestUsed^.used_next:= AMySelfPointer;
+    end;
+    ACacheMem.FNewestUsed:=AMySelfPointer;
+  end else begin
+    // Removing from list
+    if ACacheMem.FNewestUsed = AMySelfPointer then begin
+      if (Assigned(Self.used_next)) then raise ECacheMem.Create(Format('Inconsistent next <> Nil when Self = Newest in %s',[Self.ToString]));
+      ACacheMem.FNewestUsed := Self.used_previous;
+    end;
+    Self.used_previous := Nil;
+  end;
+  Self.used_next := Nil;
+end;
+
+
+function TCacheMemData.GetEndPos: Integer;
+begin
+  Result := Self.startPos + Self.GetSize - 1;
+end;
+
+function TCacheMemData.GetSize: Integer;
+begin
+  Result := Length(Self.buffer);
+end;
+
+procedure TCacheMemData.MarkAsUsed(const ACacheMem: TCacheMem; AMySelfPointer : PCacheMemData);
+begin
+  DoMark(ACacheMem,AMySelfPointer,True);
+end;
+
+procedure TCacheMemData.UnMark(const ACacheMem: TCacheMem; AMySelfPointer: PCacheMemData);
+begin
+  DoMark(ACacheMem,AMySelfPointer,False);
+end;
+
+function TCacheMemData.ToString: String;
+var i : Integer;
+begin
+  Result := Format('%d bytes from %d to %d',[Self.GetSize,Self.startPos,Self.GetEndPos]);
+  if Self.pendingToSave then Result := Result + ' (updated)';
+  Result := Result +' [';
+  i := 0;
+  while (Length(Result)<100) and (i<Self.GetSize) do begin
+    if i>0 then Result := Result + ','+IntToStr(Self.buffer[i])
+    else Result := Result + IntToStr(Self.buffer[i]);
+    inc(i);
+  end;
+  if i<Self.GetSize then Result := Result + '...';
+  Result := Result +']';
+end;
+
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+{ TCacheMemStats }
+
+procedure TCacheMemStats.Clear;
+begin
+  flushCount := 0;
+  flushSize := 0;
+  flushElapsedMillis := 0;
+  freememCount := 0;
+  freememSize := 0;
+  freememElaspedMillis := 0;
+end;
+
+function TCacheMemStats.ToString: String;
+begin
+  Result := Format('CacheMemStats Flush:%d %d bytes %d millis - FreeMem:%d %d bytes %d millis',[Self.flushCount,Self.flushSize,Self.flushElapsedMillis,Self.freememCount,Self.freememSize,Self.freememElaspedMillis]);
+end;
+{$ENDIF}
+
+{ TCacheMemDataTree }
+
+function _TCacheMemDataTree_Compare(const Left, Right: PCacheMemData): Integer;
+begin
+  Result := Left^.startPos - Right^.startPos;
+end;
+
+function TCacheMemDataTree.AreEquals(const ANode1, ANode2: PCacheMemData): Boolean;
+begin
+  Result := ANode1 = ANode2;
+end;
+
+procedure TCacheMemDataTree.ClearNode(var ANode: PCacheMemData);
+begin
+  ANode := Nil;
+end;
+
+procedure TCacheMemDataTree.ClearPosition(var ANode: PCacheMemData; APosition: TAVLTreePosition);
+begin
+  case APosition of
+    poParent: ANode.parent := Nil;
+    poLeft: ANode.left := Nil;
+    poRight: ANode.right := Nil;
+  end;
+end;
+
+constructor TCacheMemDataTree.Create;
+begin
+  FRoot := Nil;
+  inherited Create(_TCacheMemDataTree_Compare,False);
+end;
+
+procedure TCacheMemDataTree.DisposeNode(var ANode: PCacheMemData);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+function TCacheMemDataTree.GetBalance(const ANode: PCacheMemData): Integer;
+begin
+  Result := ANode.balance;
+end;
+
+function TCacheMemDataTree.GetPosition(const ANode: PCacheMemData;
+  APosition: TAVLTreePosition): PCacheMemData;
+begin
+  case APosition of
+    poParent: Result := ANode.parent;
+    poLeft: Result := ANode.left;
+    poRight: Result := ANode.right;
+  end;
+end;
+
+function TCacheMemDataTree.GetRoot: PCacheMemData;
+begin
+  Result := FRoot;
+end;
+
+function TCacheMemDataTree.HasPosition(const ANode: PCacheMemData;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  Result := Assigned(GetPosition(ANode,APosition));
+end;
+
+function TCacheMemDataTree.IsNil(const ANode: PCacheMemData): Boolean;
+begin
+  Result := Not Assigned(ANode);
+end;
+
+procedure TCacheMemDataTree.SetBalance(var ANode: PCacheMemData; ANewBalance: Integer);
+begin
+  ANode.balance := ANewBalance;
+end;
+
+procedure TCacheMemDataTree.SetPosition(var ANode: PCacheMemData;
+  APosition: TAVLTreePosition; const ANewValue: PCacheMemData);
+begin
+  case APosition of
+    poParent: ANode.parent := ANewValue;
+    poLeft: ANode.left := ANewValue;
+    poRight: ANode.right := ANewValue;
+  end;
+end;
+
+procedure TCacheMemDataTree.SetRoot(const Value: PCacheMemData);
+begin
+  FRoot := Value;
+end;
+
+function TCacheMemDataTree.ToString(const ANode: PCacheMemData): String;
+begin
+  Result := ANode.ToString;
+end;
+
+end.

src/libraries/abstractmem/UFileMem.pas

@@ -0,0 +1,289 @@
+unit UFileMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree, UAbstractMem, UCacheMem;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EFileMem = Class(Exception);
+
+  TFileMem = Class(TAbstractMem)
+  private
+    FFileStream : TFileStream;
+    FCache : TCacheMem;
+    FFileName: String;
+    FIsStableCache: Boolean;
+    FIsFlushingCache : Boolean;
+    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    procedure SetMaxCacheSize(const Value: Integer);
+    function GetMaxCacheSize: Integer;
+    function GetMaxCacheDataBlocks: Integer;
+    procedure SetMaxCacheDataBlocks(const Value: Integer);
+    procedure CacheIsNOTStable; inline;
+  protected
+    function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
+    function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
+    procedure DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos : Integer; ANeedSize : Integer); override;
+    function IsAbstractMemInfoStable : Boolean; override;
+  public
+    Constructor Create(const AFileName : String; AReadOnly : Boolean); reintroduce;
+    Destructor Destroy; override;
+    function New(AMemSize : Integer) : TAMZone; override;
+    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; override;
+    function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; override;
+    {$IFDEF ABSTRACTMEM_TESTING_MODE}
+    // Warning: Accessing Cache is not Safe Thread protected, use LockCache/UnlockCache instead
+    property Cache : TCacheMem read FCache;
+    {$ENDIF}
+    property MaxCacheSize : Integer read GetMaxCacheSize write SetMaxCacheSize;
+    property MaxCacheDataBlocks : Integer read GetMaxCacheDataBlocks write SetMaxCacheDataBlocks;
+    Function FlushCache : Boolean;
+    //
+    function LockCache : TCacheMem;
+    procedure UnlockCache;
+    property FileName : String read FFileName;
+  End;
+
+implementation
+
+{ TFileMem }
+
+function TFileMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
+begin
+  FFileStream.Seek(AAbsolutePosition,soFromBeginning);
+  Result := FFileStream.Read(ABuffer,ASize);
+end;
+
+function TFileMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
+begin
+  FFileStream.Seek(AAbsolutePosition,soFromBeginning);
+  Result := FFileStream.Write(ABuffer,ASize);
+  CacheIsNOTStable;
+end;
+
+procedure TFileMem.CacheIsNOTStable;
+begin
+  If (FIsStableCache)          // Only will mark first time
+    And (Not FIsFlushingCache) // Only will mark when not Flushing cache
+    And (Assigned(FCache)) then begin
+    FIsStableCache := False;
+    SaveHeader;
+  end;
+end;
+
+constructor TFileMem.Create(const AFileName: String; AReadOnly: Boolean);
+var LFileMode : Integer;
+  LReadOnly : Boolean;
+begin
+  FIsStableCache := True;
+  FIsFlushingCache := False;
+  FFileName := AFileName;
+  if AReadOnly then LFileMode := fmOpenRead + fmShareDenyNone
+  else begin
+    if FileExists(AFileName) then LFileMode := fmOpenReadWrite else LFileMode := fmCreate;
+    LFileMode := LFileMode + fmShareDenyWrite;
+  end;
+
+  FCache := TCacheMem.Create(OnCacheNeedDataProc,OnCacheSaveDataProc);
+  LReadOnly := True;
+  try
+    FFileStream := TFileStream.Create(AFileName,LFileMode);
+    LReadOnly := AReadOnly; // To protect against raise exception
+  finally
+    inherited Create(0,LReadOnly);
+  end;
+end;
+
+destructor TFileMem.Destroy;
+begin
+  if Not ReadOnly then FlushCache;
+  FreeAndNil(FCache);
+  inherited;
+  FreeAndNil(FFileStream);
+  FreeAndNil(FCache);
+end;
+
+procedure TFileMem.DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos: Integer; ANeedSize: Integer);
+var LBuff : TBytes;
+begin
+  FFileStream.Seek(0,soFromEnd);
+  // GoTo ANextAvailablePos
+  if (FFileStream.Position<ANextAvailablePos) then begin
+    SetLength(LBuff,ANextAvailablePos - FFileStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FFileStream.Write(LBuff[0],Length(LBuff));
+  end;
+  if (FFileStream.Position<ANextAvailablePos) then raise EFileMem.Create(Format('End file position (%d) is less than next available pos %d',[FFileStream.Position,ANextAvailablePos]));
+  // At this time ANextAvailablePos <= FFileStream.Position
+  AMaxAvailablePos := ANextAvailablePos + ANeedSize;
+  if (FFileStream.Size<AMaxAvailablePos) then begin
+    SetLength(LBuff,AMaxAvailablePos - FFileStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FFileStream.Write(LBuff[0],Length(LBuff));
+  end else AMaxAvailablePos := FFileStream.Size;
+  CacheIsNOTStable;
+end;
+
+function TFileMem.FlushCache: Boolean;
+begin
+  if Not Assigned(FCache) then Exit(True);
+  FLock.Acquire;
+  try
+    Result := FCache.FlushCache;
+  finally
+    FIsStableCache := True;
+    FIsFlushingCache := True;
+    try
+      SaveHeader;
+    finally
+      FIsFlushingCache := False;
+    end;
+    FLock.Release;
+  end;
+end;
+
+function TFileMem.GetMaxCacheDataBlocks: Integer;
+begin
+  if Not Assigned(FCache) then Exit(0);
+  Result := FCache.MaxCacheDataBlocks;
+end;
+
+function TFileMem.GetMaxCacheSize: Integer;
+begin
+  if Not Assigned(FCache) then Exit(0);
+  Result := FCache.MaxCacheSize;
+end;
+
+function TFileMem.IsAbstractMemInfoStable: Boolean;
+begin
+  Result := FIsStableCache;
+end;
+
+function TFileMem.LockCache: TCacheMem;
+begin
+  FLock.Acquire;
+  Result := FCache;
+end;
+
+function TFileMem.New(AMemSize: Integer): TAMZone;
+var LBuffer : TBytes;
+begin
+  Result := inherited New(AMemSize);
+  // Initialize cache
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  try
+    SetLength(LBuffer,Result.size);
+    FillChar(LBuffer[0],Result.size,0);
+    FCache.SaveToCache(LBuffer[0],Result.size,Result.position,True);
+  finally
+    FLock.Release;
+  end;
+end;
+
+function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Boolean;
+begin
+  Result := inherited Read(AStartPos,ABuffer,ASize) = ASize;
+end;
+
+function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Boolean;
+begin
+  inherited Write(AStartPos,ABuffer,ASize);
+  Result := True;
+end;
+
+function TFileMem.Read(const APosition: Integer; var ABuffer; ASize: Integer): Integer;
+begin
+  if Not Assigned(FCache) then begin
+    Result := inherited;
+    Exit;
+  end;
+
+  FLock.Acquire;
+  try
+    if FCache.LoadData(ABuffer,APosition,ASize) then Result := ASize
+    else Result := 0;
+  finally
+    FLock.Release;
+  end;
+end;
+
+procedure TFileMem.SetMaxCacheDataBlocks(const Value: Integer);
+begin
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  Try
+    FCache.MaxCacheDataBlocks := Value;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TFileMem.SetMaxCacheSize(const Value: Integer);
+begin
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  Try
+    FCache.MaxCacheSize := Value;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TFileMem.UnlockCache;
+begin
+  FLock.Release;
+end;
+
+procedure TFileMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+begin
+  if (Not Assigned(FCache)) Or (FIsFlushingCache) then begin
+    inherited;
+    Exit;
+  end;
+
+  CheckInitialized(True);
+  FLock.Acquire;
+  try
+    FCache.SaveToCache(ABuffer,ASize,APosition,True);
+  finally
+    FLock.Release;
+  end;
+end;
+
+end.

src/libraries/abstractmem/UOrderedList.pas

@@ -0,0 +1,236 @@
+unit UOrderedList;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 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};
+
+{$I ./ConfigAbstractMem.inc }
+
+
+type
+  {$IFDEF FPC}
+  TComparison<T> = function(const Left, Right: T): Integer;
+  {$ENDIF}
+
+  TOrderedList<T> = Class
+  private
+    FOnCompare: TComparison<T>;
+    FAllowDuplicates : Boolean;
+    FOrderedList : TList<T>;
+  public
+    Constructor Create(AAllowDuplicates : Boolean; const AOnCompareMethod: TComparison<T>); virtual;
+    Destructor Destroy; override;
+
+    Function Add(const AValue : T) : Integer; virtual;
+    Procedure Remove(const AValue : T; ARemoveDuplicates : Boolean = False); virtual;
+    Procedure Clear; virtual;
+    Procedure Delete(index : Integer); virtual;
+
+    Function Get(index : Integer) : T;
+    Function Count : Integer;
+    Function Find(const AValue: T; out Index: Integer): Boolean;
+    function FindPrecessor(const AValue : T; out Index : Integer) : Boolean;
+    function FindSuccessor(const AValue : T; out Index : Integer) : Boolean;
+    Function IndexOf(const AValue: T) : Integer;
+    property AllowDuplicates : Boolean read FAllowDuplicates;
+    property OnComparer : TComparison<T> read FOnCompare;
+  End;
+
+// Default Ordered functions
+function TComparison_Integer(const ALeft, ARight: Integer): Integer;
+function TComparison_Cardinal(const ALeft, ARight: Cardinal): Integer;
+function TComparison_Word(const ALeft, ARight: Word): Integer;
+function TComparison_Byte(const ALeft, ARight: Byte): Integer;
+function TComparison_Pointer(const ALeft, ARight: Pointer): Integer;
+function TComparison_String(const ALeft, ARight: String): Integer;
+
+implementation
+
+function TComparison_Integer(const ALeft, ARight: Integer): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Cardinal(const ALeft, ARight: Cardinal): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Word(const ALeft, ARight: Word): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Byte(const ALeft, ARight: Byte): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Pointer(const ALeft, ARight: Pointer): Integer;
+begin
+{$IFNDEF FPC}
+  Result := NativeInt(ALeft) - NativeInt(ARight);
+{$ELSE}
+  Result := PtrInt(ALeft) - PtrInt(ARight);
+{$ENDIF}
+end;
+function TComparison_String(const ALeft, ARight: String): Integer;
+begin
+  Result := CompareText(ALeft,ARight);
+end;
+
+{ TOrderedList<T> }
+
+function TOrderedList<T>.Add(const AValue: T): Integer;
+var
+  LFound : Boolean;
+begin
+  LFound := Find(AValue,Result);
+  if (LFound and FAllowDuplicates) or (Not LFound) then begin
+    FOrderedList.Insert(Result,AValue);
+  end else Result := -1;
+end;
+
+procedure TOrderedList<T>.Clear;
+begin
+  FOrderedList.Clear;
+end;
+
+function TOrderedList<T>.Count: Integer;
+begin
+  Result := FOrderedList.Count;
+end;
+
+constructor TOrderedList<T>.Create(AAllowDuplicates: Boolean;
+  const AOnCompareMethod: TComparison<T>);
+begin
+  FOnCompare := AOnCompareMethod;
+  FAllowDuplicates := AAllowDuplicates;
+  FOrderedList := TList<T>.Create;
+  inherited Create;
+end;
+
+procedure TOrderedList<T>.Delete(index: Integer);
+begin
+  FOrderedList.Delete(index);
+end;
+
+destructor TOrderedList<T>.Destroy;
+begin
+  Clear;
+  FOrderedList.Free;
+  inherited;
+end;
+
+function TOrderedList<T>.Find(const AValue: T; out Index: Integer): Boolean;
+var L, H, I: Integer;
+  C : Int64;
+begin
+  Result := False;
+  L := 0;
+  H := FOrderedList.Count - 1;
+  // Optimization when inserting always a ordered list
+  if (H>0) then begin
+    C := FOnCompare(FOrderedList[H],AValue);
+    if (C<0) then begin
+      Index := H+1;
+      Exit;
+    end else if (C=0) then begin
+      Index := H; // When equals, insert to the left
+      Result := True;
+      Exit;
+    end;
+  end;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := FOnCompare(FOrderedList[I],AValue);
+    if C < 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+function TOrderedList<T>.FindPrecessor(const AValue: T; out Index: Integer): Boolean;
+begin
+  if Find(AValue,Index) then begin
+    if (Index>0) then begin
+      Dec(Index);
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
+function TOrderedList<T>.FindSuccessor(const AValue: T; out Index: Integer): Boolean;
+begin
+  if Find(AValue,Index) then begin
+    if (Index+1<Count) then begin
+      Inc(Index);
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
+function TOrderedList<T>.Get(index: Integer): T;
+begin
+  Result := FOrderedList[index];
+end;
+
+function TOrderedList<T>.IndexOf(const AValue: T): Integer;
+begin
+  if Not Find(AValue,Result) then Result := -1;
+end;
+
+procedure TOrderedList<T>.Remove(const AValue: T; ARemoveDuplicates : Boolean = False);
+var i : Integer;
+begin
+  while Find(AValue,i) do begin
+    FOrderedList.Delete(i);
+    if (Not FAllowDuplicates) or (Not ARemoveDuplicates) then Exit; // No need to continue while
+  end;
+end;
+
+initialization
+
+finalization
+
+end.