{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Collections/Containers, ArrayLists, AVL-     | }
{ |                Trees and HashTables with common interfaces. | }
{ |                All Collections are thread safe!             | }
{ |                                                             | }
{ |   Copyright (C) - Gerrit Moeller, 2011.                     | }
{ |                                                             | }
{ |   Dstributed under GM-Software license.                     | }
{ |                                                             | }
{ |   See: http://www.gm-software.de                            | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }


{$INCLUDE GMCompilerSettings.inc}
{.$DEFINE STANDALONE_COLLECTIONS}  // <- avoid using GMIntf and GMCommon units


unit GMCollections;

interface

uses {$IFNDEF JEDIAPI}Windows{$ELSE}jwaWinType, jwaWinError{$ENDIF}
     {$IFNDEF STANDALONE_COLLECTIONS}, GMIntf{$ENDIF};

const

  cMaxPtrArraySize = High(PtrInt) div SizeOf(Pointer);
  cMaxIntArraySize = High(PtrInt) div SizeOf(PtrInt);

  cGrowDeltaDiv = 5; // <- 20%
  cGrowDeltaMax  = 1024;


  { ------------------------------------------------------------------- }
  { ---- Re-defined types when not using GMIntf and GMCommon units ---- }
  { ------------------------------------------------------------------- }

  {$IFDEF STANDALONE_COLLECTIONS}
const
  cInvalidItemIdx = Low(LongInt); // -1;

type
  TGMCompareResult = (crALessThanB, crAEqualToB, crAGreaterThanB);

  {$IFNDEF FPC}
  {$IFDEF CPU64}
  PtrInt = Int64;
  PtrUInt = QWord;
  {$ELSE}
  PtrInt = LongInt;
  PtrUInt = LongWord;
  {$ENDIF}
  PPtrInt = ^PtrInt;
  PPtrUInt = ^PtrUInt;
  {$ENDIF}

  TGMHashCode = PtrInt;

  IGMCriticalSection = interface(IUnknown)
    ['{278BDF06-1387-4181-A83D-8DDF4E18CE03}']
    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;
    //function TryEnterCriticalSection: Boolean; stdcall;
  end;


  IGMGetCount = interface(IUnknown)
    ['{93880081-2684-11d5-AB38-000021DCAD19}']
    function GetCount: PtrInt; stdcall;
    property Count: PtrInt read GetCount;
  end;


  IGMLoadStoreData = interface(IUnknown)
    ['{D8D48DE1-AE80-4132-AE40-ECA66F9256C6}']
    procedure LoadData(const Source: IUnknown); stdcall;
    procedure StoreData(const Dest: IUnknown); stdcall;
  end;


  IGMGetIntfByPosition = interface(IUnknown)
    ['{4694A884-24F6-11d5-AB38-000021DCAD19}']
    function GetIntfByPosition(const Position: PtrInt; const IID: TGUID; out Intf): HResult; stdcall;
  end;


  IGMMapIntegerOnInteger = interface(IUnknown)
    ['{1BC6F7EB-C230-48ba-B383-B332D555DA6F}']
    function MapIntegerOnInteger(const MapValue: PtrInt): PtrInt; stdcall;
  end;


  IGMExecuteOperation = interface(IUnknown)
    ['{DCC23FA6-D77E-44c9-95BA-DFAA264451FD}']
    function ExecuteOperation(const Operation: LongInt; const Parameter: IUnknown = nil): Boolean; stdcall;
  end;


  IGMHashCode = interface(IUnknown)
    ['{9C61B58B-41DF-4695-9716-AC4A343DC2DB}']
    function HashCode: TGMHashCode;
  end;
  

  TGMRefCountedObj = class(TObject, IUnknown) // IGMObjInfo, IGMCreateCopyQI
   protected
    FRefLifeTime: Boolean;
    FRefCount: LongInt;

   public
    constructor Create(const ARefLifeTime: Boolean = False); virtual;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
//  destructor Destroy; override;
    procedure OnFinalRelease; virtual;

    // IGMObjInfo
//  function GetClassName: PChar;
//  function GetClassType: TClass;
//  function GetInstance: TObject;
//  function GetTypeInfo: PTypeInfo;

    // IUnknown
    function QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} IID: TGUID; out Intf): HResult; virtual; stdcall;
    function _AddRef: LongInt; virtual; stdcall;
    function _Release: LongInt; virtual; stdcall;

    // IGMCreateCopyQI
//  function CreateCopyQI(const IID: TGUID; out Intf): HResult; virtual; stdcall;

    property RefCount: LongInt read FRefCount;
    property RefLifeTime: Boolean read FRefLifeTime write FRefLifeTime;
  end;

                                                                             
  TGMCriticalSection = class(TGMRefCountedObj, IGMCriticalSection)
   protected
    FCriticalSection: TRTLCriticalSection;
   public
    constructor Create(const ARefLifeTime: Boolean = True); override;
    destructor Destroy; override;
    procedure EnterCriticalSection;
    procedure LeaveCriticalSection;
    function TryEnterCriticalSection: Boolean;
  end;


  TGMCriticalSectionLock = class(TGMRefCountedObj{, IGMLockCriticalSection})
   protected
    FCriticalSection: IGMCriticalSection;
   public
    constructor Create(const ACriticalSection: IUnknown; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
  end;
  {$ENDIF}


  { ----------------------------- }
  { ---- Collection Gerneral ---- }
  { ----------------------------- }

type
  
  TGMIntfCompareFunc = function (const EntryA, EntryB: IUnknown): TGMCompareResult;

  TGMCountChangedProc = procedure (const Sender: TObject; const OldCount, NewCount: PtrInt) of Object;

  //TGMObjVisitFunc = function (const VisitedObj: TObject): Boolean;

  
  IGMIterator = interface(IUnknown)
    ['{A78717F7-120B-4704-BCA3-2C9E8706CE48}']
    function NextEntry(out AEntry): Boolean;
    procedure Reset;
  end;


  IGMCreateIterator = interface(IGMGetCount) // IUnknown
    ['{E57F2FDF-8660-448E-968D-C7248A20EA24}']
    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator;
  end;


  IGMCollection = interface(IGMCreateIterator)
    ['{468D1111-7D28-4195-9C44-13065516B0F4}']
    procedure SetCompareFunc(const Value: TGMIntfCompareFunc);
    //function GetCount: LongInt; stdcall;
    function IsEmpty: Boolean;
    procedure SetOnAfterCountChanged(const Value: TGMCountChangedProc);
    procedure Clear(const ANotify: Boolean = True);
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
    function IsValidIndex(const AIndex: PtrInt): Boolean;

    property Count: PtrInt read GetCount;
    property CompareItemFunc: TGMIntfCompareFunc write SetCompareFunc;
    property OnAfterCountChanged: TGMCountChangedProc write SetOnAfterCountChanged;
  end;


  IGMObjCollection = interface(IGMCollection)
    ['{979CCBB6-587C-49FD-A98A-0D3DF11789E0}']
    function First: TObject;
    function Last: TObject;
    function Add(const ANewEntry: TObject; const AReplaceIfExists: Boolean = False): TObject;
    function RemoveByInstance(const AObj: TObject): Boolean;
  end;


  IGMIntfCollection = interface(IGMCollection)
    ['{3DEA459B-0A78-4C91-981E-2E6F4D5C5D9F}']
    function First: IUnknown;
    function Last: IUnknown;
    function Add(const ANewEntry: IUnknown; const AReplaceIfExists: Boolean = False): IUnknown;
    function RemoveByInstance(const AIntf: IUnknown): Boolean;
  end;


  TGMIteratorBase = class(TGMRefCountedObj, IGMIterator)
   protected
    FCollection: TObject;
    FReverse: Boolean;
    FSyncLock: IUnknown;

   public
    constructor Create(const ACollection: TObject; const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce;
    function NextEntry(out AEntry): Boolean; virtual; abstract;
    procedure Reset; virtual; abstract;
  end;


  TGMCollectionBase = class(TGMRefCountedObj, IGMCriticalSection, IGMCollection, IGMGetCount, IGMCreateIterator)
   protected
    FCount: PtrInt;
    FCompareFunc: TGMIntfCompareFunc;
    FCriticalSection: IGMCriticalSection;
    FAcceptDuplicates: Boolean;
    FOnAfterCountChanged: TGMCountChangedProc;

    function CompareEntries(const EntryA, EntryB: IUnknown): TGMCompareResult;
    procedure SetCompareFunc(const AValue: TGMIntfCompareFunc); virtual;
    procedure AfterCompareFuncChanged; virtual;
    procedure NotifyAfterCountChanged(const OldCount, NewCount: PtrInt);
    procedure SetOnAfterCountChanged(const Value: TGMCountChangedProc);

   public
    constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False); reintroduce; overload; virtual;
    destructor Destroy; override;

    function GetCount: PtrInt; virtual; stdcall;
    function IsEmpty: Boolean; virtual;

    function IsValidIndex(const AIndex: PtrInt): Boolean; virtual;
    procedure Clear(const ANotify: Boolean = True); virtual; abstract;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; virtual; abstract;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; virtual; abstract;
    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean; virtual; abstract;
    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; virtual; abstract;

    property Count: PtrInt read GetCount;
    property CompareItemFunc: TGMIntfCompareFunc read FCompareFunc write SetCompareFunc;
    property CriticalSection: IGMCriticalSection read FCriticalSection implements IGMCriticalSection;
    property OnAfterCountChanged: TGMCountChangedProc read FOnAfterCountChanged write SetOnAfterCountChanged;
  end;


  { --------------------------- }
  { ---- Array Collections ---- }
  { --------------------------- }

  //
  // NOTE: Indexing of all array implementations is zero based!
  //

//IGMArrayListBase = interface(IGMCollection)
//  ['{313F4327-7EF8-440d-9B12-2A8EF8240A26}']
//  function GetSorted: Boolean;
//  procedure SetSorted(const Value: Boolean);
//
//  procedure RemoveByIdx(const Index: LongInt; DelCount: LongInt = 1);
//  procedure Rotate(const Delta: LongInt; const StartPos: LongInt = 0);
//  procedure Exchange(const Index1, Index2: LongInt);
//  procedure Reverse;
//  procedure Sort;
//
//  function IndexOf(const AKeyToCompare: IUnknown): LongInt;
//  function IndexOfNearest(const AKeyToCompare: IUnknown): LongInt;
//
//  property Sorted: Boolean read GetSorted write SetSorted;
//end;


  PPointerArray = ^TPointerArray;
  TPointerArray = array[0 .. cMaxPtrArraySize-1] of Pointer;

  TGMArrayCollectionBase = class(TGMCollectionBase, IGMExecuteOperation, IGMGetIntfByPosition, IGMLoadStoreData) // IGMArrayListBase,
   protected
    FEntries: PPointerArray;
    FCapacity: PtrInt;
    FSorted: Boolean;
    FFreeEntries: Boolean; 

    function GetSorted: Boolean;
    procedure SetSorted(const AValue: Boolean);
    procedure SetCapacity(const ANewCapacity: PtrInt);
    function IndexOfPointer(const Ptr: Pointer): PtrInt;
    function IsDuplicate(const AKeyToCompare: IUnknown; var AIndex: PtrInt): Boolean;
    procedure InsertPointer(const AInstance: Pointer; const AIndex: PtrInt);
    function EntryAsIntf(const Index: PtrInt): IUnknown; virtual; abstract;
    procedure FreePointer(var Item: Pointer); virtual; abstract;

    procedure AfterCompareFuncChanged; override;

    procedure NotifyAfterAddItem(const AItem: Pointer; const AIndex: PtrInt); virtual; abstract;
    procedure NotifyBeforeRemoveItem(const AItem: Pointer; const AIndex: PtrInt); virtual; abstract;

    procedure CheckSorted;
    procedure CheckUnsorted;

   public
    constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ASorted: Boolean = False;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False); reintroduce;

    function ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean; virtual; stdcall;
    function GetIntfByPosition(const APosition: LongInt; const AIID: TGUID; out AIntf): HResult; virtual; stdcall;

    procedure Clear(const ANotify: Boolean = True); override;
    procedure Sort; virtual;
    //procedure Pack; virtual;

    {$IFDEF STANDALONE_COLLECTIONS}
    procedure LoadData(const Source: IUnknown; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    procedure StoreData(const Dest: IUnknown; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    {$ELSE}
    procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    procedure StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall;
    {$ENDIF}

    procedure RemoveByIdx(const AIndex: PtrInt; ADelCount: PtrInt = 1); virtual;
    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean; override;

    function InsertIdx(const AKeyToCompare: IUnknown): PtrInt; virtual;
    function IndexOf(const AKeyToCompare: IUnknown): PtrInt; virtual;
    function IndexOfNearest(const AKeyToCompare: IUnknown): PtrInt; virtual;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;

    procedure Rotate(ADelta: PtrInt; const AStartIdx: PtrInt = 0);
    procedure Exchange(const AIndex1, AIndex2: PtrInt);
    //procedure Move(const ASourceIdx, ADestIdx: PtrInt);
    procedure Reverse;

    property Capacity: PtrInt read FCapacity {write SetCapacity};
    property Sorted: Boolean read GetSorted write SetSorted;
  end;


  TGMArrayCollectionIteratorBase = class(TGMIteratorBase)
   protected
    FCurrentIdx: PtrInt;
    procedure AssignOutEntry(out AEntry); virtual; abstract;

   public
    procedure Reset; override;
    function NextEntry(out AEntry): Boolean; override;
  end;


  TGMObjItemAddRemoveProc = procedure(const Sender, Entry: TObject; const AIndex: PtrInt) of object;

  IGMObjArrayCollection = interface(IGMObjCollection) // IGMArrayListBase
    ['{E83BD4DC-E50E-4fc3-9161-9F5829BC6C92}']
    function GetItem(const Index: PtrInt): TObject;
    procedure SetItem(const Index: PtrInt; const Value: TObject);
    procedure SetOnAfterAddItem(const Value: TGMObjItemAddRemoveProc);
    procedure SetOnBeforeRemoveItem(const Value: TGMObjItemAddRemoveProc);

    //function Add(const AObj: TObject): TObject;
    function AddIdx(const AObj: TObject; const AReplaceIfExists: Boolean = False): PtrInt;
    function Insert(const AObj: TObject; const AIndex: PtrInt; const AReplaceIfExists: Boolean = False): TObject;

    //function First: TObject;
    //function Last: TObject;

    function IndexOfObj(const AObj: TObject): PtrInt;
    //function FindObj(const AObj: TObject; var Index: LongInt): Boolean;

    property Items[const Index: PtrInt]: TObject read GetItem write SetItem; default;
    property OnAfterAddItem: TGMObjItemAddRemoveProc write SetOnAfterAddItem;
    property OnBeforeRemoveItem: TGMObjItemAddRemoveProc write SetOnBeforeRemoveItem;

    // ---- ArrayListBase ---- //
    function GetSorted: Boolean;
    procedure SetSorted(const Value: Boolean);

    procedure RemoveByIdx(const Index: PtrInt; DelCount: PtrInt = 1);
    procedure Rotate(Delta: PtrInt; const StartPos: PtrInt = 0);
    procedure Exchange(const Index1, Index2: PtrInt);
    procedure Reverse;
    procedure Sort;

    function IndexOf(const AKeyToCompare: IUnknown): PtrInt;
    function IndexOfNearest(const AKeyToCompare: IUnknown): PtrInt;

    property Sorted: Boolean read GetSorted write SetSorted;
  end;


  TGMObjArrayCollection = class(TGMArrayCollectionBase, IGMObjArrayCollection, IGMObjCollection)
   protected
    function ObjInsertIdx(const AObj: TObject): PtrInt;
    function InsertAt(const AObj: TObject; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean; virtual;
    function GetItem(const Index: PtrInt): TObject; virtual;
    function EntryAsIntf(const AIndex: PtrInt): IUnknown; override;
    procedure SetItem(const Index: PtrInt; const Value: TObject); virtual;
    procedure FreePointer(var AItem: Pointer); override;
    procedure SetOnAfterAddItem(const AValue: TGMObjItemAddRemoveProc);
    procedure SetOnBeforeRemoveItem(const Value: TGMObjItemAddRemoveProc);

    procedure NotifyAfterAddItem(const AItem: Pointer; const AIndex: PtrInt); override;
    procedure NotifyBeforeRemoveItem(const AItem: Pointer; const AIndex: PtrInt); override;

   public
    OnAfterAddItem: TGMObjItemAddRemoveProc;
    OnBeforeRemoveItem: TGMObjItemAddRemoveProc;

    constructor Create(const AFreeEntries: Boolean = False;
                       const AAcceptDuplicates: Boolean = True;
                       const ASorted: Boolean = False;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False);

    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; override;

    function Add(const AObj: TObject; const AReplaceIfExists: Boolean = False): TObject; virtual;
    function AddIdx(const AObj: TObject; const AReplaceIfExists: Boolean = False): PtrInt; virtual;
    function Insert(const AObj: TObject; const AIndex: PtrInt; const AReplaceIfExists: Boolean = False): TObject; virtual;

    function First: TObject; virtual;
    function Last: TObject; virtual;

    function IndexOfObj(const AObj: TObject): PtrInt;
    function RemoveByInstance(const AObj: TObject): Boolean;
    //function FindObj(const AObj: TObject; var Index: LongInt): Boolean; virtual;

    property Entries[const Index: PtrInt]: TObject read GetItem write SetItem; default; // <- Indexing is zero based!
    property FreeEntries: Boolean read FFreeEntries write FFreeEntries;
  end;


  TGMObjectCollectionIterator = class(TGMArrayCollectionIteratorBase)
   protected
    procedure AssignOutEntry(out AEntry); override;
  end;


  TGMIntfItemAddRemoveProc = procedure(const Sender: TObject; const Item: IUnknown; const AIndex: LongInt) of object;

  IGMIntfArrayCollection = interface(IGMIntfCollection) // IGMArrayListBase
    ['{E83BD4DC-E50E-4fc3-9161-9F5829BC6C92}']
    function GetItem(const Index: PtrInt): IUnknown;
    procedure SetOnAfterAddItem(const Value: TGMIntfItemAddRemoveProc);
    procedure SetOnBeforeRemoveItem(const Value: TGMIntfItemAddRemoveProc);

    //function Add(const AIntf: IUnknown): IUnknown;
    function AddIdx(const AIntf: IUnknown; const AReplaceIfExists: Boolean = False): PtrInt;
    function Insert(const AIntf: IUnknown; const AIndex: PtrInt; const AReplaceIfExists: Boolean = False): IUnknown;
    //function Remove(const AIntf: IUnknown): LongInt;

    //function First: IUnknown;
    //function Last: IUnknown;

    function IndexOfObj(const AIntf: IUnknown): PtrInt;
    //function FindObj(const AIntf: IUnknown; var Index: LongInt): Boolean;

    property Items[const Index: PtrInt]: IUnknown read GetItem; default;
    property OnAfterAddItem: TGMIntfItemAddRemoveProc write SetOnAfterAddItem;
    property OnBeforeRemoveItem: TGMIntfItemAddRemoveProc write SetOnBeforeRemoveItem;

    // ---- ArrayListBase ---- //
    function GetSorted: Boolean;
    procedure SetSorted(const Value: Boolean);

    procedure RemoveByIdx(const Index: PtrInt; DelCount: PtrInt = 1);
    procedure Rotate(Delta: PtrInt; const StartPos: PtrInt = 0);
    procedure Exchange(const Index1, Index2: PtrInt);
    procedure Reverse;
    procedure Sort;

    function IndexOf(const AKeyToCompare: IUnknown): PtrInt;
    function IndexOfNearest(const AKeyToCompare: IUnknown): PtrInt;

    property Sorted: Boolean read GetSorted write SetSorted;
  end;


  TGMIntfArrayCollection = class(TGMArrayCollectionBase, IGMIntfCollection, IGMIntfArrayCollection)
   protected
    function InsertAt(const AIntf: IUnknown; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean; virtual;
    function GetItem(const Index: PtrInt): IUnknown; virtual;
    function EntryAsIntf(const AIndex: PtrInt): IUnknown; override;
    procedure FreePointer(var AItem: Pointer); override;
    procedure SetOnAfterAddItem(const AValue: TGMIntfItemAddRemoveProc);
    procedure SetOnBeforeRemoveItem(const Value: TGMIntfItemAddRemoveProc);

    procedure NotifyAfterAddItem(const AItem: Pointer; const AIndex: PtrInt); override;
    procedure NotifyBeforeRemoveItem(const AItem: Pointer; const AIndex: PtrInt); override;

   public
    OnAfterAddItem: TGMIntfItemAddRemoveProc;
    OnBeforeRemoveItem: TGMIntfItemAddRemoveProc;

    Constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ASorted: Boolean = False;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = True);

    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; override;

    function Add(const AIntf: IUnknown; const AReplaceIfExists: Boolean = False): IUnknown; virtual;
    function AddIdx(const AIntf: IUnknown; const AReplaceIfExists: Boolean = False): PtrInt; virtual;
    function Insert(const AIntf: IUnknown; const AIndex: PtrInt; const AReplaceIfExists: Boolean = False): IUnknown; virtual;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;

    function First: IUnknown; virtual;
    function Last: IUnknown; virtual;

    function IndexOfObj(const AIntf: IUnknown): PtrInt;
    function RemoveByInstance(const AIntf: IUnknown): Boolean;
    //function FindObj(const Intf: IUnknown; var Index: LongInt): Boolean; virtual;

    property Entries[const Index: PtrInt]: IUnknown read GetItem; default; // <- Indexing is zero based!
  end;


  TGMIntfArrayCollectionIterator = class(TGMArrayCollectionIteratorBase)
   protected
    procedure AssignOutEntry(out AEntry); override;
  end;


  { ------------------- }
  { ---- AVL Trees ---- }
  { ------------------- }

  TGMAvlTreeNodeDirection = (tndLeft, tndRight);

  TGMAvlTreeNodeBase = class
   public
    Parent: TGMAvlTreeNodeBase; // , Left, Right
    Children: array [TGMAvlTreeNodeDirection] of TGMAvlTreeNodeBase;
    Balance: LongInt;

    procedure ResetMembers;
    function TreeHeight: LongInt;
    function CalcBalance: LongInt;
    function GetDataAsIntf: IUnknown; virtual; abstract;
    function IsDataInstance(const AInstance): Boolean; virtual; abstract;
    function GetChild(const AIdx: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;
    procedure SetChild(const AIdx: TGMAvlTreeNodeDirection; const AValue: TGMAvlTreeNodeBase);

    property Child [const Index: TGMAvlTreeNodeDirection]: TGMAvlTreeNodeBase read GetChild write SetChild; default;
    property Left: TGMAvlTreeNodeBase read Children[tndLeft] write Children[tndLeft];
    property Right: TGMAvlTreeNodeBase read Children[tndRight] write Children[tndRight];
  end;

  TGMAvlTreeNodeClass = class of TGMAvlTreeNodeBase;


  TGMAvlTreeBase = class(TGMCollectionBase)
   protected
    function TreeNodeCreateClass: TGMAvlTreeNodeClass; virtual; abstract;
    function CreateTreeNode: TGMAvlTreeNodeBase; virtual;
    procedure FreeNode(const ANode: TGMAvlTreeNodeBase); virtual;

    function Rotate(const ANode: TGMAvlTreeNodeBase; const ADirection: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;
    function DoubleRotate(const ANode: TGMAvlTreeNodeBase; const ADirection: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;

    procedure BalanceAfterInsert(const ANode: TGMAvlTreeNodeBase);
    procedure BalanceAfterDelete(const ANode: TGMAvlTreeNodeBase);
    function FindInsertPos(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
    procedure SetCompareFunc(const AValue: TGMIntfCompareFunc); override;
    function AddNode(const ANode: TGMAvlTreeNodeBase; const AReplaceIfExists: Boolean): Boolean;
    function FindNode(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
    function FindNearestNode(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
    procedure DeleteNode(const ANode: TGMAvlTreeNodeBase);
    function RemoveByInstance(const AInstance): Boolean;
    function SuccessorNode(const ANode: TGMAvlTreeNodeBase): TGMAvlTreeNodeBase;
    function PredecessorNode(const ANode: TGMAvlTreeNodeBase): TGMAvlTreeNodeBase;
    function FirstNode: TGMAvlTreeNodeBase;
    function LastNode: TGMAvlTreeNodeBase;

   public
    Root: TGMAvlTreeNodeBase;

    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean; override;
    procedure Clear(const ANotify: Boolean = True); override;
    procedure CheckIntegrity;
  end;

  //EAvlTreeInconsistency = class(Exception);


  TGMAvlTreeIteratorBase = class(TGMIteratorBase)
   protected
    FCurrentNode: TGMAvlTreeNodeBase;
    procedure AssignOutEntry(out AEntry); virtual; abstract;

   public
    procedure Reset; override;
    function NextEntry(out AEntry): Boolean; override;
  end;


  TGMAvlObjTreeNode = class(TGMAvlTreeNodeBase)
   public
    Data: TObject;
    function GetDataAsIntf: IUnknown; override;
    function IsDataInstance(const AInstance): Boolean; override;
  end;


  TGMAvlObjTree = class(TGMAvlTreeBase, IGMObjCollection)
   protected
    FFreeEntries: Boolean;

    function TreeNodeCreateClass: TGMAvlTreeNodeClass; override;
    procedure FreeNode(const ANode: TGMAvlTreeNodeBase); override;

   public
    constructor Create(const AFreeEntries: Boolean; const AAcceptDuplicates: Boolean = False; const ACompareFunc: TGMIntfCompareFunc = nil; const ARefLifeTime: Boolean = False); reintroduce; overload;
    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; override;
    function Add(const ANewEntry: TObject; const AReplaceIfExists: Boolean = False): TObject;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function RemoveByInstance(const AObj: TObject): Boolean;
    function First: TObject;
    function Last: TObject;
  end;


  TGMAvlObjectTreeIterator = class(TGMAvlTreeIteratorBase)
   protected
    procedure AssignOutEntry(out AEntry); override;
  end;


  TGMAvlIntfTreeNode = class(TGMAvlTreeNodeBase)
   public
    Data: IUnknown;
    function GetDataAsIntf: IUnknown; override;
    function IsDataInstance(const AInstance): Boolean; override;
  end;


  TGMAvlIntfTree = class(TGMAvlTreeBase, IGMIntfCollection)
   protected
    function TreeNodeCreateClass: TGMAvlTreeNodeClass; override;

   public
    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; override;
    function Add(const ANewEntry: IUnknown; const AReplaceIfExists: Boolean = False): IUnknown;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function RemoveByInstance(const AIntf: IUnknown): Boolean;
    function First: IUnknown;
    function Last: IUnknown;
  end;


  TGMAvlIntfTreeIterator = class(TGMAvlTreeIteratorBase)
   protected
    procedure AssignOutEntry(out AEntry); override;
  end;


  { --------------------- }
  { ---- Hash Tables ---- }
  { --------------------- }

  //
  // A multi-level extendable hashing algorithm is implmented here. Offering good performance along with
  // low memory consumption. Even in case of skewed distributed hash codes. And it scales gracefully
  // from only a few entries to millions of entries.
  // 

  const

  cMaxHashBucketSize = 8; // <- when using sizes greater than 256 extend type TBucketDirIdx accordingly!
  cMaxHashCodeBits = SizeOf(TGMHashCode) * 8;
  cMaxHashBitsPerDirLevel = 6; // <- when using more than 8 bits extend type TBucketDirIdx accordingly!
  cMinHashBitsPerDirLevel = 4; // <- when using more than 8 bits extend type TBucketDirIdx accordingly!


  type

  TGMHashTableBase = class;
  TGMHashEntryBucket = class;

  IGMHashEntryBucket = interface(IUnknown)
    ['{E31D8735-3491-4D0C-B421-4FF1458E3ED9}']
    function Obj: TGMHashEntryBucket;
  end;

  TBucketIdx = Word; // <- if all hash bits are used and still there are duplicates more than cMaxHashBucketSize entries may be put into a single bucket!

  TGMHashEntryBucket = class(TGMRefCountedObj, IGMHashEntryBucket)
   protected
    FEntries: PPointerArray;
    FCount: TBucketIdx;
    FCapacity: TBucketIdx;
    FHashTable: TGMHashTableBase;
    //FHashBitCount: Byte;

    function InsertIdx(const AKeyToCompare: IUnknown): TBucketIdx;
    procedure SetCapacity(const NewCapacity: TBucketIdx);
    function FindIdxOfKey(const AKeyToCompare: IUnknown; var AIndex: TBucketIdx): Boolean;

   public
    constructor Create(const AHashTable: TGMHashTableBase; const ARefLifeTime: Boolean = True); reintroduce; // const AHashBitCount: Byte;
    destructor Destroy; override;
    procedure Clear(const AFreeEntries: Boolean);
    function Obj: TGMHashEntryBucket;
    function FindKey(const AKeyToCompare: IUnknown; out AEntry): Boolean;
    function AddPointer(const ANewEntry: Pointer): Boolean;
    procedure RemoveByIdx(const AIdx: LongInt);
    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
    function RemovePointer(const AInstance: Pointer): Boolean;
  end;


  TGMHashBitMaskDirectory = class;

  IGMHashBitMaskDirectory = interface(IUnknown)
    ['{950EF49C-B643-455C-A1B5-AB3C03B8A1F6}']
    function Obj: TGMHashBitMaskDirectory;
  end;

  TBucketDirIdx = Byte;

  TGMHashBitMaskDirectory = class(TGMRefCountedObj, IGMHashBitMaskDirectory)
   protected
    FHashBitCount: Byte;
    FHashBitOffs: Byte;
    FMaxHashBits: Byte;
    FHashBitMask: TGMHashCode;
    FHashTable: TGMHashTableBase;
    FDirEntries: array of IUnknown;
    FAssignedCount: TBucketDirIdx;

    procedure ExpandHash(const ADirEntryIdx: LongInt);
    procedure ReHashBuketEntries(const ABucket: IGMHashEntryBucket);

   public
    constructor Create(const AHashTable: TGMHashTableBase; const AMaxHashBits: Byte; const AHashBitOffs: Byte = 0; const ARefLifeTime: Boolean = True); reintroduce;
    function Obj: TGMHashBitMaskDirectory;
    function CalcDirEntryIndex(const AHashCode: TGMHashCode): LongInt;
    function FindDirEntry(const AHashCode: TGMHashCode): IUnknown;
    function FindBucket(const AHashCode: TGMHashCode; var ABucket: IGMHashEntryBucket): Boolean;
    function AddPointer(const AHashCode: TGMHashCode; const ANewEntry: Pointer): Boolean;
    function RemoveByKey(const AHashCode: TGMHashCode; const AKeyToCompare: IUnknown): Boolean;
    function RemovePointer(const AInstance: Pointer): Boolean;
    function FirstEntry: Pointer;
    function LastEntry: Pointer;
  end;


  TGMHashTableBase = class (TGMCollectionBase)
   protected
    FFreeEntries: Boolean;
    FRootDirectory: IGMHashBitMaskDirectory;

    function BuildHashCode(const AKeyToCompare: IUnknown): TGMHashCode; virtual;
    function AddPointer(const AHashCode: TGMHashCode; ANewEntry: Pointer): Boolean;
    function EntryAsIntf(const AEntryPtr: Pointer): IUnknown; virtual; abstract;
    procedure FreePointer(var AEntryPtr: Pointer); virtual; abstract;
    procedure AssignOutEntry(const AEntryPtr: Pointer; out AEntry); virtual; abstract;
    function FirstEntry: Pointer;
    function LastEntry: Pointer;
    procedure DoAfterRemove;
    function RemovePointer(const AInstance: Pointer): Boolean;
    //procedure SetCompareFunc(const AValue: TGMIntfCompareFunc); override;

   public
    function CreateIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMIterator; override;
    function Find(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean; override;
    function RemoveByKey(const AKeyToCompare: IUnknown): Boolean; override;
    procedure Clear(const ANotify: Boolean = True); override;
  end;

  PHashIteratorStackRec = ^THashIteratorStackRec;
  THashIteratorStackRec = record
   Directory: IGMHashBitMaskDirectory;
   DirEntryIdx: LongInt; // <- LongInt NOT TBucketDirIdx to support negative values!
  end;

  TGMHashTableIterator = class(TGMIteratorBase)
   protected
    FDirStack: array of THashIteratorStackRec;
    FCurrentBucket: IGMHashEntryBucket;
    FCurrentBucketEntryIdx: LongInt; // <- LongInt NOT TBucketIdx to support negative values!

   public
    procedure Reset; override;
    function NextEntry(out AEntry): Boolean; override;
  end;


  TGMObjHashTable = class(TGMHashTableBase, IGMObjCollection)
   protected
    function EntryAsIntf(const AEntryPtr: Pointer): IUnknown; override;
    procedure FreePointer(var AEntryPtr: Pointer); override;
    procedure AssignOutEntry(const AEntryPtr: Pointer; out AEntry); override;

   public
    constructor Create(const AFreeEntries: Boolean = False;
                       const AAcceptDuplicates: Boolean = True;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False); reintroduce; overload;

    function Add(const ANewEntry: TObject; const AReplaceIfExists: Boolean = False): TObject;
    function RemoveByInstance(const AObj: TObject): Boolean;
    function First: TObject;
    function Last: TObject;
  end;


  TGMIntfHashTable = class(TGMHashTableBase, IGMIntfCollection)
   protected
    function EntryAsIntf(const AEntryPtr: Pointer): IUnknown; override;
    procedure FreePointer(var AEntryPtr: Pointer); override;
    procedure AssignOutEntry(const AEntryPtr: Pointer; out AEntry); override;

   public
    constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ACompareFunc: TGMIntfCompareFunc = nil;
                       const ARefLifeTime: Boolean = False); override;
    function Add(const ANewEntry: IUnknown; const AReplaceIfExists: Boolean = False): IUnknown;
    function RemoveByInstance(const AIntf: IUnknown): Boolean;
    function First: IUnknown;
    function Last: IUnknown;
  end;


  { ----------------------------- }
  { ---- Generic Collections ---- }
  { ----------------------------- }

  {$IFDEF GENERICS}
  TGMGenericCompareFunc<T> = function (const EntryA, EntryB: T): TGMCompareResult;
  TGMGenericItemAddRemoveProc<T> = procedure(const Sender: TObject; const AEntry: T; const AIndex: PtrInt) of object;

  IGMGenericIterator<T> = interface(IUnknown)
    ['{031CB54D-9BD7-4BA8-A847-A309B4FFD49C}']
    function NextEntry(out AEntry: T): Boolean;
    procedure Reset;
  end;

  IGMCreateGenericIterator<T> = interface(IGMGetCount) // IUnknown
    ['{E57F2FDF-8660-448E-968D-C7248A20EA24}']
    function CreateGenericIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMGenericIterator<T>;
  end;

  IGMGenericCollection<T> = interface(IGMCreateGenericIterator<T>)
    ['{468D1111-7D28-4195-9C44-13065516B0F4}']
    function IsEmpty: Boolean;
    function Add(const ANewEntry: T; const AReplaceIfExists: Boolean = False): T;
    function Find(const AEntry: T; var AFoundEntry: T): Boolean;
    function FindNearest(const AKeyToCompare: T; out AEntry: T): Boolean;
    procedure Clear(const ANotify: Boolean = True);
    function Remove(const AKeyToCompare: T): Boolean;
    //function RemoveByKey(const AKeyToCompare: T): Boolean;
    //function RemoveByInstance(const AInstance: T): Boolean;
    function IsValidIndex(const AIndex: PtrInt): Boolean;
    function First: T;
    function Last: T;

    procedure SetCompareFunc(const Value: TGMGenericCompareFunc<T>);
    procedure SetOnAfterCountChanged(const Value: TGMCountChangedProc);
    procedure SetOnAfterAddItem(const Value: TGMGenericItemAddRemoveProc<T>);
    procedure SetOnBeforeRemoveItem(const Value: TGMGenericItemAddRemoveProc<T>);

    property Count: PtrInt read GetCount;
    property CompareItemFunc: TGMGenericCompareFunc<T> write SetCompareFunc;
    property OnAfterCountChanged: TGMCountChangedProc write SetOnAfterCountChanged;
    property OnAfterAddItem: TGMGenericItemAddRemoveProc<T> write SetOnAfterAddItem;
    property OnBeforeRemoveItem: TGMGenericItemAddRemoveProc<T> write SetOnBeforeRemoveItem;
  end;


  TGMGenericIteratorBase<T> = class(TGMRefCountedObj, IGMGenericIterator<T>)
   protected
    FCollectionHolder: IUnknown;
    FReverse: Boolean;
    FSyncLock: IUnknown;

   public
    constructor Create(const ACollection: IUnknown; const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce;
    function NextEntry(out AEntry: T): Boolean; virtual; abstract;
    procedure Reset; virtual; abstract;
  end;


  TGMPlainGenericCollection = class(TGMRefCountedObj)
  //
  // Class for global symbol access, they cannot be accessed in generic classes derived from this class ...
  //
   public
    procedure CheckSorted(const AReqiredSorted, ASorted: Boolean);
    function ArrayGrowDelta(const ACurrentCapacity: PtrInt): PtrInt;
    function MsgStrArrayIndex: String;
  end;


  TGMGenericCollectionBase<T> = class(TGMPlainGenericCollection, IGMCriticalSection)
   protected
    FCount: PtrInt;
    FCompareFunc: TGMGenericCompareFunc<T>;
    FCriticalSection: IGMCriticalSection;
    FAcceptDuplicates: Boolean;
    FOnAfterCountChanged: TGMCountChangedProc;
    FOnAfterAddItem: TGMGenericItemAddRemoveProc<T>;
    FOnBeforeRemoveItem: TGMGenericItemAddRemoveProc<T>;

    function NullEntry: T; virtual;
    function CompareEntries(const AEntryA, AEntryB: T): TGMCompareResult;
    function IsValidIndex(const AIndex: PtrInt): Boolean;

    procedure NotifyAfterAddItem(const AEntry: T; const AIndex: PtrInt);
    procedure NotifyBeforeRemoveItem(const AEntry: T; const AIndex: PtrInt);
    procedure NotifyAfterCountChanged(const AOldCount, ANewCount: PtrInt);

   public
    constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ACompareFunc: TGMGenericCompareFunc<T> = nil;
                       const ARefLifeTime: Boolean = True); reintroduce;

    //destructor Destroy; override;

    procedure Clear(const ANotify: Boolean = False); virtual; abstract;
    function GetCount: PtrInt; stdcall;
    procedure SetCompareFunc(const ACompareFunc: TGMGenericCompareFunc<T>); virtual;
    function IsEmpty: Boolean;

    procedure SetOnAfterCountChanged(const AValue: TGMCountChangedProc);
    procedure SetOnAfterAddItem(const AValue: TGMGenericItemAddRemoveProc<T>);
    procedure SetOnBeforeRemoveItem(const AValue: TGMGenericItemAddRemoveProc<T>);

    property Count: PtrInt read GetCount;
    property CompareItemFunc: TGMGenericCompareFunc<T> read FCompareFunc write SetCompareFunc;
    property CriticalSection: IGMCriticalSection read FCriticalSection implements IGMCriticalSection;
    property OnAfterCountChanged: TGMCountChangedProc read FOnAfterCountChanged write SetOnAfterCountChanged;
  end;


  IGMGenericArrayCollection<T> = interface(IGMGenericCollection<T>)
    ['{448C6101-CC35-49F6-8811-27EEB8F4CC92}']
    function GetSorted: Boolean;
    procedure SetSorted(const AValue: Boolean);

    procedure Sort;

    function GetEntry(const AIndex: PtrInt): T;
    procedure SetEntry(const AIndex: PtrInt; const AValue: T);

    function IndexOf(const AKeyToCompare: T): PtrInt;
    procedure RemoveByIdx(const AIndex: PtrInt; ADelCount: PtrInt = 1);

    procedure Rotate(ADelta: PtrInt; const AStartIdx: PtrInt = 0);
    procedure Exchange(const AIndex1, AIndex2: PtrInt);
    //procedure Move(const ASourceIdx, ADestIdx: PtrInt);
    procedure Reverse;

    property Sorted: Boolean read GetSorted write SetSorted;
    property Entries[AIndex: PtrInt]: T read GetEntry write SetEntry; default;
  end;


  TGMGenericArrayCollection<T> = class(TGMGenericCollectionBase<T>, IGMGenericCollection<T>, IGMGenericArrayCollection<T>)
   protected
    FEntries: array of T;
    FCapacity: PtrInt;
    FSorted: Boolean;

    function GetSorted: Boolean;
    procedure SetSorted(const AValue: Boolean);

    function GetEntry(const AIndex: PtrInt): T;
    procedure SetEntry(const AIndex: PtrInt; const AValue: T);

    procedure SetCapacity(ANewCapacity: PtrInt);
    procedure InsertEntry(const AEntry: T; const AIndex: PtrInt);
    function InternalInsertIdx(const AEntry: T; const L, R: PtrInt): PtrInt;
    function InsertIdx(const AEntry: T): PtrInt;
    function InsertAt(const AEntry: T; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean;
    procedure QuickSort(L, R: PtrInt);

   public
    constructor Create(const AAcceptDuplicates: Boolean = True;
                       const ASorted: Boolean = False;
                       const ACompareFunc: TGMGenericCompareFunc<T> = nil;
                       const ARefLifeTime: Boolean = True); reintroduce;

    function CreateGenericIterator(const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False): IGMGenericIterator<T>;

    procedure SetCompareFunc(const ACompareFunc: TGMGenericCompareFunc<T>); override;

    function IndexOfNearest(const AKeyToCompare: T): PtrInt;
    function IsDuplicate(const AEntry: T; var AIndex: PtrInt): Boolean;
    function IndexOf(const AKeyToCompare: T): PtrInt;
    function Find(const AKeyToCompare: T; var AFoundEntry: T): Boolean;
    function FindNearest(const AKeyToCompare: T; out AEntry: T): Boolean;

    function Add(const ANewEntry: T; const AReplaceIfExists: Boolean = False): T;
    procedure RemoveByIdx(const AIndex: PtrInt; ADelCount: PtrInt = 1);
    function Remove(const AEntry: T): Boolean;
    procedure Clear(const ANotify: Boolean = False); override;
    //function RemoveByKey(const AKeyToCompare: T): Boolean;
    //function RemoveByInstance(const AInstance: T): Boolean;
    function First: T;
    function Last: T;

    procedure Rotate(ADelta: PtrInt; const AStartIdx: PtrInt = 0);
    procedure Exchange(const AIndex1, AIndex2: PtrInt);
    //procedure Move(const ASourceIdx, ADestIdx: PtrInt);
    procedure Reverse;

    procedure Sort;

    property Entries[AIndex: PtrInt]: T read GetEntry write SetEntry; default;
    property Capacity: PtrInt read FCapacity {write SetCapacity};
    property Sorted: Boolean read FSorted write SetSorted;
  end;


  TGMGenericArrayIterator<T> = class(TGMGenericIteratorBase<T>)
   protected
    FCollection: TGMGenericArrayCollection<T>;
    FCurrentIdx: PtrInt;

   public
    constructor Create(const ACollection: TGMGenericArrayCollection<T>; const AReverse: Boolean = False; const AConcurrentThreadLock: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce;
    function NextEntry(out AEntry: T): Boolean; override;
    procedure Reset; override;
  end;
  {$ENDIF}


  { --------------------- }
  { ---- Integer Map ---- }
  { --------------------- }

  type

  TGMIntegerMap = class;

  IGMIntegerMap = interface(IUnknown)
    ['{59388B7E-4264-4128-992D-CCE1BD926721}']
    function Obj: TGMIntegerMap;
  end;

  PPtrIntArray = ^TPtrIntArray;
  TPtrIntArray = array [0 .. cMaxIntArraySize-1] of PtrInt;
  TNotifyIntMapChangeProc =  procedure (const Value: PtrInt) of Object;
  TIndexDecideFunc = function (const Value: PtrInt): Boolean of Object;


  TGMIntegerMap = class(TGMRefCountedObj, IGMIntegerMap, IGMMapIntegerOnInteger, IGMGetCount, IGMExecuteOperation)
   protected
    FValues: PPtrIntArray;
    FCount: PtrInt;
    FCapacity: PtrInt;
    FChangeNotifyProc: TNotifyIntMapChangeProc;

    procedure SetCapacity(const ANewCapacity: PtrInt);
    function GetMappedValue(AIndex: PtrInt): PtrInt;
    function InsertIdx(const AValue: PtrInt): PtrInt;

    function GetCount: PtrInt; stdcall;
    function MapIntegerOnInteger(const AMapKeyValue: PtrInt): PtrInt; virtual; stdcall;
    function ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean; virtual; stdcall;
    procedure IntMapChanged(const AValue: PtrInt);

   public
    OnDecideAddValue: TIndexDecideFunc;

    constructor Create(const ANotifyProc: TNotifyIntMapChangeProc; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual;
    destructor Destroy; override;
    function Obj: TGMIntegerMap;

    procedure Add(const AValue: PtrInt);
    procedure RemoveByIdx(const AIndex: PtrInt);
    procedure Remove(const AValue: PtrInt);
    procedure Toggle(const AValue: PtrInt);
    procedure Clear(const ANotify: Boolean = True); virtual;
    procedure AddRange(AValue1, AValue2: PtrInt);
    procedure SetRange(AValue1, AValue2: PtrInt);

    function Contains(const AValue: PtrInt): Boolean;
    function IsEmpty: Boolean;

    property Values[Index: PtrInt]: PtrInt read GetMappedValue; default;
    property Count: PtrInt read FCount;
  end;


//
// Collection Helpers
//

function GMCollectionContains(const ACollection, AKeyToCompare: IUnknown): Boolean;
function GMCollectionAddAll(const ASrcCollection, ADstCollection: IUnknown; const AClearDstCollection: Boolean = False): PtrInt;
function GMCollectionRemoveAll(const AToRemoveCollection, ARemoveFromCollection: IUnknown): PtrInt;


//
// Helpers when not using GMCommon and GMIntf units
//
{$IFDEF STANDALONE_COLLECTIONS}
function GMStringJoin(const Value, Separator, Append: String): String;
function GMHResultFromWin32(const WinErrorCode: LongWord): HRESULT;
function GMQueryInterface(const Obj: IUnknown; const IID: TGUID; out Intf): Boolean;
function GMIsInRange(const Value, Min, Max: LongInt): Boolean;
function GMBoundedInt(Value, Min, Max: LongInt; const MinBased: Boolean = True): LongInt;
procedure GMCheckQueryInterface(const Obj: IUnknown; const IID: TGUID; out Intf; const CallingName: String);
function GMHrSucceeded(const AErrorCode: HResult): Boolean;
function GMSysErrorMsg(const ErrorCode: LongInt; const Params: array of PChar): string;
function GMObjAsIntf(const Obj: TObject): IUnknown;
procedure GMCheckIntRange(const ValueName: String; const Value, MinValue, MaxValue: LongInt; const Obj: TObject; const CallingName: String);
function Min(A, B: LongInt): LongInt;
function Max(A, B: LongInt): LongInt;
{$ENDIF}


implementation

uses SysUtils {$IFNDEF STANDALONE_COLLECTIONS}, GMCommon{$ENDIF};
           
//const
//
//  CStrErrNameSep = ' - ';

resourcestring

  RStrCollectionNotSorted = 'Operation not supported on unsorted collections';
  RStrCollectionSorted = 'Operation not supported on sorted collections';
  RStrArrayIndex = 'Array Index';
  RStrListCapacityError = 'List capacity (%d) must be smaller than (%d)';
  //RStrInvalidRotateDelta = 'Invalid Rotate Delta: %d';
  //RStrInvalidRotateStartPos = 'Invalid Rotate start Position: %d';
  RStrMapIndex = 'Map Index';

  RStrAvlTreeIntegrityViolation = 'AVL-Tree integrity violation';
  RStrLeftChildsParentNotUs = 'The parent member of the left child does not point back to us';
  RStrLeftChildGreaterThanUs = 'The left childs value is greater than ours, but it should be less or equal';
  RStrRightChildsParentNotUs = 'The parent member of the right child does not point back to us';
  RStrWeGreaterThanRightChild = 'Our value is greater than that of our right child, but it should be less or equal.';
  RStrWrongNodeBalanceFmt = 'Wrong node balance %d it should be %d';
  RStrWrongNodeCountFmt = 'Wrong total tree node count %d it should be %d';

  RStrNodeParentLinkError = 'AVL-Tree: The parent node is not correctly linked to the child node';
  RStrNoNearestInHashFmt = 'FindNearest not supported in class %s because hashing is not order preserving';

  {$IFDEF DEBUG}
  RStrDuplicateHashEntry = 'Duplicate hash entry';
  {$ENDIF}
  {$IFDEF STANDALONE_COLLECTIONS}
  RStrTheObjIsNil = 'The Object is nil';
  RStrMsgOutOfRangeFmt = '%s out of range: %d. The Value must be in Interval [%d, %d]';
  {$ENDIF}



{ ------------------------------------------------------------------ }
{ ---- Routines needed when not using GMIntf and GMCommon units ---- }
{ ------------------------------------------------------------------ }

{$IFDEF STANDALONE_COLLECTIONS}
function GMStringJoin(const Value, Separator, Append: String): String;
begin
  if Append = '' then Result := Value else
   if Value = '' then Result := Append else Result := Value + Separator + Append;
end;

function GMHResultFromWin32(const WinErrorCode: LongWord): HRESULT;
//
// Looks like Borland Windows.HResultFromWin32 is not correct ..
//
//  #define FACILITY_WIN32     7
//  #define HRESULT_FROM_WIN32(x)     ((HRESULT)(x) <= 0 ? ((HRESULT)(x)) \
//  : ((HRESULT) (((x) & 0x0000FFFF) | (FACILITY_WIN32 << 16) | 0x80000000)))
begin
  Result := HResult(WinErrorCode);
  if Result > 0 then Result := ((Result and $0000FFFF) or (FACILITY_WIN32 shl 16) or HRESULT($80000000));
end;

function GMSysErrorMsg(const ErrorCode: LongInt; const Params: array of PChar): string;
var ApiCode: DWORD; PParams: Pointer;
  function BuildSysErrMsg(Flags: DWORD): String;
  var Buffer: PChar; Len: DWORD;
  begin
    Len := FormatMessage(Flags or FORMAT_MESSAGE_ALLOCATE_BUFFER, nil, DWORD(ErrorCode), 0, PChar(@Buffer), 0, PParams);
    if Len = 0 then begin ApiCode := GetLastError; Result := ''; end else
     begin
      ApiCode := ERROR_SUCCESS;
      while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
      SetString(Result, Buffer, Len);
      //if LocalFree(HLOCAL(Buffer)) <> 0 then GMTrace('GMSysErrorMsg - LocalFree failed!', tpWarning);
     end;
  end;
begin
  if Length(Params) = 0 then PParams := nil else PParams := @Params[Low(Params)];
  Result := BuildSysErrMsg(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY);
  if (Result = '') and (ApiCode = ERROR_INVALID_PARAMETER) then
   Result := BuildSysErrMsg(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY or FORMAT_MESSAGE_IGNORE_INSERTS);
end;

function GMQueryInterface(const Obj: IUnknown; const IID: TGUID; out Intf): Boolean;
begin
  Result := (Obj <> nil) and (Obj.QueryInterface(IID, Intf) = S_OK);
end;

function GMHrSucceeded(const AErrorCode: HResult): Boolean;
begin
  Result := AErrorCode and $80000000 = 0;
end;

function GMIntfName(const AIntf: IUnknown): String;
begin
  Result := '';
end;

function GMObjName(const AObj: TObject): String;
begin
  if AObj <> nil then Result := AObj.ClassName else Result := '';
end;

procedure GMCheckQueryInterface(const Obj: IUnknown; const IID: TGUID; out Intf; const CallingName: String);
const cStrRoutineName = 'GMCheckQueryInterface';
var CallerName: String; Hr: HResult;
//function LocalBuildCallingName: String;
//begin
//  if CallerName = '' then CallerName := GMStringJoin(BuildCallingName(CallingName, cStrRoutineName), ' - ',
//                                                     GMFormat('QueryInterface<%s>("%s")', [GMIntfClassName(Obj), GMGuidToString(IID)]));
//  Result := CallerName;
//end;
begin
  //GMCheckPointerAssigned(Pointer(Obj), RStrTheObject, nil, CallerName);
  if Obj = nil then raise Exception.Create(GMStringJoin(GMStringJoin(GMIntfName(Obj), cStrErrNameSep, CallingName), ': ', RStrTheObjIsNil));

  Hr := Obj.QueryInterface(IID, Intf);
  if not GMHrSucceeded(Hr) then raise Exception.Create(GMStringJoin(GMStringJoin(GMIntfName(Obj), cStrErrNameSep, CallingName), ': ', GMSysErrorMsg(Hr, [])));

  //if Obj.QueryInterface(IID, Intf) <> S_OK then raise EGMException.IntfError(MsgIntfNotSupported(RStrTheObject, IID), Obj, BuildCallingName(CallingName, cStrRoutineName));
end;

function GMObjAsIntf(const Obj: TObject): IUnknown;
begin
  if (Obj = nil) or not Obj.GetInterface(IUnknown, Result) then Result := nil;
end;

function GMBoundedInt(Value, Min, Max: LongInt; const MinBased: Boolean = True): LongInt;
begin
  if Min > Max then if MinBased then Max := Min else Min := Max;

  if Value < Min then Result := Min
  else
  if Value > Max then Result := Max          
  else
  Result := Value;
end;

function GMCompareByInstance(const ItemA, ItemB: IUnknown): TGMCompareResult;
begin
  if PtrUInt(ItemA) > PtrUInt(ItemB) then Result := crAGreaterThanB else
  if PtrUInt(ItemA) = PtrUInt(ItemB) then Result := crAEqualToB else
  Result := crALessThanB;
end;

function GMIsInRange(const Value, Min, Max: LongInt): Boolean;
begin
  Result := (Value >= Min) and (Value <= Max);
end;

procedure GMCheckIntRange(const ValueName: String; const Value, MinValue, MaxValue: LongInt; const Obj: TObject; const CallingName: String);
const cStrRoutineName = 'GMCheckIntRange';
begin
  if not GMIsInRange(Value, MinValue, MaxValue) then
   raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(Obj), cStrErrNameSep, CallingName), ': ', GMFormat(RStrMsgOutOfRangeFmt, [ValueName, Value, MinValue, MaxValue])));
end;

function Min(A, B: LongInt): LongInt;
begin
  if A < B then Result := A else Result := B;
end;

function Max(A, B: LongInt): LongInt;
begin
  if A > B then Result := A else Result := B;
end;
{$ENDIF}


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function GrowDelta(const ACurrentCapacity: PtrInt): PtrInt;
begin
  Result := GMBoundedInt(ACurrentCapacity div cGrowDeltaDiv, 1, cGrowDeltaMax);
end;

function GMCollectionContains(const ACollection, AKeyToCompare: IUnknown): Boolean;
var PICollection: IGMCollection; Entry: IUnknown;
begin
  if not GMQUeryInterface(ACollection, IGMCollection, PICollection) then Result := False else
     Result := PICollection.Find(AKeyToCompare, Entry);
end;

function GMCollectionAddAll(const ASrcCollection, ADstCollection: IUnknown; const AClearDstCollection: Boolean = False): PtrInt;
var IntfSrc, IntfDst: IGMIntfCollection; it: IGMIterator; UnkEntry: IUnknown;
    ObjSrc, ObjDst: IGMObjCollection; ObjEntry: TObject;
begin
  Result := 0;
  if GMQueryInterface(ASrcCollection, IGMIntfCollection, IntfSrc) and
     GMQueryInterface(ADstCollection, IGMIntfCollection, IntfDst) then
   begin
    if AClearDstCollection then IntfDst.Clear;
    it := IntfSrc.CreateIterator;
    while it.NextEntry(UnkEntry) do begin IntfDst.Add(UnkEntry); Inc(Result); end;
   end else
  if GMQueryInterface(ASrcCollection, IGMObjCollection, ObjSrc) and
     GMQueryInterface(ADstCollection, IGMObjCollection, ObjDst) then
   begin
    if AClearDstCollection then ObjDst.Clear;
    it := ObjSrc.CreateIterator;
    while it.NextEntry(ObjEntry) do begin ObjDst.Add(ObjEntry); Inc(Result); end;
   end;
end;

function GMCollectionRemoveAll(const AToRemoveCollection, ARemoveFromCollection: IUnknown): PtrInt;
var toRemove, removeFrom: IGMIntfCollection; it: IGMIterator; unkEntry: IUnknown;
begin
  Result := 0;
  if GMQueryInterface(AToRemoveCollection, IGMIntfCollection, toRemove) and
     GMQueryInterface(ARemoveFromCollection, IGMIntfCollection, removeFrom) then
   begin
    it := toRemove.CreateIterator;
    while it.NextEntry(unkEntry) do begin removeFrom.RemoveByKey(unkEntry); Inc(Result); end;
   end;
end;

procedure RaiseError(const AMsg: String; const ACaller: TObject = nil; const ACallingName: String = '');
begin
  {$IFNDEF STANDALONE_COLLECTIONS}
  raise EGMException.ObjError(AMsg, ACaller, ACallingName);
  {$ELSE}
  raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(ACaller), cStrErrNameSep, ACallingName), ': ', AMsg));
  {$ENDIF}
end;


{ -------------------------- }
{ ---- TGMRefCountedObj ---- }
{ -------------------------- }

{$IFDEF STANDALONE_COLLECTIONS}
constructor TGMRefCountedObj.Create(const ARefLifeTime: Boolean);
begin
  inherited Create;
  FRefLifeTime := ARefLifeTime;
  FRefCount := 1; // <- artificial RefCount during construction, avoiding immediate destruction
                  //    when local interface variables to this instance are used by other objects during construction.
end;

procedure TGMRefCountedObj.AfterConstruction;
begin
  Dec(FRefCount);
  inherited AfterConstruction;
end;

procedure TGMRefCountedObj.BeforeDestruction;
begin
  inherited BeforeDestruction;
  Inc(FRefCount);
end;

//destructor TGMRefCountedObj.Destroy;
//begin
//inherited Destroy;
//if Assigned(vfGMCheckRefCountOnDestroy) then vfGMCheckRefCountOnDestroy(RefCount-1, Self);
//end;

procedure TGMRefCountedObj.OnFinalRelease;
begin
  Free;
end;

//function TGMRefCountedObj.CreateCopyQI(const IID: TGUID; out Intf): HResult;
//var PIUnknown: IUnknown; PIAssign: IGMAssignFromObj;
//begin
//PIUnknown := TGMRefCountedObjClass(ClassType).Create(True);
//Result := PIUnknown.QueryInterface(IID, Intf);
//if (Result = S_OK) and (PIUnknown.QueryInterface(IGMAssignFromObj, PIAssign) = S_OK) then PIAssign.AssignFromObj(Self);
//end;

//function TGMRefCountedObj.GetClassName: PChar;
//var RetVal: String;
//begin
//RetVal := ClassName;
//Result := PChar(RetVal);
//end;
//
//function TGMRefCountedObj.GetClassType: TClass;
//begin
//Result := ClassType;
//end;
//
//function TGMRefCountedObj.GetInstance: TObject;
//begin
//Result := Self;
//end;
//
//function TGMRefCountedObj.GetTypeInfo: PTypeInfo;
//begin
//Result := ClassInfo;
//end;

function TGMRefCountedObj.QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} IID: TGUID; out Intf): HResult;
begin
  if GetInterface(IID, Intf) then Result := S_OK else Result := E_NOINTERFACE;
  //GMTraceQueryInterface(Self, IID, Result);
end;

function TGMRefCountedObj._AddRef: LongInt;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TGMRefCountedObj._Release: LongInt;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and RefLifeTime then OnFinalRelease;
end;
{$ENDIF}


{ ---------------------------- }
{ ---- TGMCriticalSection ---- }
{ ---------------------------- }

{$IFDEF STANDALONE_COLLECTIONS}
constructor TGMCriticalSection.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  Windows.InitializeCriticalSection(FCriticalSection);
end;

destructor TGMCriticalSection.Destroy;
begin
  Windows.DeleteCriticalSection(FCriticalSection);
  inherited Destroy;
end;

procedure TGMCriticalSection.EnterCriticalSection;
begin
  Windows.EnterCriticalSection(FCriticalSection);
end;

procedure TGMCriticalSection.LeaveCriticalSection;
begin
  Windows.LeaveCriticalSection(FCriticalSection);
end;

function TGMCriticalSection.TryEnterCriticalSection: Boolean;
begin
  Result := Windows.TryEnterCriticalSection(FCriticalSection);
end;
{$ENDIF}


{ -------------------------------- }
{ ---- TGMCriticalSectionLock ---- }
{ -------------------------------- }

{$IFDEF STANDALONE_COLLECTIONS}
constructor TGMCriticalSectionLock.Create(const ACriticalSection: IUnknown; const ARefLifeTime: Boolean);
const cStrMethodName = 'TGMCriticalSectionLock.Create';
begin
  inherited Create(ARefLifeTime);
  if ACriticalSection = nil then Exit; // <- allow nil!
  // force ACriticalSection to support IGMCriticalSection interface
  GMCheckQueryInterface(ACriticalSection, IGMCriticalSection, FCriticalSection, cStrMethodName);
  if FCriticalSection <> nil then FCriticalSection.EnterCriticalSection;
end;

destructor TGMCriticalSectionLock.Destroy;
begin
  if FCriticalSection <> nil then FCriticalSection.LeaveCriticalSection;
  inherited Destroy;
end;
{$ENDIF}


{ --------------------------- }
{ ---- TGMCollectionBase ---- }
{ --------------------------- }

constructor TGMCollectionBase.Create(const AAcceptDuplicates: Boolean; const ACompareFunc: TGMIntfCompareFunc; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCriticalSection := TGMCriticalSection.Create(True);
  FAcceptDuplicates := AAcceptDuplicates;
  FCompareFunc := ACompareFunc;
end;

destructor TGMCollectionBase.Destroy;
begin
  Clear(False);
  inherited Destroy;
end;

function TGMCollectionBase.GetCount: PtrInt;
begin
  CriticalSection.EnterCriticalSection; // <- not technically needed, but let modifications finish before somebody else may read the count
  try
   Result := FCount;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMCollectionBase.NotifyAfterCountChanged(const OldCount, NewCount: PtrInt);
begin
  if Assigned(FOnAfterCountChanged) then FOnAfterCountChanged(Self, OldCount, NewCount);
end;

function TGMCollectionBase.CompareEntries(const EntryA, EntryB: IUnknown): TGMCompareResult;
begin
  if Assigned(FCompareFunc) then
   Result := FCompareFunc(EntryA, EntryB)
  else
   Result := GMCompareByInstance(EntryA, EntryB);
end;

procedure TGMCollectionBase.SetOnAfterCountChanged(const Value: TGMCountChangedProc);
begin
  FOnAfterCountChanged := Value;
end;

procedure TGMCollectionBase.SetCompareFunc(const AValue: TGMIntfCompareFunc);
begin
  CriticalSection.EnterCriticalSection;
  try
   if Addr(AValue) <> Addr(CompareItemFunc) then
    begin
     FCompareFunc := AValue;
     AfterCompareFuncChanged;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMCollectionBase.AfterCompareFuncChanged;
begin
  // Nothing!
end;

function TGMCollectionBase.IsEmpty: Boolean;
begin
  CriticalSection.EnterCriticalSection; // <- not technically needed, but let modifications finish before somebody else may read the count
  try
   Result := FCount = 0;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMCollectionBase.IsValidIndex(const AIndex: PtrInt): Boolean;
begin
  Result := (AIndex >= 0) and (AIndex < FCount); // GMIsInRange(AIndex, 0, FCount-1);
end;


{ ------------------------- }
{ ---- TGMIteratorBase ---- }
{ ------------------------- }

constructor TGMIteratorBase.Create(const ACollection: TObject; const AReverse, AConcurrentThreadLock: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCollection := ACollection;
  FReverse := AReverse;
  if AConcurrentThreadLock then FSyncLock := TGMCriticalSectionLock.Create(GMObjAsIntf(ACollection));
  Reset;
end;


{ -------------------------------- }
{ ---- TGMArrayCollectionBase ---- }
{ -------------------------------- }

Constructor TGMArrayCollectionBase.Create(const AAcceptDuplicates: Boolean = True;
                                          const ASorted: Boolean = False;
                                          const ACompareFunc: TGMIntfCompareFunc = nil;
                                          const ARefLifeTime: Boolean = False);
begin
  inherited Create(AAcceptDuplicates, ACompareFunc, ARefLifeTime);
  FSorted := ASorted;
end;

function TGMArrayCollectionBase.GetSorted: Boolean;
begin
  Result := FSorted;
end;

procedure TGMArrayCollectionBase.CheckSorted;
const cStrMethodName = 'CheckSorted';
begin
  if not FSorted then RaiseError(RStrCollectionNotSorted, Self, cStrMethodName);
end;

procedure TGMArrayCollectionBase.CheckUnsorted;
const cStrMethodName = 'CheckUnsorted';
begin
  if FSorted then RaiseError(RStrCollectionSorted, Self, cStrMethodName);
end;

function TGMArrayCollectionBase.ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean;
begin
  Result := True;
  case AOperation of
   {$IFNDEF STANDALONE_COLLECTIONS}
   Ord(opClear): Clear;
   {$ELSE}
   0: Clear;
   {$ENDIF}
   else Result := False;
  end;
end;

function TGMArrayCollectionBase.GetIntfByPosition(const APosition: LongInt; const AIID: TGUID; out AIntf): HResult;
//const cStrMethodName = 'GetIntfByPosition';
var PIUnkItem: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := GMHResultFromWin32(ERROR_INVALID_INDEX);
   if not GMIsInRange(APosition, 0, FCount-1) then Exit;
   //GMCheckIntRange(RStrArrayIndex, APosition, 0, FCount-1, Self, cStrMethodName);
   PIUnkItem := EntryAsIntf(APosition);
   if PIUnkItem <> nil then Result := PIUnkItem.QueryInterface(AIID, AIntf);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.SetCapacity(const ANewCapacity: PtrInt);
begin
  CriticalSection.EnterCriticalSection;
  try
   if (ANewCapacity < 0) or (ANewCapacity > cMaxPtrArraySize) then RaiseError(GMFormat(RStrListCapacityError, [ANewCapacity, cMaxPtrArraySize]), Self, 'SetCapacity');
   if ANewCapacity <> FCapacity then
    begin
     ReallocMem(FEntries, ANewCapacity * SizeOf(Pointer));
     FCapacity := ANewCapacity;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.Clear(const ANotify: Boolean);
var i, OldCount: LongInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   // Better free in reverse order
   if ANotify or FFreeEntries then
    for i:=FCount-1 downto 0 do
     begin
      if ANotify then NotifyBeforeRemoveItem(TObject(FEntries^[i]), i);
      if FFreeEntries then FreePointer(FEntries^[i]);
     end;
   OldCount := FCount;
   SetCapacity(0);
   FCount := 0;
   if ANotify then NotifyAfterCountChanged(OldCount, 0);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.SetSorted(const AValue: Boolean);
begin
  CriticalSection.EnterCriticalSection;
  try
   if AValue <> FSorted then
    begin
     FSorted := AValue;
     if AValue then Sort;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.AfterCompareFuncChanged;
begin
  if Assigned(FCompareFunc) and Sorted then Sort;
end;

function TGMArrayCollectionBase.IndexOfPointer(const Ptr: Pointer): PtrInt;
begin
  for Result := 0 to FCount-1 do if FEntries^[Result] = Ptr then Exit;
  Result := cInvalidItemIdx;
end;

function TGMArrayCollectionBase.IsDuplicate(const AKeyToCompare: IUnknown; var AIndex: PtrInt): Boolean;
var idx: PtrInt;
begin
  Result := False;
  if not FAcceptDuplicates then
   begin
    if Sorted then
     Result := IsValidIndex(AIndex) and (CompareEntries(EntryAsIntf(AIndex), AKeyToCompare) = crAEqualToB)
    else
     for idx:=0 to FCount-1 do
      if CompareEntries(EntryAsIntf(idx), AKeyToCompare) = crAEqualToB then begin AIndex := idx; Result := True; Break; end;
   end;
end;

procedure TGMArrayCollectionBase.InsertPointer(const AInstance: Pointer; const AIndex: PtrInt);
const cStrMethodName = 'InsertPointer';
begin
  GMCheckIntRange(RStrArrayIndex, AIndex, 0, FCount, Self, cStrMethodName);
  if FCount = FCapacity then SetCapacity(FCapacity + GrowDelta(FCapacity));
  if AIndex < FCount then System.Move(FEntries^[AIndex], FEntries^[AIndex + 1], (FCount - AIndex) * SizeOf(Pointer));
  FEntries^[AIndex] := AInstance;
  Inc(FCount);
  NotifyAfterAddItem(AInstance, AIndex);
  NotifyAfterCountChanged(FCount-1, FCount);
end;

{procedure TGMArrayCollectionBase.Pack;
var i: PtrInt
begin
  CriticalSection.EnterCriticalSection;
  try
   for i := FCount - 1 downto 0 do if FEntries^[i] = nil then Delete(i);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;}

{$IFNDEF STANDALONE_COLLECTIONS}
procedure TGMArrayCollectionBase.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
{$ELSE}
procedure TGMArrayCollectionBase.LoadData(const Source: IUnknown; const ACryptCtrlData: PGMCryptCtrlData);
{$ENDIF}
var i: LongInt; PILoadStore: IGMLoadStoreData;
begin
  for i:=0 to Count-1 do if (GetIntfByPosition(i, IGMLoadStoreData, PILoadStore) = S_OK) then PILoadStore.LoadData(Source, ACryptCtrlData);
end;

{$IFNDEF STANDALONE_COLLECTIONS}
procedure TGMArrayCollectionBase.StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData);
{$ELSE}
procedure TGMArrayCollectionBase.StoreData(const Dest: IUnknown; const ACryptCtrlData: PGMCryptCtrlData);
{$ENDIF}
var i: LongInt; PILoadStore: IGMLoadStoreData;
begin
  for i:=0 to Count-1 do if (GetIntfByPosition(i, IGMLoadStoreData, PILoadStore) = S_OK) then PILoadStore.StoreData(Dest, ACryptCtrlData);
end;

procedure TGMArrayCollectionBase.RemoveByIdx(const AIndex: PtrInt; ADelCount: PtrInt);
const cStrMethodName = 'RemoveByIdx';
var i: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   GMCheckIntRange(RStrArrayIndex, AIndex, 0, FCount-1, Self, cStrMethodName);
   ADelCount := Min(ADelCount, FCount - AIndex);
   if ADelCount <= 0 then Exit; // <- GMCheckIntRange should never raise with this
   for i:=AIndex to AIndex + ADelCount-1 do
    begin
     NotifyBeforeRemoveItem(FEntries^[i], i);
     if FFreeEntries then {if FEntries^[i] <> nil then} FreePointer(FEntries^[i]);
    end;
   Dec(FCount, ADelCount);
   if AIndex < FCount then System.Move(FEntries^[AIndex + ADelCount], FEntries^[AIndex], (FCount - AIndex) * SizeOf(Pointer));
   if FCapacity - FCount >= GrowDelta(FCapacity) then SetCapacity(FCapacity - GrowDelta(FCapacity));
   NotifyAfterCountChanged(FCount + ADelCount, FCount);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.InsertIdx(const AKeyToCompare: IUnknown): PtrInt;
const cStrMethodName = 'InsertIdx';
  function _InsertIdx(L, R: PtrInt): PtrInt;
  var M: PtrInt;
  begin
    //if not Assigned(CompareFunc) then Result := FCount else
    if L >= R then Result := L else
     begin
      M := (L + R) shr 1;
      case CompareEntries(AKeyToCompare, EntryAsIntf(M)) of
       crAEqualToB, crALessThanB: Result := _InsertIdx(L, M);
       crAGreaterThanB: if L = M then Result := R else Result := _InsertIdx(M, R);
       else
        {$IFNDEF STANDALONE_COLLECTIONS}
        raise EGMException.ObjError(RStrInvalidCompareResult, Self, cStrMethodName);
        {$ELSE}
        raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(Self), cStrErrNameSep, cStrMethodName), ': ', RStrInvalidCompareResult));
        {$ENDIF}
      end;
     end;
  end;
begin
  CriticalSection.EnterCriticalSection;
  try
   if not FSorted then Result := FCount else Result := _InsertIdx(0, FCount);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.IndexOf(const AKeyToCompare: IUnknown): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if not Sorted then
    begin
     for Result := 0 to FCount-1 do if CompareEntries(EntryAsIntf(Result), AKeyToCompare) = crAEqualToB then Exit;
     Result := cInvalidItemIdx;
    end
   else
    begin
     Result := InsertIdx(AKeyToCompare);
     if not IsValidIndex(Result) or (CompareEntries(EntryAsIntf(Result),  AKeyToCompare) <> crAEqualToB) then Result := cInvalidItemIdx;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.IndexOfNearest(const AKeyToCompare: IUnknown): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   CheckSorted;
   Result := GMBoundedInt(InsertIdx(AKeyToCompare), 0, FCount-1);
   if not IsValidIndex(Result) then Result := cInvalidItemIdx;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOf(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then Pointer(AEntry) := FEntries^[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOfNearest(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then Pointer(AEntry) := FEntries^[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMArrayCollectionBase.RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOf(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then RemoveByIdx(idx);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.Reverse;
var i: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount > 1 then for i:=0 to FCount-1 shr 1 do Exchange(i, FCount-1-i);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.Rotate(ADelta: PtrInt; const AStartIdx: PtrInt);
const cStrMethodName = 'Rotate';
var Buffer: Pointer; BufferSize: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount < 2 then Exit;
   CheckUnsorted;

   //if Abs(ADelta) >= FCount - AStartIdx then RaiseError(GMFormat(RStrInvalidRotateDelta, [ADelta]), Self, 'Rotate');
   ADelta := ADelta mod FCount;
   GMCheckIntRange(RStrArrayIndex, AStartIdx, 0, FCount-1, Self, cStrMethodName);
   //if AStartIdx >= FCount then RaiseError(GMFormat(RStrInvalidRotateStartPos, [AStartIdx]), Self, 'Rotate');

   BufferSize := Abs(ADelta) * SizeOf(Pointer);

   if ADelta > 0 then
    begin
     GetMem(Buffer, BufferSize);
     try
      System.Move(FEntries^[FCount-ADelta], Buffer^, BufferSize);
      System.Move(FEntries^[AStartIdx], FEntries^[ADelta+AStartIdx], (FCount-ADelta-AStartIdx) * SizeOf(Pointer));
      System.Move(Buffer^, FEntries^[AStartIdx], BufferSize);
     finally
      FreeMem(Buffer);
     end;
    end;

   if ADelta < 0 then
    begin
     GetMem(Buffer, BufferSize);
     try
      System.Move(FEntries^[AStartIdx], Buffer^, BufferSize);
      System.Move(FEntries^[-ADelta+AStartIdx], FEntries^[AStartIdx], (FCount+ADelta-AStartIdx) * SizeOf(Pointer));
      System.Move(Buffer^, FEntries^[FCount+ADelta], BufferSize);
     finally
      FreeMem(Buffer);
     end;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMArrayCollectionBase.Exchange(const AIndex1, AIndex2: PtrInt);
const cStrMethodName = 'Exchange';
var TmpItem: Pointer;
begin
  CriticalSection.EnterCriticalSection;
  try
   if AIndex1 <> AIndex2 then
    begin
     CheckUnsorted;
     GMCheckIntRange(RStrArrayIndex, AIndex1, 0, FCount-1, Self, cStrMethodName);
     GMCheckIntRange(RStrArrayIndex, AIndex2, 0, FCount-1, Self, cStrMethodName);
     TmpItem := FEntries^[AIndex1];
     FEntries^[AIndex1] := FEntries^[AIndex2];
     FEntries^[AIndex2] := TmpItem;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

//procedure TGMArrayCollectionBase.Move(const ASourceIdx, ADestIdx: PtrInt);
//const cStrMethodName = 'MoveEntry';
//var TmpItem: Pointer;
//begin
//  CriticalSection.EnterCriticalSection;
//  try
//   if ASourceIdx <> ADestIdx then
//    begin
//     CheckUnsorted;
//     GMCheckIntRange(RStrArrayIndex, ASourceIdx, 0, FCount-1, Self, cStrMethodName);
//     GMCheckIntRange(RStrArrayIndex, ADestIdx, 0, FCount-1, Self, cStrMethodName);
//
//     TmpItem := FEntries^[ASourceIdx];
//
//     if ASourceIdx < ADestIdx then
//      System.Move(FEntries^[ASourceIdx+1], FEntries^[ASourceIdx], (ADestIdx - ASourceIdx) * SizeOf(Pointer))
//     else
//      System.Move(FEntries^[ADestIdx], FEntries^[ADestIdx+1], (ASourceIdx - ADestIdx) * SizeOf(Pointer));
//
//     FEntries^[ADestIdx] := TmpItem;
//    end;
//  finally
//   CriticalSection.LeaveCriticalSection;
//  end;
//end;

procedure TGMArrayCollectionBase.Sort;
  procedure QuickSort(L, R: PtrInt);
  var i, j, m: PtrInt; P: Pointer;
  begin
    i := L;
    j := R;
    m := (L + R) shr 1;
    while i <= j do
     begin
      while CompareEntries(EntryAsIntf(i), EntryAsIntf(m)) = crALessThanB do Inc(i);
      while CompareEntries(EntryAsIntf(j), EntryAsIntf(m)) = crAGreaterThanB do Dec(j);
      if i <= j then
       begin
        if i <> j then // and CompareFunc(EntryAsIntf(i), EntryAsIntf(j)) <> crAEqualToB
         begin
          P := FEntries^[i]; FEntries^[i] := FEntries^[j]; FEntries^[j] := P; // <- exchange i <-> j
          if m = i then m := j else if m = j then m := i; // <- if [m] has been exchanged update m
         end;
        Inc(i);
        Dec(j);
       end;
     end;
    if L < j then QuickSort(L, j);
    if i < R then QuickSort(i, R);
  end;
begin
  CriticalSection.EnterCriticalSection;
  try
   if (FEntries <> nil) and (FCount > 0) then QuickSort(0, FCount-1);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;


{ ---------------------------------------- }
{ ---- TGMArrayCollectionIteratorBase ---- }
{ ---------------------------------------- }

function TGMArrayCollectionIteratorBase.NextEntry(out AEntry): Boolean;
begin
  Result := (FCollection as TGMCollectionBase).IsValidIndex(FCurrentIdx);
  if Result then begin AssignOutEntry(AEntry); if FReverse then Dec(FCurrentIdx) else Inc(FCurrentIdx); end;
end;

procedure TGMArrayCollectionIteratorBase.Reset;
begin
  if FReverse then FCurrentIdx := (FCollection as TGMCollectionBase).Count-1 else FCurrentIdx := 0;
end;


{ ------------------------------- }
{ ---- TGMObjArrayCollection ---- }
{ ------------------------------- }

Constructor TGMObjArrayCollection.Create(const AFreeEntries: Boolean = False;
                                 const AAcceptDuplicates: Boolean = True;
                                 const ASorted: Boolean = False;
                                 const ACompareFunc: TGMIntfCompareFunc = nil;
                                 const ARefLifeTime: Boolean = False);
begin
  inherited Create(AAcceptDuplicates, ASorted, ACompareFunc, ARefLifeTime);
  FFreeEntries := AFreeEntries;
end;

function TGMObjArrayCollection.CreateIterator(const AReverse, AConcurrentThreadLock: Boolean): IGMIterator;
begin
  Result := TGMObjectCollectionIterator.Create(Self, AConcurrentThreadLock, AReverse, True);
end;

function TGMObjArrayCollection.EntryAsIntf(const AIndex: PtrInt): IUnknown;
begin
  Result := GMObjAsIntf(FEntries^[AIndex]);
end;

procedure TGMObjArrayCollection.FreePointer(var AItem: Pointer);
begin
  GMFreeAndNil(TObject(AItem));
end;

procedure TGMObjArrayCollection.SetOnAfterAddItem(const AValue: TGMObjItemAddRemoveProc);
begin
  OnAfterAddItem := AValue;
end;

procedure TGMObjArrayCollection.NotifyAfterAddItem(const AItem: Pointer; const AIndex: PtrInt);
begin
  if Assigned(OnAfterAddItem) then OnAfterAddItem(Self, TObject(AItem), AIndex);
end;

procedure TGMObjArrayCollection.SetOnBeforeRemoveItem(const Value: TGMObjItemAddRemoveProc);
begin
  OnBeforeRemoveItem := Value;
end;

procedure TGMObjArrayCollection.NotifyBeforeRemoveItem(const AItem: Pointer; const AIndex: PtrInt);
begin
  if Assigned(OnBeforeRemoveItem) then OnBeforeRemoveItem(Self, TObject(AItem), AIndex);
end;

function TGMObjArrayCollection.InsertAt(const AObj: TObject; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean;
var doInsert: Boolean;
begin
  // prevent GMObjAsIntf call when FAcceptDuplicates = true so objects without IUnknown can be added
  doInsert := FAcceptDuplicates or not IsDuplicate(GMObjAsIntf(AObj), AIndex);
  Result :=  doInsert or AReplaceIfExists;

  if doInsert then
   try InsertPointer(AObj, AIndex); except if FreeEntries then AObj.Free; raise; end
  else
   if AReplaceIfExists then
      begin FreePointer(FEntries^[AIndex]); FEntries^[AIndex] := AObj; end;
end;

function TGMObjArrayCollection.ObjInsertIdx(const AObj: TObject): PtrInt;
begin
  // InsertIdx forces the added AObj to have the IUnknown interface, but this is only needed when sorted.
  // Allow Interface-less objects to be added when not sorted
  if not FSorted then Result := FCount else Result := InsertIdx(GMObjAsIntf(AObj));
end;

function TGMObjArrayCollection.Add(const AObj: TObject; const AReplaceIfExists: Boolean): TObject;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := ObjInsertIdx(AObj);
// if not InsertAt(AObj, idx, AReplaceIfExists) and FreeEntries then begin AObj.Free; Result := nil; end else Result := AObj;
   if not InsertAt(AObj, idx, AReplaceIfExists) and FreeEntries then AObj.Free;
   Result := FEntries^[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.AddIdx(const AObj: TObject; const AReplaceIfExists: Boolean): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   // InsertIdx forces the added AObj to have IUnknown, only mandatory when sorted. Allow normal objects to be added when not sorted
   //if not FSorted then Result := FCount else Result := InsertIdx(GMObjAsIntf(AObj, cStrMethodName));
   Result := ObjInsertIdx(AObj);
// if not InsertAt(AObj, Result, AReplaceIfExists) then begin if FreeEntries then AObj.Free; Result := cInvalidItemIdx; end;
   if not InsertAt(AObj, Result, AReplaceIfExists) and FreeEntries then AObj.Free;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.Insert(const AObj: TObject; const AIndex: PtrInt; const AReplaceIfExists: Boolean): TObject;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FSorted then Result := Add(AObj, AReplaceIfExists) else
    begin
     idx := AIndex;
     if not InsertAt(AObj, idx, AReplaceIfExists) and FreeEntries then AObj.Free;
     Result := FEntries^[idx];
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.GetItem(const Index: PtrInt): TObject;
const cStrMethodName = 'GetItem';
begin
  CriticalSection.EnterCriticalSection;
  try
   GMCheckIntRange(RStrArrayIndex, Index, 0, FCount-1, Self, cStrMethodName);
   Result := FEntries^[Index];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMObjArrayCollection.SetItem(const Index: PtrInt; const Value: TObject);
const cStrMethodName = 'GetItem';
begin
  CriticalSection.EnterCriticalSection;
  try
   GMCheckIntRange(RStrArrayIndex, Index, 0, FCount-1, Self, cStrMethodName);
   if FreeEntries then FreePointer(FEntries^[Index]);
   FEntries^[Index] := Value;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.First: TObject;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount = 0 then Result := nil else Result := GetItem(0);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.Last: TObject;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount = 0 then Result := nil else Result := GetItem(FCount - 1);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.IndexOfObj(const AObj: TObject): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := IndexOfPointer(AObj);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMObjArrayCollection.RemoveByInstance(const AObj: TObject): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOfObj(AObj);
   Result := IsValidIndex(idx);
   if Result then RemoveByIdx(idx);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

{function TGMObjArrayCollection.FindObj(const Obj: TObject; var Index: LongInt): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Index := IndexOfObj(Obj);
   Result := IsValidIndex(Index);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;}


{ ------------------------------------- }
{ ---- TGMObjectCollectionIterator ---- }
{ ------------------------------------- }

procedure TGMObjectCollectionIterator.AssignOutEntry(out AEntry);
begin
  TObject(AEntry) := (FCollection as TGMObjArrayCollection)[FCurrentIdx];
end;


{ -------------------------------- }
{ ---- TGMIntfArrayCollection ---- }
{ -------------------------------- }

Constructor TGMIntfArrayCollection.Create(const AAcceptDuplicates: Boolean = True;
                                    const ASorted: Boolean = False;
                                    const ACompareFunc: TGMIntfCompareFunc = nil;
                                    const ARefLifeTime: Boolean = True);
begin
  inherited Create(AAcceptDuplicates, ASorted, ACompareFunc, ARefLifeTime);
  FFreeEntries := True;
end;

function TGMIntfArrayCollection.CreateIterator(const AReverse, AConcurrentThreadLock: Boolean): IGMIterator;
begin
  Result := TGMIntfArrayCollectionIterator.Create(Self, AConcurrentThreadLock, AReverse, True);
end;

function TGMIntfArrayCollection.EntryAsIntf(const AIndex: PtrInt): IUnknown;
begin
  Result := IUnknown(FEntries^[AIndex]);
end;

procedure TGMIntfArrayCollection.FreePointer(var AItem: Pointer);
begin
  //if AItem <> nil then IUnknown(AItem)._Relea<<<<<<<se;
  if AItem <> nil then IUnknown(AItem) := nil; // <- does a IUnknown(AItem)._Release
end;

procedure TGMIntfArrayCollection.SetOnAfterAddItem(const AValue: TGMIntfItemAddRemoveProc);
begin
  OnAfterAddItem := AValue;
end;

procedure TGMIntfArrayCollection.NotifyAfterAddItem(const AItem: Pointer; const AIndex: PtrInt);
begin
  if Assigned(OnAfterAddItem) then OnAfterAddItem(Self, IUnknown(AItem), AIndex);
end;

procedure TGMIntfArrayCollection.SetOnBeforeRemoveItem(const Value: TGMIntfItemAddRemoveProc);
begin
  OnBeforeRemoveItem := Value;
end;

procedure TGMIntfArrayCollection.NotifyBeforeRemoveItem(const AItem: Pointer; const AIndex: PtrInt);
begin
  if Assigned(OnBeforeRemoveItem) then OnBeforeRemoveItem(Self, IUnknown(AItem), AIndex);
end;

function TGMIntfArrayCollection.InsertAt(const AIntf: IUnknown; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean;
var unk: IUnknown; doInsert: Boolean;
begin
  GMQueryInterface(AIntf, IUnknown, unk); // <- Always add the real IUnknown representation for proper object identifications and iterator return values

  doInsert := FAcceptDuplicates or not IsDuplicate(unk, AIndex);
  Result := doInsert or AReplaceIfExists;

  if doInsert then
   begin InsertPointer(Pointer(unk), AIndex); unk._AddRef; end
  else
   if AReplaceIfExists then
      begin FreePointer(FEntries^[AIndex]); FEntries^[AIndex] := Pointer(unk); unk._AddRef; end;
end;

function TGMIntfArrayCollection.AddIdx(const AIntf: IUnknown; const AReplaceIfExists: Boolean): PtrInt;
var itemHolder: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   // Without an additional reference stack cleanup after return of InsertIdx may free a newly
   // created object (with refcount = 0) and the call to InsertAt would cause an access violation
   // And itemHolder will cleanup a refcount = 0 AIntf in case of exceptions
   itemHolder := AIntf;
   Result := InsertIdx(AIntf);
   InsertAt(AIntf, Result, AReplaceIfExists);
// if not InsertAt(AIntf, Result, AReplaceIfExists) then Result := cInvalidItemIdx;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.Add(const AIntf: IUnknown; const AReplaceIfExists: Boolean): IUnknown;
var itemHolder: IUnknown; idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   // Without an additional reference stack cleanup after return of InsertIdx may free a newly
   // created object (with refcount = 0) and the call to InsertAt would cause an access violation
   // And itemHolder will cleanup a refcount = 0 AIntf in case of exceptions
   itemHolder := AIntf;
   idx := InsertIdx(AIntf);
   InsertAt(AIntf, idx, AReplaceIfExists);
// if (FCount > 0) and (idx = FCount) then Dec(idx); // <- Dupliacte, not inserted!
   Result := IUnknown(FEntries^[idx]);
// if InsertAt(AIntf, idx, AReplaceIfExists) then Result := IUnknown(FEntries^[idx]) else Result := AIntf;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.Insert(const AIntf: IUnknown; const AIndex: PtrInt; const AReplaceIfExists: Boolean): IUnknown;
var itemHolder: IUnknown; idx: PtrInt;
begin
  // itemHolder will cleanup a refcount = 0 AIntf in case of exceptions
  CriticalSection.EnterCriticalSection;
  try
   itemHolder := AIntf;
   if FSorted then Result := Add(AIntf, AReplaceIfExists) else
    begin
     idx := AIndex;
     InsertAt(AIntf, idx, AReplaceIfExists);
     Result := IUnknown(FEntries^[idx]);
//   if InsertAt(AIntf, idx, AReplaceIfExists) then Result := AIntf; // else Result := nil
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var idx: PtrInt;
begin

  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOf(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then IUnknown(AEntry) := IUnknown(FEntries^[idx]);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOfNearest(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then IUnknown(AEntry) := IUnknown(FEntries^[idx]);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

{function TGMIntfArrayCollection.Remove(const Item: IUnknown): LongInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := IndexOfObj(Item);
   if Result <> cInvalidItemIdx then Delete(Result);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;}

function TGMIntfArrayCollection.GetItem(const Index: PtrInt): IUnknown;
const cStrMethodName = 'GetItem';
begin
  CriticalSection.EnterCriticalSection;
  try
   GMCheckIntRange(RStrArrayIndex, Index, 0, FCount-1, Self, cStrMethodName);
   Result := IUnknown(FEntries^[Index]);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.First: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount = 0 then Result := nil else Result := GetItem(0);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.Last: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount = 0 then Result := nil else Result := GetItem(FCount - 1);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.IndexOfObj(const AIntf: IUnknown): PtrInt;
var PIUnk: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   if GMQueryInterface(AIntf, IUnknown, PIUnk) then // <- Use the real IUnknown representation for proper object identification!
    Result := IndexOfPointer(Pointer(PIUnk))
   else
    Result := cInvalidItemIdx;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMIntfArrayCollection.RemoveByInstance(const AIntf: IUnknown): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOfObj(AIntf);
   Result := IsValidIndex(idx);
   if Result then RemoveByIdx(idx);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

{function TGMIntfArrayCollection.FindObj(const Intf: IUnknown; var Index: LongInt): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Index := IndexOfObj(Intf);
   Result := IsValidIndex(Index);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;}


{ ---------------------------------------- }
{ ---- TGMIntfArrayCollectionIterator ---- }
{ ---------------------------------------- }

procedure TGMIntfArrayCollectionIterator.AssignOutEntry(out AEntry);
begin
  IUnknown(AEntry) := (FCollection as TGMIntfArrayCollection)[FCurrentIdx];
end;


{ ---------------------------- }
{ ---- TGMAvlTreeNodeBase ---- }
{ ---------------------------- }

function TGMAvlTreeNodeBase.TreeHeight: LongInt;
var LeftHeight, RightHeight: LongInt;
begin
  if Left <> nil then LeftHeight := Left.TreeHeight + 1 else LeftHeight := 0;
  if Right <> nil then RightHeight := Right.TreeHeight + 1 else RightHeight := 0;
  Result := Max(LeftHeight, RightHeight);
end;

function TGMAvlTreeNodeBase.CalcBalance: LongInt;
var LeftHeight, RightHeight: LongInt;
begin
  if Left <> nil then LeftHeight := Left.TreeHeight + 1 else LeftHeight := 0;
  if Right <> nil then RightHeight := Right.TreeHeight + 1 else RightHeight := 0;
  Result := RightHeight - LeftHeight;
end;

procedure TGMAvlTreeNodeBase.ResetMembers;
begin
  Parent := nil;
  Left := nil;
  Right := nil;
  Balance := 0;
  //Data := nil;
end;

function TGMAvlTreeNodeBase.GetChild(const AIdx: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;
begin
  case AIdx of
   tndLeft: Result := Left;
   tndRight: Result := Right;
   else Result := nil;
  end;
end;

procedure TGMAvlTreeNodeBase.SetChild(const AIdx: TGMAvlTreeNodeDirection; const AValue: TGMAvlTreeNodeBase);
begin
  case AIdx of
   tndLeft: Left := AValue;
   tndRight: Right := AValue;
  end;
end;


{ ------------------------ }
{ ---- TGMAvlTreeBase ---- }
{ ------------------------ }

procedure TGMAvlTreeBase.Clear(const ANotify: Boolean);
  procedure FreeNodeMemory(ANode: TGMAvlTreeNodeBase);
  begin
    if ANode <> nil then begin
      if ANode.Left <> nil then FreeNodeMemory(ANode.Left);
      if ANode.Right <> nil then FreeNodeMemory(ANode.Right);
      FreeNode(ANode);
    end;
  end;
begin
  if IsEmpty then Exit;
  FreeNodeMemory(Root);
  Root := nil;
  if ANotify then NotifyAfterCountChanged(FCount, 0);
  FCount := 0;
end;

function TGMAvlTreeBase.CreateTreeNode: TGMAvlTreeNodeBase;
begin
  Result := TreeNodeCreateClass.Create;
end;

procedure TGMAvlTreeBase.FreeNode(const ANode: TGMAvlTreeNodeBase);
begin
  if ANode <> nil then ANode.Free;
end;

function TGMAvlTreeBase.AddNode(const ANode: TGMAvlTreeNodeBase; const AReplaceIfExists: Boolean): Boolean;
var unkNodeData: IUnknown;
begin
  CriticalSection.EnterCriticalSection;
  try
   ANode.Left := nil;
   ANode.Right := nil;
   if Root = nil then begin Root := ANode; ANode.Parent := nil; end else
    begin
     unkNodeData := ANode.GetDataAsIntf;
     ANode.Parent := FindInsertPos(unkNodeData);
     if ANode.Parent = nil then begin unkNodeData := nil; FreeNode(ANode); Result := False; Exit; end; // <- Is duplicate but FAcceptDuplicates = False
     case CompareEntries(unkNodeData, ANode.Parent.GetDataAsIntf) of
      crALessThanB: ANode.Parent.Left := ANode;
      //crAEqualToB: if FAcceptDuplicates then ANode.Parent.Right := ANode else begin FreeNode(ANode); Exit; end;
      //crAGreaterThanB: ANode.Parent.Right := ANode;
      else ANode.Parent.Right := ANode;
     end;
     BalanceAfterInsert(ANode);
   end;
   Inc(FCount);
   NotifyAfterCountChanged(FCount-1, FCount);
   Result := True;
// CheckIntegrity;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.FirstNode: TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := Root;
   if Result <> nil then while Result.Left <> nil do Result := Result.Left;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.LastNode: TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := Root;
   if Result <> nil then while Result.Right <> nil do Result := Result.Right;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function OppositeDirection(const ADirection: TGMAvlTreeNodeDirection): TGMAvlTreeNodeDirection;
begin
  Result := TGMAvlTreeNodeDirection((Ord(ADirection) + 1) mod (Ord(High(ADirection)) + 1));
end;

function TGMAvlTreeBase.Rotate(const ANode: TGMAvlTreeNodeBase; const ADirection: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;
//const cBalanceInc: array [TGMAvlTreeNodeDirection] of LongInt = (1, -1);
var PrntNode: TGMAvlTreeNodeBase; OppDir, d: TGMAvlTreeNodeDirection;
begin
  Result := ANode;
  if ANode = nil then Exit;

  OppDir := OppositeDirection(ADirection);
  Result := ANode[OppDir];
  if Result = nil then Exit;

  ANode[OppDir] := Result[ADirection];
  if Result[ADirection] <> nil then Result[ADirection].Parent := ANode;

  PrntNode := Anode.Parent;
  Result[ADirection] := ANode;
  ANode.Parent := Result;

  Result.Parent := PrntNode;
  if PrntNode = nil then Root := Result else
   for d:=Low(d) to High(d) do if PrntNode[d] = ANode then
    begin
     PrntNode[d] := Result;
     //if Result.Balance <> 0 then Inc(PrntNode.Balance, cBalanceInc[d]);
     Break;
    end;

//ANode.Balance := cBalanceInc[ADirection] - Result.Balance;
//Inc(Result.Balance, cBalanceInc[ADirection]);
end;

function TGMAvlTreeBase.DoubleRotate(const ANode: TGMAvlTreeNodeBase; const ADirection: TGMAvlTreeNodeDirection): TGMAvlTreeNodeBase;
var OppDir: TGMAvlTreeNodeDirection;
begin
  Result := ANode;
  if ANode = nil then Exit;
  OppDir := OppositeDirection(ADirection);
  Rotate(ANode[OppDir], OppDir);
  Result := Rotate(ANode, ADirection);
end;

procedure TGMAvlTreeBase.BalanceAfterInsert(const ANode: TGMAvlTreeNodeBase);
const cBalanceInc: array [TGMAvlTreeNodeDirection] of LongInt = (-1, 1); cStrMethodName = 'BalanceAfterInsert';
var ParentNode, ChildNode: TGMAvlTreeNodeBase; Dir, OppDir: TGMAvlTreeNodeDirection;
begin
  if (ANode = nil) or (ANode.Parent = nil) then Exit;
  ParentNode := ANode.Parent;
  if ParentNode.Left = ANode then Dir := tndLeft else
   if ParentNode.Right = ANode then Dir := tndRight else
    {$IFNDEF STANDALONE_COLLECTIONS}
    raise EGMException.ObjError(RStrNodeParentLinkError, ANode, cStrMethodName);
    {$ELSE}
    raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(ANode), cStrErrNameSep, cStrMethodName), ': ', RStrNodeParentLinkError));
    {$ENDIF}

  OppDir := OppositeDirection(Dir);
  Inc(ParentNode.Balance, cBalanceInc[Dir]);
  if ParentNode.Balance = 0 then Exit;
  if ParentNode.Balance = cBalanceInc[Dir] then begin BalanceAfterInsert(ParentNode); Exit; end;
  if ANode.Balance = cBalanceInc[Dir] then
   begin
    Rotate(Anode.Parent, OppDir);
    ANode.Balance := 0;
    ParentNode.Balance := 0;
   end
  else
   begin
    ChildNode := ANode[OppDir];
    DoubleRotate(Anode.Parent, OppDir);
    case Dir of
     tndLeft: if ChildNode.Balance <= 0 then ANode.Balance := 0 else ANode.Balance := -1;
     tndRight: if ChildNode.Balance >= 0 then ANode.Balance := 0 else ANode.Balance := 1;
    end;
    if ChildNode.Balance = cBalanceInc[Dir] then ParentNode.Balance := cBalanceInc[OppDir] else ParentNode.Balance := 0;
    ChildNode.Balance := 0;
  end;
end;

procedure TGMAvlTreeBase.BalanceAfterDelete(const ANode: TGMAvlTreeNodeBase);
var NodeParent, RightChild, RightLeftchild, LeftChild, LeftRightChild: TGMAvlTreeNodeBase;
begin
  if (ANode = nil) then Exit;
  if ((ANode.Balance = 1) or (ANode.Balance = -1)) then Exit;
  NodeParent := ANode.Parent;
  if ANode.Balance = 0 then begin
    // Treeheight has decreased by one
    if NodeParent <> nil then begin
      if NodeParent.Left = ANode then Inc(NodeParent.Balance) else Dec(NodeParent.Balance);
      BalanceAfterDelete(NodeParent);
    end;
   Exit;
  end;

  if ANode.Balance = 2 then begin
    // Node is overweighted to the right
    RightChild := ANode.Right;
    if RightChild.Balance >= 0 then begin
      // RightChild.Balance is 0 or -1
      Rotate(ANode, tndLeft);
      ANode.Balance := 1 - RightChild.Balance;
      Dec(RightChild.Balance);
      BalanceAfterDelete(RightChild);
    end else begin
      // RightChild.Balance is -1
      RightLeftchild := RightChild.Left;
      DoubleRotate(ANode, tndLeft);
      if RightLeftchild.Balance <= 0 then ANode.Balance := 0 else ANode.Balance := -1;
      if RightLeftchild.Balance >= 0 then RightChild.Balance := 0 else RightChild.Balance := 1;
      RightLeftchild.Balance := 0;
      BalanceAfterDelete(RightLeftchild);
    end;
  end else begin
    // Node.Balance is -2
    // Node is overweighted to the left
    LeftChild := ANode.Left;
    if (LeftChild.Balance <= 0) then begin
      Rotate(ANode, tndRight);
      ANode.Balance := -1 - LeftChild.Balance;
      Inc(LeftChild.Balance);
      BalanceAfterDelete(LeftChild);
    end else begin
      // LeftChild.Balance is 1
      LeftRightChild := LeftChild.Right;
      DoubleRotate(ANode, tndRight);
      if LeftRightChild.Balance >= 0 then ANode.Balance := 0 else ANode.Balance := 1;
      if LeftRightChild.Balance <= 0 then LeftChild.Balance := 0 else LeftChild.Balance := -1;
      LeftRightChild.Balance := 0;
      BalanceAfterDelete(LeftRightChild);
    end;
  end;
end;

procedure TGMAvlTreeBase.DeleteNode(const ANode: TGMAvlTreeNodeBase);
var OldParent, OldLeft, OldRight, Successor, OldSuccParent, OldSuccLeft, OldSuccRight: TGMAvlTreeNodeBase; OldBalance: LongInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   OldParent := ANode.Parent;
   OldBalance := ANode.Balance;
   ANode.Parent := nil;
   ANode.Balance := 0;
   if ((ANode.Left = nil) and (ANode.Right = nil)) then begin
     // Node is Leaf (no children)
     if OldParent <> nil then begin
       // Node has parent
       if OldParent.Left = ANode then
        begin OldParent.Left := nil; Inc(OldParent.Balance); end // <- Node is left Son of OldParent
       else
        begin OldParent.Right := nil; Dec(OldParent.Balance); end; // <- Node is right Son of OldParent
       BalanceAfterDelete(OldParent);
     end else Root := nil; // <- Node is the only node in the tree
     Dec(FCount);
     FreeNode(ANode);
     NotifyAfterCountChanged(FCount+1, FCount);
     Exit;
   end;
   if ANode.Right = nil then begin
     // Left is only son
     // and because DelNode is AVL, Right has no childrens
     // replace DelNode with Left
     OldLeft := ANode.Left;
     ANode.Left := nil;
     OldLeft.Parent := OldParent;
     if (OldParent <> nil) then begin
       if (OldParent.Left=ANode) then
        begin OldParent.Left := OldLeft; Inc(OldParent.Balance); end
       else
        begin OldParent.Right := OldLeft; Dec(OldParent.Balance); end;
       BalanceAfterDelete(OldParent);
     end else begin
       Root := OldLeft;
     end;
     Dec(FCount);
     FreeNode(ANode);
     NotifyAfterCountChanged(FCount+1, FCount);
     Exit;
   end;
   if ANode.Left = nil then begin
     // Right is only son
     // and because DelNode is AVL, Left has no childrens
     // replace DelNode with Right
     OldRight := ANode.Right;
     ANode.Right := nil;
     OldRight.Parent := OldParent;
     if (OldParent <> nil) then begin
       if (OldParent.Left=ANode) then
        begin OldParent.Left := OldRight; Inc(OldParent.Balance); end
       else
        begin OldParent.Right := OldRight; Dec(OldParent.Balance); end;
       BalanceAfterDelete(OldParent);
     end else begin
       Root := OldRight;
     end;
     Dec(FCount);
     FreeNode(ANode);
     NotifyAfterCountChanged(FCount+1, FCount);
     Exit;
   end;
   // DelNode has both: Left and Right
   // Replace ANode with symmetric Successor
   Successor := SuccessorNode(ANode);
   OldLeft := ANode.Left;
   OldRight := ANode.Right;
   OldSuccParent := Successor.Parent;
   OldSuccLeft := Successor.Left;
   OldSuccRight := Successor.Right;
   ANode.Balance := Successor.Balance;
   Successor.Balance := OldBalance;
   if OldSuccParent <> ANode then begin
     // at least one node between ANode and Successor
     ANode.Parent := Successor.Parent;
     if OldSuccParent.Left = Successor then OldSuccParent.Left := ANode else OldSuccParent.Right := ANode;
     Successor.Right := OldRight;
     OldRight.Parent := Successor;
   end else begin
     // Successor is right son of ANode
     ANode.Parent := Successor;
     Successor.Right := ANode;
   end;
   Successor.Left := OldLeft;
   if OldLeft <> nil then OldLeft.Parent := Successor;
   Successor.Parent := OldParent;
   ANode.Left := OldSuccLeft;
   if ANode.Left <> nil then ANode.Left.Parent := ANode;
   ANode.Right := OldSuccRight;
   if ANode.Right <> nil then ANode.Right.Parent := ANode;
   if OldParent <> nil then begin
     if (OldParent.Left=ANode) then OldParent.Left := Successor else OldParent.Right := Successor;
   end else
     Root := Successor;

   DeleteNode(ANode); // <- recursive call!
// CheckIntegrity;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
var Node: TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Node := FindNode(AKeyToCompare);
   Result := Node <> nil;
   if Result then DeleteNode(Node);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.RemoveByInstance(const AInstance): Boolean;
var node: TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   node := FirstNode; Result := False;
   while node <> nil do
    begin
     if node.IsDataInstance(AInstance) then begin DeleteNode(node); Result := True; Break; end;
     node := SuccessorNode(node);
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.FindNode(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := Root;
   while Result <> nil do
    case CompareEntries(AKeyToCompare, Result.GetDataAsIntf) of
     crALessThanB: Result := Result.Left;
     crAEqualToB: Break;
     crAGreaterThanB: Result := Result.Right;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.FindNearestNode(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := Root;
   while Result <> nil do
    case CompareEntries(AKeyToCompare, Result.GetDataAsIntf) of
     crALessThanB: if Result.Left <> nil then Result := Result.Left else Break;
     crAEqualToB: Break;
     crAGreaterThanB: if Result.Right <> nil then Result := Result.Right else Break;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.FindInsertPos(const AKeyToCompare: IUnknown): TGMAvlTreeNodeBase;
Label GreaterThanCase;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := Root;
   while Result <> nil do
    case CompareEntries(AKeyToCompare, Result.GetDataAsIntf) of
     crALessThanB: if Result.Left <> nil then Result := Result.Left else Break;
     crAEqualToB: if FAcceptDuplicates then goto GreaterThanCase else begin Result := nil; Break; end;
     crAGreaterThanB: GreaterThanCase: if Result.Right <> nil then Result := Result.Right else Break;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.SuccessorNode(const ANode: TGMAvlTreeNodeBase): TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   if ANode = nil then begin Result := nil; Exit; end;
   Result := ANode.Right;
   if Result <> nil then begin while Result.Left <> nil do Result := Result.Left; end
   else begin
     Result := ANode;
     while (Result.Parent <> nil) and (Result.Parent.Right = Result) do Result := Result.Parent;
     Result := Result.Parent;
   end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMAvlTreeBase.PredecessorNode(const ANode: TGMAvlTreeNodeBase): TGMAvlTreeNodeBase;
begin
  CriticalSection.EnterCriticalSection;
  try
   if ANode = nil then begin Result := nil; Exit; end;
   Result := ANode.Left;
   if Result <> nil then begin while Result.Right <> nil do Result := Result.Right; end
   else begin
     Result := ANode;
     while (Result.Parent <> nil) and (Result.Parent.Left = Result) do Result := Result.Parent;
     Result := Result.Parent;
   end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMAvlTreeBase.CheckIntegrity;
var checkCount: integer;
  procedure RaiseIntegrityException(const AMsg: String);
  begin
    raise Exception.Create(RStrAvlTreeIntegrityViolation + ': ' + AMsg);
  end;

  procedure CheckNode(ANode: TGMAvlTreeNodeBase);
  var LeftHeight, RightHeight: integer;
  begin
    if ANode = nil then Exit;
    Inc(checkCount);

    // Check left child
    if ANode.Left <> nil then begin
      if ANode.Left.Parent <> ANode then RaiseIntegrityException(RStrLeftChildsParentNotUs);
      if CompareEntries(ANode.Left.GetDataAsIntf, ANode.GetDataAsIntf) = crAGreaterThanB then
         RaiseIntegrityException(RStrLeftChildGreaterThanUs);
      CheckNode(ANode.Left);
    end;

    // Check right child
    if ANode.Right <> nil then begin
      if ANode.Right.Parent <> ANode then RaiseIntegrityException(RStrRightChildsParentNotUs);
      if CompareEntries(ANode.GetDataAsIntf, ANode.Right.GetDataAsIntf) = crAGreaterThanB then
         RaiseIntegrityException(RStrWeGreaterThanRightChild);
      CheckNode(ANode.Right);
    end;

    // Check balance
    if ANode.Left <> nil then LeftHeight := ANode.Left.TreeHeight + 1 else LeftHeight := 0;
    if ANode.Right <> nil then RightHeight := ANode.Right.TreeHeight + 1 else RightHeight := 0;
    if ANode.Balance <> (RightHeight-LeftHeight) then
       RaiseIntegrityException(GMFormat(RStrWrongNodeBalanceFmt, [ANode.Balance, RightHeight-LeftHeight]));
  end;
begin
  CriticalSection.EnterCriticalSection;
  try
   checkCount := 0;
   CheckNode(Root);
   if FCount <> checkCount then RaiseIntegrityException(GMFormat(RStrWrongNodeCountFmt, [FCount, checkCount]));
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMAvlTreeBase.SetCompareFunc(const AValue: TGMIntfCompareFunc);
var Nodes: array of TGMAvlTreeNodeBase; Node: TGMAvlTreeNodeBase; i, OldCount: integer;
begin
  CriticalSection.EnterCriticalSection;
  try
   if Addr(FCompareFunc) = Addr(AValue) then Exit;

   if Count = 0 then FCompareFunc := AValue else
    begin
     OldCount := Count;
     SetLength(Nodes, OldCount);
     Node := FirstNode;
     i := Low(Nodes);
     while Node <> nil do begin Nodes[i] := Node; Inc(i); Node := SuccessorNode(Node); end;
     Root := nil; FCount := 0;
     FCompareFunc := AValue;
     for i:=Low(Nodes) to High(Nodes) do AddNode(Nodes[i], False);
   end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;


{ -------------------------------- }
{ ---- TGMAvlTreeIteratorBase ---- }
{ -------------------------------- }

function TGMAvlTreeIteratorBase.NextEntry(out AEntry): Boolean;
begin
  Result := FCurrentNode <> nil;
  if Result then
   begin
    AssignOutEntry(AEntry);
    if FReverse then
     FCurrentNode := (FCollection as TGMAvlTreeBase).PredecessorNode(FCurrentNode)
    else
     FCurrentNode := (FCollection as TGMAvlTreeBase).SuccessorNode(FCurrentNode);
   end;
end;

procedure TGMAvlTreeIteratorBase.Reset;
begin
  if FReverse then
   FCurrentNode := (FCollection as TGMAvlTreeBase).LastNode
  else
   FCurrentNode := (FCollection as TGMAvlTreeBase).FirstNode;
end;


{ --------------------------- }
{ ---- TGMAvlObjTreeNode ---- }
{ --------------------------- }

function TGMAvlObjTreeNode.GetDataAsIntf: IUnknown;
begin
  Result := GMObjAsIntf(Data);
end;

function TGMAvlObjTreeNode.IsDataInstance(const AInstance): Boolean;
begin
  Result := Data = TObject(AInstance);
end;


{ ----------------------- }
{ ---- TGMAvlObjTree ---- }
{ ----------------------- }

constructor TGMAvlObjTree.Create(const AFreeEntries: Boolean; const AAcceptDuplicates: Boolean;
  const ACompareFunc: TGMIntfCompareFunc; const ARefLifeTime: Boolean);
begin
  inherited Create(AAcceptDuplicates, ACompareFunc, ARefLifeTime);
  FFreeEntries := AFreeEntries;
end;

function TGMAvlObjTree.TreeNodeCreateClass: TGMAvlTreeNodeClass;
begin
  Result := TGMAvlObjTreeNode;
end;

function TGMAvlObjTree.CreateIterator(const AReverse, AConcurrentThreadLock: Boolean): IGMIterator;
begin
  Result := TGMAvlObjectTreeIterator.Create(Self, AConcurrentThreadLock, AReverse, True);
end;

function TGMAvlObjTree.Add(const ANewEntry: TObject; const AReplaceIfExists: Boolean): TObject;
var NewNode: TGMAvlTreeNodeBase;
begin
  NewNode := CreateTreeNode;
  (NewNode as TGMAvlObjTreeNode).Data := ANewEntry;
  if AddNode(NewNode, AReplaceIfExists) then Result := ANewEntry else Result := nil;
end;

procedure TGMAvlObjTree.FreeNode(const ANode: TGMAvlTreeNodeBase);
begin
  if FFreeEntries and ((ANode as TGMAvlObjTreeNode).Data <> nil) then TGMAvlObjTreeNode(ANode).Data.Free; //GMFreeAndNil((ANode as TGMAvlObjTreeNode).Data); // .Free;
  inherited FreeNode(ANode);
end;

function TGMAvlObjTree.Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FindNode(AKeyToCompare);
  Result := (Node is TGMAvlObjTreeNode) and (TGMAvlObjTreeNode(Node).Data <> nil);
  if Result then TObject(AEntry) := TGMAvlObjTreeNode(Node).Data;
end;

function TGMAvlObjTree.FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FindNearestNode(AKeyToCompare);
  Result := (Node is TGMAvlObjTreeNode) and (TGMAvlObjTreeNode(Node).Data <> nil);
  if Result then TObject(AEntry) := TGMAvlObjTreeNode(Node).Data;
end;

function TGMAvlObjTree.RemoveByInstance(const AObj: TObject): Boolean;
begin
  Result := inherited RemoveByInstance(AObj);
end;

function TGMAvlObjTree.First: TObject;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FirstNode;
  if Node = nil then Result := nil else Result := (Node as TGMAvlObjTreeNode).Data;
end;

function TGMAvlObjTree.Last: TObject;
var Node: TGMAvlTreeNodeBase;
begin
  Node := LastNode;
  if Node = nil then Result := nil else Result := (Node as TGMAvlObjTreeNode).Data;
end;


{ ---------------------------------- }
{ ---- TGMAvlObjectTreeIterator ---- }
{ ---------------------------------- }

procedure TGMAvlObjectTreeIterator.AssignOutEntry(out AEntry);
begin
  TObject(AEntry) := (FCurrentNode as TGMAvlObjTreeNode).Data;
end;


{ ---------------------------- }
{ ---- TGMAvlIntfTreeNode ---- }
{ ---------------------------- }

function TGMAvlIntfTreeNode.GetDataAsIntf: IUnknown;
begin
  Result := Data;
end;

function TGMAvlIntfTreeNode.IsDataInstance(const AInstance): Boolean;
var Unk: IUnknown;
begin
  GMQueryInterface(IUnknown(AInstance), IUnknown, unk); // <- Use the real IUnknown representation for proper object identifications
  Result := Data = unk;
end;


{ ------------------------ }
{ ---- TGMAvlIntfTree ---- }
{ ------------------------ }

function TGMAvlIntfTree.TreeNodeCreateClass: TGMAvlTreeNodeClass;
begin
  Result := TGMAvlIntfTreeNode;
end;

function TGMAvlIntfTree.CreateIterator(const AReverse, AConcurrentThreadLock: Boolean): IGMIterator;
begin
  Result := TGMAvlIntfTreeIterator.Create(Self, AConcurrentThreadLock, AReverse, True);
end;

function TGMAvlIntfTree.Add(const ANewEntry: IUnknown; const AReplaceIfExists: Boolean): IUnknown;
var NewNode: TGMAvlTreeNodeBase; unk: IUnknown;
begin
  GMQueryInterface(ANewEntry, IUnknown, unk); // <- Always add the real IUnknown representation for proper object identifications
  NewNode := CreateTreeNode;
  (NewNode as TGMAvlIntfTreeNode).Data := unk;
  if AddNode(NewNode, AReplaceIfExists) then Result := ANewEntry else Result := nil;
end;

function TGMAvlIntfTree.Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FindNode(AKeyToCompare);
  Result := (Node is TGMAvlIntfTreeNode) and (TGMAvlIntfTreeNode(Node).Data <> nil);
  if Result then IUnknown(AEntry) := TGMAvlIntfTreeNode(Node).Data;
end;

function TGMAvlIntfTree.FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FindNearestNode(AKeyToCompare);
  Result := (Node is TGMAvlIntfTreeNode) and (TGMAvlIntfTreeNode(Node).Data <> nil);
  if Result then IUnknown(AEntry) := TGMAvlIntfTreeNode(Node).Data;
end;

function TGMAvlIntfTree.RemoveByInstance(const AIntf: IUnknown): Boolean;
var unk: IUnknown;
begin
  Result := GMQueryInterface(AIntf, IUnknown, unk) and inherited RemoveByInstance(unk);  // <- use real Iunknown representation for proper object identification
end;

function TGMAvlIntfTree.First: IUnknown;
var Node: TGMAvlTreeNodeBase;
begin
  Node := FirstNode;
  if Node = nil then Result := nil else Result := (Node as TGMAvlIntfTreeNode).Data;
end;

function TGMAvlIntfTree.Last: IUnknown;
var Node: TGMAvlTreeNodeBase;
begin
  Node := LastNode;
  if Node = nil then Result := nil else Result := (Node as TGMAvlIntfTreeNode).Data;
end;


{ -------------------------------- }
{ ---- TGMAvlIntfTreeIterator ---- }
{ -------------------------------- }

procedure TGMAvlIntfTreeIterator.AssignOutEntry(out AEntry);
begin
  IUnknown(AEntry) := (FCurrentNode as TGMAvlIntfTreeNode).Data;
end;


{ ---------------------------- }
{ ---- TGMHashEntryBucket ---- }
{ ---------------------------- }

constructor TGMHashEntryBucket.Create(const AHashTable: TGMHashTableBase; const ARefLifeTime: Boolean); // ; const AHashBitCount: Byte;
begin
  inherited Create(ARefLifeTime);
  FHashTable := AHashTable;
  //FHashBitCount := AHashBitCount;
end;

destructor TGMHashEntryBucket.Destroy;
begin
  Clear(True); SetCapacity(0); inherited;
end;

procedure TGMHashEntryBucket.Clear(const AFreeEntries: Boolean);
var i: LongInt;
begin
  if AFreeEntries and FHashTable.FFreeEntries then for i:=0 to FCount-1 do FHashTable.FreePointer(FEntries^[i]);
  FCount := 0;
end;

function TGMHashEntryBucket.Obj: TGMHashEntryBucket;
begin
  Result := Self;
end;

procedure TGMHashEntryBucket.SetCapacity(const NewCapacity: TBucketIdx);
begin
  {TODO: Bessere Fehlermeldung}
  //if (NewCapacity < 0) or (NewCapacity > cMaxPtrArraySize) then raise EGMException.ObjError(GMFormat(RStrListCapacityError, [NewCapacity, cMaxPtrArraySize]), Self, 'SetCapacity');
  if NewCapacity <> FCapacity then
   begin
    ReallocMem(FEntries, NewCapacity * SizeOf(Pointer));
    FCapacity := NewCapacity;
   end;
end;

function TGMHashEntryBucket.InsertIdx(const AKeyToCompare: IUnknown): TBucketIdx;
const cStrMethodName = 'InsertIdx';
  function _InsertIdx(L, R: TBucketIdx): TBucketIdx;
  var M: LongInt;
  begin
    if L >= R then Result := L else
     begin
      M := (L + R) shr 1;
      case FHashTable.CompareEntries(AKeyToCompare, FHashTable.EntryAsIntf(FEntries^[M])) of
       crAEqualToB, crALessThanB: Result := _InsertIdx(L, M);
       crAGreaterThanB: if L = M then Result := R else Result := _InsertIdx(M, R);
       else
        {$IFNDEF STANDALONE_COLLECTIONS}
        raise EGMException.ObjError(RStrInvalidCompareResult, Self, cStrMethodName);
        {$ELSE}
        raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(Self), cStrErrNameSep, cStrMethodName), ': ', RStrInvalidCompareResult));
        {$ENDIF}
      end;
     end;
  end;
begin
  Result := _InsertIdx(0, FCount);
end;

function TGMHashEntryBucket.FindIdxOfKey(const AKeyToCompare: IUnknown; var AIndex: TBucketIdx): Boolean;
begin
  AIndex := InsertIdx(AKeyToCompare);
  Result := GMIsInRange(AIndex, 0, FCount-1) and (FHashTable.CompareEntries(FHashTable.EntryAsIntf(FEntries^[AIndex]), AKeyToCompare) = crAEqualToB);
end;

function TGMHashEntryBucket.FindKey(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var idx: TBucketIdx;
begin
  Result := FindIdxOfKey(AKeyToCompare, idx);
  if Result then FHashTable.AssignOutEntry(FEntries^[idx], AEntry);
end;

function TGMHashEntryBucket.AddPointer(const ANewEntry: Pointer): Boolean;
var idx: LongInt; EntryIntf: IUnknown;
begin
  EntryIntf := FHashTable.EntryAsIntf(ANewEntry);
  idx := InsertIdx(EntryIntf);
  Result := FHashTable.FAcceptDuplicates or (idx = FCount) or (FHashTable.CompareEntries(EntryIntf, FHashTable.EntryAsIntf(FEntries^[idx])) <> crAEqualToB);
  if not Result then Exit;
  if FCount = FCapacity then SetCapacity(FCapacity + GrowDelta(FCapacity));
  if idx < FCount then System.Move(FEntries^[idx], FEntries^[idx + 1], (FCount - idx) * SizeOf(Pointer));
  FEntries^[idx] := ANewEntry;
  Inc(FCount);
end;

procedure TGMHashEntryBucket.RemoveByIdx(const AIdx: LongInt);
begin
  //NotifyBeforeRemoveItem(FEntries^[i], i);
  if FHashTable.FFreeEntries then FHashTable.FreePointer(FEntries^[AIdx]);
  Dec(FCount);
  if AIdx < FCount then System.Move(FEntries^[AIdx + 1], FEntries^[AIdx], (FCount - AIdx) * SizeOf(Pointer));
  if FCapacity - FCount >= GrowDelta(FCapacity) then SetCapacity(FCapacity - GrowDelta(FCapacity));
end;

function TGMHashEntryBucket.RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
var idx: TBucketIdx;
begin
  Result := FindIdxOfKey(AKeyToCompare, idx);
  if Result then RemoveByIdx(idx);
end;

function TGMHashEntryBucket.RemovePointer(const AInstance: Pointer): Boolean;
var i: LongInt;
begin
  for i:=0 to FCount-1 do if FEntries^[i] = AInstance then begin RemoveByIdx(i); Result := True; Exit; end;
  Result := False;
end;


{ --------------------------------- }
{ ---- TGMHashBitMaskDirectory ---- }
{ --------------------------------- }

constructor TGMHashBitMaskDirectory.Create(const AHashTable: TGMHashTableBase; const AMaxHashBits: Byte; const AHashBitOffs: Byte; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FHashTable := AHashTable;
  FHashBitOffs := AHashBitOffs;
  FMaxHashBits := AMaxHashBits;
end;

function TGMHashBitMaskDirectory.Obj: TGMHashBitMaskDirectory;
begin
  Result := Self;
end;

function TGMHashBitMaskDirectory.CalcDirEntryIndex(const AHashCode: TGMHashCode): LongInt;
begin
  Result := (AHashCode and FHashBitMask) shr (FHashBitOffs + FMaxHashBits - FHashBitCount);
end;

function TGMHashBitMaskDirectory.FindDirEntry(const AHashCode: TGMHashCode): IUnknown;
begin
  if Length(FDirEntries) = 0 then Exit{$IFDEF FPC}(nil){$ENDIF};
  Result := FDirEntries[CalcDirEntryIndex(AHashCode)];
end;

procedure TGMHashBitMaskDirectory.ExpandHash(const ADirEntryIdx: LongInt);
var NewSize, i: LongInt; DirEntry: IUnknown;
begin
  NewSize := Length(FDirEntries) * 2;
  if NewSize = 0 then NewSize := 1;
  SetLength(FDirEntries, NewSize);
  for i:=NewSize div 2 - 1 downto 0 do
   begin
    DirEntry := FDirEntries[i];
    FDirEntries[i*2] := DirEntry;
    FDirEntries[(i*2)+1] := DirEntry;
    if DirEntry <> nil then Inc(FAssignedCount); // <- original entries have already been counted!
   end;
  Inc(FHashBitCount);
  FHashBitMask := (FHashBitMask shr 1) or (1 shl (FHashBitOffs + FMaxHashBits - 1));
end;

function TGMHashBitMaskDirectory.FindBucket(const AHashCode: TGMHashCode; var ABucket: IGMHashEntryBucket): Boolean;
var DirEntry: IUnknown; SubDir: IGMHashBitMaskDirectory;
begin
  DirEntry := FindDirEntry(AHashCode);
  if DirEntry = nil then Result := False else
   begin
    if GMQueryInterface(DirEntry, IGMHashBitMaskDirectory, SubDir) then
     Result := SubDir.Obj.FindBucket(AHashCode, ABucket)
    else
     Result := GMQueryInterface(DirEntry, IGMHashEntryBucket, ABucket);
   end;
end;

procedure TGMHashBitMaskDirectory.ReHashBuketEntries(const ABucket: IGMHashEntryBucket);
var i: LongInt; BucketEntry: Pointer; ReHashCode: TGMHashCode;
begin
  for i:=0 to ABucket.Obj.FCount-1 do
   begin
    BucketEntry := ABucket.Obj.FEntries^[i];
    ReHashCode := FHashTable.BuildHashCode(FHashTable.EntryAsIntf(BucketEntry));
    {$IFDEF DEBUG}
    if not AddPointer(ReHashCode, BucketEntry) then RaiseError(RStrDuplicateHashEntry, Self);
    {$ELSE}
    AddPointer(ReHashCode, BucketEntry);
    {$ENDIF}
   end;
  ABucket.Obj.Clear(False);
end;

function TGMHashBitMaskDirectory.AddPointer(const AHashCode: TGMHashCode; const ANewEntry: Pointer): Boolean;
var DirEntryIdx, i: LongInt; DirEntry: IUnknown; Bucket: IGMHashEntryBucket; SubDir: IGMHashBitMaskDirectory;
begin
  if Length(FDirEntries) = 0 then SetLength(FDirEntries, 1);
  DirEntryIdx := CalcDirEntryIndex(AHashCode);
  DirEntry := FDirEntries[DirEntryIdx];

  if DirEntry = nil then
   begin
    Bucket := TGMHashEntryBucket.Create(FHashTable, True); // FHashBitCount, 
    FDirEntries[DirEntryIdx] := Bucket;
    Inc(FAssignedCount);
   end
  else
   if GMQueryInterface(DirEntry, IGMHashBitMaskDirectory, SubDir) then
    begin Result := SubDir.Obj.AddPointer(AHashCode, ANewEntry); Exit; end // <- Attention: Recursive call and Exit here!
   else
    GMQueryInterface(DirEntry, IGMHashEntryBucket, Bucket);

  if Bucket = nil then Result := False else
   begin
    if (Bucket.Obj.FCount < cMaxHashBucketSize) or (FHashBitCount + FHashBitOffs >= cMaxHashcodeBits) then
     Result := Bucket.Obj.AddPointer(ANewEntry)
    else
     begin
      // The bucket is full, extend hash bit mask or add new directories.
      // There may be more duplicates, but if there are duplicates, neighbours are always duplicate!
      if (Length(FDirEntries) > 1) and (FDirEntries[DirEntryIdx and $FE] = FDirEntries[DirEntryIdx or 1]) then
       begin
        // This two neighbours point to the same bucket, set it nil and re-hash to create a new bucket
        {TODO: loop only through relevant entries here}
        for i:=Low(FDirEntries) to High(FDirEntries) do
         if FDirEntries[i] = Bucket then begin FDirEntries[i] := nil; Dec(FAssignedCount); end;
       end
      else
       if FHashBitCount < FMaxHashBits then
        begin
         FDirEntries[DirEntryIdx] := nil;
         Dec(FAssignedCount);
         ExpandHash(DirEntryIdx);
        end else
         FDirEntries[DirEntryIdx] := TGMHashBitMaskDirectory.Create(FHashTable, Max(FMaxHashBits-1, cMinHashBitsPerDirLevel), FHashBitOffs + FHashBitCount, FRefLifeTime);

      ReHashBuketEntries(Bucket);
      Result := AddPointer(AHashCode, ANewEntry);
     end;
   end;
end;

function TGMHashBitMaskDirectory.RemoveByKey(const AHashCode: TGMHashCode; const AKeyToCompare: IUnknown): Boolean;
var dirEntryIdx: TBucketDirIdx; dirEntry: IUnknown; SubDir: IGMHashBitMaskDirectory; Bucket: IGMHashEntryBucket;
begin
  Result := False;
  if Length(FDirEntries) = 0 then Exit;
  dirEntryIdx := CalcDirEntryIndex(AHashCode);
  dirEntry := FDirEntries[dirEntryIdx];
  if dirEntry <> nil then
   begin
    if GMQueryInterface(dirEntry, IGMHashBitMaskDirectory, SubDir) then
     begin
      Result := SubDir.Obj.RemoveByKey(AHashCode, AKeyToCompare);
      if Result and (SubDir.Obj.FAssignedCount = 0) then begin FDirEntries[dirEntryIdx] := nil; Dec(FAssignedCount); end;
     end else
      if GMQueryInterface(dirEntry, IGMHashEntryBucket, Bucket) then
       begin
        Result := Bucket.Obj.RemoveByKey(AKeyToCompare);
        {TODO: add case for merging buckets and shrink directory size}
        if Result and (Bucket.Obj.FCount = 0) then begin FDirEntries[dirEntryIdx] := nil; Dec(FAssignedCount); end;
       end;
   end;
end;

function TGMHashBitMaskDirectory.RemovePointer(const AInstance: Pointer): Boolean;
var i: LongInt; subDir: IGMHashBitMaskDirectory; bucket: IGMHashEntryBucket;
begin
  Result := False;
  for i:=Low(FDirEntries) to High(FDirEntries) do
   if FDirEntries[i] <> nil then
    begin
     if GMQueryInterface(FDirEntries[i], IGMHashBitMaskDirectory, subDir) then
      begin
       Result := subDir.Obj.RemovePointer(AInstance);
       if Result and (subDir.Obj.FAssignedCount = 0) then begin FDirEntries[i] := nil; Dec(FAssignedCount); end;
      end else
       if GMQueryInterface(FDirEntries[i], IGMHashEntryBucket, bucket) then
        begin
         Result := bucket.Obj.RemovePointer(AInstance);
         {TODO: add case for merging buckets and shrink directory size}
         if Result and (bucket.Obj.FCount = 0) then begin FDirEntries[i] := nil; Dec(FAssignedCount); end;
        end;
      if Result then Break;
    end;
end;

function TGMHashBitMaskDirectory.FirstEntry: Pointer;
label SearchDirEntry;
var DirEntryIdx: TBucketDirIdx; SubDir: IGMHashBitMaskDirectory; Bucket: IGMHashEntryBucket;
begin
  Result := nil;
  DirEntryIdx := Low(FDirEntries);
  SearchDirEntry:
  while (DirEntryIdx <= High(FDirEntries)) and (FDirEntries[DirEntryIdx] = nil) do Inc(DirEntryIdx);

  if DirEntryIdx > High(FDirEntries) then Exit;

  if GMQueryInterface(FDirEntries[DirEntryIdx], IGMHashBitMaskDirectory, SubDir) then Result := SubDir.Obj.FirstEntry
  else
  if GMQueryInterface(FDirEntries[DirEntryIdx], IGMHashEntryBucket, Bucket) then
   if Bucket.Obj.FCount > 0 then Result := Bucket.Obj.FEntries[0] else
    begin Inc(DirEntryIdx); goto SearchDirEntry; end;
end;

function TGMHashBitMaskDirectory.LastEntry: Pointer;
label SearchDirEntry;
var DirEntryIdx: LongInt; SubDir: IGMHashBitMaskDirectory; Bucket: IGMHashEntryBucket;
begin
  Result := nil;
  DirEntryIdx := High(FDirEntries);
  SearchDirEntry:
  while (DirEntryIdx >= Low(FDirEntries)) and (FDirEntries[DirEntryIdx] = nil) do Dec(DirEntryIdx);

  if DirEntryIdx < Low(FDirEntries) then Exit;

  if GMQueryInterface(FDirEntries[DirEntryIdx], IGMHashBitMaskDirectory, SubDir) then Result := SubDir.Obj.FirstEntry
  else
  if GMQueryInterface(FDirEntries[DirEntryIdx], IGMHashEntryBucket, Bucket) then
   if Bucket.Obj.FCount > 0 then Result := Bucket.Obj.FEntries[Bucket.Obj.FCount-1] else
    begin Dec(DirEntryIdx); goto SearchDirEntry; end;
end;


{ -------------------------- }
{ ---- TGMHashTableBase ---- }
{ -------------------------- }

function TGMHashTableBase.CreateIterator(const AReverse, AConcurrentThreadLock: Boolean): IGMIterator;
begin
  Result := TGMHashTableIterator.Create(Self, AConcurrentThreadLock, AReverse, True);
end;

function TGMHashTableBase.BuildHashCode(const AKeyToCompare: IUnknown): TGMHashCode;
var PIHashCode: IGMHashCode;
begin
  GMCheckQueryInterface(AKeyToCompare, IGMHashCode, PIHashCode, 'BuildHashCode');
  Result := PIHashCode.HashCode;
end;

procedure TGMHashTableBase.Clear(const ANotify: Boolean);
var OldCount: LongInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FRootDirectory = nil then Exit;
   FRootDirectory := nil;
   OldCount := FCount;
   FCount := 0;
   if ANotify then NotifyAfterCountChanged(OldCount, 0);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMHashTableBase.AddPointer(const AHashCode: TGMHashCode; ANewEntry: Pointer): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FRootDirectory = nil then FRootDirectory := TGMHashBitMaskDirectory.Create(Self, cMaxHashBitsPerDirLevel, 0, True);
   Result := FRootDirectory.Obj.AddPointer(AHashCode, ANewEntry);
   if Result then
     begin Inc(FCount); NotifyAfterCountChanged(FCount-1, FCount); end
    else
     if FFreeEntries then FreePointer(ANewEntry);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMHashTableBase.DoAfterRemove;
begin
  if FRootDirectory.Obj.FAssignedCount = 0 then FRootDirectory := nil;
  Dec(FCount);
  NotifyAfterCountChanged(FCount+1, FCount);
end;

function TGMHashTableBase.RemoveByKey(const AKeyToCompare: IUnknown): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := (FRootDirectory <> nil) and FRootDirectory.Obj.RemoveByKey(BuildHashCode(AKeyToCompare), AKeyToCompare);
   if Result then DoAfterRemove;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMHashTableBase.RemovePointer(const AInstance: Pointer): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := (FRootDirectory <> nil) and FRootDirectory.Obj.RemovePointer(AInstance);
   if Result then DoAfterRemove;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMHashTableBase.Find(const AKeyToCompare: IUnknown; out AEntry): Boolean;
var PIBucket: IGMHashEntryBucket;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := (FRootDirectory <> nil) and FRootDirectory.Obj.FindBucket(BuildHashCode(AKeyToCompare), PIBucket) and PIBucket.Obj.FindKey(AKeyToCompare, AEntry);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMHashTableBase.FindNearest(const AKeyToCompare: IUnknown; out AEntry): Boolean;
begin
  raise Exception.Create(GMFormat(RStrNoNearestInHashFmt, [ClassName]));
end;

function TGMHashTableBase.FirstEntry: Pointer;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FRootDirectory = nil then Result := nil else Result := FRootDirectory.Obj.FirstEntry
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMHashTableBase.LastEntry: Pointer;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FRootDirectory = nil then Result := nil else Result := FRootDirectory.Obj.LastEntry
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;


{ ------------------------------ }
{ ---- TGMHashTableIterator ---- }
{ ------------------------------ }

// Some Statistics, useful for parameter optimization
//var
//  BucketCount: LongInt = 0;
//  SingleBucketCount: LongInt = 0;

function TGMHashTableIterator.NextEntry(out AEntry): Boolean;
var StackData: PHashIteratorStackRec; DirEntry: IUnknown; SubDir: IGMHashBitMaskDirectory; //Bucket: IGMHashEntryBucket;
  procedure NextIndex(var AIndex: LongInt);
  begin
    if FReverse then Dec(AIndex) else Inc(AIndex);
  end;

  function TellBucketEntry: Boolean;
  begin
    if (FCurrentBucket = nil) or (FCurrentBucketEntryIdx < 0) or (FCurrentBucketEntryIdx >= FCurrentBucket.Obj.FCount) then
     Result := False
    else
     begin
      (FCollection as TGMHashTableBase).AssignOutEntry(FCurrentBucket.Obj.FEntries[FCurrentBucketEntryIdx], AEntry);
      if (FReverse and (FCurrentBucketEntryIdx > 0)) or (not FReverse and (FCurrentBucketEntryIdx < FCurrentBucket.OBj.FCount-1)) then
       NextIndex(FCurrentBucketEntryIdx)
      else
       begin
        FCurrentBucketEntryIdx := -1;
        NextIndex(StackData.DirEntryIdx);
        with StackData^ do
         while (DirEntryIdx >= Low(Directory.Obj.FDirEntries)) and (DirEntryIdx <= High(Directory.Obj.FDirEntries)) and
               (Directory.Obj.FDirEntries[DirEntryIdx] = FCurrentBucket) do NextIndex(StackData.DirEntryIdx);
        FCurrentBucket := nil;
       end;
      Result := True;
     end;
  end;
begin
  Result := False;

  if Length(FDirStack) = 0 then Exit;
  StackData := @FDirStack[High(FDirStack)];
  if StackData.Directory = nil then Exit;

  if TellBucketEntry then begin Result := True; Exit; end;

  with StackData^ do
   while (DirEntryIdx >= Low(Directory.Obj.FDirEntries)) and (DirEntryIdx <= High(Directory.Obj.FDirEntries)) and
         (Directory.Obj.FDirEntries[DirEntryIdx] = nil) do NextIndex(StackData.DirEntryIdx);

  if (StackData.DirEntryIdx < Low(StackData.Directory.Obj.FDirEntries)) or
     (StackData.DirEntryIdx > High(StackData.Directory.Obj.FDirEntries)) then
   begin
    SetLength(FDirStack, Length(FDirStack)-1);
    if Length(FDirStack) = 0 then Exit;
    NextIndex(FDirStack[High(FDirStack)].DirEntryIdx);
    Result := NextEntry(AEntry);
    Exit;
   end;

  DirEntry := StackData.Directory.Obj.FDirEntries[StackData.DirEntryIdx];

  if GMQueryInterface(DirEntry, IGMHashEntryBucket, FCurrentBucket) then
   begin
    //Inc(BucketCount);
    //if FCurrentBucket.Obj.FCount = 1 then Inc(SingleBucketCount);
    if FReverse then FCurrentBucketEntryIdx := FCurrentBucket.Obj.FCount-1 else FCurrentBucketEntryIdx := 0;
    if TellBucketEntry then Result := True else
     begin
      FCurrentBucket := nil;
      NextIndex(StackData.DirEntryIdx);
      Result := NextEntry(AEntry);
     end;
   end else
  if GMQueryInterface(DirEntry, IGMHashBitMaskDirectory, SubDir) then
   begin
    SetLength(FDirStack, Length(FDirStack)+1);
    FDirStack[High(FDirStack)].Directory := SubDir;
    if FReverse then FDirStack[High(FDirStack)].DirEntryIdx := High(SubDir.Obj.FDirEntries) else FDirStack[High(FDirStack)].DirEntryIdx := 0;
    Result := NextEntry(AEntry);
   end;
end;

procedure TGMHashTableIterator.Reset;
var RootDir: IGMHashBitMaskDirectory;
begin
  if not (FCollection is TGMHashTableBase) or ((FCollection as TGMHashTableBase).FRootDirectory = nil) then SetLength(FDirStack, 0) else
   begin
    SetLength(FDirStack, 1);
    RootDir := (FCollection as TGMHashTableBase).FRootDirectory;
    FDirStack[Low(FDirStack)].Directory := RootDir;
    if FReverse then FDirStack[Low(FDirStack)].DirEntryIdx := High(RootDir.Obj.FDirEntries) else FDirStack[Low(FDirStack)].DirEntryIdx := 0;
   end;

  FCurrentBucket := nil;
  FCurrentBucketEntryIdx := -1;
end;


{ ------------------------- }
{ ---- TGMObjHashTable ---- }
{ ------------------------- }

constructor TGMObjHashTable.Create(const AFreeEntries,
  AAcceptDuplicates: Boolean; const ACompareFunc: TGMIntfCompareFunc;
  const ARefLifeTime: Boolean);
begin
  inherited Create(AAcceptDuplicates, ACompareFunc, ARefLifeTime);
  FFreeEntries := AFreeEntries;
end;

procedure TGMObjHashTable.AssignOutEntry(const AEntryPtr: Pointer; out AEntry);
begin
  TObject(AEntry) := AEntryPtr;
end;

procedure TGMObjHashTable.FreePointer(var AEntryPtr: Pointer);
begin
  //if AEntryPtr <> nil then TObject(AEntryPtr).Free;
  GMFreeAndNil(TObject(AEntryPtr));
end;

function TGMObjHashTable.EntryAsIntf(const AEntryPtr: Pointer): IUnknown;
begin
  Result := GMObjAsIntf(TObject(AEntryPtr));
end;

function TGMObjHashTable.Add(const ANewEntry: TObject; const AReplaceIfExists: Boolean): TObject;
var HashCode: TGMHashCode; UnkEntry: IUnknown;
begin
  UnkEntry := GMObjAsIntf(ANewEntry);
  HashCode := BuildHashCode(UnkEntry);
  UnkEntry := nil; // <- Needed when borlands memory manager is used
  if AddPointer(HashCode, ANewEntry) then Result := ANewEntry else Result := nil;
end;

function TGMObjHashTable.RemoveByInstance(const AObj: TObject): Boolean;
begin
  Result := RemovePointer(Pointer(AObj));
end;

function TGMObjHashTable.First: TObject;
begin
  AssignOutEntry(FirstEntry, Result);
end;

function TGMObjHashTable.Last: TObject;
begin
  AssignOutEntry(LastEntry, Result);
end;


{ -------------------------- }
{ ---- TGMIntfHashTable ---- }
{ -------------------------- }

constructor TGMIntfHashTable.Create(const AAcceptDuplicates: Boolean; const ACompareFunc: TGMIntfCompareFunc; const ARefLifeTime: Boolean);
begin
  inherited Create(AAcceptDuplicates, ACompareFunc, ARefLifeTime);
  FFreeEntries := True;
end;

procedure TGMIntfHashTable.FreePointer(var AEntryPtr: Pointer);
begin
  //if AEntryPtr <> nil then
  IUnknown(AEntryPtr) := nil;
end;

procedure TGMIntfHashTable.AssignOutEntry(const AEntryPtr: Pointer; out AEntry);
begin
  IUnknown(AEntry) := IUnknown(AEntryPtr);
end;

function TGMIntfHashTable.EntryAsIntf(const AEntryPtr: Pointer): IUnknown;
begin
  Result := IUnknown(AEntryPtr);
end;

function TGMIntfHashTable.Add(const ANewEntry: IUnknown; const AReplaceIfExists: Boolean): IUnknown;
var itemHolder: IUnknown;
begin
  //
  // Always add the real IUnknown representation for proper iterator return values, and put an additional RefCount for the duration of this call
  //
  if not GMQueryInterface(ANewEntry, IUnknown, itemHolder) then Exit{$IFDEF FPC}(nil){$ENDIF};
  //
  // Always _AddRef! Either the entry gets stored or, if it is a duplicate, it will be released again.
  //
  itemHolder._AddRef;
  if AddPointer(BuildHashCode(itemHolder), Pointer(itemHolder)) then Result := ANewEntry else Result := nil;
end;

function TGMIntfHashTable.RemoveByInstance(const AIntf: IUnknown): Boolean;
var unk: IUnknown;
begin
  Result := GMQueryInterface(AIntf, IUnknown, unk) and RemovePointer(Pointer(unk)); // <- use real Iunknown representation for proper object identification
end;

function TGMIntfHashTable.First: IUnknown;
begin
  AssignOutEntry(FirstEntry, Result);
end;

function TGMIntfHashTable.Last: IUnknown;
begin
  AssignOutEntry(LastEntry, Result);
end;


{$IFDEF GENERICS}
{ ----------------------------------- }
{ ---- TGMPlainGenericCollection ---- }
{ ----------------------------------- }

procedure TGMPlainGenericCollection.CheckSorted(const AReqiredSorted, ASorted: Boolean);
const cStrMethodName = 'CheckSorted';
begin
  if AReqiredSorted and not ASorted then RaiseError(RStrCollectionNotSorted, Self, cStrMethodName);
  if not AReqiredSorted and ASorted then RaiseError(RStrCollectionSorted, Self, cStrMethodName);
end;

function TGMPlainGenericCollection.ArrayGrowDelta(const ACurrentCapacity: PtrInt): PtrInt;
begin
  Result := GrowDelta(ACurrentCapacity);
end;

function TGMPlainGenericCollection.MsgStrArrayIndex: String;
begin
  Result := RStrArrayIndex;
end;


{ ----------------------------------- }
{ ---- TGMGenericIteratorBase<T> ---- }
{ ----------------------------------- }

constructor TGMGenericIteratorBase<T>.Create(
  const ACollection: IUnknown; const AReverse: Boolean;
  const AConcurrentThreadLock: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCollectionHolder := ACollection;
  FReverse := AReverse;
  if AConcurrentThreadLock then FSyncLock := TGMCriticalSectionLock.Create(ACollection);
  Reset;
end;


{ ------------------------------------- }
{ ---- TGMGenericCollectionBase<T> ---- }
{ ------------------------------------- }

constructor TGMGenericCollectionBase<T>.Create(
 const AAcceptDuplicates: Boolean; const ACompareFunc: TGMGenericCompareFunc<T>; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCriticalSection := TGMCriticalSection.Create(True);
  FCompareFunc :=  ACompareFunc;
  FAcceptDuplicates := AAcceptDuplicates;
end;

//destructor TGMGenericCollectionBase<T>.Destroy;
//begin
//  Clear(False);
//  inherited;
//end;

function TGMGenericCollectionBase<T>.NullEntry: T;
begin
  FillChar(Result, SizeOf(Result), 0);
end;

function TGMGenericCollectionBase<T>.IsValidIndex(const AIndex: PtrInt): Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := (AIndex >= 0) and (AIndex < FCount)
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericCollectionBase<T>.SetCompareFunc(const ACompareFunc: TGMGenericCompareFunc<T>);
begin
  CriticalSection.EnterCriticalSection;
  try
   FCompareFunc := ACompareFunc;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericCollectionBase<T>.GetCount: PtrInt; stdcall;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := FCount;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericCollectionBase<T>.IsEmpty: Boolean;
begin
  CriticalSection.EnterCriticalSection;
  try
   Result := FCount = 0;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericCollectionBase<T>.CompareEntries(const AEntryA, AEntryB: T): TGMCompareResult;
begin
  if Assigned(FCompareFunc) then Result := FCompareFunc(AEntryA, AEntryB) else
     Result := GMCompareMemory(@AEntryA, @AEntryB, SizeOf(T));
end;

procedure TGMGenericCollectionBase<T>.NotifyAfterCountChanged(const AOldCount, ANewCount: PtrInt);
begin
  if Assigned(FOnAfterCountChanged) then FOnAfterCountChanged(Self, AOldCount, ANewCount);
end;

procedure TGMGenericCollectionBase<T>.NotifyAfterAddItem(const AEntry: T; const AIndex: PtrInt);
begin
  if Assigned(FOnAfterAddItem) then FOnAfterAddItem(Self, AEntry, AIndex);
end;

procedure TGMGenericCollectionBase<T>.NotifyBeforeRemoveItem(const AEntry: T; const AIndex: PtrInt);
begin
  if Assigned(FOnBeforeRemoveItem) then FOnBeforeRemoveItem(Self, AEntry, AIndex);
end;

procedure TGMGenericCollectionBase<T>.SetOnAfterCountChanged(const AValue: TGMCountChangedProc);
begin
  FOnAfterCountChanged := AValue;
end;

procedure TGMGenericCollectionBase<T>.SetOnAfterAddItem(const AValue: TGMGenericItemAddRemoveProc<T>);
begin
  FOnAfterAddItem := AValue;
end;

procedure TGMGenericCollectionBase<T>.SetOnBeforeRemoveItem(const AValue: TGMGenericItemAddRemoveProc<T>);
begin
  FOnBeforeRemoveItem := AValue;
end;


{ -------------------------------------- }
{ ---- TGMGenericArrayCollection<T> ---- }
{ -------------------------------------- }

constructor TGMGenericArrayCollection<T>.Create(const AAcceptDuplicates: Boolean = True;
                                                const ASorted: Boolean = False;
                                                const ACompareFunc: TGMGenericCompareFunc<T> = nil;
                                                const ARefLifeTime: Boolean = True);
begin
  inherited Create(AAcceptDuplicates, ACompareFunc, ARefLifeTime);
  FSorted := ASorted;
end;

function TGMGenericArrayCollection<T>.GetSorted: Boolean;
begin
  Result := FSorted;
end;

procedure TGMGenericArrayCollection<T>.QuickSort(L, R: PtrInt);
var i, j, m: PtrInt; P: T;
begin
  i := L;
  j := R;
  m := (L + R) shr 1;
  while i <= j do
   begin
    while CompareEntries(FEntries[i], FEntries[m]) = crALessThanB do Inc(i);
    while CompareEntries(FEntries[j], FEntries[m]) = crAGreaterThanB do Dec(j);
    if i <= j then
     begin
      if i <> j then // and CompareFunc(EntryAsIntf(i), EntryAsIntf(j)) <> crAEqualToB
       begin
        P := FEntries[i]; FEntries[i] := FEntries[j]; FEntries[j] := P; // <- exchange i <-> j
        if m = i then m := j else if m = j then m := i; // <- if [m] has been exchanged update m
       end;
      Inc(i);
      Dec(j);
     end;
   end;
  if L < j then QuickSort(L, j);
  if i < R then QuickSort(i, R);
end;

procedure TGMGenericArrayCollection<T>.Sort;
begin
  CriticalSection.EnterCriticalSection;
  try
   if (FEntries <> nil) and (FCount > 0) then QuickSort(0, FCount-1);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.SetSorted(const AValue: Boolean);
begin
  CriticalSection.EnterCriticalSection;
  try
   if AValue <> FSorted then
    begin
     FSorted := AValue;
     if AValue then Sort;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.GetEntry(const AIndex: PtrInt): T;
begin
  Result := FEntries[AIndex];
end;

procedure TGMGenericArrayCollection<T>.SetEntry(const AIndex: PtrInt; const AValue: T);
begin
  FEntries[AIndex] := AValue;
end;

procedure TGMGenericArrayCollection<T>.SetCapacity(ANewCapacity: PtrInt);
begin
  CriticalSection.EnterCriticalSection;
  try
   //if (ANewCapacity < 0) or (ANewCapacity > cMaxPtrArraySize) then RaiseError(GMFormat(RStrListCapacityError, [ANewCapacity, cMaxPtrArraySize]), Self, 'SetCapacity');
   if ANewCapacity < 0 then ANewCapacity := 0;
   if ANewCapacity <> FCapacity then
    begin
     //ReallocMem(FEntries, ANewCapacity * SizeOf(T));
     SetLength(FEntries, ANewCapacity);
     FCapacity := ANewCapacity;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.InternalInsertIdx(const AEntry: T; const L, R: PtrInt): PtrInt;
const cStrMethodName = 'InternalInsertIdx';
var M: PtrInt;
begin
  //if not Assigned(CompareFunc) then Result := FCount else
  if L >= R then Result := L else
   begin
    M := (L + R) shr 1;
    case CompareEntries(AEntry, FEntries[M]) of
     crAEqualToB, crALessThanB: Result := InternalInsertIdx(AEntry, L, M);
     crAGreaterThanB: if L = M then Result := R else Result := InternalInsertIdx(AEntry, M, R);
     else
      {$IFNDEF STANDALONE_COLLECTIONS}
      raise EGMException.ObjError(RStrInvalidCompareResult, Self, cStrMethodName);
      {$ELSE}
      raise Exception.Create(GMStringJoin(GMStringJoin(GMObjName(Self), cStrErrNameSep, cStrMethodName), ': ', RStrInvalidCompareResult));
      {$ENDIF}
    end;
   end;
end;

function TGMGenericArrayCollection<T>.InsertIdx(const AEntry: T): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if not FSorted then Result := FCount else Result := InternalInsertIdx(AEntry, 0, FCount);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.IndexOf(const AKeyToCompare: T): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if not FSorted then
    begin
     for Result := 0 to FCount-1 do if CompareEntries(FEntries[Result], AKeyToCompare) = crAEqualToB then Exit;
     Result := cInvalidItemIdx;
    end
   else
    begin
     Result := InsertIdx(AKeyToCompare);
     if not IsValidIndex(Result) or (CompareEntries(FEntries[Result],  AKeyToCompare) <> crAEqualToB) then Result := cInvalidItemIdx;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.InsertEntry(const AEntry: T; const AIndex: PtrInt);
const cStrMethodName = 'InsertEntry';
begin
  GMCheckIntRange(MsgStrArrayIndex, AIndex, 0, FCount, Self, cStrMethodName);
  if FCount = FCapacity then SetCapacity(FCapacity + ArrayGrowDelta(FCapacity));
  if AIndex < FCount then System.Move(FEntries[AIndex], FEntries[AIndex + 1], (FCount - AIndex) * SizeOf(T));
  FEntries[AIndex] := AEntry;
  Inc(FCount);
  NotifyAfterAddItem(AEntry, AIndex);
  NotifyAfterCountChanged(FCount-1, FCount);
end;

function TGMGenericArrayCollection<T>.IsDuplicate(const AEntry: T; var AIndex: PtrInt): Boolean;
var idx: PtrInt;
begin
  Result := False;
  if not FAcceptDuplicates then
   begin
    if FSorted then
     Result := IsValidIndex(AIndex) and (CompareEntries(FEntries[AIndex], AEntry) = crAEqualToB)
    else
     for idx:=0 to FCount-1 do
      if CompareEntries(FEntries[idx], AEntry) = crAEqualToB then begin AIndex := idx; Result := True; Break; end;
   end;
end;

function TGMGenericArrayCollection<T>.InsertAt(const AEntry: T; var AIndex: PtrInt; const AReplaceIfExists: Boolean = False): Boolean;
var doInsert: Boolean;
begin
  //GMQueryInterface(AIntf, IUnknown, unk); // <- Always add the real IUnknown representation for proper object identifications and iterator return values

  doInsert := FAcceptDuplicates or not IsDuplicate(AEntry, AIndex);
  Result := doInsert or AReplaceIfExists;

  if doInsert then
   InsertEntry(AEntry, AIndex)
  else
   if AReplaceIfExists then
      begin {Finalize(FEntries[AIndex]);} FEntries[AIndex] := AEntry; end;
end;

function TGMGenericArrayCollection<T>.CreateGenericIterator(const AReverse: Boolean; const AConcurrentThreadLock: Boolean): IGMGenericIterator<T>;
begin
  Result := TGMGenericArrayIterator<T>.Create(Self, AReverse, AConcurrentThreadLock);
end;

procedure TGMGenericArrayCollection<T>.SetCompareFunc(const ACompareFunc: TGMGenericCompareFunc<T>);
var oldCmpFunc: TGMGenericCompareFunc<T>;
begin
  oldCmpFunc := FCompareFunc;
  inherited SetCompareFunc(ACompareFunc);
  if Sorted and (@ACompareFunc <> @oldCmpFunc) then Sort;
end;

function TGMGenericArrayCollection<T>.IndexOfNearest(const AKeyToCompare: T): PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   CheckSorted(True, FSorted);
   Result := GMBoundedInt(InsertIdx(AKeyToCompare), 0, FCount-1);
   if not IsValidIndex(Result) then Result := cInvalidItemIdx;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.Add(const ANewEntry: T; const AReplaceIfExists: Boolean): T;
//var itemHolder: T;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   // Without an additional reference stack cleanup after return of InsertIdx may free a newly
   // created object (with refcount = 0) and the call to InsertAt would cause an access violation
   // And itemHolder will cleanup a refcount = 0 AIntf in case of exceptions
   //itemHolder := ANewEntry;
   idx := InsertIdx(ANewEntry);
// if InsertAt(ANewEntry, idx, AReplaceIfExists) then Result := ANewEntry else Result := NullEntry;
   InsertAt(ANewEntry, idx, AReplaceIfExists);
   Result := FEntries[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.Find(const AKeyToCompare: T; var AFoundEntry: T): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOf(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then AFoundEntry := FEntries[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.FindNearest(const AKeyToCompare: T; out AEntry: T): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOfNearest(AKeyToCompare);
   Result := IsValidIndex(idx);
   if Result then AEntry := FEntries[idx];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.RemoveByIdx(const AIndex: PtrInt; ADelCount: PtrInt);
const cStrMethodName = 'RemoveByIdx';
var i: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   GMCheckIntRange(MsgStrArrayIndex, AIndex, 0, FCount-1, Self, cStrMethodName);
   ADelCount := Min(ADelCount, FCount - AIndex);
   if ADelCount <= 0 then Exit; // <- GMCheckIntRange should never raise with this
   for i:=AIndex to AIndex + ADelCount-1 do
    begin
     NotifyBeforeRemoveItem(FEntries[i], i);
     //if FFreeEntries then {if FEntries^[i] <> nil then} Finalize(FEntries[i]);
    end;
   Dec(FCount, ADelCount);
   if AIndex < FCount then System.Move(FEntries[AIndex + ADelCount], FEntries[AIndex], (FCount - AIndex) * SizeOf(T));
   if FCapacity - FCount >= ArrayGrowDelta(FCapacity) then SetCapacity(FCapacity - ArrayGrowDelta(FCapacity));
   NotifyAfterCountChanged(FCount + ADelCount, FCount);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.Remove(const AEntry: T): Boolean;
var idx: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   idx := IndexOf(AEntry);
   Result := IsValidIndex(idx);
   if Result then RemoveByIdx(idx);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.Clear(const ANotify: Boolean);
var i, oldCount: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   // Better free in reverse order
   if ANotify then
     for i:=FCount-1 downto 0 do NotifyBeforeRemoveItem(FEntries[i], i);
     //begin
      //if FFreeEntries then Finalize(FEntries[i]);
     //end;

   oldCount := FCount;
   SetCapacity(0);
   FCount := 0;
   if ANotify then NotifyAfterCountChanged(oldCount, 0);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

//function TGMGenericArrayCollection<T>.RemoveByKey(const AKeyToCompare: T): Boolean;
//begin
//
//end;
//
//function TGMGenericArrayCollection<T>.RemoveByInstance(const AInstance: T): Boolean;
//begin
//
//end;

procedure TGMGenericArrayCollection<T>.Rotate(ADelta: PtrInt; const AStartIdx: PtrInt);
const cStrMethodName = 'Rotate';
var Buffer: Pointer; BufferSize: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount < 2 then Exit;
   CheckSorted(False, FSorted);

   //if Abs(ADelta) >= FCount - AStartIdx then RaiseError(GMFormat(RStrInvalidRotateDelta, [ADelta]), Self, 'Rotate');
   ADelta := ADelta mod FCount;
   GMCheckIntRange(MsgStrArrayIndex, AStartIdx, 0, FCount-1, Self, cStrMethodName);
   //if AStartIdx >= FCount then RaiseError(GMFormat(RStrInvalidRotateStartPos, [AStartIdx]), Self, 'Rotate');

   BufferSize := Abs(ADelta) * SizeOf(T);

   if ADelta > 0 then
    begin
     GetMem(Buffer, BufferSize);
     try
      System.Move(FEntries[FCount-ADelta], Buffer^, BufferSize);
      System.Move(FEntries[AStartIdx], FEntries[ADelta+AStartIdx], (FCount-ADelta-AStartIdx) * SizeOf(T));
      System.Move(Buffer^, FEntries[AStartIdx], BufferSize);
     finally
      FreeMem(Buffer);
     end;
    end;

   if ADelta < 0 then
    begin
     GetMem(Buffer, BufferSize);
     try
      System.Move(FEntries[AStartIdx], Buffer^, BufferSize);
      System.Move(FEntries[-ADelta+AStartIdx], FEntries[AStartIdx], (FCount+ADelta-AStartIdx) * SizeOf(T));
      System.Move(Buffer^, FEntries[FCount+ADelta], BufferSize);
     finally
      FreeMem(Buffer);
     end;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.Exchange(const AIndex1, AIndex2: PtrInt);
const cStrMethodName = 'Exchange';
var TmpItem: T;
begin
  CriticalSection.EnterCriticalSection;
  try
   if AIndex1 <> AIndex2 then
    begin
     CheckSorted(False, FSorted);
     GMCheckIntRange(MsgStrArrayIndex, AIndex1, 0, FCount-1, Self, cStrMethodName);
     GMCheckIntRange(MsgStrArrayIndex, AIndex2, 0, FCount-1, Self, cStrMethodName);
     TmpItem := FEntries[AIndex1];
     FEntries[AIndex1] := FEntries[AIndex2];
     FEntries[AIndex2] := TmpItem;
    end;
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

procedure TGMGenericArrayCollection<T>.Reverse;
var i: PtrInt;
begin
  CriticalSection.EnterCriticalSection;
  try
   if FCount > 1 then for i:=0 to FCount-1 shr 1 do Exchange(i, FCount-1-i);
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.First: T;
begin
  CriticalSection.EnterCriticalSection;
  try
   if IsEmpty then Result := NullEntry else Result := FEntries[Low(FEntries)];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;

function TGMGenericArrayCollection<T>.Last: T;
begin
  CriticalSection.EnterCriticalSection;
  try
   if IsEmpty then Result := NullEntry else Result := FEntries[High(FEntries)];
  finally
   CriticalSection.LeaveCriticalSection;
  end;
end;


{ ------------------------------------ }
{ ---- TGMGenericArrayIterator<T> ---- }
{ ------------------------------------ }

constructor TGMGenericArrayIterator<T>.Create(
  const ACollection: TGMGenericArrayCollection<T>; const AReverse: Boolean;
  const AConcurrentThreadLock: Boolean; const ARefLifeTime: Boolean);
begin
  inherited Create(ACollection, AReverse, AConcurrentThreadLock, ARefLifeTime);
  FCollection := ACollection;
end;

function TGMGenericArrayIterator<T>.NextEntry(out AEntry: T): Boolean;
begin
  Result := FCollection.IsValidIndex(FCurrentIdx);
  if Result then
   begin
    AEntry := FCollection.FEntries[FCurrentIdx];
    if FReverse then Dec(FCurrentIdx) else Inc(FCurrentIdx);
   end;
end;

procedure TGMGenericArrayIterator<T>.Reset;
begin
  if FReverse then FCurrentIdx := FCollection.Count-1 else FCurrentIdx := 0;
end;

{$ENDIF} // GENERICS

{ ----------------------- }
{ ---- TGMIntegerMap ---- }
{ ----------------------- }

constructor TGMIntegerMap.Create(const ANotifyProc: TNotifyIntMapChangeProc; const ARefLifeTime: Boolean = False);
begin
  inherited Create(ARefLifeTime);
  FChangeNotifyProc := ANotifyProc;
end;

destructor TGMIntegerMap.Destroy;
begin
  SetCapacity(0);
  inherited Destroy;
end;

function TGMIntegerMap.Obj: TGMIntegerMap;
begin
  Result := Self;
end;

procedure TGMIntegerMap.IntMapChanged(const AValue: PtrInt);
begin
  if Assigned(FChangeNotifyProc) then FChangeNotifyProc(AValue);
end;

function TGMIntegerMap.MapIntegerOnInteger(const AMapKeyValue: PtrInt): PtrInt;
begin
  Result := Values[AMapKeyValue];
end;

function TGMIntegerMap.IsEmpty: Boolean;
begin
  Result := Count = 0;
end;

function TGMIntegerMap.GetCount: PtrInt; stdcall;
begin
  Result := Count;
end;

function TGMIntegerMap.ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown = nil): Boolean;
begin
  Result := True;
  case AOperation of
   {$IFNDEF STANDALONE_COLLECTIONS}
   Ord(opClear): Clear(True);
   {$ELSE}
   0: Clear(True);
   {$ENDIF}
   else Result := False;
  end;
end;

procedure TGMIntegerMap.SetCapacity(const ANewCapacity: PtrInt);
const cStrMethodName = 'SetCapacity';
begin
  {TODO: Bessere Fehlermeldung}
  if (ANewCapacity < 0) or (ANewCapacity > cMaxIntArraySize) then RaiseError(GMFormat(RStrListCapacityError, [ANewCapacity, cMaxIntArraySize]), Self, cStrMethodName);
  if ANewCapacity <> FCapacity then
   begin
    ReallocMem(FValues, ANewCapacity * SizeOf(PtrInt));
    FCapacity := ANewCapacity;
   end;
end;

function TGMIntegerMap.GetMappedValue(AIndex: PtrInt): PtrInt;
const cStrMethodName = 'GetMappedValue';
begin
  GMCheckIntRange(RStrMapIndex, AIndex, 0, Count-1, Self, cStrMethodName);
  Result := FValues^[AIndex];
end;

function TGMIntegerMap.InsertIdx(const AValue: PtrInt): PtrInt;
  function _InsertIdx(L, R: PtrInt): PtrInt;
  var M: LongInt;
  begin
    if L >= R then Result := L else
     begin
      M := (L + R) shr 1;
      if AValue <= FValues^[M] then Result := _InsertIdx(L, M) else
       if L = M then Result := R else Result := _InsertIdx(M, R);
     end;
  end;
begin
  {if IsEmpty then Result := 0 else} Result := _InsertIdx(0, Count);
end;

procedure TGMIntegerMap.Add(const AValue: PtrInt);
const cStrMethodName = 'Add';
var idx: PtrInt;
begin
  if Assigned(OnDecideAddValue) and not OnDecideAddValue(AValue) then Exit;
  idx := InsertIdx(AValue);
  if (idx = Count) or (FValues^[idx] <> AValue) then
   begin
    GMCheckIntRange(RStrMapIndex, idx, 0, FCount, Self, cStrMethodName);
    if FCount = FCapacity then SetCapacity(FCapacity + GrowDelta(FCapacity));
    if idx < FCount then System.Move(FValues^[idx], FValues^[idx + 1], (FCount - idx) * SizeOf(PtrInt));
    FValues^[idx] := AValue;
    Inc(FCount);
    IntMapChanged(AValue);
   end;
end;

procedure TGMIntegerMap.RemoveByIdx(const AIndex: PtrInt);
const cStrMethodName = 'RemoveByIdx';
var val: PtrInt;
begin
  GMCheckIntRange(RStrMapIndex, AIndex, 0, FCount-1, Self, cStrMethodName);
  val := FValues^[AIndex];
  Dec(FCount);
  if AIndex < FCount then System.Move(FValues^[AIndex + 1], FValues^[AIndex], (FCount - AIndex) * SizeOf(PtrInt));
  if FCapacity - FCount >= GrowDelta(FCapacity) then SetCapacity(FCapacity - GrowDelta(FCapacity));
  IntMapChanged(val);
end;

procedure TGMIntegerMap.Remove(const AValue: PtrInt);
var idx: PtrInt;
begin
  idx := InsertIdx(AValue);
  if (idx < Count) and (FValues^[idx] = AValue) then RemoveByIdx(idx);
end;

procedure TGMIntegerMap.Toggle(const AValue: PtrInt);
begin
  if Contains(AValue) then Remove(AValue) else Add(AValue);
end;

procedure TGMIntegerMap.AddRange(AValue1, AValue2: PtrInt);
var i, tmp: PtrInt;
begin
  if AValue1 > AValue2 then begin tmp := AValue1; AValue1 := AValue2; AValue2 := tmp; end;
  for i:=AValue1 to AValue2 do Add(i);
end;

procedure TGMIntegerMap.SetRange(AValue1, AValue2: PtrInt);
var tmp: PtrInt;
begin
  if AValue1 > AValue2 then begin tmp := AValue1; AValue1 := AValue2; AValue2 := tmp; end;
  while not IsEmpty and (FValues[0] < AValue1) do RemoveByIdx(0);
  while not IsEmpty and (FValues[Count-1] > AValue2) do RemoveByIdx(Count-1);
  AddRange(AValue1, AValue2);
end;

function TGMIntegerMap.Contains(const AValue: PtrInt): Boolean;
var idx: PtrInt;
begin
  idx := InsertIdx(AValue);
  Result := (idx < Count) and (FValues^[idx] = AValue);
end;

procedure TGMIntegerMap.Clear(const ANotify: Boolean);
var i: PtrInt; valArr: array of PtrInt;
begin
  if ANotify then
   begin
    SetLength(valArr, Count);
    for i:=0 to Count-1 do valArr[i] := Values[i];
   end;
  SetCapacity(0);
  FCount := 0;
  if ANotify then for i:=Low(valArr) to High(valArr) do IntMapChanged(valArr[i]);
end;


end.