Added: expanded framework code

PascalCoinWalletLazarus.dpr

@@ -26,6 +26,7 @@ uses
   UAES in 'Units\PascalCoin\UAES.pas',
   UFRMWallet in 'Units\Forms\UFRMWallet.pas' {FRMWallet},
   UFileStorage in 'Units\PascalCoin\UFileStorage.pas',
+  UCommon in 'Units\PascalCoin\Utils\UCommon.pas',
   UFolderHelper in 'Units\Utils\UFolderHelper.pas',
   UAppParams in 'Units\Utils\UAppParams.pas',
   UGridUtils in 'Units\Utils\UGridUtils.pas',
@@ -43,8 +44,6 @@ uses
   UOpenSSL in 'Units\PascalCoin\UOpenSSL.pas',
   UOpenSSLdef in 'Units\PascalCoin\UOpenSSLdef.pas';
 
-{.$R *.res}
-
 {$R *.res}
 
 begin

PascalCoinWalletLazarus.lpi

@@ -38,7 +38,7 @@
         <PackageName Value="LCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="37">
+    <Units Count="43">
       <Unit0>
         <Filename Value="PascalCoinWalletLazarus.dpr"/>
         <IsPartOfProject Value="True"/>
@@ -214,6 +214,36 @@
         <Filename Value="Units\Utils\UCommon.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit36>
+      <Unit37>
+        <Filename Value="Units\Utils\generics.collections.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.Collections"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="Units\Utils\generics.defaults.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.Defaults"/>
+      </Unit38>
+      <Unit39>
+        <Filename Value="Units\Utils\generics.hashes.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.Hashes"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="Units\Utils\generics.helpers.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.Helpers"/>
+      </Unit40>
+      <Unit41>
+        <Filename Value="Units\Utils\generics.memoryexpanders.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.MemoryExpanders"/>
+      </Unit41>
+      <Unit42>
+        <Filename Value="Units\Utils\generics.strings.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Generics.Strings"/>
+      </Unit42>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -238,9 +268,6 @@
       </Optimizations>
     </CodeGeneration>
     <Linking>
-      <Debugging>
-        <GenerateDebugInfo Value="False"/>
-      </Debugging>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

Units/Utils/UCommon.pas

@@ -1,14 +1,16 @@
-{ Copyright (c) 2017 PascalCoin Developers
+{
+  Copyright (c) 2017 The PascalCoin Project
+
+  Author: Herman Schoenfeld <[email protected]>
 
   Distributed under the MIT software license, see the accompanying file LICENSE
   or visit http://www.opensource.org/licenses/mit-license.php.
 
-  This unit is a part of Pascal Coin, a P2P crypto currency without need of
-  historical operations.
+  This code has been donated to The PascalCoin Project by Sphere 10 Software (www.sphere10.com)
+  who retains independentCopyright (c) 2017 Sphere 10 Software.
 
-  CREDITS:
-  [2017-06-29] Herman Schoenfeld ([email protected]): Created unit, added IFF functions
-  [2017-08-10] Herman Schoenfeld ([email protected]): Added String2Hex, BinStrComp functions
+  Additional Credits:
+    <contributors add yourselves here>
 }
 
 unit UCommon;
@@ -19,25 +21,85 @@ unit UCommon;
 
 interface
 
+uses
+  Classes, SysUtils, Controls, FGL, Generics.Collections, Generics.Defaults;
+
+{ GLOBAL FUNCTIONS }
+
 { Converts a string to hexidecimal format }
 function String2Hex(const Buffer: AnsiString): AnsiString;
 
 { Binary-safe StrComp replacement. StrComp will return 0 for when str1 and str2 both start with NUL character. }
 function BinStrComp(const Str1, Str2 : AnsiString): Integer;
 
-{ Language-level tools }
+{ Ternary operator equivalent of predicate ? (true-val) : (false-value) }
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: Cardinal): Cardinal; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: Integer): Integer; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: Int64): Int64; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: UInt64): UInt64; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: Double): Double; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: string): string; overload;
+function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: TObject): TObject; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: variant): variant; overload;
 
+{ DateTime functions }
+function TimeStamp : AnsiString;
+function UtcTimeStamp : AnsiString;
+
+type
+  { TBox - a generic wrapper class for wrappying any type, mainly strings and primtives }
+  TBox<T> = class(TObject)
+    type
+      TDestroyItemDelegate = procedure (constref val : T) of object;
+    strict private
+      FValue: T;
+      FDestroyFunc : TDestroyItemDelegate;
+      class procedure NoOpDestroyItem(constref val : T);
+    public
+      constructor Create(Value: T); overload;
+      constructor Create(Value: T; destroyItemFunc: TDestroyItemDelegate); overload;
+      destructor Destroy; override;
+      property Value: T read FValue;
+  end;
+
+  { A TObject-wrapped string }
+  TStringObject = TBox<AnsiString>;
+
+  { TArrayTool }
+  TArrayTool<T> = class
+    public
+      class function Contains(const Values: TArray<T>; const Item: T; const Comparer: IEqualityComparer<T>; out ItemIndex: SizeInt): Boolean; overload; static;
+      class function Contains(const Values: TArray<T>; const Item: T; out ItemIndex: SizeInt): Boolean; overload; static;
+      class function Contains(const Values: TArray<T>; const Item: T) : Boolean; overload; static;
+      class function IndexOf(const Values: TArray<T>; const Item: T; const Comparer: IEqualityComparer<T>): SizeInt; overload; static;
+      class function IndexOf(const Values: TArray<T>; const Item: T): SizeInt; overload; static;
+      class procedure Add(var Values: TArray<T>; const AValue : T); static;
+      class procedure Remove(var Values : TArray<T>; const Item : T; const Comparer : IEqualityComparer<T>); overload; static;
+      class procedure Remove(var Values : TArray<T>; const Item : T); overload; static;
+      class procedure RemoveAt(var Values : TArray<T>; ItemIndex : SizeInt); static;
+      class function Concat(const Arrays: array of TArray<T>): TArray<T>; static;
+      class function Create(const a : T; const b : T) : TArray<T>; static;
+      class function ToArray(Enumerable: TEnumerable<T>; Count: SizeInt): TArray<T>; static;
+    end;
+
+  { TNotifyManyEvent - support for multiple listeners }
+  TNotifyManyEvent = TArray<TNotifyEvent>;
+
+  { Helper for TNotifyManyEvent }
+  TNotifyManyEventHelper = record helper for TNotifyManyEvent
+    procedure Add(listener : TNotifyEvent);
+    procedure Remove(listener : TNotifyEvent);
+    procedure Invoke(sender : TObject);
+  end;
+
+  { Controls Helpers }
+  TWinControlHelper = class helper for TWinControl
+    procedure RemoveAllControls(destroy : boolean);
+  end;
+
 implementation
 
-uses
-  Classes, SysUtils, Math;
+{%region Global functions %}
 
 function String2Hex(const Buffer: AnsiString): AnsiString;
 var
@@ -72,6 +134,8 @@ begin
    end;
 End;
 
+{%endregion}
+
 {%region Language-level tools }
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: Cardinal): Cardinal;
 begin
@@ -121,6 +185,14 @@ begin
     Result := AFalseResult;
 end;
 
+function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: TObject): TObject;
+begin
+  if ACondition then
+    Result := ATrueResult
+  else
+    Result := AFalseResult;
+end;
+
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: variant): variant;
 begin
   if ACondition then
@@ -128,7 +200,192 @@ begin
   else
     Result := AFalseResult;
 end;
+
+{ DateTime functions }
+function TimeStamp : AnsiString;
+begin
+  Result := FormatDateTime('yyy-mm-dd hh:nn:ss', Now);
+end;
+
+function UtcTimeStamp : AnsiString;
+begin
+  raise Exception.Create('Not implemented');
+end;
+
+{%endregion}
+
+{%region TBox }
+
+constructor TBox<T>.Create(Value: T);
+begin
+  Create(Value, NoOpDestroyItem);
+end;
+
+constructor TBox<T>.Create(Value: T; destroyItemFunc: TDestroyItemDelegate);
+begin
+  inherited Create;
+  FValue := Value;
+  FDestroyFunc := destroyItemFunc;
+end;
+
+destructor TBox<T>.Destroy;
+begin
+  FDestroyFunc(FValue);
+  inherited;
+end;
+
+class procedure TBox<T>.NoOpDestroyItem(constref val : T);
+begin
+  // No op
+end;
+
+{%endregion}
+
+{%region TArrayTool }
+
+class function TArrayTool<T>.Contains(const Values: TArray<T>; const Item: T; const Comparer: IEqualityComparer<T>; out ItemIndex: SizeInt): Boolean;
+var
+  Index: SizeInt;
+begin
+  for Index := 0 to high(Values) do begin
+    if Comparer.Equals(Values[Index], Item) then begin
+      ItemIndex := Index;
+      Result := True;
+      exit;
+    end;
+  end;
+  ItemIndex := -1;
+  Result := False;
+end;
+
+class function TArrayTool<T>.Contains(const Values: TArray<T>; const Item: T; out ItemIndex: SizeInt): Boolean;
+begin
+  Result := TArrayTool<T>.Contains(Values, Item, TEqualityComparer<T>.Default, ItemIndex);
+end;
+
+class function TArrayTool<T>.Contains(const Values: TArray<T>; const Item: T): Boolean;
+var
+  ItemIndex: SizeInt;
+begin
+  Result := TArrayTool<T>.Contains(Values, Item, ItemIndex);
+end;
+
+class function TArrayTool<T>.IndexOf(const Values: TArray<T>; const Item: T; const Comparer: IEqualityComparer<T>): SizeInt;
+begin
+  TArrayTool<T>.Contains(Values, Item, Comparer, Result);
+end;
+
+class function TArrayTool<T>.IndexOf(const Values: TArray<T>; const Item: T): SizeInt;
+begin
+  TArrayTool<T>.Contains(Values, Item, Result);
+end;
+
+class procedure TArrayTool<T>.Add(var Values: TArray<T>; const AValue : T);
+begin
+  SetLength(Values, SizeInt(Length(Values)) + 1);
+  Values[High(Values)] := AValue;
+end;
+
+class procedure TArrayTool<T>.Remove(var Values : TArray<T>; const Item : T; const Comparer : IEqualityComparer<T>);
+var index : SizeInt;
+begin
+  while TArrayTool<T>.Contains(Values, item, Comparer, index) do begin
+    TArrayTool<T>.RemoveAt(Values, index);
+  end;
+end;
+
+class procedure TArrayTool<T>.Remove(var Values : TArray<T>; const Item : T);
+begin
+  TArrayTool<T>.Remove(Values, Item, TEqualityComparer<T>.Default);
+end;
+
+class procedure TArrayTool<T>.RemoveAt(var Values : TArray<T>; ItemIndex : SizeInt);
+var i : Integer;
+begin
+  for i := ItemIndex + 1 to High(Values) do
+    Values[i - 1] := Values[i];
+  SetLength(Values, Length(Values) - 1);
+end;
+
+class function TArrayTool<T>.Concat(const Arrays: array of TArray<T>): TArray<T>;
+var
+  i, k, LIndex, LLength: Integer;
+begin
+  LLength := 0;
+  for i := 0 to High(Arrays) do
+    Inc(LLength, Length(Arrays[i]));
+  SetLength(Result, LLength);
+  LIndex := 0;
+  for i := 0 to High(Arrays) do
+  begin
+    for k := 0 to High(Arrays[i]) do
+    begin
+      Result[LIndex] := Arrays[i][k];
+      Inc(LIndex);
+    end;
+  end;
+end;
+
+class function TArrayTool<T>.Create(const a, b: T): TArray<T>;
+begin
+  SetLength(result,2);
+  result[0] := a;
+  result[1] := b;
+end;
+
+class function TArrayTool<T>.ToArray(Enumerable: TEnumerable<T>; Count: SizeInt): TArray<T>;
+var
+  LItem: T;
+begin
+  SetLength(Result, Count);
+  Count := 0;
+  for LItem in Enumerable do
+  begin
+    Result[Count] := LItem;
+    Inc(Count);
+  end;
+end;
+
+{%endregion}
+
+{%region TNotifyManyEventHelper}
+
+procedure TNotifyManyEventHelper.Add(listener : TNotifyEvent);
+begin
+  if TArrayTool<TNotifyEvent>.IndexOf(self, listener) = -1 then begin
+    TArrayTool<TNotifyEvent>.Add(self, listener);
+  end;
+end;
+
+procedure TNotifyManyEventHelper.Remove(listener : TNotifyEvent);
+begin
+  TArrayTool<TNotifyEvent>.Remove(self, listener);
+end;
+
+procedure TNotifyManyEventHelper.Invoke(sender : TObject);
+var i : Integer;
+begin
+  for i := 0 to high(self) do
+    self[i](sender);
+end;
+
 {%endregion}
 
+{%region TWinControlHelper }
+
+procedure TWinControlHelper.RemoveAllControls(destroy : boolean);
+var
+  control : TControl;
+begin
+  while self.ControlCount > 0 do begin
+    control := self.Controls[0];
+    self.RemoveControl(control);
+    if destroy then control.Destroy;
+  end;
+end;
+
+{%endregion}
+
+
 end.
 

Units/Utils/generics.collections.pas

@@ -0,0 +1,1348 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.Collections;
+
+{$MODE DELPHI}{$H+}
+{$MACRO ON}
+{$COPERATORS ON}
+{$DEFINE CUSTOM_DICTIONARY_CONSTRAINTS := TKey, TValue, THashFactory}
+{$DEFINE OPEN_ADDRESSING_CONSTRAINTS := TKey, TValue, THashFactory, TProbeSequence}
+{$DEFINE CUCKOO_CONSTRAINTS := TKey, TValue, THashFactory, TCuckooCfg}
+{$WARNINGS OFF}
+{$HINTS OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+
+interface
+
+uses
+    Classes, SysUtils, Generics.MemoryExpanders, Generics.Defaults,
+    Generics.Helpers, Generics.Strings;
+
+{ FPC BUGS related to Generics.* (54 bugs, 19 fixed)
+  REGRESSION: 26483, 26481
+  FIXED REGRESSION: 26480, 26482
+
+  CRITICAL: 24848(!!!), 24872(!), 25607(!), 26030, 25917, 25918, 25620, 24283, 24254, 24287 (Related to? 24872)
+  IMPORTANT: 23862(!), 24097, 24285, 24286 (Similar to? 24285), 24098, 24609 (RTL inconsistency), 24534,
+             25606, 25614, 26177, 26195
+  OTHER: 26484, 24073, 24463, 25593, 25596, 25597, 25602, 26181 (or MYBAD?)
+  CLOSED BUT IMO STILL TO FIX: 25601(!), 25594
+  FIXED: 25610(!), 24064, 24071, 24282, 24458, 24867, 24871, 25604, 25600, 25605, 25598, 25603, 25929, 26176, 26180,
+         26193, 24072
+  MYBAD: 24963, 25599
+}
+
+{ LAZARUS BUGS related to Generics.* (7 bugs, 0 fixed)
+  CRITICAL: 25613
+  OTHER: 25595, 25612, 25615, 25617, 25618, 25619
+}
+
+type
+  // bug #24254 workaround
+  // should be TArray = record class procedure Sort<T>(...) etc.
+  TCustomArrayHelper<T> = class abstract
+  private
+    type
+      // bug #24282
+      TComparerBugHack = TComparer<T>;
+  protected
+    // modified QuickSort from classes\lists.inc
+    class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>);
+      virtual; abstract;
+  public
+    class procedure Sort(var AValues: array of T); overload;
+    class procedure Sort(var AValues: array of T;
+      const AComparer: IComparer<T>);   overload;
+    class procedure Sort(var AValues: array of T;
+      const AComparer: IComparer<T>; AIndex, ACount: SizeInt); overload;
+
+    class function BinarySearch(constref AValues: array of T; constref AItem: T;
+      out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
+      AIndex, ACount: SizeInt): Boolean; virtual; abstract; overload;
+    class function BinarySearch(constref AValues: array of T; constref AItem: T;
+      out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
+    class function BinarySearch(constref AValues: array of T; constref AItem: T;
+      out AFoundIndex: SizeInt): Boolean; overload;
+  end experimental; // will be renamed to TCustomArray (bug #24254)
+
+  TArrayHelper<T> = class(TCustomArrayHelper<T>)
+  protected
+    // modified QuickSort from classes\lists.inc
+    class procedure QuickSort(var AValues: array of T; ALeft, ARight: SizeInt; const AComparer: IComparer<T>); override;
+  public
+    class function BinarySearch(constref AValues: array of T; constref AItem: T;
+      out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
+      AIndex, ACount: SizeInt): Boolean; override; overload;
+  end experimental; // will be renamed to TArray (bug #24254)
+
+  TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
+  TCollectionNotifyEvent<T> = procedure(ASender: TObject; constref AItem: T; AAction: TCollectionNotification)
+    of object;
+
+  { TEnumerator }
+
+  TEnumerator<T> = class abstract
+  protected
+    function DoGetCurrent: T; virtual; abstract;
+    function DoMoveNext: boolean; virtual; abstract;
+  public
+    property Current: T read DoGetCurrent;
+    function MoveNext: boolean;
+  end;
+
+  { TEnumerable }
+
+  TEnumerable<T> = class abstract
+  protected
+    function ToArrayImpl(ACount: SizeInt): TArray<T>; overload; // used by descendants
+  protected
+    function DoGetEnumerator: TEnumerator<T>; virtual; abstract;
+  public
+    function GetEnumerator: TEnumerator<T>; inline;
+    function ToArray: TArray<T>; virtual; overload;
+  end;
+
+  // More info: http://stackoverflow.com/questions/5232198/about-vectors-growth
+  // TODO: custom memory managers (as constraints)
+  {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result + Result div 2} // ~approximation to golden ratio: n = n * 1.5 }
+  // {$DEFINE CUSTOM_LIST_CAPACITY_INC := Result * 2} // standard inc
+  TCustomList<T> = class abstract(TEnumerable<T>)
+  protected
+    type // bug #24282
+      TArrayHelperBugHack = TArrayHelper<T>;
+  private
+    FOnNotify: TCollectionNotifyEvent<T>;
+    function GetCapacity: SizeInt; inline;
+  protected
+    FItemsLength: SizeInt;
+    FItems: array of T;
+
+    function PrepareAddingItem: SizeInt; virtual;
+    function PrepareAddingRange(ACount: SizeInt): SizeInt; virtual;
+    procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); virtual;
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; virtual;
+    procedure SetCapacity(AValue: SizeInt); virtual; abstract;
+    function GetCount: SizeInt; virtual;
+  public
+    function ToArray: TArray<T>; override; final;
+
+    property Count: SizeInt read GetCount;
+    property Capacity: SizeInt read GetCapacity write SetCapacity;
+    property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
+  end;
+
+  TCustomListEnumerator<T> = class abstract(TEnumerator< T >)
+  private
+    FList: TCustomList<T>;
+    FIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: T; override;
+    function GetCurrent: T; virtual;
+  public
+    constructor Create(AList: TCustomList<T>);
+  end;
+
+  TList<T> = class(TCustomList<T>)
+  private var
+    FComparer: IComparer<T>;
+  protected
+    // bug #24287 - workaround for generics type name conflict (Identifier not found)
+    // next bug workaround - for another error related to previous workaround
+    // change order (method must be declared before TEnumerator declaration)
+    function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
+  public
+    // with this type declaration i found #24285, #24285
+    type
+      // bug workaround
+      TEnumerator = class(TCustomListEnumerator<T>);
+
+    function GetEnumerator: TEnumerator; reintroduce;
+  protected
+    procedure SetCapacity(AValue: SizeInt); override;
+    procedure SetCount(AValue: SizeInt);
+  private
+    function GetItem(AIndex: SizeInt): T;
+    procedure SetItem(AIndex: SizeInt; const AValue: T);
+  public
+    constructor Create; overload;
+    constructor Create(const AComparer: IComparer<T>); overload;
+    constructor Create(ACollection: TEnumerable<T>); overload;
+    destructor Destroy; override;
+
+    function Add(constref AValue: T): SizeInt;
+    procedure AddRange(constref AValues: array of T); overload;
+    procedure AddRange(const AEnumerable: IEnumerable<T>); overload;
+    procedure AddRange(AEnumerable: TEnumerable<T>); overload;
+
+    procedure Insert(AIndex: SizeInt; constref AValue: T);
+    procedure InsertRange(AIndex: SizeInt; constref AValues: array of T); overload;
+    procedure InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>); overload;
+    procedure InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>); overload;
+
+    function Remove(constref AValue: T): SizeInt;
+    procedure Delete(AIndex: SizeInt); inline;
+    procedure DeleteRange(AIndex, ACount: SizeInt);
+    function ExtractIndex(const AIndex: SizeInt): T; overload;
+    function Extract(constref AValue: T): T; overload;
+
+    procedure Exchange(AIndex1, AIndex2: SizeInt);
+    procedure Move(AIndex, ANewIndex: SizeInt);
+
+    function First: T; inline;
+    function Last: T; inline;
+
+    procedure Clear;
+
+    function Contains(constref AValue: T): Boolean; inline;
+    function IndexOf(constref AValue: T): SizeInt; virtual;
+    function LastIndexOf(constref AValue: T): SizeInt; virtual;
+
+    procedure Reverse;
+
+    procedure TrimExcess;
+
+    procedure Sort; overload;
+    procedure Sort(const AComparer: IComparer<T>); overload;
+    function BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean; overload;
+    function BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
+
+    property Count: SizeInt read FItemsLength write SetCount;
+    property Items[Index: SizeInt]: T read GetItem write SetItem; default;
+  end;
+
+  TThreadList<T> = class
+  private
+    FList: TList<T>;
+    FDuplicates: TDuplicates;
+    FLock: TRTLCriticalSection;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Add(constref AValue: T);
+    procedure Remove(constref AValue: T);
+    procedure Clear;
+
+    function LockList: TList<T>;
+    procedure UnlockList; inline;
+
+    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
+  end;
+
+  TQueue<T> = class(TCustomList<T>)
+  protected
+    // bug #24287 - workaround for generics type name conflict (Identifier not found)
+    // next bug workaround - for another error related to previous workaround
+    // change order (function must be declared before TEnumerator declaration}
+    function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
+  public
+    type
+      TEnumerator = class(TCustomListEnumerator<T>)
+      public
+        constructor Create(AQueue: TQueue<T>);
+      end;
+
+    function GetEnumerator: TEnumerator; reintroduce;
+  private
+    FLow: SizeInt;
+  protected
+    procedure SetCapacity(AValue: SizeInt); override;
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
+    function GetCount: SizeInt; override;
+  public
+    constructor Create(ACollection: TEnumerable<T>); overload;
+    destructor Destroy; override;
+    procedure Enqueue(constref AValue: T);
+    function Dequeue: T;
+    function Extract: T;
+    function Peek: T;
+    procedure Clear;
+    procedure TrimExcess;
+  end;
+
+  TStack<T> = class(TCustomList<T>)
+  protected
+  // bug #24287 - workaround for generics type name conflict (Identifier not found)
+  // next bug workaround - for another error related to previous workaround
+  // change order (function must be declared before TEnumerator declaration}
+    function DoGetEnumerator: {Generics.Collections.}TEnumerator<T>; override;
+  public
+    type
+      TEnumerator = class(TCustomListEnumerator<T>);
+
+    function GetEnumerator: TEnumerator; reintroduce;
+  protected
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
+    procedure SetCapacity(AValue: SizeInt); override;
+  public
+    constructor Create(ACollection: TEnumerable<T>); overload;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Push(constref AValue: T);
+    function Pop: T; inline;
+    function Peek: T;
+    function Extract: T; inline;
+    procedure TrimExcess;
+  end;
+
+  TObjectList<T: class> = class(TList<T>)
+  private
+    FObjectsOwner: Boolean;
+  protected
+    procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
+  public
+    constructor Create(AOwnsObjects: Boolean = True); overload;
+    constructor Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean = True); overload;
+    constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
+    property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
+  end;
+
+  TObjectQueue<T: class> = class(TQueue<T>)
+  private
+    FObjectsOwner: Boolean;
+  protected
+    procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
+  public
+    constructor Create(AOwnsObjects: Boolean = True); overload;
+    constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
+    procedure Dequeue;
+    property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
+  end;
+
+  TObjectStack<T: class> = class(TStack<T>)
+  private
+    FObjectsOwner: Boolean;
+  protected
+    procedure Notify(constref AValue: T; ACollectionNotification: TCollectionNotification); override;
+  public
+    constructor Create(AOwnsObjects: Boolean = True); overload;
+    constructor Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
+    function Pop: T;
+    property OwnsObjects: Boolean read FObjectsOwner write FObjectsOwner;
+  end;
+
+  PObject = ^TObject;
+
+{$I generics.dictionariesh.inc}
+
+function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
+
+implementation
+
+function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
+begin
+  Result :=
+       (ABottom < AItem) and (AItem <= ATop )
+    or (ATop < ABottom) and (AItem > ABottom)
+    or (ATop < ABottom ) and (AItem <= ATop );
+end;
+
+{ TCustomArrayHelper<T> }
+
+class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
+  out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
+begin
+  Result := BinarySearch(AValues, AItem, AFoundIndex, AComparer, Low(AValues), Length(AValues));
+end;
+
+class function TCustomArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
+  out AFoundIndex: SizeInt): Boolean;
+begin
+  Result := BinarySearch(AValues, AItem, AFoundIndex, TComparerBugHack.Default, Low(AValues), Length(AValues));
+end;
+
+class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T);
+begin
+  QuickSort(AValues, Low(AValues), High(AValues), TComparerBugHack.Default);
+end;
+
+class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
+  const AComparer: IComparer<T>);
+begin
+  QuickSort(AValues, Low(AValues), High(AValues), AComparer);
+end;
+
+class procedure TCustomArrayHelper<T>.Sort(var AValues: array of T;
+  const AComparer: IComparer<T>; AIndex, ACount: SizeInt);
+begin
+  if ACount <= 1 then
+    Exit;
+  QuickSort(AValues, AIndex, Pred(AIndex + ACount), AComparer);
+end;
+
+{ TArrayHelper<T> }
+
+class procedure TArrayHelper<T>.QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
+  const AComparer: IComparer<T>);
+var
+  I, J: SizeInt;
+  P, Q: T;
+begin
+  if ((ARight - ALeft) <= 0) or (Length(AValues) = 0) then
+    Exit;
+  repeat
+    I := ALeft;
+    J := ARight;
+    P := AValues[ALeft + (ARight - ALeft) shr 1];
+    repeat
+        while AComparer.Compare(AValues[I], P) < 0 do
+          I += 1;
+        while AComparer.Compare(AValues[J], P) > 0 do
+          J -= 1;
+      if I <= J then
+      begin
+        if I <> J then
+        begin
+          Q := AValues[I];
+          AValues[I] := AValues[J];
+          AValues[J] := Q;
+        end;
+        I += 1;
+        J -= 1;
+      end;
+    until I > J;
+    // sort the smaller range recursively
+    // sort the bigger range via the loop
+    // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+    if J - ALeft < ARight - I then
+    begin
+      if ALeft < J then
+        QuickSort(AValues, ALeft, J, AComparer);
+      ALeft := I;
+    end
+    else
+    begin
+      if I < ARight then
+        QuickSort(AValues, I, ARight, AComparer);
+      ARight := J;
+    end;
+   until ALeft >= ARight;
+end;
+
+class function TArrayHelper<T>.BinarySearch(constref AValues: array of T; constref AItem: T;
+  out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
+  AIndex, ACount: SizeInt): Boolean;
+var
+  imin, imax, imid: Int32;
+  LCompare: SizeInt;
+begin
+  // continually narrow search until just one element remains
+  imin := AIndex;
+  imax := Pred(AIndex + ACount);
+
+  // http://en.wikipedia.org/wiki/Binary_search_algorithm
+  while (imin < imax) do
+  begin
+        imid := imin + ((imax - imin) shr 1);
+
+        // code must guarantee the interval is reduced at each iteration
+        // assert(imid < imax);
+        // note: 0 <= imin < imax implies imid will always be less than imax
+
+        LCompare := AComparer.Compare(AValues[imid], AItem);
+        // reduce the search
+        if (LCompare < 0) then
+          imin := imid + 1
+        else
+        begin
+          imax := imid;
+          if LCompare = 0 then
+          begin
+            AFoundIndex := imid;
+            Exit(True);
+          end;
+        end;
+  end;
+    // At exit of while:
+    //   if A[] is empty, then imax < imin
+    //   otherwise imax == imin
+
+    // deferred test for equality
+
+  LCompare := AComparer.Compare(AValues[imin], AItem);
+  if (imax = imin) and (LCompare = 0) then
+  begin
+    AFoundIndex := imin;
+    Exit(True);
+  end
+  else
+  begin
+    AFoundIndex := -1;
+    Exit(False);
+  end;
+end;
+
+{ TEnumerator<T> }
+
+function TEnumerator<T>.MoveNext: boolean;
+begin
+  Exit(DoMoveNext);
+end;
+
+{ TEnumerable<T> }
+
+function TEnumerable<T>.ToArrayImpl(ACount: SizeInt): TArray<T>;
+var
+  i: SizeInt;
+  LEnumerator: TEnumerator<T>;
+begin
+  SetLength(Result, ACount);
+
+  try
+    LEnumerator := GetEnumerator;
+
+    i := 0;
+    while LEnumerator.MoveNext do
+    begin
+      Result[i] := LEnumerator.Current;
+      Inc(i);
+    end;
+  finally
+    LEnumerator.Free;
+  end;
+end;
+
+function TEnumerable<T>.GetEnumerator: TEnumerator<T>;
+begin
+  Exit(DoGetEnumerator);
+end;
+
+function TEnumerable<T>.ToArray: TArray<T>;
+var
+  LEnumerator: TEnumerator<T>;
+  LBuffer: TList<T>;
+begin
+  LBuffer := TList<T>.Create;
+  try
+    LEnumerator := GetEnumerator;
+
+    while LEnumerator.MoveNext do
+      LBuffer.Add(LEnumerator.Current);
+
+    Result := LBuffer.ToArray;
+  finally
+    LBuffer.Free;
+    LEnumerator.Free;
+  end;
+end;
+
+{ TCustomList<T> }
+
+function TCustomList<T>.PrepareAddingItem: SizeInt;
+begin
+  Result := Length(FItems);
+
+  if (FItemsLength < 4) and (Result < 4) then
+    SetLength(FItems, 4)
+  else if FItemsLength = High(FItemsLength) then
+    OutOfMemoryError
+  else if FItemsLength = Result then
+    SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
+
+  Result := FItemsLength;
+  Inc(FItemsLength);
+end;
+
+function TCustomList<T>.PrepareAddingRange(ACount: SizeInt): SizeInt;
+begin
+  if ACount < 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+  if ACount = 0 then
+    Exit(FItemsLength - 1);
+
+  if (FItemsLength = 0) and (Length(FItems) = 0) then
+    SetLength(FItems, 4)
+  else if FItemsLength = High(FItemsLength) then
+    OutOfMemoryError;
+
+  Result := Length(FItems);
+  while Pred(FItemsLength + ACount) >= Result do
+  begin
+    SetLength(FItems, CUSTOM_LIST_CAPACITY_INC);
+    Result := Length(FItems);
+  end;
+
+  Result := FItemsLength;
+  Inc(FItemsLength, ACount);
+end;
+
+function TCustomList<T>.ToArray: TArray<T>;
+begin
+  Result := ToArrayImpl(Count);
+end;
+
+function TCustomList<T>.GetCount: SizeInt;
+begin
+  Result := FItemsLength;
+end;
+
+procedure TCustomList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
+begin
+  if Assigned(FOnNotify) then
+    FOnNotify(Self, AValue, ACollectionNotification);
+end;
+
+function TCustomList<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
+begin
+  if (AIndex < 0) or (AIndex >= FItemsLength) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Result := FItems[AIndex];
+  Dec(FItemsLength);
+
+  FItems[AIndex] := Default(T);
+  if AIndex <> FItemsLength then
+  begin
+    System.Move(FItems[AIndex + 1], FItems[AIndex], (FItemsLength - AIndex) * SizeOf(T));
+    FillChar(FItems[FItemsLength], SizeOf(T), 0);
+  end;
+
+  Notify(Result, ACollectionNotification);
+end;
+
+function TCustomList<T>.GetCapacity: SizeInt;
+begin
+  Result := Length(FItems);
+end;
+
+{ TCustomListEnumerator<T> }
+
+function TCustomListEnumerator<T>.DoMoveNext: boolean;
+begin
+  Inc(FIndex);
+  Result := (FList.FItemsLength <> 0) and (FIndex < FList.FItemsLength)
+end;
+
+function TCustomListEnumerator<T>.DoGetCurrent: T;
+begin
+  Result := GetCurrent;
+end;
+
+function TCustomListEnumerator<T>.GetCurrent: T;
+begin
+  Result := FList.FItems[FIndex];
+end;
+
+constructor TCustomListEnumerator<T>.Create(AList: TCustomList<T>);
+begin
+  inherited Create;
+  FIndex := -1;
+  FList := AList;
+end;
+
+{ TList<T> }
+
+constructor TList<T>.Create;
+begin
+  FComparer := TComparer<T>.Default;
+end;
+
+constructor TList<T>.Create(const AComparer: IComparer<T>);
+begin
+  FComparer := AComparer;
+end;
+
+constructor TList<T>.Create(ACollection: TEnumerable<T>);
+var
+  LItem: T;
+begin
+  Create;
+  for LItem in ACollection do
+    Add(LItem);
+end;
+
+destructor TList<T>.Destroy;
+begin
+  SetCapacity(0);
+end;
+
+procedure TList<T>.SetCapacity(AValue: SizeInt);
+begin
+  if AValue < Count then
+    Count := AValue;
+
+  SetLength(FItems, AValue);
+end;
+
+procedure TList<T>.SetCount(AValue: SizeInt);
+begin
+  if AValue < 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  if AValue > Capacity then
+    Capacity := AValue;
+  if AValue < Count then
+    DeleteRange(AValue, Count - AValue);
+
+  FItemsLength := AValue;
+end;
+
+function TList<T>.GetItem(AIndex: SizeInt): T;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Result := FItems[AIndex];
+end;
+
+procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
+begin
+  if (AIndex < 0) or (AIndex >= Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  FItems[AIndex] := AValue;
+end;
+
+function TList<T>.GetEnumerator: TEnumerator;
+begin
+  Result := TEnumerator.Create(Self);
+end;
+
+function TList<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
+begin
+  Result := GetEnumerator;
+end;
+
+function TList<T>.Add(constref AValue: T): SizeInt;
+begin
+  Result := PrepareAddingItem;
+  FItems[Result] := AValue;
+  Notify(AValue, cnAdded);
+end;
+
+procedure TList<T>.AddRange(constref AValues: array of T);
+begin
+  InsertRange(Count, AValues);
+end;
+
+procedure TList<T>.AddRange(const AEnumerable: IEnumerable<T>);
+var
+  LValue: T;
+begin
+  for LValue in AEnumerable do
+    Add(LValue);
+end;
+
+procedure TList<T>.AddRange(AEnumerable: TEnumerable<T>);
+var
+  LValue: T;
+begin
+  for LValue in AEnumerable do
+    Add(LValue);
+end;
+
+procedure TList<T>.Insert(AIndex: SizeInt; constref AValue: T);
+begin
+  if (AIndex < 0) or (AIndex > Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  if AIndex <> PrepareAddingItem then
+  begin
+    System.Move(FItems[AIndex], FItems[AIndex + 1], ((Count - AIndex) - 1) * SizeOf(T));
+    FillChar(FItems[AIndex], SizeOf(T), 0);
+  end;
+
+  FItems[AIndex] := AValue;
+  Notify(AValue, cnAdded);
+end;
+
+procedure TList<T>.InsertRange(AIndex: SizeInt; constref AValues: array of T);
+var
+  i: SizeInt;
+  LLength: SizeInt;
+  LValue: ^T;
+begin
+  if (AIndex < 0) or (AIndex > Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  LLength := Length(AValues);
+  if LLength = 0 then
+    Exit;
+
+  if AIndex <> PrepareAddingRange(LLength) then
+  begin
+    System.Move(FItems[AIndex], FItems[AIndex + LLength], ((Count - AIndex) - LLength) * SizeOf(T));
+    FillChar(FItems[AIndex], SizeOf(T) * LLength, 0);
+  end;
+
+  LValue := @AValues[0];
+  for i := AIndex to Pred(AIndex + LLength) do
+  begin
+    FItems[i] := LValue^;
+    Notify(LValue^, cnAdded);
+    Inc(LValue);
+  end;
+end;
+
+procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: IEnumerable<T>);
+var
+  LValue: T;
+  i: SizeInt;
+begin
+  if (AIndex < 0) or (AIndex > Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  i := 0;
+  for LValue in AEnumerable do
+  begin
+    Insert(Aindex + i, LValue);
+    Inc(i);
+  end;
+end;
+
+procedure TList<T>.InsertRange(AIndex: SizeInt; const AEnumerable: TEnumerable<T>);
+var
+  LValue: T;
+  i:  SizeInt;
+begin
+  if (AIndex < 0) or (AIndex > Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  i := 0;
+  for LValue in AEnumerable do
+  begin
+    Insert(Aindex + i, LValue);
+    Inc(i);
+  end;
+end;
+
+function TList<T>.Remove(constref AValue: T): SizeInt;
+begin
+  Result := IndexOf(AValue);
+  if Result >= 0 then
+    DoRemove(Result, cnRemoved);
+end;
+
+procedure TList<T>.Delete(AIndex: SizeInt);
+begin
+  DoRemove(AIndex, cnRemoved);
+end;
+
+procedure TList<T>.DeleteRange(AIndex, ACount: SizeInt);
+var
+  LDeleted: array of T;
+  i: SizeInt;
+  LMoveDelta: SizeInt;
+begin
+  if ACount = 0 then
+    Exit;
+
+  if (ACount < 0) or (AIndex < 0) or (AIndex + ACount > Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  SetLength(LDeleted, Count);
+  System.Move(FItems[AIndex], LDeleted[0], ACount * SizeOf(T));
+
+  LMoveDelta := Count - (AIndex + ACount);
+
+  if LMoveDelta = 0 then
+    FillChar(FItems[AIndex], ACount * SizeOf(T), #0)
+  else
+  begin
+    System.Move(FItems[AIndex + ACount], FItems[AIndex], LMoveDelta * SizeOf(T));
+    FillChar(FItems[Count - ACount], ACount * SizeOf(T), #0);
+  end;
+
+  FItemsLength -= ACount;
+
+  for i := 0 to High(LDeleted) do
+    Notify(LDeleted[i], cnRemoved);
+end;
+
+function TList<T>.ExtractIndex(const AIndex: SizeInt): T;
+begin
+  Result := DoRemove(AIndex, cnExtracted);
+end;
+
+function TList<T>.Extract(constref AValue: T): T;
+var
+  LIndex: SizeInt;
+begin
+  LIndex := IndexOf(AValue);
+  if LIndex < 0 then
+    Exit(Default(T));
+
+  Result := DoRemove(LIndex, cnExtracted);
+end;
+
+procedure TList<T>.Exchange(AIndex1, AIndex2: SizeInt);
+var
+  LTemp: T;
+begin
+  LTemp := FItems[AIndex1];
+  FItems[AIndex1] := FItems[AIndex2];
+  FItems[AIndex2] := LTemp;
+end;
+
+procedure TList<T>.Move(AIndex, ANewIndex: SizeInt);
+var
+  LTemp: T;
+begin
+  if ANewIndex = AIndex then
+    Exit;
+
+  if (ANewIndex < 0) or (ANewIndex >= Count) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  LTemp := FItems[AIndex];
+  FItems[AIndex] := Default(T);
+
+  if AIndex < ANewIndex then
+    System.Move(FItems[Succ(AIndex)], FItems[AIndex], (ANewIndex - AIndex) * SizeOf(T))
+  else
+    System.Move(FItems[ANewIndex], FItems[Succ(ANewIndex)], (AIndex - ANewIndex) * SizeOf(T));
+
+  FillChar(FItems[ANewIndex], SizeOf(T), #0);
+  FItems[ANewIndex] := LTemp;
+end;
+
+function TList<T>.First: T;
+begin
+  Result := Items[0];
+end;
+
+function TList<T>.Last: T;
+begin
+  Result := Items[Pred(Count)];
+end;
+
+procedure TList<T>.Clear;
+begin
+  SetCount(0);
+  SetCapacity(0);
+end;
+
+procedure TList<T>.TrimExcess;
+begin
+  SetCapacity(Count);
+end;
+
+function TList<T>.Contains(constref AValue: T): Boolean;
+begin
+  Result := IndexOf(AValue) >= 0;
+end;
+
+function TList<T>.IndexOf(constref AValue: T): SizeInt;
+var
+  i: SizeInt;
+begin
+  for i := 0 to Count - 1 do
+    if FComparer.Compare(AValue, FItems[i]) = 0 then
+      Exit(i);
+  Result := -1;
+end;
+
+function TList<T>.LastIndexOf(constref AValue: T): SizeInt;
+var
+  i: SizeInt;
+begin
+  for i := Count - 1 downto 0 do
+    if FComparer.Compare(AValue, FItems[i]) = 0 then
+      Exit(i);
+  Result := -1;
+end;
+
+procedure TList<T>.Reverse;
+var
+  a, b: SizeInt;
+  LTemp: T;
+begin
+  a := 0;
+  b := Count - 1;
+  while a < b do
+  begin
+    LTemp := FItems[a];
+    FItems[a] := FItems[b];
+    FItems[b] := LTemp;
+    Inc(a);
+    Dec(b);
+  end;
+end;
+
+procedure TList<T>.Sort;
+begin
+  TArrayHelperBugHack.Sort(FItems, FComparer, 0, Count);
+end;
+
+procedure TList<T>.Sort(const AComparer: IComparer<T>);
+begin
+  TArrayHelperBugHack.Sort(FItems, AComparer, 0, Count);
+end;
+
+function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt): Boolean;
+begin
+  Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex);
+end;
+
+function TList<T>.BinarySearch(constref AItem: T; out AIndex: SizeInt; const AComparer: IComparer<T>): Boolean;
+begin
+  Result := TArrayHelperBugHack.BinarySearch(FItems, AItem, AIndex, AComparer);
+end;
+
+{ TThreadList<T> }
+
+constructor TThreadList<T>.Create;
+begin
+  inherited Create;
+  FDuplicates:=dupIgnore;
+  InitCriticalSection(FLock);
+  FList := TList<T>.Create;
+end;
+
+destructor TThreadList<T>.Destroy;
+begin
+  LockList;
+  try
+    FList.Free;
+    inherited Destroy;
+  finally
+    UnlockList;
+    DoneCriticalSection(FLock);
+  end;
+end;
+
+procedure TThreadList<T>.Add(constref AValue: T);
+begin
+  LockList;
+  try
+    if (Duplicates = dupAccept) or (FList.IndexOf(AValue) = -1) then
+      FList.Add(AValue)
+    else if Duplicates = dupError then
+      raise EArgumentException.CreateRes(@SDuplicatesNotAllowed);
+  finally
+    UnlockList;
+  end;
+end;
+
+procedure TThreadList<T>.Remove(constref AValue: T);
+begin
+  LockList;
+  try
+    FList.Remove(AValue);
+  finally
+    UnlockList;
+  end;
+end;
+
+procedure TThreadList<T>.Clear;
+begin
+  LockList;
+  try
+    FList.Clear;
+  finally
+    UnlockList;
+  end;
+end;
+
+function TThreadList<T>.LockList: TList<T>;
+begin
+  Result:=FList;
+  System.EnterCriticalSection(FLock);
+end;
+
+procedure TThreadList<T>.UnlockList;
+begin
+  System.LeaveCriticalSection(FLock);
+end;
+
+{ TQueue<T>.TEnumerator }
+
+constructor TQueue<T>.TEnumerator.Create(AQueue: TQueue<T>);
+begin
+  inherited Create(AQueue);
+
+  FIndex := Pred(AQueue.FLow);
+end;
+
+{ TQueue<T> }
+
+function TQueue<T>.GetEnumerator: TEnumerator;
+begin
+  Result := TEnumerator.Create(Self);
+end;
+
+function TQueue<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
+begin
+  Result := GetEnumerator;
+end;
+
+function TQueue<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
+begin
+  Result := FItems[AIndex];
+  FItems[AIndex] := Default(T);
+  Notify(Result, ACollectionNotification);
+  FLow += 1;
+  if FLow = FItemsLength then
+  begin
+    FLow := 0;
+    FItemsLength := 0;
+  end;
+end;
+
+procedure TQueue<T>.SetCapacity(AValue: SizeInt);
+begin
+  if AValue < Count then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  if AValue = FItemsLength then
+    Exit;
+
+  if (Count > 0) and (FLow > 0) then
+  begin
+    Move(FItems[FLow], FItems[0], Count * SizeOf(T));
+    FillChar(FItems[Count], (FItemsLength - Count) * SizeOf(T), #0);
+  end;
+
+  SetLength(FItems, AValue);
+  FItemsLength := Count;
+  FLow := 0;
+end;
+
+function TQueue<T>.GetCount: SizeInt;
+begin
+  Result := FItemsLength - FLow;
+end;
+
+constructor TQueue<T>.Create(ACollection: TEnumerable<T>);
+var
+  LItem: T;
+begin
+  for LItem in ACollection do
+    Enqueue(LItem);
+end;
+
+destructor TQueue<T>.Destroy;
+begin
+  Clear;
+end;
+
+procedure TQueue<T>.Enqueue(constref AValue: T);
+var
+  LIndex: SizeInt;
+begin
+  LIndex := PrepareAddingItem;
+  FItems[LIndex] := AValue;
+  Notify(AValue, cnAdded);
+end;
+
+function TQueue<T>.Dequeue: T;
+begin
+  Result := DoRemove(FLow, cnRemoved);
+end;
+
+function TQueue<T>.Extract: T;
+begin
+  Result := DoRemove(FLow, cnExtracted);
+end;
+
+function TQueue<T>.Peek: T;
+begin
+  if (Count = 0) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Result := FItems[FLow];
+end;
+
+procedure TQueue<T>.Clear;
+begin
+  while Count <> 0 do
+    Dequeue;
+  FLow := 0;
+  FItemsLength := 0;
+end;
+
+procedure TQueue<T>.TrimExcess;
+begin
+  SetCapacity(Count);
+end;
+
+{ TStack<T> }
+
+function TStack<T>.GetEnumerator: TEnumerator;
+begin
+  Result := TEnumerator.Create(Self);
+end;
+
+function TStack<T>.DoGetEnumerator: {Generics.Collections.}TEnumerator<T>;
+begin
+  Result := GetEnumerator;
+end;
+
+constructor TStack<T>.Create(ACollection: TEnumerable<T>);
+var
+  LItem: T;
+begin
+  for LItem in ACollection do
+    Push(LItem);
+end;
+
+function TStack<T>.DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T;
+begin
+  if AIndex < 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Result := FItems[AIndex];
+  FItems[AIndex] := Default(T);
+  FItemsLength -= 1;
+  Notify(Result, ACollectionNotification);
+end;
+
+destructor TStack<T>.Destroy;
+begin
+  Clear;
+end;
+
+procedure TStack<T>.Clear;
+begin
+  while Count <> 0 do
+    Pop;
+end;
+
+procedure TStack<T>.SetCapacity(AValue: SizeInt);
+begin
+  if AValue < Count then
+    AValue := Count;
+
+  SetLength(FItems, AValue);
+end;
+
+procedure TStack<T>.Push(constref AValue: T);
+var
+  LIndex: SizeInt;
+begin
+  LIndex := PrepareAddingItem;
+  FItems[LIndex] := AValue;
+  Notify(AValue, cnAdded);
+end;
+
+function TStack<T>.Pop: T;
+begin
+  Result := DoRemove(FItemsLength - 1, cnRemoved);
+end;
+
+function TStack<T>.Peek: T;
+begin
+  if (Count = 0) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Result := FItems[FItemsLength - 1];
+end;
+
+function TStack<T>.Extract: T;
+begin
+  Result := DoRemove(FItemsLength - 1, cnExtracted);
+end;
+
+procedure TStack<T>.TrimExcess;
+begin
+  SetCapacity(Count);
+end;
+
+{ TObjectList<T> }
+
+procedure TObjectList<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
+begin
+  inherited Notify(AValue, ACollectionNotification);
+
+  if FObjectsOwner and (ACollectionNotification = cnRemoved) then
+    TObject(AValue).Free;
+end;
+
+constructor TObjectList<T>.Create(AOwnsObjects: Boolean);
+begin
+  inherited Create;
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+constructor TObjectList<T>.Create(const AComparer: IComparer<T>; AOwnsObjects: Boolean);
+begin
+  inherited Create(AComparer);
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+constructor TObjectList<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
+begin
+  inherited Create(ACollection);
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+{ TObjectQueue<T> }
+
+procedure TObjectQueue<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
+begin
+  inherited Notify(AValue, ACollectionNotification);
+  if FObjectsOwner and (ACollectionNotification = cnRemoved) then
+    TObject(AValue).Free;
+end;
+
+constructor TObjectQueue<T>.Create(AOwnsObjects: Boolean);
+begin
+  inherited Create;
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+constructor TObjectQueue<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
+begin
+  inherited Create(ACollection);
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+procedure TObjectQueue<T>.Dequeue;
+begin
+  inherited Dequeue;
+end;
+
+{ TObjectStack<T> }
+
+procedure TObjectStack<T>.Notify(constref AValue: T; ACollectionNotification: TCollectionNotification);
+begin
+  inherited Notify(AValue, ACollectionNotification);
+  if FObjectsOwner and (ACollectionNotification = cnRemoved) then
+    TObject(AValue).Free;
+end;
+
+constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
+begin
+  inherited Create;
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+constructor TObjectStack<T>.Create(ACollection: TEnumerable<T>; AOwnsObjects: Boolean);
+begin
+  inherited Create(ACollection);
+
+  FObjectsOwner := AOwnsObjects;
+end;
+
+function TObjectStack<T>.Pop: T;
+begin
+  Result := inherited Pop;
+end;
+
+{$I generics.dictionaries.inc}
+
+end.

Units/Utils/generics.defaults.pas

@@ -0,0 +1,3278 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.Defaults;
+
+{$MODE DELPHI}{$H+}
+{$POINTERMATH ON}
+{$MACRO ON}
+{$COPERATORS ON}
+{$HINTS OFF}
+{$WARNINGS OFF}
+{$NOTES OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Hashes, TypInfo, Variants, Math, Generics.Strings, Generics.Helpers;
+
+type
+  IComparer<T> = interface
+    function Compare(constref Left, Right: T): Integer; overload;
+  end;
+
+  TOnComparison<T> = function(constref Left, Right: T): Integer of object;
+  TComparisonFunc<T> = function(constref Left, Right: T): Integer;
+
+  TComparer<T> = class(TInterfacedObject, IComparer<T>)
+  public
+    class function Default: IComparer<T>; static;
+    function Compare(constref ALeft, ARight: T): Integer; virtual; abstract; overload;
+
+    class function Construct(const AComparison: TOnComparison<T>): IComparer<T>; overload;
+    class function Construct(const AComparison: TComparisonFunc<T>): IComparer<T>; overload;
+  end;
+
+  TDelegatedComparerEvents<T> = class(TComparer<T>)
+  private
+    FComparison: TOnComparison<T>;
+  public
+    function Compare(constref ALeft, ARight: T): Integer; override;
+    constructor Create(AComparison: TOnComparison<T>);
+  end;
+
+  TDelegatedComparerFunc<T> = class(TComparer<T>)
+  private
+    FComparison: TComparisonFunc<T>;
+  public
+    function Compare(constref ALeft, ARight: T): Integer; override;
+    constructor Create(AComparison: TComparisonFunc<T>);
+  end;
+
+  IEqualityComparer<T> = interface
+    function Equals(constref ALeft, ARight: T): Boolean;
+    function GetHashCode(constref AValue: T): UInt32;
+  end;
+
+  IExtendedEqualityComparer<T> = interface(IEqualityComparer<T>)
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); // for double hashing and more
+  end;
+
+  ShortString1 = string[1];
+  ShortString2 = string[2];
+  ShortString3 = string[3];
+
+  { TAbstractInterface }
+
+  TInterface = class
+  public
+    function QueryInterface(constref {%H-}IID: TGUID;{%H-} out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
+    function _AddRef: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual; abstract;
+    function _Release: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};  virtual; abstract;
+  end;
+
+  { TRawInterface }
+
+  TRawInterface = class(TInterface)
+  public
+    function _AddRef: LongInt; override;
+    function _Release: LongInt; override;
+  end;
+
+  { TComTypeSizeInterface }
+
+  // INTERNAL USE ONLY!
+  TComTypeSizeInterface = class(TInterface)
+  public
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    function _AddRef: LongInt; override;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    function _Release: LongInt; override;
+  end;
+
+  { TSingletonImplementation }
+
+  TSingletonImplementation = class(TRawInterface, IInterface)
+  public
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; override;
+  end;
+
+  TCompare = class
+  protected
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function _Binary(constref ALeft, ARight): Integer;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function _DynArray(constref ALeft, ARight: Pointer): Integer;
+  public
+    class function Integer(constref ALeft, ARight: Integer): Integer;
+    class function Int8(constref ALeft, ARight: Int8): Integer;
+    class function Int16(constref ALeft, ARight: Int16): Integer;
+    class function Int32(constref ALeft, ARight: Int32): Integer;
+    class function Int64(constref ALeft, ARight: Int64): Integer;
+    class function UInt8(constref ALeft, ARight: UInt8): Integer;
+    class function UInt16(constref ALeft, ARight: UInt16): Integer;
+    class function UInt32(constref ALeft, ARight: UInt32): Integer;
+    class function UInt64(constref ALeft, ARight: UInt64): Integer;
+    class function Single(constref ALeft, ARight: Single): Integer;
+    class function Double(constref ALeft, ARight: Double): Integer;
+    class function Extended(constref ALeft, ARight: Extended): Integer;
+    class function Currency(constref ALeft, ARight: Currency): Integer;
+    class function Comp(constref ALeft, ARight: Comp): Integer;
+    class function Binary(constref ALeft, ARight; const ASize: SizeInt): Integer;
+    class function DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Integer;
+    class function ShortString1(constref ALeft, ARight: ShortString1): Integer;
+    class function ShortString2(constref ALeft, ARight: ShortString2): Integer;
+    class function ShortString3(constref ALeft, ARight: ShortString3): Integer;
+    class function &String(constref ALeft, ARight: string): Integer;
+    class function ShortString(constref ALeft, ARight: ShortString): Integer;
+    class function AnsiString(constref ALeft, ARight: AnsiString): Integer;
+    class function WideString(constref ALeft, ARight: WideString): Integer;
+    class function UnicodeString(constref ALeft, ARight: UnicodeString): Integer;
+    class function Method(constref ALeft, ARight: TMethod): Integer;
+    class function Variant(constref ALeft, ARight: PVariant): Integer;
+    class function Pointer(constref ALeft, ARight: PtrUInt): Integer;
+  end;
+
+  { TEquals }
+
+  TEquals = class
+  protected
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function _Binary(constref ALeft, ARight): Boolean;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function _DynArray(constref ALeft, ARight: Pointer): Boolean;
+  public
+    class function Integer(constref ALeft, ARight: Integer): Boolean;
+    class function Int8(constref ALeft, ARight: Int8): Boolean;
+    class function Int16(constref ALeft, ARight: Int16): Boolean;
+    class function Int32(constref ALeft, ARight: Int32): Boolean;
+    class function Int64(constref ALeft, ARight: Int64): Boolean;
+    class function UInt8(constref ALeft, ARight: UInt8): Boolean;
+    class function UInt16(constref ALeft, ARight: UInt16): Boolean;
+    class function UInt32(constref ALeft, ARight: UInt32): Boolean;
+    class function UInt64(constref ALeft, ARight: UInt64): Boolean;
+    class function Single(constref ALeft, ARight: Single): Boolean;
+    class function Double(constref ALeft, ARight: Double): Boolean;
+    class function Extended(constref ALeft, ARight: Extended): Boolean;
+    class function Currency(constref ALeft, ARight: Currency): Boolean;
+    class function Comp(constref ALeft, ARight: Comp): Boolean;
+    class function Binary(constref ALeft, ARight; const ASize: SizeInt): Boolean;
+    class function DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Boolean;
+    class function &Class(constref ALeft, ARight: TObject): Boolean;
+    class function ShortString1(constref ALeft, ARight: ShortString1): Boolean;
+    class function ShortString2(constref ALeft, ARight: ShortString2): Boolean;
+    class function ShortString3(constref ALeft, ARight: ShortString3): Boolean;
+    class function &String(constref ALeft, ARight: String): Boolean;
+    class function ShortString(constref ALeft, ARight: ShortString): Boolean;
+    class function AnsiString(constref ALeft, ARight: AnsiString): Boolean;
+    class function WideString(constref ALeft, ARight: WideString): Boolean;
+    class function UnicodeString(constref ALeft, ARight: UnicodeString): Boolean;
+    class function Method(constref ALeft, ARight: TMethod): Boolean;
+    class function Variant(constref ALeft, ARight: PVariant): Boolean;
+    class function Pointer(constref ALeft, ARight: PtrUInt): Boolean;
+  end;
+
+  THashServiceClass = class of THashService;
+  TExtendedHashServiceClass = class of TExtendedHashService;
+  THashFactoryClass = class of THashFactory;
+
+  TExtendedHashFactoryClass = class of TExtendedHashFactory;
+
+  { TComparerService }
+
+{$DEFINE STD_RAW_INTERFACE_METHODS :=
+    QueryInterface: @TRawInterface.QueryInterface;
+    _AddRef       : @TRawInterface._AddRef;
+    _Release      : @TRawInterface._Release
+}
+
+{$DEFINE STD_COM_TYPESIZE_INTERFACE_METHODS :=
+    QueryInterface: @TComTypeSizeInterface.QueryInterface;
+    _AddRef       : @TComTypeSizeInterface._AddRef;
+    _Release      : @TComTypeSizeInterface._Release
+}
+
+  TGetHashListOptions = set of (ghloHashListAsInitData);
+
+  THashFactory = class
+  private type
+    PPEqualityComparerVMT = ^PEqualityComparerVMT;
+    PEqualityComparerVMT = ^TEqualityComparerVMT;
+    TEqualityComparerVMT = packed record
+      QueryInterface: CodePointer;
+      _AddRef: CodePointer;
+      _Release: CodePointer;
+      Equals: CodePointer;
+      GetHashCode: CodePointer;
+      __Reserved: Pointer; // initially or TExtendedEqualityComparerVMT compatibility
+                           // (important when ExtendedEqualityComparer is calling Binary method)
+      __ClassRef: THashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
+    end;
+
+  private
+(***********************************************************************************************************************
+      Hashes
+(**********************************************************************************************************************)
+
+    class function Int8         (constref AValue: Int8         ): UInt32; overload;
+    class function Int16        (constref AValue: Int16        ): UInt32; overload;
+    class function Int32        (constref AValue: Int32        ): UInt32; overload;
+    class function Int64        (constref AValue: Int64        ): UInt32; overload;
+    class function UInt8        (constref AValue: UInt8        ): UInt32; overload;
+    class function UInt16       (constref AValue: UInt16       ): UInt32; overload;
+    class function UInt32       (constref AValue: UInt32       ): UInt32; overload;
+    class function UInt64       (constref AValue: UInt64       ): UInt32; overload;
+    class function Single       (constref AValue: Single       ): UInt32; overload;
+    class function Double       (constref AValue: Double       ): UInt32; overload;
+    class function Extended     (constref AValue: Extended     ): UInt32; overload;
+    class function Currency     (constref AValue: Currency     ): UInt32; overload;
+    class function Comp         (constref AValue: Comp         ): UInt32; overload;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function Binary       (constref AValue               ): UInt32; overload;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class function DynArray     (constref AValue: Pointer      ): UInt32; overload;
+    class function &Class       (constref AValue: TObject      ): UInt32; overload;
+    class function ShortString1 (constref AValue: ShortString1 ): UInt32; overload;
+    class function ShortString2 (constref AValue: ShortString2 ): UInt32; overload;
+    class function ShortString3 (constref AValue: ShortString3 ): UInt32; overload;
+    class function ShortString  (constref AValue: ShortString   ): UInt32; overload;
+    class function AnsiString   (constref AValue: AnsiString   ): UInt32; overload;
+    class function WideString   (constref AValue: WideString   ): UInt32; overload;
+    class function UnicodeString(constref AValue: UnicodeString): UInt32; overload;
+    class function Method       (constref AValue: TMethod      ): UInt32; overload;
+    class function Variant      (constref AValue: PVariant     ): UInt32; overload;
+    class function Pointer      (constref AValue: Pointer      ): UInt32; overload;
+  public
+    const MAX_HASHLIST_COUNT = 1;
+    const HASH_FUNCTIONS_COUNT = 1;
+    const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (1);
+    const HASH_FUNCTIONS_MASK_SIZE = 1;
+
+    class function GetHashService: THashServiceClass; virtual; abstract;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; virtual; abstract; reintroduce;
+  end;
+
+  TExtendedHashFactory = class(THashFactory)
+  private type
+    PPExtendedEqualityComparerVMT = ^PExtendedEqualityComparerVMT;
+    PExtendedEqualityComparerVMT = ^TExtendedEqualityComparerVMT;
+    TExtendedEqualityComparerVMT = packed record
+      QueryInterface: CodePointer;
+      _AddRef: CodePointer;
+      _Release: CodePointer;
+      Equals: CodePointer;
+      GetHashCode: CodePointer;
+      GetHashList: CodePointer;
+      __ClassRef: TExtendedHashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
+    end;
+  private
+(***********************************************************************************************************************
+      Hashes 2
+(**********************************************************************************************************************)
+
+    class procedure Int8         (constref AValue: Int8         ; AHashList: PUInt32); overload;
+    class procedure Int16        (constref AValue: Int16        ; AHashList: PUInt32); overload;
+    class procedure Int32        (constref AValue: Int32        ; AHashList: PUInt32); overload;
+    class procedure Int64        (constref AValue: Int64        ; AHashList: PUInt32); overload;
+    class procedure UInt8        (constref AValue: UInt8        ; AHashList: PUInt32); overload;
+    class procedure UInt16       (constref AValue: UInt16       ; AHashList: PUInt32); overload;
+    class procedure UInt32       (constref AValue: UInt32       ; AHashList: PUInt32); overload;
+    class procedure UInt64       (constref AValue: UInt64       ; AHashList: PUInt32); overload;
+    class procedure Single       (constref AValue: Single       ; AHashList: PUInt32); overload;
+    class procedure Double       (constref AValue: Double       ; AHashList: PUInt32); overload;
+    class procedure Extended     (constref AValue: Extended     ; AHashList: PUInt32); overload;
+    class procedure Currency     (constref AValue: Currency     ; AHashList: PUInt32); overload;
+    class procedure Comp         (constref AValue: Comp         ; AHashList: PUInt32); overload;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class procedure Binary       (constref AValue               ; AHashList: PUInt32); overload;
+    // warning ! self as PSpoofInterfacedTypeSizeObject
+    class procedure DynArray     (constref AValue: Pointer      ; AHashList: PUInt32); overload;
+    class procedure &Class       (constref AValue: TObject      ; AHashList: PUInt32); overload;
+    class procedure ShortString1 (constref AValue: ShortString1 ; AHashList: PUInt32); overload;
+    class procedure ShortString2 (constref AValue: ShortString2 ; AHashList: PUInt32); overload;
+    class procedure ShortString3 (constref AValue: ShortString3 ; AHashList: PUInt32); overload;
+    class procedure ShortString  (constref AValue: ShortString   ; AHashList: PUInt32); overload;
+    class procedure AnsiString   (constref AValue: AnsiString   ; AHashList: PUInt32); overload;
+    class procedure WideString   (constref AValue: WideString   ; AHashList: PUInt32); overload;
+    class procedure UnicodeString(constref AValue: UnicodeString; AHashList: PUInt32); overload;
+    class procedure Method       (constref AValue: TMethod      ; AHashList: PUInt32); overload;
+    class procedure Variant      (constref AValue: PVariant     ; AHashList: PUInt32); overload;
+    class procedure Pointer      (constref AValue: Pointer      ; AHashList: PUInt32); overload;
+  public
+    class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); virtual; abstract;
+  end;
+
+  TComparerService = class abstract
+  private type
+    TSelectMethod = function(ATypeData: PTypeData; ASize: SizeInt): Pointer of object;
+  private
+    class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
+    class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
+    class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
+    class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
+    class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract;
+  private type
+    PSpoofInterfacedTypeSizeObject = ^TSpoofInterfacedTypeSizeObject;
+    TSpoofInterfacedTypeSizeObject = record
+      VMT: Pointer;
+      RefCount: LongInt;
+      Size: SizeInt;
+    end;
+
+    PInstance = ^TInstance;
+    TInstance = record
+      class function Create(ASelector: Boolean; AInstance: Pointer): TComparerService.TInstance; static;
+      class function CreateSelector(ASelectorInstance: CodePointer): TComparerService.TInstance; static;
+
+      case Selector: Boolean of
+        false: (Instance: Pointer);
+        true:  (SelectorInstance: CodePointer);
+    end;
+
+    PComparerVMT = ^TComparerVMT;
+    TComparerVMT = packed record
+      QueryInterface: CodePointer;
+      _AddRef: CodePointer;
+      _Release: CodePointer;
+      Compare: CodePointer;
+    end;
+
+    TSelectFunc = function(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+
+  private
+    class function CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject; static;
+
+    class function SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+    class function SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+    class function SelectFloatComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+    class function SelectShortStringComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+    class function SelectBinaryComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+    class function SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static;
+  private const
+    // IComparer VMT
+    Comparer_Int8_VMT  : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int8);
+    Comparer_Int16_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int16 );
+    Comparer_Int32_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int32 );
+    Comparer_Int64_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int64 );
+    Comparer_UInt8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt8 );
+    Comparer_UInt16_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt16);
+    Comparer_UInt32_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt32);
+    Comparer_UInt64_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UInt64);
+
+    Comparer_Single_VMT  : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Single  );
+    Comparer_Double_VMT  : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Double  );
+    Comparer_Extended_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Extended);
+
+    Comparer_Currency_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Currency);
+    Comparer_Comp_VMT    : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Comp    );
+
+    Comparer_Binary_VMT  : TComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Compare: @TCompare._Binary  );
+    Comparer_DynArray_VMT: TComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Compare: @TCompare._DynArray);
+
+    Comparer_ShortString1_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString1 );
+    Comparer_ShortString2_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString2 );
+    Comparer_ShortString3_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString3 );
+    Comparer_ShortString_VMT  : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.ShortString  );
+    Comparer_AnsiString_VMT   : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.AnsiString   );
+    Comparer_WideString_VMT   : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.WideString   );
+    Comparer_UnicodeString_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.UnicodeString);
+
+    Comparer_Method_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Method );
+    Comparer_Variant_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Variant);
+    Comparer_Pointer_VMT: TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Pointer);
+
+    // Instances
+    Comparer_Int8_Instance  : Pointer = @Comparer_Int8_VMT  ;
+    Comparer_Int16_Instance : Pointer = @Comparer_Int16_VMT ;
+    Comparer_Int32_Instance : Pointer = @Comparer_Int32_VMT ;
+    Comparer_Int64_Instance : Pointer = @Comparer_Int64_VMT ;
+    Comparer_UInt8_Instance : Pointer = @Comparer_UInt8_VMT ;
+    Comparer_UInt16_Instance: Pointer = @Comparer_UInt16_VMT;
+    Comparer_UInt32_Instance: Pointer = @Comparer_UInt32_VMT;
+    Comparer_UInt64_Instance: Pointer = @Comparer_UInt64_VMT;
+
+    Comparer_Single_Instance  : Pointer = @Comparer_Single_VMT  ;
+    Comparer_Double_Instance  : Pointer = @Comparer_Double_VMT  ;
+    Comparer_Extended_Instance: Pointer = @Comparer_Extended_VMT;
+
+    Comparer_Currency_Instance: Pointer = @Comparer_Currency_VMT;
+    Comparer_Comp_Instance    : Pointer = @Comparer_Comp_VMT    ;
+
+    //Comparer_Binary_Instance  : Pointer = @Comparer_Binary_VMT  ;  // dynamic instance
+    //Comparer_DynArray_Instance: Pointer = @Comparer_DynArray_VMT;  // dynamic instance
+
+    Comparer_ShortString1_Instance : Pointer = @Comparer_ShortString1_VMT ;
+    Comparer_ShortString2_Instance : Pointer = @Comparer_ShortString2_VMT ;
+    Comparer_ShortString3_Instance : Pointer = @Comparer_ShortString3_VMT ;
+    Comparer_ShortString_Instance  : Pointer = @Comparer_ShortString_VMT  ;
+    Comparer_AnsiString_Instance   : Pointer = @Comparer_AnsiString_VMT   ;
+    Comparer_WideString_Instance   : Pointer = @Comparer_WideString_VMT   ;
+    Comparer_UnicodeString_Instance: Pointer = @Comparer_UnicodeString_VMT;
+
+    Comparer_Method_Instance : Pointer = @Comparer_Method_VMT ;
+    Comparer_Variant_Instance: Pointer = @Comparer_Variant_VMT;
+    Comparer_Pointer_Instance: Pointer = @Comparer_Pointer_VMT;
+
+    ComparerInstances: array[TTypeKind] of TInstance =
+      (
+        // tkUnknown
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer),
+        // tkInteger
+        (Selector: True;  SelectorInstance: @TComparerService.SelectIntegerComparer),
+        // tkChar
+        (Selector: False; Instance: @Comparer_UInt8_Instance),
+        // tkEnumeration
+        (Selector: True;  SelectorInstance: @TComparerService.SelectIntegerComparer),
+        // tkFloat
+        (Selector: True;  SelectorInstance: @TComparerService.SelectFloatComparer),
+        // tkSet
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer),
+        // tkMethod
+        (Selector: False; Instance: @Comparer_Method_Instance),
+        // tkSString
+        (Selector: True;  SelectorInstance: @TComparerService.SelectShortStringComparer),
+        // tkLString - only internal use / deprecated in compiler
+        (Selector: False; Instance: @Comparer_AnsiString_Instance), // <- unsure
+        // tkAString
+        (Selector: False; Instance: @Comparer_AnsiString_Instance),
+        // tkWString
+        (Selector: False; Instance: @Comparer_WideString_Instance),
+        // tkVariant
+        (Selector: False; Instance: @Comparer_Variant_Instance),
+        // tkArray
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer),
+        // tkRecord
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer),
+        // tkInterface
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkClass
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkObject
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer),
+        // tkWChar
+        (Selector: False; Instance: @Comparer_UInt16_Instance),
+        // tkBool
+        (Selector: True;  SelectorInstance: @TComparerService.SelectIntegerComparer),
+        // tkInt64
+        (Selector: False;  Instance: @Comparer_Int64_Instance),
+        // tkQWord
+        (Selector: False;  Instance: @Comparer_UInt64_Instance),
+        // tkDynArray
+        (Selector: True;  SelectorInstance: @TComparerService.SelectDynArrayComparer),
+        // tkInterfaceRaw
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkProcVar
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkUString
+        (Selector: False; Instance: @Comparer_UnicodeString_Instance),
+        // tkUChar - WTF? ... http://bugs.freepascal.org/view.php?id=24609
+        (Selector: False; Instance: @Comparer_UInt16_Instance), // <- unsure maybe Comparer_UInt32_Instance
+        // tkHelper
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkFile
+        (Selector: True;  SelectorInstance: @TComparerService.SelectBinaryComparer), // <- unsure what type?
+        // tkClassRef
+        (Selector: False; Instance: @Comparer_Pointer_Instance),
+        // tkPointer
+        (Selector: False; Instance: @Comparer_Pointer_Instance)
+      );
+  public
+    class function LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; static;
+  end;
+
+  THashService = class(TComparerService)
+  public
+    class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
+  end;
+
+  TExtendedHashService = class(THashService)
+  public
+    class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
+  end;
+
+{$DEFINE HASH_FACTORY := PPEqualityComparerVMT(Self)^.__ClassRef}
+{$DEFINE EXTENDED_HASH_FACTORY := PPExtendedEqualityComparerVMT(Self)^.__ClassRef}
+
+  { THashService }
+
+  THashService<T: THashFactory> = class(THashService)
+  private
+    class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+  private const
+    // IEqualityComparer VMT templates
+{$WARNINGS OFF}
+    EqualityComparer_Int8_VMT  : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int8  ; GetHashCode: @THashFactory.Int8  );
+    EqualityComparer_Int16_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int16 ; GetHashCode: @THashFactory.Int16 );
+    EqualityComparer_Int32_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int32 ; GetHashCode: @THashFactory.Int32 );
+    EqualityComparer_Int64_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int64 ; GetHashCode: @THashFactory.Int64 );
+    EqualityComparer_UInt8_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt8 ; GetHashCode: @THashFactory.UInt8 );
+    EqualityComparer_UInt16_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt16; GetHashCode: @THashFactory.UInt16);
+    EqualityComparer_UInt32_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt32; GetHashCode: @THashFactory.UInt32);
+    EqualityComparer_UInt64_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt64; GetHashCode: @THashFactory.UInt64);
+
+    EqualityComparer_Single_VMT  : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Single  ; GetHashCode: @THashFactory.Single  );
+    EqualityComparer_Double_VMT  : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Double  ; GetHashCode: @THashFactory.Double  );
+    EqualityComparer_Extended_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Extended; GetHashCode: @THashFactory.Extended);
+
+    EqualityComparer_Currency_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Currency; GetHashCode: @THashFactory.Currency);
+    EqualityComparer_Comp_VMT    : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Comp    ; GetHashCode: @THashFactory.Comp    );
+
+    EqualityComparer_Binary_VMT  : THashFactory.TEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._Binary  ; GetHashCode: @THashFactory.Binary  );
+    EqualityComparer_DynArray_VMT: THashFactory.TEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._DynArray; GetHashCode: @THashFactory.DynArray);
+
+    EqualityComparer_Class_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.&Class; GetHashCode: @THashFactory.&Class);
+
+    EqualityComparer_ShortString1_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString1 ; GetHashCode: @THashFactory.ShortString1 );
+    EqualityComparer_ShortString2_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString2 ; GetHashCode: @THashFactory.ShortString2 );
+    EqualityComparer_ShortString3_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString3 ; GetHashCode: @THashFactory.ShortString3 );
+    EqualityComparer_ShortString_VMT  : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString  ; GetHashCode: @THashFactory.ShortString  );
+    EqualityComparer_AnsiString_VMT   : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.AnsiString   ; GetHashCode: @THashFactory.AnsiString   );
+    EqualityComparer_WideString_VMT   : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.WideString   ; GetHashCode: @THashFactory.WideString   );
+    EqualityComparer_UnicodeString_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UnicodeString; GetHashCode: @THashFactory.UnicodeString);
+
+    EqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method );
+    EqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant);
+    EqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer);
+{$WARNINGS ON}
+  private class var
+    // IEqualityComparer VMT
+    FEqualityComparer_Int8_VMT  : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Int16_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Int32_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Int64_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_UInt8_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_UInt16_VMT: THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_UInt32_VMT: THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_UInt64_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Single_VMT  : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Double_VMT  : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Extended_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Currency_VMT: THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Comp_VMT    : THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Binary_VMT  : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_DynArray_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Class_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_ShortString1_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_ShortString2_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_ShortString3_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_ShortString_VMT  : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_AnsiString_VMT   : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_WideString_VMT   : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_UnicodeString_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT;
+    FEqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT;
+
+    FEqualityComparer_Int8_Instance         : Pointer;
+    FEqualityComparer_Int16_Instance        : Pointer;
+    FEqualityComparer_Int32_Instance        : Pointer;
+    FEqualityComparer_Int64_Instance        : Pointer;
+    FEqualityComparer_UInt8_Instance        : Pointer;
+    FEqualityComparer_UInt16_Instance       : Pointer;
+    FEqualityComparer_UInt32_Instance       : Pointer;
+    FEqualityComparer_UInt64_Instance       : Pointer;
+
+    FEqualityComparer_Single_Instance       : Pointer;
+    FEqualityComparer_Double_Instance       : Pointer;
+    FEqualityComparer_Extended_Instance     : Pointer;
+
+    FEqualityComparer_Currency_Instance     : Pointer;
+    FEqualityComparer_Comp_Instance         : Pointer;
+
+    //FEqualityComparer_Binary_Instance     : Pointer;  // dynamic instance
+    //FEqualityComparer_DynArray_Instance   : Pointer;  // dynamic instance
+
+    FEqualityComparer_ShortString1_Instance : Pointer;
+    FEqualityComparer_ShortString2_Instance : Pointer;
+    FEqualityComparer_ShortString3_Instance : Pointer;
+    FEqualityComparer_ShortString_Instance  : Pointer;
+    FEqualityComparer_AnsiString_Instance   : Pointer;
+    FEqualityComparer_WideString_Instance   : Pointer;
+    FEqualityComparer_UnicodeString_Instance: Pointer;
+
+    FEqualityComparer_Method_Instance       : Pointer;
+    FEqualityComparer_Variant_Instance      : Pointer;
+    FEqualityComparer_Pointer_Instance      : Pointer;
+
+
+    FEqualityComparerInstances: array[TTypeKind] of TInstance;
+  private
+    class constructor Create;
+  public
+    class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
+  end;
+
+  { TExtendedHashService }
+
+  TExtendedHashService<T: TExtendedHashFactory> = class(TExtendedHashService)
+  private
+    class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+    class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override;
+  private const
+    // IExtendedEqualityComparer VMT templates
+{$WARNINGS OFF}
+    ExtendedEqualityComparer_Int8_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int8  ; GetHashCode: @THashFactory.Int8  ; GetHashList: @TExtendedHashFactory.Int8  );
+    ExtendedEqualityComparer_Int16_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int16 ; GetHashCode: @THashFactory.Int16 ; GetHashList: @TExtendedHashFactory.Int16 );
+    ExtendedEqualityComparer_Int32_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int32 ; GetHashCode: @THashFactory.Int32 ; GetHashList: @TExtendedHashFactory.Int32 );
+    ExtendedEqualityComparer_Int64_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Int64 ; GetHashCode: @THashFactory.Int64 ; GetHashList: @TExtendedHashFactory.Int64 );
+    ExtendedEqualityComparer_UInt8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt8 ; GetHashCode: @THashFactory.UInt8 ; GetHashList: @TExtendedHashFactory.UInt8 );
+    ExtendedEqualityComparer_UInt16_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt16; GetHashCode: @THashFactory.UInt16; GetHashList: @TExtendedHashFactory.UInt16);
+    ExtendedEqualityComparer_UInt32_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt32; GetHashCode: @THashFactory.UInt32; GetHashList: @TExtendedHashFactory.UInt32);
+    ExtendedEqualityComparer_UInt64_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UInt64; GetHashCode: @THashFactory.UInt64; GetHashList: @TExtendedHashFactory.UInt64);
+
+    ExtendedEqualityComparer_Single_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Single  ; GetHashCode: @THashFactory.Single  ; GetHashList: @TExtendedHashFactory.Single  );
+    ExtendedEqualityComparer_Double_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Double  ; GetHashCode: @THashFactory.Double  ; GetHashList: @TExtendedHashFactory.Double  );
+    ExtendedEqualityComparer_Extended_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Extended; GetHashCode: @THashFactory.Extended; GetHashList: @TExtendedHashFactory.Extended);
+
+    ExtendedEqualityComparer_Currency_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Currency; GetHashCode: @THashFactory.Currency; GetHashList: @TExtendedHashFactory.Currency);
+    ExtendedEqualityComparer_Comp_VMT    : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Comp    ; GetHashCode: @THashFactory.Comp    ; GetHashList: @TExtendedHashFactory.Comp    );
+
+    ExtendedEqualityComparer_Binary_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._Binary  ; GetHashCode: @THashFactory.Binary  ; GetHashList: @TExtendedHashFactory.Binary   );
+    ExtendedEqualityComparer_DynArray_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_COM_TYPESIZE_INTERFACE_METHODS; Equals: @TEquals._DynArray; GetHashCode: @THashFactory.DynArray; GetHashList: @TExtendedHashFactory.DynArray);
+
+    ExtendedEqualityComparer_Class_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.&Class; GetHashCode: @THashFactory.&Class; GetHashList: @TExtendedHashFactory.&Class);
+
+    ExtendedEqualityComparer_ShortString1_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString1 ; GetHashCode: @THashFactory.ShortString1 ; GetHashList: @TExtendedHashFactory.ShortString1 );
+    ExtendedEqualityComparer_ShortString2_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString2 ; GetHashCode: @THashFactory.ShortString2 ; GetHashList: @TExtendedHashFactory.ShortString2 );
+    ExtendedEqualityComparer_ShortString3_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString3 ; GetHashCode: @THashFactory.ShortString3 ; GetHashList: @TExtendedHashFactory.ShortString3 );
+    ExtendedEqualityComparer_ShortString_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.ShortString  ; GetHashCode: @THashFactory.ShortString  ; GetHashList: @TExtendedHashFactory.ShortString  );
+    ExtendedEqualityComparer_AnsiString_VMT   : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.AnsiString   ; GetHashCode: @THashFactory.AnsiString   ; GetHashList: @TExtendedHashFactory.AnsiString   );
+    ExtendedEqualityComparer_WideString_VMT   : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.WideString   ; GetHashCode: @THashFactory.WideString   ; GetHashList: @TExtendedHashFactory.WideString   );
+    ExtendedEqualityComparer_UnicodeString_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.UnicodeString; GetHashCode: @THashFactory.UnicodeString; GetHashList: @TExtendedHashFactory.UnicodeString);
+
+    ExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method ; GetHashList: @TExtendedHashFactory.Method );
+    ExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant; GetHashList: @TExtendedHashFactory.Variant);
+    ExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer; GetHashList: @TExtendedHashFactory.Pointer);
+{$WARNINGS ON}
+  private class var
+    // IExtendedEqualityComparer VMT
+    FExtendedEqualityComparer_Int8_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Int16_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Int32_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Int64_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_UInt8_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_UInt16_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_UInt32_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_UInt64_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Single_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Double_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Extended_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Currency_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Comp_VMT    : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Binary_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_DynArray_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Class_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_ShortString1_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_ShortString2_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_ShortString3_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_ShortString_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_AnsiString_VMT   : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_WideString_VMT   : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_UnicodeString_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+    FExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT;
+
+    FExtendedEqualityComparer_Int8_Instance         : Pointer;
+    FExtendedEqualityComparer_Int16_Instance        : Pointer;
+    FExtendedEqualityComparer_Int32_Instance        : Pointer;
+    FExtendedEqualityComparer_Int64_Instance        : Pointer;
+    FExtendedEqualityComparer_UInt8_Instance        : Pointer;
+    FExtendedEqualityComparer_UInt16_Instance       : Pointer;
+    FExtendedEqualityComparer_UInt32_Instance       : Pointer;
+    FExtendedEqualityComparer_UInt64_Instance       : Pointer;
+
+    FExtendedEqualityComparer_Single_Instance       : Pointer;
+    FExtendedEqualityComparer_Double_Instance       : Pointer;
+    FExtendedEqualityComparer_Extended_Instance     : Pointer;
+
+    FExtendedEqualityComparer_Currency_Instance     : Pointer;
+    FExtendedEqualityComparer_Comp_Instance         : Pointer;
+
+    //FExtendedEqualityComparer_Binary_Instance     : Pointer;  // dynamic instance
+    //FExtendedEqualityComparer_DynArray_Instance   : Pointer;  // dynamic instance
+
+    FExtendedEqualityComparer_ShortString1_Instance : Pointer;
+    FExtendedEqualityComparer_ShortString2_Instance : Pointer;
+    FExtendedEqualityComparer_ShortString3_Instance : Pointer;
+    FExtendedEqualityComparer_ShortString_Instance  : Pointer;
+    FExtendedEqualityComparer_AnsiString_Instance   : Pointer;
+    FExtendedEqualityComparer_WideString_Instance   : Pointer;
+    FExtendedEqualityComparer_UnicodeString_Instance: Pointer;
+
+    FExtendedEqualityComparer_Method_Instance       : Pointer;
+    FExtendedEqualityComparer_Variant_Instance      : Pointer;
+    FExtendedEqualityComparer_Pointer_Instance      : Pointer;
+
+    // all instances
+    FExtendedEqualityComparerInstances: array[TTypeKind] of TInstance;
+  private
+    class constructor Create;
+  public
+    class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
+  end;
+
+  TOnEqualityComparison<T> = function(constref ALeft, ARight: T): Boolean of object;
+  TEqualityComparisonFunc<T> = function(constref ALeft, ARight: T): Boolean;
+
+  TOnHasher<T> = function(constref AValue: T): UInt32 of object;
+  TOnExtendedHasher<T> = procedure(constref AValue: T; AHashList: PUInt32) of object;
+  THasherFunc<T> = function(constref AValue: T): UInt32;
+  TExtendedHasherFunc<T> = procedure(constref AValue: T; AHashList: PUInt32);
+
+  TEqualityComparer<T> = class(TInterfacedObject, IEqualityComparer<T>)
+  public
+    class function Default: IEqualityComparer<T>; static; overload;
+    class function Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>; static; overload;
+
+    class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
+      const AHasher: TOnHasher<T>): IEqualityComparer<T>; overload;
+    class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
+      const AHasher: THasherFunc<T>): IEqualityComparer<T>; overload;
+
+    function Equals(constref ALeft, ARight: T): Boolean; virtual; overload; abstract;
+    function GetHashCode(constref AValue: T): UInt32;  virtual; overload; abstract;
+  end;
+
+  { TDelegatedEqualityComparerEvent }
+
+  TDelegatedEqualityComparerEvents<T> = class(TEqualityComparer<T>)
+  private
+    FEqualityComparison: TOnEqualityComparison<T>;
+    FHasher: TOnHasher<T>;
+  public
+    function Equals(constref ALeft, ARight: T): Boolean; override;
+    function GetHashCode(constref AValue: T): UInt32; override;
+
+    constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
+      const AHasher: TOnHasher<T>);
+  end;
+
+  TDelegatedEqualityComparerFunc<T> = class(TEqualityComparer<T>)
+  private
+    FEqualityComparison: TEqualityComparisonFunc<T>;
+    FHasher: THasherFunc<T>;
+  public
+    function Equals(constref ALeft, ARight: T): Boolean; override;
+    function GetHashCode(constref AValue: T): UInt32; override;
+
+    constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+      const AHasher: THasherFunc<T>);
+  end;
+
+  { TExtendedEqualityComparer }
+
+  TExtendedEqualityComparer<T> = class(TEqualityComparer<T>, IExtendedEqualityComparer<T>)
+  public
+    class function Default: IExtendedEqualityComparer<T>; static; overload; reintroduce;
+    class function Default(AExtenedHashFactoryClass: TExtendedHashFactoryClass): IExtendedEqualityComparer<T>; static; overload; reintroduce;
+
+    class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
+       const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
+    class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
+       const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
+    class function Construct(const AEqualityComparison: TOnEqualityComparison<T>;
+       const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
+    class function Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
+       const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>; overload; reintroduce;
+
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); virtual; abstract;
+  end;
+
+  TDelegatedExtendedEqualityComparerEvents<T> = class(TExtendedEqualityComparer<T>)
+  private
+    FEqualityComparison: TOnEqualityComparison<T>;
+    FHasher: TOnHasher<T>;
+    FExtendedHasher: TOnExtendedHasher<T>;
+
+    function GetHashCodeMethod(constref AValue: T): UInt32;
+  public
+    function Equals(constref ALeft, ARight: T): Boolean; override;
+    function GetHashCode(constref AValue: T): UInt32; override;
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
+
+    constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
+      const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>); overload;
+    constructor Create(const AEqualityComparison: TOnEqualityComparison<T>;
+      const AExtendedHasher: TOnExtendedHasher<T>); overload;
+  end;
+
+  TDelegatedExtendedEqualityComparerFunc<T> = class(TExtendedEqualityComparer<T>)
+  private
+    FEqualityComparison: TEqualityComparisonFunc<T>;
+    FHasher: THasherFunc<T>;
+    FExtendedHasher: TExtendedHasherFunc<T>;
+  public
+    function Equals(constref ALeft, ARight: T): Boolean; override;
+    function GetHashCode(constref AValue: T): UInt32; override;
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
+
+    constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+      const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>); overload;
+    constructor Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+      const AExtendedHasher: TExtendedHasherFunc<T>); overload;
+  end;
+
+  { TDelphiHashFactory }
+
+  TDelphiHashFactory = class(THashFactory)
+  public
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+  end;
+
+  { TAdler32HashFactory }
+
+  TAdler32HashFactory = class(THashFactory)
+  public
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+  end;
+
+  { TSdbmHashFactory }
+
+  TSdbmHashFactory = class(THashFactory)
+  public
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+  end;
+
+  { TSdbmHashFactory }
+
+  TSimpleChecksumFactory = class(THashFactory)
+  public
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+  end;
+
+  { TDelphiDoubleHashFactory }
+
+  TDelphiDoubleHashFactory = class(TExtendedHashFactory)
+  public
+    const MAX_HASHLIST_COUNT = 2;
+    const HASH_FUNCTIONS_COUNT = 1;
+    const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2);
+    const HASH_FUNCTIONS_MASK_SIZE = 1;
+    const HASH_FUNCTIONS_MASK = 1; // 00000001b
+
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+    class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
+  end;
+
+  TDelphiQuadrupleHashFactory = class(TExtendedHashFactory)
+  public
+    const MAX_HASHLIST_COUNT = 4;
+    const HASH_FUNCTIONS_COUNT = 2;
+    const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2, 2);
+    const HASH_FUNCTIONS_MASK_SIZE = 2;
+    const HASH_FUNCTIONS_MASK = 3; // 00000011b
+
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+    class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
+  end;
+
+  TDelphiSixfoldHashFactory = class(TExtendedHashFactory)
+  public
+    const MAX_HASHLIST_COUNT = 6;
+    const HASH_FUNCTIONS_COUNT = 3;
+    const HASHLIST_COUNT_PER_FUNCTION: array[1..HASH_FUNCTIONS_COUNT] of Integer = (2, 2, 2);
+    const HASH_FUNCTIONS_MASK_SIZE = 3;
+    const HASH_FUNCTIONS_MASK = 7; // 00000111b
+
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+    class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
+  end;
+
+  TDefaultHashFactory = TDelphiQuadrupleHashFactory;
+
+  TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
+
+  TCustomComparer<T> = class(TSingletonImplementation, IComparer<T>, IEqualityComparer<T>, IExtendedEqualityComparer<T>)
+  protected
+    function Compare(constref Left, Right: T): Integer; virtual; abstract;
+    function Equals(constref Left, Right: T): Boolean; reintroduce; overload; virtual; abstract;
+    function GetHashCode(constref Value: T): UInt32; reintroduce; overload; virtual; abstract;
+    procedure GetHashList(constref Value: T; AHashList: PUInt32); virtual; abstract;
+  end;
+
+  TOrdinalComparer<T, THashFactory> = class(TCustomComparer<T>)
+  protected class var
+    FComparer: IComparer<T>;
+    FEqualityComparer: IEqualityComparer<T>;
+    FExtendedEqualityComparer: IExtendedEqualityComparer<T>;
+
+    class constructor Create;
+  public
+    class function Ordinal: TCustomComparer<T>; virtual; abstract;
+  end;
+
+  // TGStringComparer will be renamed to TStringComparer -> bug #26030
+  // anyway class var can't be used safely -> bug #24848
+
+  TGStringComparer<T, THashFactory> = class(TOrdinalComparer<T, THashFactory>)
+  private class var
+    FOrdinal: TCustomComparer<T>;
+    class destructor Destroy;
+  public
+    class function Ordinal: TCustomComparer<T>; override;
+  end;
+
+  TGStringComparer<T> = class(TGStringComparer<T, TDelphiQuadrupleHashFactory>);
+  TStringComparer = class(TGStringComparer<string>);
+  TAnsiStringComparer = class(TGStringComparer<AnsiString>);
+  TUnicodeStringComparer = class(TGStringComparer<UnicodeString>);
+
+  { TGOrdinalStringComparer }
+
+  // TGOrdinalStringComparer will be renamed to TOrdinalStringComparer -> bug #26030
+  // anyway class var can't be used safely -> bug #24848
+  TGOrdinalStringComparer<T, THashFactory> = class(TGStringComparer<T, THashFactory>)
+  public
+    function Compare(constref ALeft, ARight: T): Integer; override;
+    function Equals(constref ALeft, ARight: T): Boolean; overload; override;
+    function GetHashCode(constref AValue: T): UInt32; overload; override;
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
+  end;
+
+  TGOrdinalStringComparer<T> = class(TGOrdinalStringComparer<T, TDelphiQuadrupleHashFactory>);
+  TOrdinalStringComparer = class(TGOrdinalStringComparer<string>);
+
+  TGIStringComparer<T, THashFactory> = class(TOrdinalComparer<T, THashFactory>)
+  private class var
+    FOrdinal: TCustomComparer<T>;
+    class destructor Destroy;
+  public
+    class function Ordinal: TCustomComparer<T>; override;
+  end;
+
+  TGIStringComparer<T> = class(TGIStringComparer<T, TDelphiQuadrupleHashFactory>);
+  TIStringComparer = class(TGIStringComparer<string>);
+  TIAnsiStringComparer = class(TGIStringComparer<AnsiString>);
+  TIUnicodeStringComparer = class(TGIStringComparer<UnicodeString>);
+
+  TGOrdinalIStringComparer<T, THashFactory> = class(TGIStringComparer<T, THashFactory>)
+  public
+    function Compare(constref ALeft, ARight: T): Integer; override;
+    function Equals(constref ALeft, ARight: T): Boolean; overload; override;
+    function GetHashCode(constref AValue: T): UInt32; overload; override;
+    procedure GetHashList(constref AValue: T; AHashList: PUInt32); override;
+  end;
+
+  TGOrdinalIStringComparer<T> = class(TGOrdinalIStringComparer<T, TDelphiQuadrupleHashFactory>);
+  TOrdinalIStringComparer = class(TGOrdinalIStringComparer<string>);
+
+// Delphi version of Bob Jenkins Hash
+function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer; // same result as HashLittle_Delphi, just different interface
+function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer; inline;
+
+function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; inline;
+function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
+  AFactory: THashFactoryClass): Pointer;
+
+implementation
+
+{ TComparer<T> }
+
+class function TComparer<T>.Default: IComparer<T>;
+begin
+  Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T));
+end;
+
+class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;
+begin
+  Result := TDelegatedComparerEvents<T>.Create(AComparison);
+end;
+
+class function TComparer<T>.Construct(const AComparison: TComparisonFunc<T>): IComparer<T>;
+begin
+  Result := TDelegatedComparerFunc<T>.Create(AComparison);
+end;
+
+function TDelegatedComparerEvents<T>.Compare(constref ALeft, ARight: T): Integer;
+begin
+  Result := FComparison(ALeft, ARight);
+end;
+
+constructor TDelegatedComparerEvents<T>.Create(AComparison: TOnComparison<T>);
+begin
+  FComparison := AComparison;
+end;
+
+function TDelegatedComparerFunc<T>.Compare(constref ALeft, ARight: T): Integer;
+begin
+  Result := FComparison(ALeft, ARight);
+end;
+
+constructor TDelegatedComparerFunc<T>.Create(AComparison: TComparisonFunc<T>);
+begin
+  FComparison := AComparison;
+end;
+
+{ TInterface }
+
+function TInterface.QueryInterface(constref IID: TGUID; out Obj): HResult;
+begin
+  Result := E_NOINTERFACE;
+end;
+
+{ TRawInterface }
+
+function TRawInterface._AddRef: LongInt;
+begin
+  Result := -1;
+end;
+
+function TRawInterface._Release: LongInt;
+begin
+  Result := -1;
+end;
+
+{ TComTypeSizeInterface }
+
+function TComTypeSizeInterface._AddRef: LongInt;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := InterLockedIncrement(_self.RefCount);
+end;
+
+function TComTypeSizeInterface._Release: LongInt;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := InterLockedDecrement(_self.RefCount);
+  if _self.RefCount = 0 then
+    Dispose(_self);
+end;
+
+{ TSingletonImplementation }
+
+function TSingletonImplementation.QueryInterface(constref IID: TGUID; out Obj): HResult;
+begin
+  if GetInterface(IID, Obj) then
+    Result := S_OK
+  else
+    Result := E_NOINTERFACE;
+end;
+
+{ TCompare }
+
+(***********************************************************************************************************************
+  Comparers
+(**********************************************************************************************************************)
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers Int8 - Int32 and UInt8 - UInt32
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Integer(constref ALeft, ARight: Integer): Integer;
+begin
+  Result := Math.CompareValue(ALeft, ARight);
+end;
+
+class function TCompare.Int8(constref ALeft, ARight: Int8): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+
+class function TCompare.Int16(constref ALeft, ARight: Int16): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+
+class function TCompare.Int32(constref ALeft, ARight: Int32): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.Int64(constref ALeft, ARight: Int64): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.UInt8(constref ALeft, ARight: UInt8): Integer;
+begin
+  Result := System.Integer(ALeft) - System.Integer(ARight);
+end;
+
+class function TCompare.UInt16(constref ALeft, ARight: UInt16): Integer;
+begin
+  Result := System.Integer(ALeft) - System.Integer(ARight);
+end;
+
+class function TCompare.UInt32(constref ALeft, ARight: UInt32): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.UInt64(constref ALeft, ARight: UInt64): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for Float types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Single(constref ALeft, ARight: Single): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.Double(constref ALeft, ARight: Double): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.Extended(constref ALeft, ARight: Extended): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for other number types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Currency(constref ALeft, ARight: Currency): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.Comp(constref ALeft, ARight: Comp): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for binary data (records etc) and dynamics arrays
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare._Binary(constref ALeft, ARight): Integer;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := CompareMemRange(@ALeft, @ARight, _self.Size);
+end;
+
+class function TCompare._DynArray(constref ALeft, ARight: Pointer): Integer;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+  LLength, LLeftLength, LRightLength: Integer;
+begin
+  LLeftLength := DynArraySize(ALeft);
+  LRightLength := DynArraySize(ARight);
+  if LLeftLength > LRightLength then
+    LLength := LRightLength
+  else
+    LLength := LLeftLength;
+
+  Result := CompareMemRange(ALeft, ARight, LLength * _self.Size);
+
+  if Result = 0 then
+    Result := LLeftLength - LRightLength;
+end;
+
+class function TCompare.Binary(constref ALeft, ARight; const ASize: SizeInt): Integer;
+begin
+  Result := CompareMemRange(@ALeft, @ARight, ASize);
+end;
+
+class function TCompare.DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Integer;
+var
+  LLength, LLeftLength, LRightLength: Integer;
+begin
+  LLeftLength := DynArraySize(ALeft);
+  LRightLength := DynArraySize(ARight);
+  if LLeftLength > LRightLength then
+    LLength := LRightLength
+  else
+    LLength := LLeftLength;
+
+  Result := CompareMemRange(ALeft, ARight, LLength * AElementSize);
+
+  if Result = 0 then
+    Result := LLeftLength - LRightLength;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for string types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.ShortString1(constref ALeft, ARight: ShortString1): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.ShortString2(constref ALeft, ARight: ShortString2): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.ShortString3(constref ALeft, ARight: ShortString3): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.ShortString(constref ALeft, ARight: ShortString): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+class function TCompare.&String(constref ALeft, ARight: String): Integer;
+begin
+  Result := CompareStr(ALeft, ARight);
+end;
+
+class function TCompare.AnsiString(constref ALeft, ARight: AnsiString): Integer;
+begin
+  Result := AnsiCompareStr(ALeft, ARight);
+end;
+
+class function TCompare.WideString(constref ALeft, ARight: WideString): Integer;
+begin
+  Result := WideCompareStr(ALeft, ARight);
+end;
+
+class function TCompare.UnicodeString(constref ALeft, ARight: UnicodeString): Integer;
+begin
+  Result := UnicodeCompareStr(ALeft, ARight);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for Delegates
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Method(constref ALeft, ARight: TMethod): Integer;
+begin
+  Result := CompareMemRange(@ALeft, @ARight, SizeOf(System.TMethod));
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for Variant
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Variant(constref ALeft, ARight: PVariant): Integer;
+var
+  LLeftString, LRightString: string;
+begin
+  try
+    case VarCompareValue(ALeft^, ARight^) of
+      vrGreaterThan:
+        Exit(1);
+      vrLessThan:
+        Exit(-1);
+      vrEqual:
+        Exit(0);
+      vrNotEqual:
+        if VarIsEmpty(ALeft^) or VarIsNull(ALeft^) then
+          Exit(1)
+        else
+          Exit(-1);
+    end;
+  except
+    try
+      LLeftString := ALeft^;
+      LRightString := ARight^;
+      Result := CompareStr(LLeftString, LRightString);
+    except
+      Result := CompareMemRange(ALeft, ARight, SizeOf(System.Variant));
+    end;
+  end;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Comparers for Pointer
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TCompare.Pointer(constref ALeft, ARight: PtrUInt): Integer;
+begin
+  if ALeft > ARight then
+    Exit(1)
+  else if ALeft < ARight then
+    Exit(-1)
+  else
+    Exit(0);
+end;
+
+{ TEquals }
+
+(***********************************************************************************************************************
+  Equality Comparers
+(**********************************************************************************************************************)
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers Int8 - Int32 and UInt8 - UInt32
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Integer(constref ALeft, ARight: Integer): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Int8(constref ALeft, ARight: Int8): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Int16(constref ALeft, ARight: Int16): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Int32(constref ALeft, ARight: Int32): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Int64(constref ALeft, ARight: Int64): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.UInt8(constref ALeft, ARight: UInt8): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.UInt16(constref ALeft, ARight: UInt16): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.UInt32(constref ALeft, ARight: UInt32): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.UInt64(constref ALeft, ARight: UInt64): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for Float types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Single(constref ALeft, ARight: Single): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Double(constref ALeft, ARight: Double): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Extended(constref ALeft, ARight: Extended): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for other number types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Currency(constref ALeft, ARight: Currency): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.Comp(constref ALeft, ARight: Comp): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for binary data (records etc) and dynamics arrays
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals._Binary(constref ALeft, ARight): Boolean;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := CompareMem(@ALeft, @ARight, _self.Size);
+end;
+
+class function TEquals._DynArray(constref ALeft, ARight: Pointer): Boolean;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+  LLength: Integer;
+begin
+  LLength := DynArraySize(ALeft);
+  if LLength <> DynArraySize(ARight) then
+    Exit(False);
+
+  Result := CompareMem(ALeft, ARight, LLength * _self.Size);
+end;
+
+class function TEquals.Binary(constref ALeft, ARight; const ASize: SizeInt): Boolean;
+begin
+  Result := CompareMem(@ALeft, @ARight, ASize);
+end;
+
+class function TEquals.DynArray(constref ALeft, ARight: Pointer; const AElementSize: SizeInt): Boolean;
+var
+  LLength: Integer;
+begin
+  LLength := DynArraySize(ALeft);
+  if LLength <> DynArraySize(ARight) then
+    Exit(False);
+
+  Result := CompareMem(ALeft, ARight, LLength * AElementSize);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for classes
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.&class(constref ALeft, ARight: TObject): Boolean;
+begin
+  if ALeft <> nil then
+    Exit(ALeft.Equals(ARight))
+  else
+    Exit(ARight = nil);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for string types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.ShortString1(constref ALeft, ARight: ShortString1): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.ShortString2(constref ALeft, ARight: ShortString2): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.ShortString3(constref ALeft, ARight: ShortString3): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.&String(constref ALeft, ARight: String): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.ShortString(constref ALeft, ARight: ShortString): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.AnsiString(constref ALeft, ARight: AnsiString): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.WideString(constref ALeft, ARight: WideString): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+class function TEquals.UnicodeString(constref ALeft, ARight: UnicodeString): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for Delegates
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Method(constref ALeft, ARight: TMethod): Boolean;
+begin
+  Result := (ALeft.Code = ARight.Code) and (ALeft.Data = ARight.Data);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for Variant
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Variant(constref ALeft, ARight: PVariant): Boolean;
+begin
+  Result := VarCompareValue(ALeft^, ARight^) = vrEqual;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  Equality Comparers for Pointer
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function TEquals.Pointer(constref ALeft, ARight: PtrUInt): Boolean;
+begin
+  Result := ALeft = ARight;
+end;
+
+(***********************************************************************************************************************
+  Hashes
+(**********************************************************************************************************************)
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode Int8 - Int32 and UInt8 - UInt32
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Int8(constref AValue: Int8): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int8), 0);
+end;
+
+class function THashFactory.Int16(constref AValue: Int16): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int16), 0);
+end;
+
+class function THashFactory.Int32(constref AValue: Int32): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int32), 0);
+end;
+
+class function THashFactory.Int64(constref AValue: Int64): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
+end;
+
+class function THashFactory.UInt8(constref AValue: UInt8): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt8), 0);
+end;
+
+class function THashFactory.UInt16(constref AValue: UInt16): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt16), 0);
+end;
+
+class function THashFactory.UInt32(constref AValue: UInt32): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt32), 0);
+end;
+
+class function THashFactory.UInt64(constref AValue: UInt64): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.UInt64), 0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Float types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Single(constref AValue: Single): UInt32;
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
+  Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
+end;
+
+class function THashFactory.Double(constref AValue: Double): UInt32;
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
+  Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
+end;
+
+class function THashFactory.Extended(constref AValue: Extended): UInt32;
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  Result := HASH_FACTORY.GetHashCode(@LMantissa, SizeOf(Math.Float), 0);
+  Result := HASH_FACTORY.GetHashCode(@LExponent, SizeOf(System.Integer), Result);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for other number types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Currency(constref AValue: Currency): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
+end;
+
+class function THashFactory.Comp(constref AValue: Comp): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Int64), 0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for binary data (records etc) and dynamics arrays
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Binary(constref AValue): UInt32;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, _self.Size, 0);
+end;
+
+class function THashFactory.DynArray(constref AValue: Pointer): UInt32;
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  Result := HASH_FACTORY.GetHashCode(AValue, DynArraySize(AValue) * _self.Size, 0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for classes
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.&Class(constref AValue: TObject): UInt32;
+begin
+  if AValue = nil then
+    Exit($2A);
+
+  Result := AValue.GetHashCode;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for string types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.ShortString1(constref AValue: ShortString1): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
+end;
+
+class function THashFactory.ShortString2(constref AValue: ShortString2): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
+end;
+
+class function THashFactory.ShortString3(constref AValue: ShortString3): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
+end;
+
+class function THashFactory.ShortString(constref AValue: ShortString): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue), 0);
+end;
+
+class function THashFactory.AnsiString(constref AValue: AnsiString): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.AnsiChar), 0);
+end;
+
+class function THashFactory.WideString(constref AValue: WideString): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.WideChar), 0);
+end;
+
+class function THashFactory.UnicodeString(constref AValue: UnicodeString): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue[1], Length(AValue) * SizeOf(System.UnicodeChar), 0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Delegates
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Method(constref AValue: TMethod): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.TMethod), 0);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Variant
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Variant(constref AValue: PVariant): UInt32;
+begin
+  try
+    Result := HASH_FACTORY.UnicodeString(AValue^);
+  except
+    Result := HASH_FACTORY.GetHashCode(AValue, SizeOf(System.Variant), 0);
+  end;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Pointer
+{----------------------------------------------------------------------------------------------------------------------}
+
+class function THashFactory.Pointer(constref AValue: Pointer): UInt32;
+begin
+  Result := HASH_FACTORY.GetHashCode(@AValue, SizeOf(System.Pointer), 0);
+end;
+
+{ TExtendedHashFactory }
+
+(***********************************************************************************************************************
+  Hashes 2
+(**********************************************************************************************************************)
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode Int8 - Int32 and UInt8 - UInt32
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Int8(constref AValue: Int8; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int8), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.Int16(constref AValue: Int16; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int16), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.Int32(constref AValue: Int32; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int32), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.Int64(constref AValue: Int64; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.UInt8(constref AValue: UInt8; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt8), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.UInt16(constref AValue: UInt16; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt16), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.UInt32(constref AValue: UInt32; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt32), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.UInt64(constref AValue: UInt64; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.UInt64), AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Float types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Single(constref AValue: Single; AHashList: PUInt32);
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
+  EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
+end;
+
+class procedure TExtendedHashFactory.Double(constref AValue: Double; AHashList: PUInt32);
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
+  EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
+end;
+
+class procedure TExtendedHashFactory.Extended(constref AValue: Extended; AHashList: PUInt32);
+var
+  LMantissa: Float;
+  LExponent: Integer;
+begin
+  Frexp(AValue, LMantissa, LExponent);
+
+  if LMantissa = 0 then
+    LMantissa := Abs(LMantissa);
+
+  EXTENDED_HASH_FACTORY.GetHashList(@LMantissa, SizeOf(Math.Float), AHashList, []);
+  EXTENDED_HASH_FACTORY.GetHashList(@LExponent, SizeOf(System.Integer), AHashList, [ghloHashListAsInitData]);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for other number types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Currency(constref AValue: Currency; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.Comp(constref AValue: Comp; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Int64), AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for binary data (records etc) and dynamics arrays
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Binary(constref AValue; AHashList: PUInt32);
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, _self.Size, AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.DynArray(constref AValue: Pointer; AHashList: PUInt32);
+var
+  _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(AValue, DynArraySize(AValue) * _self.Size, AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for classes
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.&Class(constref AValue: TObject; AHashList: PUInt32);
+var
+  LValue: PtrInt;
+begin
+  if AValue = nil then
+  begin
+    LValue := $2A;
+    EXTENDED_HASH_FACTORY.GetHashList(@LValue, SizeOf(LValue), AHashList, []);
+    Exit;
+  end;
+
+  LValue := AValue.GetHashCode;
+  EXTENDED_HASH_FACTORY.GetHashList(@LValue, SizeOf(LValue), AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for string types
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.ShortString1(constref AValue: ShortString1; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.ShortString2(constref AValue: ShortString2; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.ShortString3(constref AValue: ShortString3; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.ShortString(constref AValue: ShortString; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.AnsiString(constref AValue: AnsiString; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.AnsiChar), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.WideString(constref AValue: WideString; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.WideChar), AHashList, []);
+end;
+
+class procedure TExtendedHashFactory.UnicodeString(constref AValue: UnicodeString; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue[1], Length(AValue) * SizeOf(System.UnicodeChar), AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Delegates
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Method(constref AValue: TMethod; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.TMethod), AHashList, []);
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Variant
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Variant(constref AValue: PVariant; AHashList: PUInt32);
+begin
+  try
+    EXTENDED_HASH_FACTORY.UnicodeString(AValue^, AHashList);
+  except
+    EXTENDED_HASH_FACTORY.GetHashList(AValue, SizeOf(System.Variant), AHashList, []);
+  end;
+end;
+
+{-----------------------------------------------------------------------------------------------------------------------
+  GetHashCode for Pointer
+{----------------------------------------------------------------------------------------------------------------------}
+
+class procedure TExtendedHashFactory.Pointer(constref AValue: Pointer; AHashList: PUInt32);
+begin
+  EXTENDED_HASH_FACTORY.GetHashList(@AValue, SizeOf(System.Pointer), AHashList, []);
+end;
+
+{ TComparerService }
+
+class function TComparerService.CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject;
+begin
+    Result := New(PSpoofInterfacedTypeSizeObject);
+    Result.VMT      := AVMT;
+    Result.RefCount := 0;
+    Result.Size     := ASize;
+end;
+
+class function TComparerService.SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  case ATypeData.OrdType of
+    otSByte:
+      Exit(@Comparer_Int8_Instance);
+    otUByte:
+      Exit(@Comparer_UInt8_Instance);
+    otSWord:
+      Exit(@Comparer_Int16_Instance);
+    otUWord:
+      Exit(@Comparer_UInt16_Instance);
+    otSLong:
+      Exit(@Comparer_Int32_Instance);
+    otULong:
+      Exit(@Comparer_UInt32_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function TComparerService.SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  if ATypeData.MaxInt64Value > ATypeData.MinInt64Value then
+    Exit(@Comparer_Int64_Instance)
+  else
+    Exit(@Comparer_UInt64_Instance);
+end;
+
+class function TComparerService.SelectFloatComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ATypeData.FloatType of
+    ftSingle:
+      Exit(@Comparer_Single_Instance);
+    ftDouble:
+      Exit(@Comparer_Double_Instance);
+    ftExtended:
+      Exit(@Comparer_Extended_Instance);
+    ftComp:
+      Exit(@Comparer_Comp_Instance);
+    ftCurr:
+      Exit(@Comparer_Currency_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function TComparerService.SelectShortStringComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    2: Exit(@Comparer_ShortString1_Instance);
+    3: Exit(@Comparer_ShortString2_Instance);
+    4: Exit(@Comparer_ShortString3_Instance);
+  else
+    Exit(@Comparer_ShortString_Instance);
+  end;
+end;
+
+class function TComparerService.SelectBinaryComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    1: Exit(@Comparer_UInt8_Instance);
+    2: Exit(@Comparer_UInt16_Instance);
+    4: Exit(@Comparer_UInt32_Instance);
+{$IFDEF CPU64}
+    8: Exit(@Comparer_UInt64_Instance)
+{$ENDIF}
+  else
+    Result := CreateInterface(@Comparer_Binary_VMT, ASize);
+  end;
+end;
+
+class function TComparerService.SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  Result := CreateInterface(@Comparer_DynArray_VMT, ATypeData.elSize);
+end;
+
+class function TComparerService.LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
+var
+  LInstance: PInstance;
+begin
+  if ATypeInfo = nil then
+    Exit(SelectBinaryComparer(GetTypeData(ATypeInfo), ASize))
+  else
+  begin
+    LInstance := @ComparerInstances[ATypeInfo.Kind];
+    Result := LInstance.Instance;
+    if LInstance.Selector then
+      Result := TSelectFunc(Result)(GetTypeData(ATypeInfo), ASize);
+  end;
+end;
+
+{ TComparerService.TInstance }
+
+class function TComparerService.TInstance.Create(ASelector: Boolean;
+  AInstance: Pointer): TComparerService.TInstance;
+begin
+  Result.Selector := ASelector;
+  Result.Instance := AInstance;
+end;
+
+class function TComparerService.TInstance.CreateSelector(ASelectorInstance: CodePointer): TComparerService.TInstance;
+begin
+  Result.Selector := True;
+  Result.SelectorInstance := ASelectorInstance;
+end;
+
+{ THashService }
+
+class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  case ATypeData.OrdType of
+    otSByte:
+      Exit(@FEqualityComparer_Int8_Instance);
+    otUByte:
+      Exit(@FEqualityComparer_UInt8_Instance);
+    otSWord:
+      Exit(@FEqualityComparer_Int16_Instance);
+    otUWord:
+      Exit(@FEqualityComparer_UInt16_Instance);
+    otSLong:
+      Exit(@FEqualityComparer_Int32_Instance);
+    otULong:
+      Exit(@FEqualityComparer_UInt32_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function THashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ATypeData.FloatType of
+    ftSingle:
+      Exit(@FEqualityComparer_Single_Instance);
+    ftDouble:
+      Exit(@FEqualityComparer_Double_Instance);
+    ftExtended:
+      Exit(@FEqualityComparer_Extended_Instance);
+    ftComp:
+      Exit(@FEqualityComparer_Comp_Instance);
+    ftCurr:
+      Exit(@FEqualityComparer_Currency_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function THashService<T>.SelectShortStringEqualityComparer(
+  ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    2: Exit(@FEqualityComparer_ShortString1_Instance);
+    3: Exit(@FEqualityComparer_ShortString2_Instance);
+    4: Exit(@FEqualityComparer_ShortString3_Instance);
+  else
+    Exit(@FEqualityComparer_ShortString_Instance);
+  end
+end;
+
+class function THashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    1: Exit(@FEqualityComparer_UInt8_Instance);
+    2: Exit(@FEqualityComparer_UInt16_Instance);
+    4: Exit(@FEqualityComparer_UInt32_Instance);
+{$IFDEF CPU64}
+    8: Exit(@FEqualityComparer_UInt64_Instance)
+{$ENDIF}
+  else
+    Result := CreateInterface(@FEqualityComparer_Binary_VMT, ASize);
+  end;
+end;
+
+class function THashService<T>.SelectDynArrayEqualityComparer(
+  ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  Result := CreateInterface(@FEqualityComparer_DynArray_VMT, ATypeData.elSize);
+end;
+
+class function THashService<T>.LookupEqualityComparer(ATypeInfo: PTypeInfo;
+  ASize: SizeInt): Pointer;
+var
+  LInstance: PInstance;
+  LSelectMethod: TSelectMethod;
+begin
+  if ATypeInfo = nil then
+    Exit(SelectBinaryEqualityComparer(GetTypeData(ATypeInfo), ASize))
+  else
+  begin
+    LInstance := @FEqualityComparerInstances[ATypeInfo.Kind];
+    Result := LInstance.Instance;
+    if LInstance.Selector then
+    begin
+      TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
+      TMethod(LSelectMethod).Data := Self;
+      Result := LSelectMethod(GetTypeData(ATypeInfo), ASize);
+    end;
+  end;
+end;
+
+class constructor THashService<T>.Create;
+begin
+  FEqualityComparer_Int8_VMT          := EqualityComparer_Int8_VMT         ;
+  FEqualityComparer_Int16_VMT         := EqualityComparer_Int16_VMT        ;
+  FEqualityComparer_Int32_VMT         := EqualityComparer_Int32_VMT        ;
+  FEqualityComparer_Int64_VMT         := EqualityComparer_Int64_VMT        ;
+  FEqualityComparer_UInt8_VMT         := EqualityComparer_UInt8_VMT        ;
+  FEqualityComparer_UInt16_VMT        := EqualityComparer_UInt16_VMT       ;
+  FEqualityComparer_UInt32_VMT        := EqualityComparer_UInt32_VMT       ;
+  FEqualityComparer_UInt64_VMT        := EqualityComparer_UInt64_VMT       ;
+  FEqualityComparer_Single_VMT        := EqualityComparer_Single_VMT       ;
+  FEqualityComparer_Double_VMT        := EqualityComparer_Double_VMT       ;
+  FEqualityComparer_Extended_VMT      := EqualityComparer_Extended_VMT     ;
+  FEqualityComparer_Currency_VMT      := EqualityComparer_Currency_VMT     ;
+  FEqualityComparer_Comp_VMT          := EqualityComparer_Comp_VMT         ;
+  FEqualityComparer_Binary_VMT        := EqualityComparer_Binary_VMT       ;
+  FEqualityComparer_DynArray_VMT      := EqualityComparer_DynArray_VMT     ;
+  FEqualityComparer_Class_VMT         := EqualityComparer_Class_VMT        ;
+  FEqualityComparer_ShortString1_VMT  := EqualityComparer_ShortString1_VMT ;
+  FEqualityComparer_ShortString2_VMT  := EqualityComparer_ShortString2_VMT ;
+  FEqualityComparer_ShortString3_VMT  := EqualityComparer_ShortString3_VMT ;
+  FEqualityComparer_ShortString_VMT   := EqualityComparer_ShortString_VMT  ;
+  FEqualityComparer_AnsiString_VMT    := EqualityComparer_AnsiString_VMT   ;
+  FEqualityComparer_WideString_VMT    := EqualityComparer_WideString_VMT   ;
+  FEqualityComparer_UnicodeString_VMT := EqualityComparer_UnicodeString_VMT;
+  FEqualityComparer_Method_VMT        := EqualityComparer_Method_VMT       ;
+  FEqualityComparer_Variant_VMT       := EqualityComparer_Variant_VMT      ;
+  FEqualityComparer_Pointer_VMT       := EqualityComparer_Pointer_VMT      ;
+
+  /////
+  FEqualityComparer_Int8_VMT.__ClassRef          := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Int16_VMT.__ClassRef         := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Int32_VMT.__ClassRef         := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Int64_VMT.__ClassRef         := THashFactoryClass(T.ClassType);
+  FEqualityComparer_UInt8_VMT.__ClassRef         := THashFactoryClass(T.ClassType);
+  FEqualityComparer_UInt16_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_UInt32_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_UInt64_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Single_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Double_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Extended_VMT.__ClassRef      := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Currency_VMT.__ClassRef      := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Comp_VMT.__ClassRef          := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Binary_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_DynArray_VMT.__ClassRef      := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Class_VMT.__ClassRef         := THashFactoryClass(T.ClassType);
+  FEqualityComparer_ShortString1_VMT.__ClassRef  := THashFactoryClass(T.ClassType);
+  FEqualityComparer_ShortString2_VMT.__ClassRef  := THashFactoryClass(T.ClassType);
+  FEqualityComparer_ShortString3_VMT.__ClassRef  := THashFactoryClass(T.ClassType);
+  FEqualityComparer_ShortString_VMT.__ClassRef   := THashFactoryClass(T.ClassType);
+  FEqualityComparer_AnsiString_VMT.__ClassRef    := THashFactoryClass(T.ClassType);
+  FEqualityComparer_WideString_VMT.__ClassRef    := THashFactoryClass(T.ClassType);
+  FEqualityComparer_UnicodeString_VMT.__ClassRef := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Method_VMT.__ClassRef        := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Variant_VMT.__ClassRef       := THashFactoryClass(T.ClassType);
+  FEqualityComparer_Pointer_VMT.__ClassRef       := THashFactoryClass(T.ClassType);
+
+  ///////
+  FEqualityComparer_Int8_Instance          := @FEqualityComparer_Int8_VMT         ;
+  FEqualityComparer_Int16_Instance         := @FEqualityComparer_Int16_VMT        ;
+  FEqualityComparer_Int32_Instance         := @FEqualityComparer_Int32_VMT        ;
+  FEqualityComparer_Int64_Instance         := @FEqualityComparer_Int64_VMT        ;
+  FEqualityComparer_UInt8_Instance         := @FEqualityComparer_UInt8_VMT        ;
+  FEqualityComparer_UInt16_Instance        := @FEqualityComparer_UInt16_VMT       ;
+  FEqualityComparer_UInt32_Instance        := @FEqualityComparer_UInt32_VMT       ;
+  FEqualityComparer_UInt64_Instance        := @FEqualityComparer_UInt64_VMT       ;
+  FEqualityComparer_Single_Instance        := @FEqualityComparer_Single_VMT       ;
+  FEqualityComparer_Double_Instance        := @FEqualityComparer_Double_VMT       ;
+  FEqualityComparer_Extended_Instance      := @FEqualityComparer_Extended_VMT     ;
+  FEqualityComparer_Currency_Instance      := @FEqualityComparer_Currency_VMT     ;
+  FEqualityComparer_Comp_Instance          := @FEqualityComparer_Comp_VMT         ;
+  //FEqualityComparer_Binary_Instance        := @FEqualityComparer_Binary_VMT       ;  // dynamic instance
+  //FEqualityComparer_DynArray_Instance      := @FEqualityComparer_DynArray_VMT     ;  // dynamic instance
+  FEqualityComparer_ShortString1_Instance  := @FEqualityComparer_ShortString1_VMT ;
+  FEqualityComparer_ShortString2_Instance  := @FEqualityComparer_ShortString2_VMT ;
+  FEqualityComparer_ShortString3_Instance  := @FEqualityComparer_ShortString3_VMT ;
+  FEqualityComparer_ShortString_Instance   := @FEqualityComparer_ShortString_VMT  ;
+  FEqualityComparer_AnsiString_Instance    := @FEqualityComparer_AnsiString_VMT   ;
+  FEqualityComparer_WideString_Instance    := @FEqualityComparer_WideString_VMT   ;
+  FEqualityComparer_UnicodeString_Instance := @FEqualityComparer_UnicodeString_VMT;
+  FEqualityComparer_Method_Instance        := @FEqualityComparer_Method_VMT       ;
+  FEqualityComparer_Variant_Instance       := @FEqualityComparer_Variant_VMT      ;
+  FEqualityComparer_Pointer_Instance       := @FEqualityComparer_Pointer_VMT      ;
+
+  //////
+  FEqualityComparerInstances[tkUnknown]      := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkInteger]      := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
+  FEqualityComparerInstances[tkChar]         := TInstance.Create(False, @FEqualityComparer_UInt8_Instance);
+  FEqualityComparerInstances[tkEnumeration]  := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
+  FEqualityComparerInstances[tkFloat]        := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectFloatEqualityComparer)).Code);
+  FEqualityComparerInstances[tkSet]          := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkMethod]       := TInstance.Create(False, @FEqualityComparer_Method_Instance);
+  FEqualityComparerInstances[tkSString]      := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectShortStringEqualityComparer)).Code);
+  FEqualityComparerInstances[tkLString]      := TInstance.Create(False, @FEqualityComparer_AnsiString_Instance);
+  FEqualityComparerInstances[tkAString]      := TInstance.Create(False, @FEqualityComparer_AnsiString_Instance);
+  FEqualityComparerInstances[tkWString]      := TInstance.Create(False, @FEqualityComparer_WideString_Instance);
+  FEqualityComparerInstances[tkVariant]      := TInstance.Create(False, @FEqualityComparer_Variant_Instance);
+  FEqualityComparerInstances[tkArray]        := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkRecord]       := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkInterface]    := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkClass]        := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkObject]       := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkWChar]        := TInstance.Create(False, @FEqualityComparer_UInt16_Instance);
+  FEqualityComparerInstances[tkBool]         := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectIntegerEqualityComparer)).Code);
+  FEqualityComparerInstances[tkInt64]        := TInstance.Create(False, @FEqualityComparer_Int64_Instance);
+  FEqualityComparerInstances[tkQWord]        := TInstance.Create(False, @FEqualityComparer_UInt64_Instance);
+  FEqualityComparerInstances[tkDynArray]     := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectDynArrayEqualityComparer)).Code);
+  FEqualityComparerInstances[tkInterfaceRaw] := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkProcVar]      := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkUString]      := TInstance.Create(False, @FEqualityComparer_UnicodeString_Instance);
+  FEqualityComparerInstances[tkUChar]        := TInstance.Create(False, @FEqualityComparer_UInt16_Instance);
+  FEqualityComparerInstances[tkHelper]       := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkFile]         := TInstance.CreateSelector(TMethod(TSelectMethod(THashService<T>.SelectBinaryEqualityComparer)).Code);
+  FEqualityComparerInstances[tkClassRef]     := TInstance.Create(False, @FEqualityComparer_Pointer_Instance);
+  FEqualityComparerInstances[tkPointer]      := TInstance.Create(False, @FEqualityComparer_Pointer_Instance)
+end;
+
+{ TExtendedHashService }
+
+class function TExtendedHashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  case ATypeData.OrdType of
+    otSByte:
+      Exit(@FExtendedEqualityComparer_Int8_Instance);
+    otUByte:
+      Exit(@FExtendedEqualityComparer_UInt8_Instance);
+    otSWord:
+      Exit(@FExtendedEqualityComparer_Int16_Instance);
+    otUWord:
+      Exit(@FExtendedEqualityComparer_UInt16_Instance);
+    otSLong:
+      Exit(@FExtendedEqualityComparer_Int32_Instance);
+    otULong:
+      Exit(@FExtendedEqualityComparer_UInt32_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function TExtendedHashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  case ATypeData.FloatType of
+    ftSingle:
+      Exit(@FExtendedEqualityComparer_Single_Instance);
+    ftDouble:
+      Exit(@FExtendedEqualityComparer_Double_Instance);
+    ftExtended:
+      Exit(@FExtendedEqualityComparer_Extended_Instance);
+    ftComp:
+      Exit(@FExtendedEqualityComparer_Comp_Instance);
+    ftCurr:
+      Exit(@FExtendedEqualityComparer_Currency_Instance);
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+class function TExtendedHashService<T>.SelectShortStringEqualityComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    2: Exit(@FExtendedEqualityComparer_ShortString1_Instance);
+    3: Exit(@FExtendedEqualityComparer_ShortString2_Instance);
+    4: Exit(@FExtendedEqualityComparer_ShortString3_Instance);
+  else
+    Exit(@FExtendedEqualityComparer_ShortString_Instance);
+  end
+end;
+
+class function TExtendedHashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
+  ASize: SizeInt): Pointer;
+begin
+  case ASize of
+    1: Exit(@FExtendedEqualityComparer_UInt8_Instance);
+    2: Exit(@FExtendedEqualityComparer_UInt16_Instance);
+    4: Exit(@FExtendedEqualityComparer_UInt32_Instance);
+{$IFDEF CPU64}
+    8: Exit(@FExtendedEqualityComparer_UInt64_Instance)
+{$ENDIF}
+  else
+    Result := CreateInterface(@FExtendedEqualityComparer_Binary_VMT, ASize);
+  end;
+end;
+
+class function TExtendedHashService<T>.SelectDynArrayEqualityComparer(
+  ATypeData: PTypeData; ASize: SizeInt): Pointer;
+begin
+  Result := CreateInterface(@FExtendedEqualityComparer_DynArray_VMT, ATypeData.elSize);
+end;
+
+class function TExtendedHashService<T>.LookupExtendedEqualityComparer(
+  ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
+var
+  LInstance: PInstance;
+  LSelectMethod: TSelectMethod;
+begin
+  if ATypeInfo = nil then
+    Exit(SelectBinaryEqualityComparer(GetTypeData(ATypeInfo), ASize))
+  else
+  begin
+    LInstance := @FExtendedEqualityComparerInstances[ATypeInfo.Kind];
+    Result := LInstance.Instance;
+    if LInstance.Selector then
+    begin
+      TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
+      TMethod(LSelectMethod).Data := Self;
+      Result := LSelectMethod(GetTypeData(ATypeInfo), ASize);
+    end;
+  end;
+end;
+
+class constructor TExtendedHashService<T>.Create;
+begin
+  FExtendedEqualityComparer_Int8_VMT          := ExtendedEqualityComparer_Int8_VMT         ;
+  FExtendedEqualityComparer_Int16_VMT         := ExtendedEqualityComparer_Int16_VMT        ;
+  FExtendedEqualityComparer_Int32_VMT         := ExtendedEqualityComparer_Int32_VMT        ;
+  FExtendedEqualityComparer_Int64_VMT         := ExtendedEqualityComparer_Int64_VMT        ;
+  FExtendedEqualityComparer_UInt8_VMT         := ExtendedEqualityComparer_UInt8_VMT        ;
+  FExtendedEqualityComparer_UInt16_VMT        := ExtendedEqualityComparer_UInt16_VMT       ;
+  FExtendedEqualityComparer_UInt32_VMT        := ExtendedEqualityComparer_UInt32_VMT       ;
+  FExtendedEqualityComparer_UInt64_VMT        := ExtendedEqualityComparer_UInt64_VMT       ;
+  FExtendedEqualityComparer_Single_VMT        := ExtendedEqualityComparer_Single_VMT       ;
+  FExtendedEqualityComparer_Double_VMT        := ExtendedEqualityComparer_Double_VMT       ;
+  FExtendedEqualityComparer_Extended_VMT      := ExtendedEqualityComparer_Extended_VMT     ;
+  FExtendedEqualityComparer_Currency_VMT      := ExtendedEqualityComparer_Currency_VMT     ;
+  FExtendedEqualityComparer_Comp_VMT          := ExtendedEqualityComparer_Comp_VMT         ;
+  FExtendedEqualityComparer_Binary_VMT        := ExtendedEqualityComparer_Binary_VMT       ;
+  FExtendedEqualityComparer_DynArray_VMT      := ExtendedEqualityComparer_DynArray_VMT     ;
+  FExtendedEqualityComparer_Class_VMT         := ExtendedEqualityComparer_Class_VMT        ;
+  FExtendedEqualityComparer_ShortString1_VMT  := ExtendedEqualityComparer_ShortString1_VMT ;
+  FExtendedEqualityComparer_ShortString2_VMT  := ExtendedEqualityComparer_ShortString2_VMT ;
+  FExtendedEqualityComparer_ShortString3_VMT  := ExtendedEqualityComparer_ShortString3_VMT ;
+  FExtendedEqualityComparer_ShortString_VMT   := ExtendedEqualityComparer_ShortString_VMT  ;
+  FExtendedEqualityComparer_AnsiString_VMT    := ExtendedEqualityComparer_AnsiString_VMT   ;
+  FExtendedEqualityComparer_WideString_VMT    := ExtendedEqualityComparer_WideString_VMT   ;
+  FExtendedEqualityComparer_UnicodeString_VMT := ExtendedEqualityComparer_UnicodeString_VMT;
+  FExtendedEqualityComparer_Method_VMT        := ExtendedEqualityComparer_Method_VMT       ;
+  FExtendedEqualityComparer_Variant_VMT       := ExtendedEqualityComparer_Variant_VMT      ;
+  FExtendedEqualityComparer_Pointer_VMT       := ExtendedEqualityComparer_Pointer_VMT      ;
+
+  /////
+  FExtendedEqualityComparer_Int8_VMT.__ClassRef          := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Int16_VMT.__ClassRef         := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Int32_VMT.__ClassRef         := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Int64_VMT.__ClassRef         := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_UInt8_VMT.__ClassRef         := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_UInt16_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_UInt32_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_UInt64_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Single_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Double_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Extended_VMT.__ClassRef      := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Currency_VMT.__ClassRef      := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Comp_VMT.__ClassRef          := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Binary_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_DynArray_VMT.__ClassRef      := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Class_VMT.__ClassRef         := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_ShortString1_VMT.__ClassRef  := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_ShortString2_VMT.__ClassRef  := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_ShortString3_VMT.__ClassRef  := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_ShortString_VMT.__ClassRef   := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_AnsiString_VMT.__ClassRef    := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_WideString_VMT.__ClassRef    := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_UnicodeString_VMT.__ClassRef := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Method_VMT.__ClassRef        := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Variant_VMT.__ClassRef       := TExtendedHashFactoryClass(T.ClassType);
+  FExtendedEqualityComparer_Pointer_VMT.__ClassRef       := TExtendedHashFactoryClass(T.ClassType);
+
+  ///////
+  FExtendedEqualityComparer_Int8_Instance          := @FExtendedEqualityComparer_Int8_VMT         ;
+  FExtendedEqualityComparer_Int16_Instance         := @FExtendedEqualityComparer_Int16_VMT        ;
+  FExtendedEqualityComparer_Int32_Instance         := @FExtendedEqualityComparer_Int32_VMT        ;
+  FExtendedEqualityComparer_Int64_Instance         := @FExtendedEqualityComparer_Int64_VMT        ;
+  FExtendedEqualityComparer_UInt8_Instance         := @FExtendedEqualityComparer_UInt8_VMT        ;
+  FExtendedEqualityComparer_UInt16_Instance        := @FExtendedEqualityComparer_UInt16_VMT       ;
+  FExtendedEqualityComparer_UInt32_Instance        := @FExtendedEqualityComparer_UInt32_VMT       ;
+  FExtendedEqualityComparer_UInt64_Instance        := @FExtendedEqualityComparer_UInt64_VMT       ;
+  FExtendedEqualityComparer_Single_Instance        := @FExtendedEqualityComparer_Single_VMT       ;
+  FExtendedEqualityComparer_Double_Instance        := @FExtendedEqualityComparer_Double_VMT       ;
+  FExtendedEqualityComparer_Extended_Instance      := @FExtendedEqualityComparer_Extended_VMT     ;
+  FExtendedEqualityComparer_Currency_Instance      := @FExtendedEqualityComparer_Currency_VMT     ;
+  FExtendedEqualityComparer_Comp_Instance          := @FExtendedEqualityComparer_Comp_VMT         ;
+  //FExtendedEqualityComparer_Binary_Instance        := @FExtendedEqualityComparer_Binary_VMT       ;  // dynamic instance
+  //FExtendedEqualityComparer_DynArray_Instance      := @FExtendedEqualityComparer_DynArray_VMT     ;  // dynamic instance
+  FExtendedEqualityComparer_ShortString1_Instance  := @FExtendedEqualityComparer_ShortString1_VMT ;
+  FExtendedEqualityComparer_ShortString2_Instance  := @FExtendedEqualityComparer_ShortString2_VMT ;
+  FExtendedEqualityComparer_ShortString3_Instance  := @FExtendedEqualityComparer_ShortString3_VMT ;
+  FExtendedEqualityComparer_ShortString_Instance   := @FExtendedEqualityComparer_ShortString_VMT  ;
+  FExtendedEqualityComparer_AnsiString_Instance    := @FExtendedEqualityComparer_AnsiString_VMT   ;
+  FExtendedEqualityComparer_WideString_Instance    := @FExtendedEqualityComparer_WideString_VMT   ;
+  FExtendedEqualityComparer_UnicodeString_Instance := @FExtendedEqualityComparer_UnicodeString_VMT;
+  FExtendedEqualityComparer_Method_Instance        := @FExtendedEqualityComparer_Method_VMT       ;
+  FExtendedEqualityComparer_Variant_Instance       := @FExtendedEqualityComparer_Variant_VMT      ;
+  FExtendedEqualityComparer_Pointer_Instance       := @FExtendedEqualityComparer_Pointer_VMT      ;
+
+  //////
+  FExtendedEqualityComparerInstances[tkUnknown]      := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkInteger]      := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkChar]         := TInstance.Create(False, @FExtendedEqualityComparer_UInt8_Instance);
+  FExtendedEqualityComparerInstances[tkEnumeration]  := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkFloat]        := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectFloatEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkSet]          := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkMethod]       := TInstance.Create(False, @FExtendedEqualityComparer_Method_Instance);
+  FExtendedEqualityComparerInstances[tkSString]      := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectShortStringEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkLString]      := TInstance.Create(False, @FExtendedEqualityComparer_AnsiString_Instance);
+  FExtendedEqualityComparerInstances[tkAString]      := TInstance.Create(False, @FExtendedEqualityComparer_AnsiString_Instance);
+  FExtendedEqualityComparerInstances[tkWString]      := TInstance.Create(False, @FExtendedEqualityComparer_WideString_Instance);
+  FExtendedEqualityComparerInstances[tkVariant]      := TInstance.Create(False, @FExtendedEqualityComparer_Variant_Instance);
+  FExtendedEqualityComparerInstances[tkArray]        := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkRecord]       := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkInterface]    := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkClass]        := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkObject]       := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkWChar]        := TInstance.Create(False, @FExtendedEqualityComparer_UInt16_Instance);
+  FExtendedEqualityComparerInstances[tkBool]         := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectIntegerEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkInt64]        := TInstance.Create(False, @FExtendedEqualityComparer_Int64_Instance);
+  FExtendedEqualityComparerInstances[tkQWord]        := TInstance.Create(False, @FExtendedEqualityComparer_UInt64_Instance);
+  FExtendedEqualityComparerInstances[tkDynArray]     := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectDynArrayEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkInterfaceRaw] := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkProcVar]      := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkUString]      := TInstance.Create(False, @FExtendedEqualityComparer_UnicodeString_Instance);
+  FExtendedEqualityComparerInstances[tkUChar]        := TInstance.Create(False, @FExtendedEqualityComparer_UInt16_Instance);
+  FExtendedEqualityComparerInstances[tkHelper]       := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkFile]         := TInstance.CreateSelector(TMethod(TSelectMethod(TExtendedHashService<T>.SelectBinaryEqualityComparer)).Code);
+  FExtendedEqualityComparerInstances[tkClassRef]     := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+  FExtendedEqualityComparerInstances[tkPointer]      := TInstance.Create(False, @FExtendedEqualityComparer_Pointer_Instance);
+end;
+
+{ TEqualityComparer<T> }
+
+class function TEqualityComparer<T>.Default: IEqualityComparer<T>;
+begin
+  Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T));
+end;
+
+class function TEqualityComparer<T>.Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>;
+begin
+  if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then
+    Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass)
+  else if AHashFactoryClass.InheritsFrom(THashFactory) then
+    Result := _LookupVtableInfoEx(giEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass);
+end;
+
+class function  TEqualityComparer<T>.Construct(const AEqualityComparison: TOnEqualityComparison<T>;
+  const AHasher: TOnHasher<T>): IEqualityComparer<T>;
+begin
+  Result := TDelegatedEqualityComparerEvents<T>.Create(AEqualityComparison, AHasher);
+end;
+
+class function  TEqualityComparer<T>.Construct(const AEqualityComparison: TEqualityComparisonFunc<T>;
+  const AHasher: THasherFunc<T>): IEqualityComparer<T>;
+begin
+  Result := TDelegatedEqualityComparerFunc<T>.Create(AEqualityComparison, AHasher);
+end;
+
+{ TDelegatedEqualityComparerEvents<T> }
+
+function TDelegatedEqualityComparerEvents<T>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparison(ALeft, ARight);
+end;
+
+function TDelegatedEqualityComparerEvents<T>.GetHashCode(constref AValue: T): UInt32;
+begin
+  Result := FHasher(AValue);
+end;
+
+constructor TDelegatedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
+  const AHasher: TOnHasher<T>);
+begin
+  FEqualityComparison := AEqualityComparison;
+  FHasher := AHasher;
+end;
+
+{ TDelegatedEqualityComparerFunc<T> }
+
+function TDelegatedEqualityComparerFunc<T>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparison(ALeft, ARight);
+end;
+
+function TDelegatedEqualityComparerFunc<T>.GetHashCode(constref AValue: T): UInt32;
+begin
+  Result := FHasher(AValue);
+end;
+
+constructor TDelegatedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+  const AHasher: THasherFunc<T>);
+begin
+  FEqualityComparison := AEqualityComparison;
+  FHasher := AHasher;
+end;
+
+{ TDelegatedExtendedEqualityComparerEvents<T> }
+
+function TDelegatedExtendedEqualityComparerEvents<T>.GetHashCodeMethod(constref AValue: T): UInt32;
+var
+  LHashList: array[0..1] of Int32;
+  LHashListParams: array[0..3] of Int16 absolute LHashList;
+begin
+  LHashListParams[0] := -1;
+  FExtendedHasher(AValue, @LHashList[0]);
+  Result := LHashList[1];
+end;
+
+function TDelegatedExtendedEqualityComparerEvents<T>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparison(ALeft, ARight);
+end;
+
+function TDelegatedExtendedEqualityComparerEvents<T>.GetHashCode(constref AValue: T): UInt32;
+begin
+  Result := FHasher(AValue);
+end;
+
+procedure TDelegatedExtendedEqualityComparerEvents<T>.GetHashList(constref AValue: T; AHashList: PUInt32);
+begin
+  FExtendedHasher(AValue, AHashList);
+end;
+
+constructor TDelegatedExtendedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
+  const AHasher: TOnHasher<T>; const AExtendedHasher: TOnExtendedHasher<T>);
+begin
+  FEqualityComparison := AEqualityComparison;
+  FHasher := AHasher;
+  FExtendedHasher := AExtendedHasher;
+end;
+
+constructor TDelegatedExtendedEqualityComparerEvents<T>.Create(const AEqualityComparison: TOnEqualityComparison<T>;
+  const AExtendedHasher: TOnExtendedHasher<T>);
+begin
+  Create(AEqualityComparison, GetHashCodeMethod, AExtendedHasher);
+end;
+
+{ TDelegatedExtendedEqualityComparerFunc<T> }
+
+function TDelegatedExtendedEqualityComparerFunc<T>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparison(ALeft, ARight);
+end;
+
+function TDelegatedExtendedEqualityComparerFunc<T>.GetHashCode(constref AValue: T): UInt32;
+var
+  LHashList: array[0..1] of Int32;
+  LHashListParams: array[0..3] of Int16 absolute LHashList;
+begin
+  if not Assigned(FHasher) then
+  begin
+    LHashListParams[0] := -1;
+    FExtendedHasher(AValue, @LHashList[0]);
+    Result := LHashList[1];
+  end
+  else
+    Result := FHasher(AValue);
+end;
+
+procedure TDelegatedExtendedEqualityComparerFunc<T>.GetHashList(constref AValue: T; AHashList: PUInt32);
+begin
+  FExtendedHasher(AValue, AHashList);
+end;
+
+constructor TDelegatedExtendedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+  const AHasher: THasherFunc<T>; const AExtendedHasher: TExtendedHasherFunc<T>);
+begin
+  FEqualityComparison := AEqualityComparison;
+  FHasher := AHasher;
+  FExtendedHasher := AExtendedHasher;
+end;
+
+constructor TDelegatedExtendedEqualityComparerFunc<T>.Create(const AEqualityComparison: TEqualityComparisonFunc<T>;
+  const AExtendedHasher: TExtendedHasherFunc<T>);
+begin
+  Create(AEqualityComparison, nil, AExtendedHasher);
+end;
+
+{ TExtendedEqualityComparer<T> }
+
+class function TExtendedEqualityComparer<T>.Default: IExtendedEqualityComparer<T>;
+begin
+  Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T));
+end;
+
+class function TExtendedEqualityComparer<T>.Default(
+  AExtenedHashFactoryClass: TExtendedHashFactoryClass
+  ): IExtendedEqualityComparer<T>;
+begin
+  Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AExtenedHashFactoryClass);
+end;
+
+class function TExtendedEqualityComparer<T>.Construct(
+  const AEqualityComparison: TOnEqualityComparison<T>; const AHasher: TOnHasher<T>;
+  const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>;
+begin
+  Result := TDelegatedExtendedEqualityComparerEvents<T>.Create(AEqualityComparison, AHasher, AExtendedHasher);
+end;
+
+class function TExtendedEqualityComparer<T>.Construct(
+  const AEqualityComparison: TEqualityComparisonFunc<T>; const AHasher: THasherFunc<T>;
+  const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>;
+begin
+  Result := TDelegatedExtendedEqualityComparerFunc<T>.Create(AEqualityComparison, AHasher, AExtendedHasher);
+end;
+
+class function TExtendedEqualityComparer<T>.Construct(
+  const AEqualityComparison: TOnEqualityComparison<T>;
+  const AExtendedHasher: TOnExtendedHasher<T>): IExtendedEqualityComparer<T>;
+begin
+  Result := TDelegatedExtendedEqualityComparerEvents<T>.Create(AEqualityComparison, AExtendedHasher);
+end;
+
+class function TExtendedEqualityComparer<T>.Construct(
+  const AEqualityComparison: TEqualityComparisonFunc<T>;
+  const AExtendedHasher: TExtendedHasherFunc<T>): IExtendedEqualityComparer<T>;
+begin
+  Result := TDelegatedExtendedEqualityComparerFunc<T>.Create(AEqualityComparison, AExtendedHasher);
+end;
+
+{ TDelphiHashFactory }
+
+class function TDelphiHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TDelphiHashFactory>;
+end;
+
+class function TDelphiHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := DelphiHashLittle(AKey, ASize, AInitVal);
+end;
+
+{ TAdler32HashFactory }
+
+class function TAdler32HashFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TAdler32HashFactory>;
+end;
+
+class function TAdler32HashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
+  AInitVal: UInt32): UInt32;
+begin
+  Result := Adler32(AKey, ASize);
+end;
+
+{ TSdbmHashFactory }
+
+class function TSdbmHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TSdbmHashFactory>;
+end;
+
+class function TSdbmHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
+  AInitVal: UInt32): UInt32;
+begin
+  Result := sdbm(AKey, ASize);
+end;
+
+{ TSimpleChecksumFactory }
+
+class function TSimpleChecksumFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TSimpleChecksumFactory>;
+end;
+
+class function TSimpleChecksumFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
+  AInitVal: UInt32): UInt32;
+begin
+  Result := SimpleChecksumHash(AKey, ASize);
+end;
+
+{ TDelphiDoubleHashFactory }
+
+class function TDelphiDoubleHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := TExtendedHashService<TDelphiDoubleHashFactory>;
+end;
+
+class function TDelphiDoubleHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := DelphiHashLittle(AKey, ASize, AInitVal);
+end;
+
+class procedure TDelphiDoubleHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
+        AOptions: TGetHashListOptions);
+var
+  LHash: UInt32;
+  AHashListParams: PUInt16 absolute AHashList;
+begin
+{$WARNINGS OFF}
+  case AHashListParams[0] of
+    -2:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    0: Exit;
+    1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    2:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+        begin
+          AHashList[1] := 0;
+          AHashList[2] := 0;
+        end;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+        Exit;
+      end;
+  else
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+  end;
+{$WARNINGS ON}
+end;
+
+{ TDelphiQuadrupleHashFactory }
+
+class function TDelphiQuadrupleHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := TExtendedHashService<TDelphiQuadrupleHashFactory>;
+end;
+
+class function TDelphiQuadrupleHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := DelphiHashLittle(AKey, ASize, AInitVal);
+end;
+
+class procedure TDelphiQuadrupleHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
+        AOptions: TGetHashListOptions);
+var
+  LHash: UInt32;
+  AHashListParams: PInt16 absolute AHashList;
+begin
+  case AHashListParams[0] of
+    -4:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 1988;
+        LHash := 2004;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -3:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 2004;
+        LHash := 1988;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    -2:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    0: Exit;
+    1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    2:
+      begin
+        case AHashListParams[1] of
+          0, 1:
+            begin
+              if not (ghloHashListAsInitData in AOptions) then
+              begin
+                AHashList[1] := 0;
+                AHashList[2] := 0;
+              end;
+              DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+              Exit;
+            end;
+          2:
+            begin
+              if not (ghloHashListAsInitData in AOptions) then
+              begin
+                AHashList[1] := 2004;
+                AHashList[2] := 1988;
+              end;
+              DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+              Exit;
+            end;
+        else
+          raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+        end;
+      end;
+    4:
+      case AHashListParams[1] of
+        1:
+          begin
+            if not (ghloHashListAsInitData in AOptions) then
+            begin
+              AHashList[1] := 0;
+              AHashList[2] := 0;
+            end;
+            DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+            Exit;
+          end;
+        2:
+          begin
+            if not (ghloHashListAsInitData in AOptions) then
+            begin
+              AHashList[3] := 2004;
+              AHashList[4] := 1988;
+            end;
+            DelphiHashLittle2(AKey, ASize, AHashList[3], AHashList[4]);
+            Exit;
+          end;
+      else
+        raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+      end;
+  else
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+  end;
+end;
+
+{ TDelphiSixfoldHashFactory }
+
+class function TDelphiSixfoldHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := TExtendedHashService<TDelphiSixfoldHashFactory>;
+end;
+
+class function TDelphiSixfoldHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := DelphiHashLittle(AKey, ASize, AInitVal);
+end;
+
+class procedure TDelphiSixfoldHashFactory.GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32;
+        AOptions: TGetHashListOptions);
+var
+  LHash: UInt32;
+  AHashListParams: PInt16 absolute AHashList;
+begin
+  case AHashListParams[0] of
+    -6:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 2;
+        LHash := 1;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -5:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 1;
+        LHash := 2;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    -4:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 1988;
+        LHash := 2004;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -3:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 2004;
+        LHash := 1988;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    -2:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, LHash, AHashList[1]);
+        Exit;
+      end;
+    -1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    0: Exit;
+    1:
+      begin
+        if not (ghloHashListAsInitData in AOptions) then
+          AHashList[1] := 0;
+        LHash := 0;
+        DelphiHashLittle2(AKey, ASize, AHashList[1], LHash);
+        Exit;
+      end;
+    2:
+      begin
+        case AHashListParams[1] of
+          0, 1:
+            begin
+              if not (ghloHashListAsInitData in AOptions) then
+              begin
+                AHashList[1] := 0;
+                AHashList[2] := 0;
+              end;
+              DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+              Exit;
+            end;
+          2:
+            begin
+              if not (ghloHashListAsInitData in AOptions) then
+              begin
+                AHashList[1] := 2004;
+                AHashList[2] := 1988;
+              end;
+              DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+              Exit;
+            end;
+        else
+          raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+        end;
+      end;
+    6:
+      case AHashListParams[1] of
+        1:
+          begin
+            if not (ghloHashListAsInitData in AOptions) then
+            begin
+              AHashList[1] := 0;
+              AHashList[2] := 0;
+            end;
+            DelphiHashLittle2(AKey, ASize, AHashList[1], AHashList[2]);
+            Exit;
+          end;
+        2:
+          begin
+            if not (ghloHashListAsInitData in AOptions) then
+            begin
+              AHashList[3] := 2004;
+              AHashList[4] := 1988;
+            end;
+            DelphiHashLittle2(AKey, ASize, AHashList[3], AHashList[4]);
+            Exit;
+          end;
+        3:
+          begin
+            if not (ghloHashListAsInitData in AOptions) then
+            begin
+              AHashList[5] := 1;
+              AHashList[6] := 2;
+            end;
+            DelphiHashLittle2(AKey, ASize, AHashList[5], AHashList[6]);
+            Exit;
+          end;
+      else
+        raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+      end;
+  else
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+  end;
+end;
+
+{ TOrdinalComparer<T, THashFactory> }
+
+class constructor TOrdinalComparer<T, THashFactory>.Create;
+begin
+  if THashFactory.InheritsFrom(TExtendedHashService) then
+  begin
+    FExtendedEqualityComparer := TExtendedEqualityComparer<T>.Default(TExtendedHashFactoryClass(THashFactory));
+    FEqualityComparer := IEqualityComparer<T>(FExtendedEqualityComparer);
+  end
+  else
+    FEqualityComparer := TEqualityComparer<T>.Default(THashFactory);
+  FComparer := TComparer<T>.Default;
+end;
+
+{ TGStringComparer<T, THashFactory> }
+
+class destructor TGStringComparer<T, THashFactory>.Destroy;
+begin
+  if Assigned(FOrdinal) then
+    FOrdinal.Free;
+end;
+
+class function TGStringComparer<T, THashFactory>.Ordinal: TCustomComparer<T>;
+begin
+  if not Assigned(FOrdinal) then
+    FOrdinal := TGOrdinalStringComparer<T, THashFactory>.Create;
+  Result := FOrdinal;
+end;
+
+{ TGOrdinalStringComparer<T, THashFactory> }
+
+function TGOrdinalStringComparer<T, THashFactory>.Compare(constref ALeft, ARight: T): Integer;
+begin
+  Result := FComparer.Compare(ALeft, ARight);
+end;
+
+function TGOrdinalStringComparer<T, THashFactory>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparer.Equals(ALeft, ARight);
+end;
+
+function TGOrdinalStringComparer<T, THashFactory>.GetHashCode(constref AValue: T): UInt32;
+begin
+  Result := FEqualityComparer.GetHashCode(AValue);
+end;
+
+procedure TGOrdinalStringComparer<T, THashFactory>.GetHashList(constref AValue: T; AHashList: PUInt32);
+begin
+  FExtendedEqualityComparer.GetHashList(AValue, AHashList);
+end;
+
+{ TGIStringComparer<T, THashFactory> }
+
+class destructor TGIStringComparer<T, THashFactory>.Destroy;
+begin
+  if Assigned(FOrdinal) then
+    FOrdinal.Free;
+end;
+
+class function TGIStringComparer<T, THashFactory>.Ordinal: TCustomComparer<T>;
+begin
+  if not Assigned(FOrdinal) then
+    FOrdinal := TGOrdinalIStringComparer<T, THashFactory>.Create;
+  Result := FOrdinal;
+end;
+
+{ TGOrdinalIStringComparer<T, THashFactory> }
+
+function TGOrdinalIStringComparer<T, THashFactory>.Compare(constref ALeft, ARight: T): Integer;
+begin
+  Result := FComparer.Compare(ALeft.ToLower, ARight.ToLower);
+end;
+
+function TGOrdinalIStringComparer<T, THashFactory>.Equals(constref ALeft, ARight: T): Boolean;
+begin
+  Result := FEqualityComparer.Equals(ALeft.ToLower, ARight.ToLower);
+end;
+
+function TGOrdinalIStringComparer<T, THashFactory>.GetHashCode(constref AValue: T): UInt32;
+begin
+  Result := FEqualityComparer.GetHashCode(AValue.ToLower);
+end;
+
+procedure TGOrdinalIStringComparer<T, THashFactory>.GetHashList(constref AValue: T; AHashList: PUInt32);
+begin
+  FExtendedEqualityComparer.GetHashList(AValue.ToLower, AHashList);
+end;
+
+function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer;
+begin
+  Result := DelphiHashLittle(@AData, ALength, AInitData);
+end;
+
+function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer;
+begin
+  Result := CompareMemRange(ALeft, ARight, ASize);
+end;
+
+function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
+begin
+  Result := _LookupVtableInfoEx(AGInterface, ATypeInfo, ASize, nil);
+end;
+
+function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
+  AFactory: THashFactoryClass): Pointer;
+begin
+  case AGInterface of
+    giComparer:
+        Exit(
+          TComparerService.LookupComparer(ATypeInfo, ASize));
+    giEqualityComparer:
+      begin
+        if AFactory = nil then
+          AFactory := TDelphiHashFactory;
+
+        Exit(
+          AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize));
+      end;
+    giExtendedEqualityComparer:
+      begin
+        if AFactory = nil then
+          AFactory := TDelphiDoubleHashFactory;
+
+        Exit(
+          TExtendedHashServiceClass(AFactory.GetHashService).LookupExtendedEqualityComparer(ATypeInfo, ASize));
+      end;
+  else
+    System.Error(reRangeError);
+    Exit(nil);
+  end;
+end;
+
+end.
+

Units/Utils/generics.dictionaries.inc

@@ -0,0 +1,1940 @@
+{%MainUnit generics.collections.pas}
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ TPair<TKey,TValue> }
+
+class function TPair<TKey, TValue>.Create(AKey: TKey;
+  AValue: TValue): TPair<TKey, TValue>;
+begin
+  Result.Key := AKey;
+  Result.Value := AValue;
+end;
+
+{ TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS> }
+
+procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.PairNotify(constref APair: TPair<TKey, TValue>;
+  ACollectionNotification: TCollectionNotification);
+begin
+  KeyNotify(APair.Key, ACollectionNotification);
+  ValueNotify(APair.Value, ACollectionNotification);
+end;
+
+procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.KeyNotify(constref AKey: TKey;
+  ACollectionNotification: TCollectionNotification);
+begin
+  if Assigned(FOnKeyNotify) then
+    FOnKeyNotify(Self, AKey, ACollectionNotification);
+end;
+
+procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.SetValue(var AValue: TValue; constref ANewValue: TValue);
+var
+  LOldValue: TValue;
+begin
+  LOldValue := AValue;
+  AValue := ANewValue;
+
+  ValueNotify(LOldValue, cnRemoved);
+  ValueNotify(ANewValue, cnAdded);
+end;
+
+procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.ValueNotify(constref AValue: TValue;
+  ACollectionNotification: TCollectionNotification);
+begin
+  if Assigned(FOnValueNotify) then
+    FOnValueNotify(Self, AValue, ACollectionNotification);
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create;
+begin
+  Create(0);
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACapacity: SizeInt); overload;
+begin
+  Create(ACapacity, TEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+  FEqualityComparer := AComparer;
+  SetCapacity(ACapacity);
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(const AComparer: IEqualityComparer<TKey>);
+begin
+  Create(0, AComparer);
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>);
+begin
+  Create(ACollection, TEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>); overload;
+var
+  LItem: TPair<TKey, TValue>;
+begin
+  Create(AComparer);
+  for LItem in ACollection do
+    Add(LItem);
+end;
+
+destructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Destroy;
+begin
+  Clear;
+  FKeys.Free;
+  FValues.Free;
+  inherited;
+end;
+
+function TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray(ACount: SizeInt): TArray<TDictionaryPair>;
+var
+  i: SizeInt;
+  LEnumerator: TEnumerator<TDictionaryPair>;
+begin
+  SetLength(Result, ACount);
+  LEnumerator := DoGetEnumerator;
+
+  i := 0;
+  while LEnumerator.MoveNext do
+  begin
+    Result[i] := LEnumerator.Current;
+    Inc(i);
+  end;
+  LEnumerator.Free;
+end;
+
+function TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<TDictionaryPair>;
+begin
+  Result := ToArray(Count);
+end;
+
+{ TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS> }
+
+constructor TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
+  ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+begin
+  inherited Create;
+  FIndex := -1;
+  FDictionary := ADictionary;
+end;
+
+function TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>.DoGetCurrent: T;
+begin
+  Result := GetCurrent;
+end;
+
+{ TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS> }
+
+constructor TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
+  ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+begin
+  FDictionary := ADictionary;
+end;
+
+function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.
+  DoGetEnumerator: TDictionaryEnumerator;
+begin
+  Result := TDictionaryEnumerator(TDictionaryEnumerator.NewInstance);
+  TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>(Result).Create(FDictionary);
+end;
+
+function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetCount: SizeInt;
+begin
+  Result := TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>(FDictionary).Count;
+end;
+
+function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<T>;
+begin
+  Result := ToArrayImpl(FDictionary.Count);
+end;
+
+{ TOpenAddressingEnumerator<T, DICTIONARY_CONSTRAINTS> }
+
+function TOpenAddressingEnumerator<T, OPEN_ADDRESSING_CONSTRAINTS>.DoMoveNext: Boolean;
+var
+  LLength: SizeInt;
+begin
+  Inc(FIndex);
+
+  LLength := Length(TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems);
+
+  if FIndex >= LLength then
+    Exit(False);
+
+  // maybe related to bug #24098
+  // compiler error for (TDictionary<DICTIONARY_CONSTRAINTS>(FDictionary).FItems[FIndex].Hash and UInt32.GetSignMask) = 0
+  while ((TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Hash) and UInt32.GetSignMask) = 0 do
+  begin
+    Inc(FIndex);
+    if FIndex = LLength then
+      Exit(False);
+  end;
+
+  Result := True;
+end;
+
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> }
+
+constructor TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+  inherited Create(ACapacity, AComparer);
+
+  FMaxLoadFactor := TProbeSequence.DEFAULT_LOAD_FACTOR;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetKeys: TKeyCollection;
+begin
+  if not Assigned(FKeys) then
+    FKeys := TKeyCollection.Create(Self);
+  Result := TKeyCollection(FKeys);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetValues: TValueCollection;
+begin
+  if not Assigned(FValues) then
+    FValues := TValueCollection.Create(Self);
+  Result := TValueCollection(FValues);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AKey: TKey): SizeInt;
+var
+  LHash: UInt32;
+begin
+  Result := FindBucketIndex(FItems, AKey, LHash);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.PrepareAddingItem: SizeInt;
+begin
+  if RealItemsLength > FItemsThreshold then
+    Rehash(Length(FItems) shl 1)
+  else if FItemsThreshold = 0 then
+  begin
+    SetLength(FItems, 8);
+    UpdateItemsThreshold(8);
+  end
+  else if FItemsLength = $40000001 then // High(TIndex) ... Error: Type mismatch
+    OutOfMemoryError;
+
+  Result := FItemsLength;
+  Inc(FItemsLength);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
+begin
+  if ASize = $40000000 then
+    FItemsThreshold := $40000001
+  else
+    FItemsThreshold := Pred(Round(ASize * FMaxLoadFactor));
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.AddItem(var AItem: TItem; constref AKey: TKey;
+  constref AValue: TValue; const AHash: UInt32);
+begin
+  AItem.Hash := AHash;
+  AItem.Pair.Key := AKey;
+  AItem.Pair.Value := AValue;
+
+  PairNotify(AItem.Pair, cnAdded);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue);
+begin
+  DoAdd(AKey, AValue);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Add(constref APair: TPair<TKey, TValue>);
+begin
+  DoAdd(APair.Key, APair.Value);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.DoAdd(constref AKey: TKey; constref AValue: TValue): SizeInt;
+var
+  LHash: UInt32;
+begin
+  PrepareAddingItem;
+
+  Result := FindBucketIndex(FItems, AKey, LHash);
+  if Result >= 0 then
+    raise EListError.CreateRes(@SDuplicatesNotAllowed);
+
+  Result := not Result;
+  AddItem(FItems[Result], AKey, AValue, LHash);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.DoRemove(AIndex: SizeInt;
+  ACollectionNotification: TCollectionNotification): TValue;
+var
+  LItem: PItem;
+  LPair: TPair<TKey, TValue>;
+begin
+  LItem := @FItems[AIndex];
+  LItem.Hash := 0;
+  Result := LItem.Pair.Value;
+  LPair := LItem.Pair;
+  LItem.Pair := Default(TPair<TKey, TValue>);
+  Dec(FItemsLength);
+  PairNotify(LPair, ACollectionNotification);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Remove(constref AKey: TKey);
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  if LIndex  < 0 then
+    Exit;
+
+  DoRemove(LIndex, cnRemoved);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.ExtractPair(constref AKey: TKey): TPair<TKey, TValue>;
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  if LIndex  < 0 then
+    Exit(Default(TPair<TKey, TValue>));
+
+  Result.Key := AKey;
+  Result.Value := DoRemove(LIndex, cnExtracted);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Clear;
+var
+  LItem: PItem;
+  i: SizeInt;
+  LOldItems: array of TItem;
+begin
+  FItemsLength := 0;
+  FItemsThreshold := 0;
+  // ClearTombstones;
+  LOldItems := FItems;
+  FItems := nil;
+
+  for i := 0 to High(LOldItems) do
+  begin
+    LItem := @LOldItems[i];
+    if (LItem.Hash and UInt32.GetSignMask = 0) then
+      Continue;
+
+    PairNotify(LItem.Pair, cnRemoved);
+  end;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.RealItemsLength: SizeInt;
+begin
+  Result := FItemsLength;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Rehash(ASizePow2: SizeInt; AForce: Boolean): Boolean;
+var
+  LNewItems: TArray<TItem>;
+  LHash: UInt32;
+  LIndex: SizeInt;
+  i: SizeInt;
+  LItem, LNewItem: PItem;
+begin
+  if (ASizePow2 = Length(FItems)) and not AForce then
+    Exit(False);
+  if ASizePow2 < 0 then
+    OutOfMemoryError;
+
+  SetLength(LNewItems, ASizePow2);
+  UpdateItemsThreshold(ASizePow2);
+
+  for i := 0 to High(FItems) do
+  begin
+    LItem := @FItems[i];
+
+    if (LItem.Hash and UInt32.GetSignMask) <> 0 then
+    begin
+      LIndex := FindBucketIndex(LNewItems, LItem.Pair.Key, LHash);
+      LIndex := not LIndex;
+
+      LNewItem := @LNewItems[LIndex];
+      LNewItem.Hash := LHash;
+      LNewItem.Pair := LItem.Pair;
+    end;
+  end;
+
+  FItems := LNewItems;
+  Result := True;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.DoGetEnumerator: TEnumerator<TDictionaryPair>;
+begin
+  Result := GetEnumerator;
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.SetCapacity(ACapacity: SizeInt);
+begin
+  if ACapacity < FItemsLength then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Resize(ACapacity);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.SetMaxLoadFactor(AValue: single);
+var
+  LItemsLength: SizeInt;
+begin
+  if (AValue > TProbeSequence.MAX_LOAD_FACTOR) or (AValue <= 0) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  FMaxLoadFactor := AValue;
+
+  repeat
+    LItemsLength := Length(FItems);
+    UpdateItemsThreshold(LItemsLength);
+    if RealItemsLength > FItemsThreshold then
+      Rehash(LItemsLength shl 1);
+  until RealItemsLength <= FItemsThreshold;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetLoadFactor: single;
+begin
+  Result := FItemsLength / Length(FItems);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetCapacity: SizeInt;
+begin
+  Result := Length(FItems);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Resize(ANewSize: SizeInt);
+var
+  LNewSize: SizeInt;
+begin
+  if ANewSize < 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  LNewSize := 0;
+  if ANewSize > 0 then
+  begin
+    LNewSize := 8;
+    while LNewSize < ANewSize do
+      LNewSize := LNewSize shl 1;
+  end;
+
+  Rehash(LNewSize);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetEnumerator: TPairEnumerator;
+begin
+  Result := TPairEnumerator.Create(Self);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetItem(const AKey: TKey): TValue;
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  if LIndex < 0 then
+    raise EListError.CreateRes(@SDictionaryKeyDoesNotExist);
+  Result := FItems[LIndex].Pair.Value;
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TrimExcess;
+begin
+  SetCapacity(Succ(FItemsLength));
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.SetItem(const AKey: TKey; const AValue: TValue);
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  if LIndex < 0 then
+    raise EListError.CreateRes(@SItemNotFound);
+
+  SetValue(FItems[LIndex].Pair.Value, AValue);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  Result := LIndex >= 0;
+
+  if Result then
+    AValue := FItems[LIndex].Pair.Value
+  else
+    AValue := Default(TValue);
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
+var
+  LIndex: SizeInt;
+  LHash: UInt32;
+begin
+  LIndex := FindBucketIndex(FItems, AKey, LHash);
+
+  if LIndex < 0 then
+    DoAdd(AKey, AValue)
+  else
+    SetValue(FItems[LIndex].Pair.Value, AValue);
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.ContainsKey(constref AKey: TKey): Boolean;
+var
+  LIndex: SizeInt;
+begin
+  LIndex := FindBucketIndex(AKey);
+  Result := LIndex >= 0;
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.ContainsValue(constref AValue: TValue): Boolean;
+begin
+  Result := ContainsValue(AValue, TEqualityComparer<TValue>.Default(THashFactory));
+end;
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.ContainsValue(constref AValue: TValue;
+  const AEqualityComparer: IEqualityComparer<TValue>): Boolean;
+var
+  i: SizeInt;
+  LItem: PItem;
+begin
+  if Length(FItems) = 0 then
+    Exit(False);
+
+  for i := 0 to High(FItems) do
+  begin
+    LItem := @FItems[i];
+    if (LItem.Hash and UInt32.GetSignMask) = 0 then
+      Continue;
+
+    if AEqualityComparer.Equals(AValue, LItem.Pair.Value) then
+      Exit(True);
+  end;
+  Result := False;
+end;
+
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetMemoryLayout(
+  const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
+var
+  i: SizeInt;
+begin
+  for i := 0 to High(FItems) do
+    if (FItems[i].Hash and UInt32.GetSignMask) <> 0 then
+      AOnGetMemoryLayoutKeyPosition(Self, i);
+end;
+
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPairEnumerator }
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPairEnumerator.GetCurrent: TPair<TKey, TValue>;
+begin
+  Result := TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair;
+end;
+
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TValueEnumerator }
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TValueEnumerator.GetCurrent: TValue;
+begin
+  Result := TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Value;
+end;
+
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TKeyEnumerator }
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
+begin
+  Result := TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Key;
+end;
+
+{ TOpenAddressingLP<DICTIONARY_CONSTRAINTS> }
+
+procedure TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.NotifyIndexChange(AFrom, ATo: SizeInt);
+begin
+end;
+
+function TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.DoRemove(AIndex: SizeInt;
+  ACollectionNotification: TCollectionNotification): TValue;
+var
+  LItem: PItem;
+  LPair: TPair<TKey, TValue>;
+  LLengthMask: SizeInt;
+  i, LIndex, LGapIndex: SizeInt;
+  LHash, LBucket: UInt32;
+begin
+  LItem := @FItems[AIndex];
+  LPair := LItem.Pair;
+
+  // try fill gap
+  LHash := LItem.Hash;
+  LItem.Hash := 0; // prevents an infinite searching loop
+  LLengthMask := Length(FItems) - 1;
+  i := Succ(AIndex - (LHash and LLengthMask));
+  LGapIndex := AIndex;
+  repeat
+    LIndex := TProbeSequence.Probe(i, LHash) and LLengthMask;
+    LItem := @FItems[LIndex];
+
+    // Empty position
+    if (LItem.Hash and UInt32.GetSignMask) = 0 then
+      Break; // breaking bad!
+
+    LBucket := LItem.Hash and LLengthMask;
+    if not InCircularRange(LGapIndex, LBucket, LIndex) then
+    begin
+      NotifyIndexChange(LIndex, LGapIndex);
+      FItems[LGapIndex] := LItem^;
+      LItem.Hash := 0; // new gap
+      LGapIndex := LIndex;
+    end;
+    Inc(i);
+  until false;
+
+  LItem := @FItems[LGapIndex];
+  LItem.Hash := 0;
+  LItem.Pair := Default(TPair<TKey, TValue>);
+  Dec(FItemsLength);
+
+  Result := LPair.Value;
+  PairNotify(LPair, ACollectionNotification);
+end;
+
+function TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  LLengthMask: SizeInt;
+  i, m: SizeInt;
+  LHash: UInt32;
+begin
+  m := Length(AItems);
+  LLengthMask := m - 1;
+
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
+
+  if m = 0 then
+    Exit(-1);
+
+  Result := AHash and LLengthMask;
+
+  repeat
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position
+    if (LItem.Hash and UInt32.GetSignMask) = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+
+    Inc(i);
+
+    Result := TProbeSequence.Probe(i, AHash) and LLengthMask;
+
+  until false;
+end;
+
+{ TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS> }
+
+function TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.Rehash(ASizePow2: SizeInt; AForce: Boolean): Boolean;
+begin
+  if inherited then
+    FTombstonesCount := 0;
+end;
+
+function TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.RealItemsLength: SizeInt;
+begin
+  Result := FItemsLength + FTombstonesCount
+end;
+
+procedure TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.ClearTombstones;
+begin
+  Rehash(Length(FItems), True);
+end;
+
+procedure TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.Clear;
+begin
+  FTombstonesCount := 0;
+  inherited;
+end;
+
+function TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.DoRemove(AIndex: SizeInt;
+  ACollectionNotification: TCollectionNotification): TValue;
+begin
+  Result := inherited;
+
+  FItems[AIndex].Hash := 1;
+  Inc(FTombstonesCount);
+end;
+
+function TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>.DoAdd(constref AKey: TKey;
+  constref AValue: TValue): SizeInt;
+var
+  LHash: UInt32;
+begin
+  PrepareAddingItem;
+
+  Result := FindBucketIndexOrTombstone(FItems, AKey, LHash);
+  if Result >= 0 then
+    raise EListError.CreateRes(@SDuplicatesNotAllowed);
+
+  Result := not Result;
+  // Can't ovverride because we lost info about old hash
+  if FItems[Result].Hash <> 0 then
+    Dec(FTombstonesCount);
+
+  AddItem(FItems[Result], AKey, AValue, LHash);
+end;
+
+{ TOpenAddressingSH<OPEN_ADDRESSING_CONSTRAINTS> }
+
+function TOpenAddressingSH<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  LLengthMask: SizeInt;
+  i, m: SizeInt;
+  LHash: UInt32;
+begin
+  m := Length(AItems);
+  LLengthMask := m - 1;
+
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
+
+  if m = 0 then
+    Exit(-1);
+
+  Result := AHash and LLengthMask;
+
+  repeat
+    LItem := _TItem(AItems[Result]);
+    // Empty position
+    if LItem.Hash = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+
+    Inc(i);
+
+    Result := TProbeSequence.Probe(i, AHash) and LLengthMask;
+
+  until false;
+end;
+
+function TOpenAddressingSH<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  LLengthMask: SizeInt;
+  i, m: SizeInt;
+  LHash: UInt32;
+begin
+  m := Length(AItems);
+  LLengthMask := m - 1;
+
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
+
+  if m = 0 then
+    Exit(-1);
+
+  Result := AHash and LLengthMask;
+
+  repeat
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position or tombstone
+    if LItem.Hash and UInt32.GetSignMask = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+
+    Inc(i);
+
+    Result := TProbeSequence.Probe(i, AHash) and LLengthMask;
+
+  until false;
+end;
+
+{ TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS> }
+
+procedure TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
+begin
+  if ASize = $40000000 then
+    FItemsThreshold := $40000001
+  else
+    begin
+      FPrimaryNumberAsSizeApproximation := PrimaryNumbersJustLessThanPowerOfTwo[
+        MultiplyDeBruijnBitPosition[UInt32(((ASize and -ASize) * $077CB531)) shr 27]];
+
+      FItemsThreshold := Pred(Round(FPrimaryNumberAsSizeApproximation * FMaxLoadFactor));
+    end;
+end;
+
+function TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  i: SizeInt;
+  LHash: UInt32;
+begin
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
+
+  if Length(AItems) = 0 then
+    Exit(-1);
+
+  for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do
+  begin
+    Result := TProbeSequence.Probe(i, AHash) mod FPrimaryNumberAsSizeApproximation;
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position
+    if LItem.Hash = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+  end;
+
+  Result := -1;
+end;
+
+
+function TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  i: SizeInt;
+  LHash: UInt32;
+begin
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
+
+  if Length(AItems) = 0 then
+    Exit(-1);
+
+  for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do
+  begin
+    Result := TProbeSequence.Probe(i, AHash) mod FPrimaryNumberAsSizeApproximation;
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position or tombstone
+    if LItem.Hash and UInt32.GetSignMask = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+  end;
+
+  Result := -1;
+end;
+
+{ TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS> }
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt);
+begin
+  Create(ACapacity, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  FMaxLoadFactor := TProbeSequence.DEFAULT_LOAD_FACTOR;
+  FEqualityComparer := AComparer;
+  SetCapacity(ACapacity);
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  Create(0, AComparer);
+end;
+
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: TPair<TKey, TValue>;
+begin
+  Create(AComparer);
+  for LItem in ACollection do
+    Add(LItem);
+end;
+
+procedure TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
+begin
+  inherited;
+  R :=
+    PrimaryNumbersJustLessThanPowerOfTwo[
+      MultiplyDeBruijnBitPosition[UInt32(((ASize and -ASize) * $077CB531)) shr 27]]
+end;
+
+function TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  LLengthMask: SizeInt;
+  i, m: SizeInt;
+  LHash: array[-1..1] of UInt32;
+  LHash1: UInt32 absolute LHash[0];
+  LHash2: UInt32 absolute LHash[1];
+begin
+  m := Length(AItems);
+  LLengthMask := m - 1;
+  LHash[-1] := 2; // number of hashes
+
+  IExtendedEqualityComparer<TKey>(FEqualityComparer).GetHashList(AKey, @LHash[-1]);
+
+  i := 0;
+  AHash := LHash1 or UInt32.GetSignMask;
+
+  if m = 0 then
+    Exit(-1);
+
+  Result := LHash1 and LLengthMask;
+  // second hash function must be special
+  LHash2 := (R - (LHash2 mod R)) or 1;
+
+  repeat
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position
+    if LItem.Hash = 0 then
+      Exit(not Result);
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+
+    Inc(i);
+
+    Result := TProbeSequence.Probe(i, AHash, LHash2) and LLengthMask;
+  until false;
+end;
+
+function TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  LLengthMask: SizeInt;
+  i, m: SizeInt;
+  LHash: array[-1..1] of UInt32;
+  LHash1: UInt32 absolute LHash[0];
+  LHash2: UInt32 absolute LHash[1];
+begin
+  m := Length(AItems);
+  LLengthMask := m - 1;
+  LHash[-1] := 2; // number of hashes
+
+  IExtendedEqualityComparer<TKey>(FEqualityComparer).GetHashList(AKey, @LHash[-1]);
+
+  i := 0;
+  AHash := LHash1 or UInt32.GetSignMask;
+
+  if m = 0 then
+    Exit(-1);
+
+  Result := LHash1 and LLengthMask;
+  // second hash function must be special
+  LHash2 := (R - (LHash2 mod R)) or 1;
+
+  repeat
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position or tombstone
+    if LItem.Hash and UInt32.GetSignMask = 0 then
+      Exit(not Result);
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+
+    Inc(i);
+
+    Result := TProbeSequence.Probe(i, AHash, LHash2) and LLengthMask;
+  until false;
+end;
+
+{ TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS> }
+
+constructor TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS>.Create(
+  ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+begin
+  inherited;
+  if ADictionary.Count = 0 then
+    FMainIndex := TCuckooCfg.D
+  else
+    FMainIndex := 0;
+end;
+
+function TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS>.DoMoveNext: Boolean;
+var
+  LLength: SizeInt;
+  LArray: TItemsArray;
+begin
+  Inc(FIndex);
+
+  if (FMainIndex = TCuckooCfg.D) then // queue
+  begin
+    LLength := Length(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems);
+    if FIndex >= LLength then
+      Exit(False);
+
+    while ((TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Hash)
+      and UInt32.GetSignMask) = 0 do
+    begin
+      Inc(FIndex);
+      if FIndex = LLength then
+        Exit(False);
+    end;
+  end
+  else // d-array
+  begin
+    LArray := TItemsArray(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex]);
+    LLength := Length(LArray);
+    if FIndex >= LLength then
+    begin
+      Inc(FMainIndex);
+      FIndex := -1;
+      Exit(DoMoveNext);
+    end;
+
+    while ((LArray[FIndex].Hash) and UInt32.GetSignMask) = 0 do
+    begin
+      Inc(FIndex);
+      if FIndex = LLength then
+      begin
+        Inc(FMainIndex);
+        FIndex := -1;
+        Exit(DoMoveNext);
+      end;
+    end;
+  end;
+
+  Result := True;
+end;
+
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS> }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Rehash(ASizePow2: SizeInt;
+  AForce: boolean): Boolean;
+var
+  FOldIdx: array of TKey;
+  i: SizeInt;
+begin
+  SetLength(FOldIdx, FIdx.Count);
+  for i := 0 to FIdx.Count - 1 do
+    FOldIdx[i] := FItems[FIdx[i]].Pair.Key;
+
+  Result := inherited Rehash(ASizePow2, AForce);
+
+  for i := 0 to FIdx.Count - 1 do
+    FIdx[i] := FindBucketIndex(FOldIdx[i]);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.NotifyIndexChange(AFrom, ATo: SizeInt);
+var
+  i: SizeInt;
+begin
+  // notify change position
+  for i := 0 to FIdx.Count-1 do
+    if FIdx[i] = AFrom then
+    begin
+      FIdx[i] := ATo;
+      Exit;
+    end;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.InsertIntoBack(AItem: Pointer);
+//var
+//  LItem: TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.PItem; absolute AItem; !!! bug #25917
+var
+  LItem: TQueueDictionary.PValue absolute AItem;
+  LIndex: SizeInt;
+begin
+  LIndex := DoAdd(LItem.Pair.Key, LItem^);
+  FIdx.Insert(0, LIndex);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.InsertIntoHead(AItem: Pointer);
+//var
+//  LItem: TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.PItem absolute AItem; !!! bug #25917
+var
+  LItem: TQueueDictionary.PValue absolute AItem;
+  LIndex: SizeInt;
+begin
+  LIndex := DoAdd(LItem.Pair.Key, LItem^);
+  FIdx.Add(LIndex);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.IsEmpty: Boolean;
+begin
+  Result := FIdx.Count = 0;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Pop: Pointer;
+var
+  AIndex, LGap: SizeInt;
+  //LResult: TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TItem; !!!bug #25917
+begin
+  AIndex := FIdx.DoRemove(FIdx.Count - 1, cnExtracted);
+
+  Result := New(TQueueDictionary.PValue);
+  TQueueDictionary.PValue(Result)^ := DoRemove(AIndex, cnExtracted);
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Create(ACapacity: SizeInt;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+  FIdx := TList<UInt32>.Create;
+  inherited Create(ACapacity, AComparer);
+end;
+
+destructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Destroy;
+begin
+  FIdx.Free;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetQueueCount: SizeInt;
+begin
+  Result := FQueue.Count;
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create;
+begin
+  Create(0);
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACapacity: SizeInt);
+begin
+  Create(ACapacity, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACapacity: SizeInt;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  FMaxLoadFactor := TCuckooCfg.MAX_LOAD_FACTOR;
+  FQueue := TQueueDictionary.Create;
+  FCDM   := TCDM.Create;
+
+  // to do - check constraint consts
+
+  if TCuckooCfg.D > THashFactory.MAX_HASHLIST_COUNT then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  // should be moved to class constructor, but bug #24848
+  CUCKOO_SIGN := UInt32.GetSizedSignMask(THashFactory.HASH_FUNCTIONS_MASK_SIZE + 1);
+  CUCKOO_INDEX_SIZE := UInt32.GetBitsLength - (THashFactory.HASH_FUNCTIONS_MASK_SIZE + 1);
+  CUCKOO_HASH_SIGN := THashFactory.HASH_FUNCTIONS_MASK shl CUCKOO_INDEX_SIZE;
+
+  FEqualityComparer := AComparer;
+  SetCapacity(ACapacity);
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  Create(0, AComparer);
+end;
+
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: TPair<TKey, TValue>;
+begin
+  Create(AComparer);
+  for LItem in ACollection do
+    Add(LItem);
+end;
+
+destructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Destroy;
+begin
+  inherited;
+  FQueue.Free;
+  FCDM.Free;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetKeys: TKeyCollection;
+begin
+  if not Assigned(FKeys) then
+    FKeys := TKeyCollection.Create(Self);
+  Result := TKeyCollection(FKeys);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetValues: TValueCollection;
+begin
+  if not Assigned(FValues) then
+    FValues := TValueCollection.Create(Self);
+  Result := TValueCollection(FValues);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Lookup(constref AKey: TKey;
+  var AHashListOrIndex: PUInt32): SizeInt;
+begin
+  Result := Lookup(FItems, AKey, AHashListOrIndex);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Lookup(constref AItems: TItemsDArray; constref AKey: TKey;
+  var AHashListOrIndex: PUInt32): SizeInt;
+var
+  LLengthMask: SizeInt;
+  i, j, k: SizeInt;
+  AHashList: PUInt32 absolute AHashListOrIndex;
+  AHashListParams: PUInt16 absolute AHashListOrIndex;
+  AIndex: PtrInt absolute AHashListOrIndex;
+  // LBloomFilter: UInt32; // to rethink. now is useless
+begin
+  if Length(AItems[0]) = 0 then
+    Exit(LR_NIL);
+
+  LLengthMask := Length(AItems[0]) - 1;
+  AHashListParams[0] := TCuckooCfg.D; // number of hashes
+
+  i := 1; // ineks iteracji iteracji haszy
+  k := 1; // indeks iteracji haszy
+  // LBloomFilter := 0;
+  repeat
+    AHashListParams[1] := i; // iteration
+    IExtendedEqualityComparer<TKey>(FEqualityComparer).GetHashList(AKey, AHashList);
+    for j := 0 to THashFactory.HASHLIST_COUNT_PER_FUNCTION[i] - 1 do
+    begin
+      AHashList[k] := AHashList[k] or CUCKOO_SIGN;
+      // LBloomFilter := LBloomFilter or AHashList[k];
+
+      with AItems[k-1][AHashList[k] and LLengthMask] do
+        if (Hash and UInt32.GetSignMask) <> 0 then
+          if (AHashList[k] = Hash or CUCKOO_SIGN) and FEqualityComparer.Equals(AKey, Pair.Key) then
+            Exit(k-1);
+
+      Inc(k);
+    end;
+    Inc(i);
+  until k > TCuckooCfg.D;
+
+  i := FQueue.FindBucketIndex(AKey);
+  if i >= 0 then
+  begin
+    AIndex := i;
+    Exit(LR_QUEUE);
+  end;
+
+{  LBloomFilter := not LBloomFilter;
+  for i := 0 to FDicQueueList.Count - 1 do
+    // with FQueue[i] do
+    if LBloomFilter and FQueue[i].Hash = 0 then
+      for j := 1 to TCuckooCfg.D do
+        if (FQueue[i].Hash or CUCKOO_SIGN = AHashList[j]) then
+          if FEqualityComparer.Equals(AKey, FQueue[i].Pair.Key) then
+          begin
+            AIndex := i;
+            Exit(LR_QUEUE);
+          end;     }
+
+  Result := LR_NIL;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.PrepareAddingItem: SizeInt;
+var
+  i: SizeInt;
+begin
+  if FItemsLength > FItemsThreshold then
+    Rehash(Length(FItems[0]) shl 1)
+  else if FItemsThreshold = 0 then
+  begin
+    for i := 0 to TCuckooCfg.D - 1 do
+      SetLength(FItems[i], 4);
+    UpdateItemsThreshold(4);
+  end
+  else if FItemsLength = $40000001 then // High(TIndex) ... Error: Type mismatch
+    OutOfMemoryError;
+
+  Result := FItemsLength;
+  Inc(FItemsLength);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
+var
+  LLength: SizeInt;
+begin
+  LLength := ASize*TCuckooCfg.D;
+  if LLength = $40000000 then
+    FItemsThreshold := $40000001
+  else
+    FItemsThreshold := Pred(Round(LLength * FMaxLoadFactor));
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.AddItem(constref AItems: TItemsDArray; constref AKey: TKey;
+  constref AValue: TValue; const AHashList: PUInt32);
+var
+  LNewItem: TItem;
+  LPNewItem: PItem;
+  y: boolean = false;
+  b: UInt32;
+  LIndex: UInt32;
+  i, j, LLengthMask: SizeInt;
+  LTempItem: TItem;
+  LHashList: array[0..1] of UInt32;
+  LHashListParams: array[0..3] of UInt16 absolute LHashList;
+begin
+  LLengthMask := Length(AItems[0]) - 1;
+
+  LNewItem.Pair.Key := AKey;
+  LNewItem.Pair.Value := AValue;
+  // by concept already sign bit is set
+  LNewItem.Hash := ((not CUCKOO_HASH_SIGN) and AHashList[1]) or UInt32.GetSignMask; // start at array [0]
+  FQueue.InsertIntoBack(@LNewItem);
+
+  for i := 0 to TCuckooCfg.L - 1 do
+  begin
+    if not y then
+      if FQueue.IsEmpty then
+        Exit
+      else
+      begin
+        LPNewItem := FQueue.Pop; // bug #25917 workaround
+        LNewItem := LPNewItem^;
+        Dispose(LPNewItem);
+        b := (LNewItem.Hash and CUCKOO_HASH_SIGN) shr CUCKOO_INDEX_SIZE;
+        y := true;
+      end;
+    LIndex := LNewItem.Hash and LLengthMask;
+    if (AItems[b][LIndex].Hash and UInt32.GetSignMask) = 0 then // insert!
+    begin
+      AItems[b][LIndex] := LNewItem;
+      FCDM.Clear;
+      y := false;
+    end
+    else
+    begin
+      if FCDM.ContainsKey(LNewItem.Pair.Key) then // found second cycle
+      begin
+        FQueue.InsertIntoBack(@LNewItem);
+        FCDM.Clear;
+        y := false;
+      end
+      else
+      begin
+        LTempItem := AItems[b][LIndex];
+        AItems[b][LIndex] := LNewItem;
+        LNewItem.Hash := LNewItem.Hash or CUCKOO_SIGN;
+        FCDM.AddOrSetValue(LNewItem.Pair.Key, EmptyRecord);
+
+        LNewItem := LTempItem;
+        b := b + 1;
+        if b >= TCuckooCfg.D then
+          b := 0;
+        LHashListParams[0] := -Succ(b);
+        IExtendedEqualityComparer<TKey>(FEqualityComparer).GetHashList(LNewItem.Pair.Key, @LHashList[0]);
+        LNewItem.Hash := (LHashList[1] and not CUCKOO_SIGN) or (b shl CUCKOO_INDEX_SIZE) or UInt32.GetSignMask;
+        //  y := True; // always true in this place
+      end;
+    end;
+  end;
+  if y then
+    FQueue.InsertIntoHead(@LNewItem);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.DoAdd(constref AKey: TKey; constref AValue: TValue;
+  const AHashList: PUInt32);
+begin
+  AddItem(FItems, AKey, AValue, AHashList);
+  KeyNotify(AKey, cnAdded);
+  ValueNotify(AValue, cnAdded);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue);
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+begin
+  PrepareAddingItem;
+  LHashListOrIndex := @LHashList[0];
+  if Lookup(AKey, LHashListOrIndex) <> LR_NIL then
+    raise EListError.CreateRes(@SDuplicatesNotAllowed);
+
+  DoAdd(AKey, AValue, LHashListOrIndex);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Add(constref APair: TPair<TKey, TValue>);
+begin
+  Add(APair.Key, APair.Value);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.DoRemove(const AHashListOrIndex: PUInt32;
+  ALookupResult: SizeInt; ACollectionNotification: TCollectionNotification): TValue;
+var
+  LItem: PItem;
+  LIndex: UInt32;
+  LQueueIndex: SizeInt absolute AHashListOrIndex;
+  LPair: TPair<TKey, TValue>;
+begin
+  case ALookupResult of
+    LR_QUEUE:
+      LPair := FQueue.FItems[LQueueIndex].Pair.Value.Pair;
+    LR_NIL:
+      raise ERangeError.Create(SItemNotFound);
+  else
+    LIndex := AHashListOrIndex[ALookupResult + 1] and (Length(FItems[0]) - 1);
+    LItem := @FItems[ALookupResult][LIndex];
+    LItem.Hash := 0;
+    LPair := LItem.Pair;
+    LItem.Pair := Default(TPair<TKey, TValue>);
+  end;
+
+  Result := LPair.Value;
+  Dec(FItemsLength);
+  if ALookupResult = LR_QUEUE then
+  begin
+    FQueue.FIdx.Remove(LQueueIndex);
+    FQueue.DoRemove(LQueueIndex, cnRemoved);
+  end;
+
+  FCDM.Remove(LPair.Key); // item can exist in CDM
+
+  PairNotify(LPair, ACollectionNotification);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Remove(constref AKey: TKey);
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+  if LLookupResult = LR_NIL then
+    Exit;
+
+  DoRemove(LHashListOrIndex, LLookupResult, cnRemoved);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ExtractPair(constref AKey: TKey): TPair<TKey, TValue>;
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+  if LLookupResult = LR_NIL then
+    Exit(Default(TPair<TKey, TValue>));
+
+  Result.Key := AKey;
+  Result.Value := DoRemove(LHashListOrIndex, LLookupResult, cnExtracted);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Clear;
+var
+  LItem: PItem;
+  i, j: SizeInt;
+  LOldItems: TItemsDArray;
+  LOldQueueItems: TQueueDictionary.TItemsArray;
+  LQueueItem: TQueueDictionary._TItem;
+begin
+  FItemsLength := 0;
+  FItemsThreshold := 0;
+  LOldItems := FItems;
+  for i := 0 to TCuckooCfg.D - 1 do
+    FItems[i] := nil;
+
+  for i := 0 to TCuckooCfg.D - 1 do
+  begin
+    for j := 0 to High(LOldItems[0]) do
+    begin
+      LItem := @LOldItems[i][j];
+      if (LItem.Hash and UInt32.GetSignMask <> 0) then
+        PairNotify(LItem.Pair, cnRemoved);
+    end;
+  end;
+
+  FCDM.Clear;
+
+  // queue
+  FQueue.FItemsLength := 0;
+  FQueue.FItemsThreshold := 0;
+  LOldQueueItems := FQueue.FItems;
+  FQueue.FItems := nil;
+
+  for i := 0 to High(LOldQueueItems) do
+  begin
+    LQueueItem := TQueueDictionary._TItem(LOldQueueItems[i]);
+    if (LQueueItem.Hash and UInt32.GetSignMask = 0) then
+      Continue;
+
+    PairNotify(LQueueItem.Pair.Value.Pair, cnRemoved);
+  end;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Rehash(ASizePow2: SizeInt);
+var
+  LNewItems: TItemsDArray;
+  LHash: UInt32;
+  LIndex: SizeInt;
+  i, j: SizeInt;
+  LItem, LNewItem: PItem;
+  LOldQueue: TQueueDictionary;
+var
+  LHashList: array[0..1] of UInt32;
+  LHashListParams: array[0..3] of Int16 absolute LHashList;
+begin
+  if ASizePow2 = Length(FItems[0]) then
+    Exit;
+  if ASizePow2 < 0 then
+    OutOfMemoryError;
+
+  for i := 0 to TCuckooCfg.D - 1 do
+    SetLength(LNewItems[i], ASizePow2);
+
+  LHashListParams[0] := -1;
+
+  // opportunity to clear the queue
+  LOldQueue := FQueue;
+  FCDM.Clear;
+  FQueue := TQueueDictionary.Create;
+  for i := 0 to LOldQueue.FIdx.Count - 1 do
+  begin
+   LItem := @LOldQueue.FItems[LOldQueue.FIdx[i]].Pair.Value;
+   LHashList[1] := FEqualityComparer.GetHashCode(LItem.Pair.Key);
+   AddItem(LNewItems, LItem.Pair.Key, LItem.Pair.Value, @LHashList[0]);
+  end;
+  LOldQueue.Free;
+
+  // copy the old elements
+  for i := 0 to TCuckooCfg.D - 1 do
+    for j := 0 to High(FItems[0]) do
+    begin
+      LItem := @FItems[i][j];
+      if (LItem.Hash and UInt32.GetSignMask) = 0 then
+        Continue;
+
+      // small optimization. most of items exist in table 0
+      if LItem.Hash and CUCKOO_HASH_SIGN = 0 then
+      begin
+        LHashList[1] := LItem.Hash;
+        AddItem(LNewItems, LItem.Pair.Key, LItem.Pair.Value, @LHashList[0]);
+      end
+      else
+      begin
+        LHashList[1] := FEqualityComparer.GetHashCode(LItem.Pair.Key);
+        AddItem(LNewItems, LItem.Pair.Key, LItem.Pair.Value, @LHashList[0]);
+      end;
+    end;
+
+  FItems := LNewItems;
+  UpdateItemsThreshold(ASizePow2);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.DoGetEnumerator: TEnumerator<TDictionaryPair>;
+begin
+  Result := GetEnumerator;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.SetCapacity(ACapacity: SizeInt);
+begin
+  if ACapacity < FItemsLength then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  Resize(ACapacity);
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.SetMaxLoadFactor(AValue: single);
+var
+  LItemsLength: SizeInt;
+begin
+  if (AValue > TCuckooCfg.MAX_LOAD_FACTOR) or (AValue <= 0) then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  FMaxLoadFactor := AValue;
+
+  repeat
+    LItemsLength := Length(FItems[0]);
+    UpdateItemsThreshold(LItemsLength);
+    if FItemsLength > FItemsThreshold then
+      Rehash(LItemsLength shl 1);
+  until FItemsLength <= FItemsThreshold;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetLoadFactor: single;
+begin
+  Result := FItemsLength / (Length(FItems[0]) * TCuckooCfg.D);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetCapacity: SizeInt;
+begin
+  Result := Length(FItems[0]) * TCuckooCfg.D;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Resize(ANewSize: SizeInt);
+var
+  LNewSize: SizeInt;
+begin
+  if ANewSize < 0 then
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
+
+  LNewSize := 0;
+  if ANewSize > 0 then
+  begin
+    LNewSize := 4;
+    while LNewSize * TCuckooCfg.D < ANewSize do
+      LNewSize := LNewSize shl 1;
+  end;
+
+  Rehash(LNewSize);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetEnumerator: TPairEnumerator;
+begin
+  Result := TPairEnumerator.Create(Self);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetItem(const AKey: TKey): TValue;
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+  LIndex: UInt32;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+
+  case LLookupResult of
+    LR_QUEUE:
+      Result := FQueue.FItems[PtrInt(LHashListOrIndex)].Pair.Value.Pair.Value;
+    LR_NIL:
+      raise EListError.CreateRes(@SDictionaryKeyDoesNotExist);
+  else
+    LIndex := LHashListOrIndex[LLookupResult + 1] and (Length(FItems[0]) - 1);
+    Result := FItems[LLookupResult][LIndex].Pair.Value;
+  end;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TrimExcess;
+begin
+  SetCapacity(Succ(FItemsLength));
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.SetItem(constref AValue: TValue;
+  const AHashListOrIndex: PUInt32; ALookupResult: SizeInt);
+var
+  LIndex: UInt32;
+begin
+  case ALookupResult of
+    LR_QUEUE:
+      SetValue(FQueue.FItems[PtrInt(AHashListOrIndex)].Pair.Value.Pair.Value, AValue);
+    LR_NIL:
+      raise EListError.CreateRes(@SItemNotFound);
+  else
+    LIndex := AHashListOrIndex[ALookupResult + 1] and (Length(FItems[0]) - 1);
+    SetValue(FItems[ALookupResult][LIndex].Pair.Value, AValue);
+  end;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.SetItem(const AKey: TKey; const AValue: TValue);
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+  LIndex: UInt32;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+
+  SetItem(AValue, LHashListOrIndex, LLookupResult);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+  LIndex: UInt32;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+
+  Result := LLookupResult <> LR_NIL;
+
+  case LLookupResult of
+    LR_QUEUE:
+      AValue := FQueue.FItems[PtrInt(LHashListOrIndex)].Pair.Value.Pair.Value;
+    LR_NIL:
+      AValue := Default(TValue);
+  else
+    LIndex := LHashListOrIndex[LLookupResult + 1] and (Length(FItems[0]) - 1);
+    AValue := FItems[LLookupResult][LIndex].Pair.Value;
+  end;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+  LLookupResult: SizeInt;
+  LIndex: UInt32;
+begin
+  LHashListOrIndex := @LHashList[0];
+  LLookupResult := Lookup(AKey, LHashListOrIndex);
+
+  if LLookupResult = LR_NIL then
+  begin
+    PrepareAddingItem;
+    DoAdd(AKey, AValue, LHashListOrIndex);
+  end
+  else
+    SetItem(AValue, LHashListOrIndex, LLookupResult);
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ContainsKey(constref AKey: TKey): Boolean;
+var
+  LHashList: array[0..TCuckooCfg.D] of UInt32;
+  LHashListOrIndex: PUint32;
+begin
+  LHashListOrIndex := @LHashList[0];
+  Result := Lookup(AKey, LHashListOrIndex) <> LR_NIL;
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ContainsValue(constref AValue: TValue): Boolean;
+begin
+  Result := ContainsValue(AValue, TEqualityComparer<TValue>.Default(THashFactory));
+end;
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ContainsValue(constref AValue: TValue;
+  const AEqualityComparer: IEqualityComparer<TValue>): Boolean;
+var
+  i, j: SizeInt;
+  LItem: PItem;
+begin
+  if Length(FItems[0]) = 0 then
+    Exit(False);
+
+  for i := 0 to TCuckooCfg.D - 1 do
+    for j := 0 to High(FItems[0]) do
+    begin
+      LItem := @FItems[i][j];
+      if (LItem.Hash and UInt32.GetSignMask) = 0 then
+        Continue;
+
+      if AEqualityComparer.Equals(AValue, LItem.Pair.Value) then
+        Exit(True);
+    end;
+  Result := False;
+end;
+
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetMemoryLayout(
+  const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
+var
+  i, j, k: SizeInt;
+begin
+  k := 0;
+  for i := 0 to TCuckooCfg.D - 1 do
+    for j := 0 to High(FItems[0]) do
+    begin
+      if FItems[i][j].Hash and UInt32.GetSignMask <> 0 then
+        AOnGetMemoryLayoutKeyPosition(Self, k);
+      inc(k);
+    end;
+end;
+
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPairEnumerator }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPairEnumerator.GetCurrent: TPair<TKey, TValue>;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Pair.Value.Pair
+  else
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair;
+end;
+
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TValueEnumerator }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TValueEnumerator.GetCurrent: TValue;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Pair.Value.Pair.Value
+  else
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Value;
+end;
+
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TKeyEnumerator }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Pair.Value.Pair.Key
+  else
+    Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Key;
+end;
+
+{ TObjectDictionary<DICTIONARY_CONSTRAINTS> }
+
+procedure TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.KeyNotify(
+  constref AKey: TKey; ACollectionNotification: TCollectionNotification);
+begin
+  inherited;
+
+  if (doOwnsKeys in FOwnerships) and (ACollectionNotification = cnRemoved) then
+    TObject(AKey).Free;
+end;
+
+procedure TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ValueNotify(constref AValue: TValue;
+  ACollectionNotification: TCollectionNotification);
+begin
+  inherited;
+
+  if (doOwnsValues in FOwnerships) and (ACollectionNotification = cnRemoved) then
+    TObject(AValue).Free;
+end;
+
+constructor TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(
+  AOwnerships: TDictionaryOwnerships);
+begin
+  Create(AOwnerships, 0);
+end;
+
+constructor TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(
+  AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt);
+begin
+  inherited Create(ACapacity);
+
+  FOwnerships := AOwnerships;
+end;
+
+constructor TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(
+  AOwnerships: TDictionaryOwnerships; const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  inherited Create(AComparer);
+
+  FOwnerships := AOwnerships;
+end;
+
+constructor TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(
+  AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt; const AComparer: IExtendedEqualityComparer<TKey>);
+begin
+  inherited Create(ACapacity, AComparer);
+
+  FOwnerships := AOwnerships;
+end;
+
+procedure TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.KeyNotify(
+  constref AKey: TKey; ACollectionNotification: TCollectionNotification);
+begin
+  inherited;
+
+  if (doOwnsKeys in FOwnerships) and (ACollectionNotification = cnRemoved) then
+    TObject(AKey).Free;
+end;
+
+procedure TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.ValueNotify(
+  constref AValue: TValue; ACollectionNotification: TCollectionNotification);
+begin
+  inherited;
+
+  if (doOwnsValues in FOwnerships) and (ACollectionNotification = cnRemoved) then
+    TObject(AValue).Free;
+end;
+
+constructor TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.Create(AOwnerships: TDictionaryOwnerships);
+begin
+  Create(AOwnerships, 0);
+end;
+
+constructor TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.Create(AOwnerships: TDictionaryOwnerships;
+  ACapacity: SizeInt);
+begin
+  inherited Create(ACapacity);
+
+  FOwnerships := AOwnerships;
+end;
+
+constructor TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.Create(AOwnerships: TDictionaryOwnerships;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+  inherited Create(AComparer);
+
+  FOwnerships := AOwnerships;
+end;
+
+constructor TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.Create(AOwnerships: TDictionaryOwnerships;
+  ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>);
+begin
+  inherited Create(ACapacity, AComparer);
+
+  FOwnerships := AOwnerships;
+end;

Units/Utils/generics.dictionariesh.inc

@@ -0,0 +1,544 @@
+{%MainUnit generics.collections.pas}
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$WARNINGS OFF}
+type
+  TEmptyRecord = record // special record for Dictionary TValue (Dictionary as Set)
+  end;
+
+  { TPair }
+
+  TPair<TKey, TValue> = record
+  public
+    Key: TKey;
+    Value: TValue;
+    class function Create(AKey: TKey; AValue: TValue): TPair<TKey, TValue>; static;
+  end;
+
+  { TCustomDictionary }
+
+  // bug #24283 and #24097 (forward declaration) - should be:
+  // TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS> = class(TEnumerable<TPair<TKey, TValue> >);
+  TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract
+  public type
+    //  workaround... no generics types in generics types
+    TDictionaryPair = TPair<TKey, TValue>;
+    PDictionaryPair = ^TDictionaryPair;
+    PKey = ^TKey;
+    PValue = ^TValue;
+    THashFactoryClass = THashFactory;
+  public
+    FItemsLength: SizeInt;
+    FEqualityComparer: IEqualityComparer<TKey>;
+    FKeys: TEnumerable<TKey>;
+    FValues: TEnumerable<TValue>;
+    FMaxLoadFactor: single;
+  protected
+    procedure SetCapacity(ACapacity: SizeInt); virtual; abstract;
+    // bug #24283. workaround for this class because can't inherit from TEnumerable
+    function DoGetEnumerator: TEnumerator<TDictionaryPair>; virtual; abstract; {override;}
+
+    procedure SetMaxLoadFactor(AValue: single); virtual; abstract;
+    function GetLoadFactor: single; virtual; abstract;
+    function GetCapacity: SizeInt; virtual; abstract;
+  public
+    property MaxLoadFactor: single read FMaxLoadFactor write SetMaxLoadFactor;
+    property LoadFactor: single read GetLoadFactor;
+    property Capacity: SizeInt read GetCapacity write SetCapacity;
+
+    property Count: SizeInt read FItemsLength;
+
+    procedure Clear; virtual; abstract;
+    procedure Add(constref APair: TPair<TKey, TValue>); virtual; abstract;
+  strict private // bug #24283. workaround for this class because can't inherit from TEnumerable
+    function ToArray(ACount: SizeInt): TArray<TDictionaryPair>; overload;
+  public
+    function ToArray: TArray<TDictionaryPair>; virtual; final; {override; final; // bug #24283} overload;
+
+    constructor Create; virtual; overload;
+    constructor Create(ACapacity: SizeInt); virtual; overload;
+    constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); virtual; overload;
+    constructor Create(const AComparer: IEqualityComparer<TKey>); overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>); virtual; overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); virtual; overload;
+
+    destructor Destroy; override;
+  private
+    FOnKeyNotify: TCollectionNotifyEvent<TKey>;
+    FOnValueNotify: TCollectionNotifyEvent<TValue>;
+  protected
+    procedure UpdateItemsThreshold(ASize: SizeInt); virtual; abstract;
+
+    procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); virtual;
+    procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); virtual;
+    procedure PairNotify(constref APair: TPair<TKey, TValue>; ACollectionNotification: TCollectionNotification); inline;
+    procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
+  public
+    property OnKeyNotify: TCollectionNotifyEvent<TKey> read FOnKeyNotify write FOnKeyNotify;
+    property OnValueNotify: TCollectionNotifyEvent<TValue> read FOnValueNotify write FOnValueNotify;
+  end;
+
+  { TCustomDictionaryEnumerator }
+
+  TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerator< T >)
+  private
+    FDictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>;
+    FIndex: SizeInt;
+  protected
+    function DoGetCurrent: T; override;
+    function GetCurrent: T; virtual; abstract;
+  public
+    constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+  end;
+
+  { TDictionaryEnumerable }
+
+  TDictionaryEnumerable<TDictionaryEnumerator: TObject; // ... inherits from TCustomDictionaryEnumerator. workaround...
+    T, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerable<T>)
+  private
+    FDictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>;
+    function GetCount: SizeInt;
+  public
+    constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+    function DoGetEnumerator: TDictionaryEnumerator; override;
+    function ToArray: TArray<T>; override; final;
+    property Count: SizeInt read GetCount;
+  end;
+
+  // more info : http://en.wikipedia.org/wiki/Open_addressing
+
+  { TDictionaryEnumerable }
+
+  TOpenAddressingEnumerator<T, OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
+  protected
+    function DoMoveNext: Boolean; override;
+  end;
+
+  TOnGetMemoryLayoutKeyPosition = procedure(Sender: TObject; AKeyPos: UInt32) of object;
+
+  TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>)
+  private type
+    PItem = ^TItem;
+    TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+
+    TItemsArray = array of TItem;
+  private var
+    FItemsThreshold: SizeInt;
+    FItems: TItemsArray;
+
+    procedure Resize(ANewSize: SizeInt);
+    function PrepareAddingItem: SizeInt;
+  protected
+    function RealItemsLength: SizeInt; virtual;
+    function Rehash(ASizePow2: SizeInt; AForce: Boolean = False): boolean; virtual;
+    function FindBucketIndex(constref AKey: TKey): SizeInt; overload; inline;
+    function FindBucketIndex(constref AItems: TArray<TItem>; constref AKey: TKey; out AHash: UInt32): SizeInt; virtual; abstract; overload;
+  public
+    type
+      // Enumerators
+      TPairEnumerator = class(TOpenAddressingEnumerator<TDictionaryPair, OPEN_ADDRESSING_CONSTRAINTS>)
+      protected
+        function GetCurrent: TPair<TKey,TValue>; override;
+      end;
+
+      TValueEnumerator = class(TOpenAddressingEnumerator<TValue, OPEN_ADDRESSING_CONSTRAINTS>)
+      protected
+        function GetCurrent: TValue; override;
+      end;
+
+      TKeyEnumerator = class(TOpenAddressingEnumerator<TKey, OPEN_ADDRESSING_CONSTRAINTS>)
+      protected
+        function GetCurrent: TKey; override;
+      end;
+
+      // Collections
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+
+    // bug #24283 - workaround related to lack of DoGetEnumerator
+    function GetEnumerator: TPairEnumerator; reintroduce;
+  private
+    function GetKeys: TKeyCollection;
+    function GetValues: TValueCollection;
+  private
+    function GetItem(const AKey: TKey): TValue; inline;
+    procedure SetItem(const AKey: TKey; const AValue: TValue); inline;
+    procedure AddItem(var AItem: TItem; constref AKey: TKey; constref AValue: TValue; const AHash: UInt32); inline;
+  protected
+     // useful for using dictionary as array
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): TValue; virtual;
+    function DoAdd(constref AKey: TKey; constref AValue: TValue): SizeInt; virtual;
+
+    procedure UpdateItemsThreshold(ASize: SizeInt); override;
+
+    procedure SetCapacity(ACapacity: SizeInt); override;
+    // bug #24283 - can't descadent from TEnumerable
+    function DoGetEnumerator: TEnumerator<TDictionaryPair>; override;
+    procedure SetMaxLoadFactor(AValue: single); override;
+    function GetLoadFactor: single; override;
+    function GetCapacity: SizeInt; override;
+  public
+    // many constructors because bug #25607
+    constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
+
+    procedure Add(constref APair: TPair<TKey, TValue>); override; overload;
+    procedure Add(constref AKey: TKey; constref AValue: TValue); overload; inline;
+    procedure Remove(constref AKey: TKey);
+    function ExtractPair(constref AKey: TKey): TPair<TKey, TValue>;
+    procedure Clear; override;
+    procedure TrimExcess;
+    function TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+    procedure AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
+    function ContainsKey(constref AKey: TKey): Boolean; inline;
+    function ContainsValue(constref AValue: TValue): Boolean; overload;
+    function ContainsValue(constref AValue: TValue; const AEqualityComparer: IEqualityComparer<TValue>): Boolean; virtual; overload;
+
+    property Items[Index: TKey]: TValue read GetItem write SetItem; default;
+    property Keys: TKeyCollection read GetKeys;
+    property Values: TValueCollection read GetValues;
+
+    procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
+  end;
+
+  TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS> = class(TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>)
+  private type // for workaround Lazarus bug #25613
+    _TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+  protected
+    procedure NotifyIndexChange(AFrom, ATo: SizeInt); virtual;
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): TValue; override;
+    function FindBucketIndex(constref AItems: TArray<TItem>; constref AKey: TKey; out AHash: UInt32): SizeInt; override; overload;
+  end;
+
+  // More info and TODO
+  // https://github.com/OpenHFT/UntitledCollectionsProject/wiki/Tombstones-purge-from-hashtable:-theory-and-practice
+
+  TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>)
+  private
+    FTombstonesCount: SizeInt;
+  protected
+    function Rehash(ASizePow2: SizeInt; AForce: Boolean = False): boolean; override;
+    function RealItemsLength: SizeInt; override;
+
+    function FindBucketIndexOrTombstone(constref AItems: TArray<TItem>; constref AKey: TKey;
+      out AHash: UInt32): SizeInt; virtual; abstract;
+
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): TValue; override;
+    function DoAdd(constref AKey: TKey; constref AValue: TValue): SizeInt; override;
+  public
+    property TombstonesCount: SizeInt read FTombstonesCount;
+    procedure ClearTombstones; virtual;
+    procedure Clear; override;
+  end;
+
+  TOpenAddressingSH<OPEN_ADDRESSING_CONSTRAINTS> = class(TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>)
+  private type // for workaround Lazarus bug #25613
+    _TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+  protected
+    function FindBucketIndex(constref AItems: TArray<TItem>; constref AKey: TKey;
+      out AHash: UInt32): SizeInt; override; overload;
+    function FindBucketIndexOrTombstone(constref AItems: TArray<TItem>; constref AKey: TKey;
+      out AHash: UInt32): SizeInt; override;
+  end;
+
+  TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS> = class(TOpenAddressingSH<OPEN_ADDRESSING_CONSTRAINTS>)
+  private
+    FPrimaryNumberAsSizeApproximation: SizeInt;
+  protected
+    procedure UpdateItemsThreshold(ASize: SizeInt); override;
+    function FindBucketIndex(constref AItems: TArray<TItem>;
+      constref AKey: TKey; out AHash: UInt32): SizeInt; override; overload;
+    function FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+      constref AKey: TKey; out AHash: UInt32): SizeInt; override;
+  end;
+
+  TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS> = class(TOpenAddressingTombstones<OPEN_ADDRESSING_CONSTRAINTS>)
+  private type // for workaround Lazarus bug #25613
+    _TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+  private
+    R: UInt32;
+  protected
+    procedure UpdateItemsThreshold(ASize: SizeInt); override;
+    function FindBucketIndex(constref AItems: TArray<TItem>; constref AKey: TKey;
+      out AHash: UInt32): SizeInt; override; overload;
+    function FindBucketIndexOrTombstone(constref AItems: TArray<TItem>; constref AKey: TKey;
+      out AHash: UInt32): SizeInt; override;
+  strict protected
+    constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
+    constructor Create(const AComparer: IEqualityComparer<TKey>); reintroduce; overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+  public // bug #26181 (redundancy of constructors)
+    constructor Create(ACapacity: SizeInt); override; overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>); override; overload;
+    constructor Create(ACapacity: SizeInt; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    constructor Create(const AComparer: IExtendedEqualityComparer<TKey>); overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+  end;
+
+  TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
+  private type // for workaround Lazarus bug #25613
+    TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+    TItemsArray = array of TItem;
+  private
+    FMainIndex: SizeInt;
+  protected
+    function DoMoveNext: Boolean; override;
+  public
+    constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
+  end;
+
+  // more info :
+  // http://arxiv.org/abs/0903.0391
+
+  TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS> = class(TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>)
+  private const // Lookup Result
+    LR_NIL = -1;
+    LR_QUEUE = -2;
+  private type
+    PItem = ^TItem;
+    TItem = record
+      Hash: UInt32;
+      Pair: TPair<TKey, TValue>;
+    end;
+    TValueForQueue = TItem;
+
+    TQueueDictionary = class(TOpenAddressingLP<TKey, TValueForQueue, TDelphiHashFactory, TLinearProbing>)
+    private type // for workaround Lazarus bug #25613
+      _TItem = record
+        Hash: UInt32;
+        Pair: TPair<TKey, TValueForQueue>;
+      end;
+    private
+      FIdx: TList<UInt32>; // list to keep order
+    protected
+      procedure NotifyIndexChange(AFrom, ATo: SizeInt); override;
+      function Rehash(ASizePow2: SizeInt; AForce: Boolean = False): Boolean; override;
+    public
+      procedure InsertIntoBack(AItem: Pointer);
+      procedure InsertIntoHead(AItem: Pointer);
+      function IsEmpty: Boolean;
+      function Pop: Pointer;
+      constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
+      destructor Destroy; override;
+    end;
+
+    // cycle-detection mechanism class
+    TCDM = class(TOpenAddressingSH<TKey, TEmptyRecord, TDelphiHashFactory, TLinearProbing>);
+    TItemsArray = array of TItem;
+    TItemsDArray = array[0..Pred(TCuckooCfg.D)] of TItemsArray;
+  private var
+    FQueue: TQueueDictionary;  // probably can be optimized - hash TItem give information from TItem.Hash for cuckoo ...
+      // currently is kept in "TQueueDictionary = class(TOpenAddressingSH<TKey, TItem, ...>"
+
+    FCDM: TCDM; // cycle-detection mechanism
+    FItemsThreshold: SizeInt;
+    FItems: TItemsDArray;
+  // sadly there is bug #24848 for class var ...
+  {class} var
+    CUCKOO_SIGN, CUCKOO_INDEX_SIZE, CUCKOO_HASH_SIGN: UInt32;
+    // CUCKOO_MAX_ITEMS_LENGTH: <- to do : calc max length for items based on CUCKOO sign
+    // maybe some CDM bloom filter?
+
+    procedure Resize(ANewSize: SizeInt);
+    procedure Rehash(ASizePow2: SizeInt);
+    function PrepareAddingItem: SizeInt;
+  protected
+    procedure UpdateItemsThreshold(ASize: SizeInt); override;
+    function Lookup(constref AKey: TKey; var AHashListOrIndex: PUInt32): SizeInt; inline; overload;
+    function Lookup(constref AItems: TItemsDArray; constref AKey: TKey; var AHashListOrIndex: PUInt32): SizeInt; virtual; overload;
+  public
+    type
+      // Enumerators
+      TPairEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<TDictionaryPair, CUCKOO_CONSTRAINTS>)
+      protected
+        function GetCurrent: TPair<TKey,TValue>; override;
+      end;
+
+      TValueEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<TValue, CUCKOO_CONSTRAINTS>)
+      protected
+        function GetCurrent: TValue; override;
+      end;
+
+      TKeyEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<TKey, CUCKOO_CONSTRAINTS>)
+      protected
+        function GetCurrent: TKey; override;
+      end;
+
+      // Collections
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+
+    // bug #24283 - workaround related to lack of DoGetEnumerator
+    function GetEnumerator: TPairEnumerator; reintroduce;
+  private
+    function GetKeys: TKeyCollection;
+    function GetValues: TValueCollection;
+  private
+    function GetItem(const AKey: TKey): TValue; inline;
+    procedure SetItem(const AKey: TKey; const AValue: TValue); overload; inline;
+    procedure SetItem(constref AValue: TValue; const AHashListOrIndex: PUInt32; ALookupResult: SizeInt); overload;
+
+    procedure AddItem(constref AItems: TItemsDArray; constref AKey: TKey; constref AValue: TValue; const AHashList: PUInt32); overload;
+    procedure DoAdd(constref AKey: TKey; constref AValue: TValue; const AHashList: PUInt32); overload; inline;
+    function DoRemove(const AHashListOrIndex: PUInt32; ALookupResult: SizeInt;
+      ACollectionNotification: TCollectionNotification): TValue;
+
+    function GetQueueCount: SizeInt;
+  protected
+    procedure SetCapacity(ACapacity: SizeInt); override;
+    // bug #24283 - can't descadent from TEnumerable
+    function DoGetEnumerator: TEnumerator<TDictionaryPair>; override;
+    procedure SetMaxLoadFactor(AValue: single); override;
+    function GetLoadFactor: single; override;
+    function GetCapacity: SizeInt; override;
+  strict protected // bug #26181
+    constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
+    constructor Create(const AComparer: IEqualityComparer<TKey>); reintroduce; overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+  public
+    // TODO: function TryFlushQueue(ACount: SizeInt): SizeInt;
+
+    constructor Create; override; overload;
+    constructor Create(ACapacity: SizeInt); override; overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>); override; overload;
+    constructor Create(ACapacity: SizeInt; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    constructor Create(const AComparer: IExtendedEqualityComparer<TKey>); overload;
+    constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    destructor Destroy; override;
+
+    procedure Add(constref APair: TPair<TKey, TValue>); override; overload;
+    procedure Add(constref AKey: TKey; constref AValue: TValue); overload;
+    procedure Remove(constref AKey: TKey);
+    function ExtractPair(constref AKey: TKey): TPair<TKey, TValue>;
+    procedure Clear; override;
+    procedure TrimExcess;
+    function TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+    procedure AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
+    function ContainsKey(constref AKey: TKey): Boolean; inline;
+    function ContainsValue(constref AValue: TValue): Boolean; overload;
+    function ContainsValue(constref AValue: TValue; const AEqualityComparer: IEqualityComparer<TValue>): Boolean; virtual; overload;
+
+    property Items[Index: TKey]: TValue read GetItem write SetItem; default;
+    property Keys: TKeyCollection read GetKeys;
+    property Values: TValueCollection read GetValues;
+
+    property QueueCount: SizeInt read GetQueueCount;
+    procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
+  end;
+
+  TDictionaryOwnerships = set of (doOwnsKeys, doOwnsValues);
+
+  TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS> = class(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>)
+  private
+    FOwnerships: TDictionaryOwnerships;
+  protected
+    procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); override;
+    procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); override;
+  public
+    // can't be as "Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt = 0)"
+    // because bug #25607
+    constructor Create(AOwnerships: TDictionaryOwnerships); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships;
+      const AComparer: IExtendedEqualityComparer<TKey>); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt;
+      const AComparer: IExtendedEqualityComparer<TKey>); overload;
+  end;
+
+  TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS> = class(TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>)
+  private
+    FOwnerships: TDictionaryOwnerships;
+  protected
+    procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); override;
+    procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); override;
+  public
+    // can't be as "Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt = 0)"
+    // because bug #25607
+    constructor Create(AOwnerships: TDictionaryOwnerships); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships;
+      const AComparer: IEqualityComparer<TKey>); overload;
+    constructor Create(AOwnerships: TDictionaryOwnerships; ACapacity: SizeInt;
+      const AComparer: IEqualityComparer<TKey>); overload;
+  end;
+
+  // useful generics overloads
+  TOpenAddressingLP<TKey, TValue, THashFactory> = class(TOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
+  TOpenAddressingLP<TKey, TValue>  = class(TOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+
+  TObjectOpenAddressingLP<TKey, TValue, THashFactory> = class(TObjectOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
+  TObjectOpenAddressingLP<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+
+  // Linear Probing with Tombstones (LPT)
+  TOpenAddressingLPT<TKey, TValue, THashFactory> = class(TOpenAddressingSH<TKey, TValue, THashFactory, TLinearProbing>);
+  TOpenAddressingLPT<TKey, TValue> = class(TOpenAddressingSH<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+
+  TOpenAddressingQP<TKey, TValue, THashFactory> = class(TOpenAddressingQP<TKey, TValue, THashFactory, TQuadraticProbing>);
+  TOpenAddressingQP<TKey, TValue> = class(TOpenAddressingQP<TKey, TValue, TDelphiHashFactory, TQuadraticProbing>);
+
+  TOpenAddressingDH<TKey, TValue, THashFactory> = class(TOpenAddressingDH<TKey, TValue, THashFactory, TDoubleHashing>);
+  TOpenAddressingDH<TKey, TValue> = class(TOpenAddressingDH<TKey, TValue, TDelphiDoubleHashFactory, TDoubleHashing>);
+
+  TCuckooD2<TKey, TValue, THashFactory> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D2>);
+  TCuckooD2<TKey, TValue> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiDoubleHashFactory, TDeamortizedCuckooHashingCfg_D2>);
+
+  TCuckooD4<TKey, TValue, THashFactory> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D4>);
+  TCuckooD4<TKey, TValue> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiQuadrupleHashFactory, TDeamortizedCuckooHashingCfg_D4>);
+
+  TCuckooD6<TKey, TValue, THashFactory> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D6>);
+  TCuckooD6<TKey, TValue> = class(TDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiSixfoldHashFactory, TDeamortizedCuckooHashingCfg_D6>);
+
+  TObjectCuckooD2<TKey, TValue, THashFactory> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D2>);
+  TObjectCuckooD2<TKey, TValue> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiDoubleHashFactory, TDeamortizedCuckooHashingCfg_D2>);
+
+  TObjectCuckooD4<TKey, TValue, THashFactory> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D4>);
+  TObjectCuckooD4<TKey, TValue> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiQuadrupleHashFactory, TDeamortizedCuckooHashingCfg_D4>);
+
+  TObjectCuckooD6<TKey, TValue, THashFactory> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, THashFactory, TDeamortizedCuckooHashingCfg_D6>);
+  TObjectCuckooD6<TKey, TValue> = class(TObjectDeamortizedDArrayCuckooMap<TKey, TValue, TDelphiSixfoldHashFactory, TDeamortizedCuckooHashingCfg_D6>);
+
+  // for normal programmers to normal use =)
+  TDictionary<TKey, TValue> = class(TOpenAddressingLP<TKey, TValue>);
+  TObjectDictionary<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue>);
+
+  TFastHashMap<TKey, TValue> = class(TCuckooD2<TKey, TValue>);
+  TFastObjectHashMap<TKey, TValue> = class(TObjectCuckooD2<TKey, TValue>);
+
+  THashMap<TKey, TValue> = class(TCuckooD4<TKey, TValue>);
+  TObjectHashMap<TKey, TValue> = class(TObjectCuckooD4<TKey, TValue>);
+
+var
+  EmptyRecord: TEmptyRecord;

Units/Utils/generics.hashes.pas

@@ -0,0 +1,915 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.Hashes;
+
+{$MODE DELPHI}{$H+}
+{$POINTERMATH ON}
+{$MACRO ON}
+{$COPERATORS ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+// Original version of Bob Jenkins Hash
+// http://burtleburtle.net/bob/c/lookup3.c
+function HashWord(
+  AKey: PLongWord;                   //* the key, an array of uint32_t values */
+  ALength: SizeInt;                  //* the length of the key, in uint32_ts */
+  AInitVal: UInt32): UInt32;         //* the previous hash, or an arbitrary value */
+procedure HashWord2 (
+  AKey: PLongWord;                   //* the key, an array of uint32_t values */
+  ALength: SizeInt;                  //* the length of the key, in uint32_ts */
+  var APrimaryHashAndInitVal: UInt32;                  //* IN: seed OUT: primary hash value */
+  var ASecondaryHashAndInitVal: UInt32);               //* IN: more seed OUT: secondary hash value */
+
+function HashLittle(AKey: Pointer; ALength: SizeInt; AInitVal: UInt32): UInt32;
+procedure HashLittle2(
+  AKey: Pointer;        //* the key to hash */
+  ALength: SizeInt;     //* length of the key */
+  var APrimaryHashAndInitVal: UInt32;                  //* IN: primary initval, OUT: primary hash */
+  var ASecondaryHashAndInitVal: UInt32);               //* IN: secondary initval, OUT: secondary hash */
+
+function DelphiHashLittle(AKey: Pointer; ALength: SizeInt; AInitVal: UInt32): Int32;
+procedure DelphiHashLittle2(AKey: Pointer; ALength: SizeInt; var APrimaryHashAndInitVal, ASecondaryHashAndInitVal: UInt32);
+
+// hash function from fstl
+function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
+
+// some other hashes
+// http://stackoverflow.com/questions/14409466/simple-hash-functions
+// http://www.partow.net/programming/hashfunctions/
+// http://en.wikipedia.org/wiki/List_of_hash_functions
+// http://www.cse.yorku.ca/~oz/hash.html
+
+// https://code.google.com/p/hedgewars/source/browse/hedgewars/adler32.pas
+function Adler32(AKey: Pointer; ALength: SizeInt): UInt32;
+function sdbm(AKey: Pointer; ALength: SizeInt): UInt32;
+
+implementation
+
+function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
+var
+  i: Integer;
+  ABuffer: PUInt8 absolute AKey;
+begin
+  Result := 0;
+  for i := 0 to ALength - 1 do
+     Inc(Result,ABuffer[i]);
+end;
+
+function Adler32(AKey: Pointer; ALength: SizeInt): UInt32;
+const
+  MOD_ADLER = 65521;
+var
+  ABuffer: PUInt8 absolute AKey;
+  a: UInt32 = 1;
+  b: UInt32 = 0;
+  n: Integer;
+begin
+  for n := 0 to ALength -1 do
+  begin
+    a := (a + ABuffer[n]) mod MOD_ADLER;
+    b := (b + a) mod MOD_ADLER;
+  end;
+  Result := (b shl 16) or a;
+end;
+
+function sdbm(AKey: Pointer; ALength: SizeInt): UInt32;
+var
+  c: PUInt8 absolute AKey;
+  i: Integer;
+begin
+  Result := 0;
+  c := AKey;
+  for i := 0 to ALength - 1 do
+  begin
+    Result := c^ + (Result shl 6) + (Result shl 16) {%H-}- Result;
+    Inc(c);
+  end;
+end;
+
+{ BobJenkinsHash }
+
+{$define mix_abc :=
+  a -= c;  a := a xor (((c)shl(4)) or ((c)shr(32-(4))));  c += b;
+  b -= a;  b := b xor (((a)shl(6)) or ((a)shr(32-(6))));  a += c;
+  c -= b;  c := c xor (((b)shl(8)) or ((b)shr(32-(8))));  b += a;
+  a -= c;  a := a xor (((c)shl(16)) or ((c)shr(32-(16))));  c += b;
+  b -= a;  b := b xor (((a)shl(19)) or ((a)shr(32-(19))));  a += c;
+  c -= b;  c := c xor (((b)shl(4)) or ((b)shr(32-(4))));  b += a
+}
+
+{$define final_abc :=
+  c := c xor b; c -= (((b)shl(14)) or ((b)shr(32-(14))));
+  a := a xor c; a -= (((c)shl(11)) or ((c)shr(32-(11))));
+  b := b xor a; b -= (((a)shl(25)) or ((a)shr(32-(25))));
+  c := c xor b; c -= (((b)shl(16)) or ((b)shr(32-(16))));
+  a := a xor c; a -= (((c)shl(4)) or ((c)shr(32-(4))));
+  b := b xor a; b -= (((a)shl(14)) or ((a)shr(32-(14))));
+  c := c xor b; c -= (((b)shl(24)) or ((b)shr(32-(24))))
+}
+
+function HashWord(
+  AKey: PLongWord;                   //* the key, an array of uint32_t values */
+  ALength: SizeInt;               //* the length of the key, in uint32_ts */
+  AInitVal: UInt32): UInt32;         //* the previous hash, or an arbitrary value */
+var
+  a,b,c: UInt32;
+label
+  Case0, Case1, Case2, Case3;
+begin
+  //* Set up the internal state */
+  a := $DEADBEEF + (UInt32(ALength) shl 2) + AInitVal;
+  b := a;
+  c := b;
+
+  //*------------------------------------------------- handle most of the key */
+  while ALength > 3 do
+  begin
+    a += AKey[0];
+    b += AKey[1];
+    c += AKey[2];
+    mix_abc;
+    ALength -= 3;
+    AKey += 3;
+  end;
+
+  //*------------------------------------------- handle the last 3 uint32_t's */
+  case ALength of //* all the case statements fall through */
+    3: goto Case3;
+    2: goto Case2;
+    1: goto Case1;
+    0: goto Case0;
+  end;
+  Case3: c+=AKey[2];
+  Case2: b+=AKey[1];
+  Case1: a+=AKey[0];
+    final_abc;
+  Case0:     //* case 0: nothing left to add */
+  //*------------------------------------------------------ report the result */
+  Result := c;
+end;
+
+procedure HashWord2 (
+AKey: PLongWord;                   //* the key, an array of uint32_t values */
+ALength: SizeInt;               //* the length of the key, in uint32_ts */
+var APrimaryHashAndInitVal: UInt32;                      //* IN: seed OUT: primary hash value */
+var ASecondaryHashAndInitVal: UInt32);               //* IN: more seed OUT: secondary hash value */
+var
+  a,b,c: UInt32;
+label
+  Case0, Case1, Case2, Case3;
+begin
+  //* Set up the internal state */
+  a := $deadbeef + (UInt32(ALength shl 2)) + APrimaryHashAndInitVal;
+  b := a;
+  c := b;
+  c += ASecondaryHashAndInitVal;
+
+  //*------------------------------------------------- handle most of the key */
+  while ALength > 3 do
+  begin
+    a += AKey[0];
+    b += AKey[1];
+    c += AKey[2];
+    mix_abc;
+    ALength -= 3;
+    AKey += 3;
+  end;
+
+  //*------------------------------------------- handle the last 3 uint32_t's */
+  case ALength of                     //* all the case statements fall through */
+    3: goto Case3;
+    2: goto Case2;
+    1: goto Case1;
+    0: goto Case0;
+  end;
+  Case3: c+=AKey[2];
+  Case2: b+=AKey[1];
+  Case1: a+=AKey[0];
+    final_abc;
+  Case0:     //* case 0: nothing left to add */
+  //*------------------------------------------------------ report the result */
+  APrimaryHashAndInitVal := c;
+  ASecondaryHashAndInitVal := b;
+end;
+
+function HashLittle(AKey: Pointer; ALength: SizeInt; AInitVal: UInt32): UInt32;
+var
+  a, b, c: UInt32;
+  u: record case byte of
+    0: (ptr: Pointer);
+    1: (i: PtrUint);
+  end absolute AKey;
+
+  k32: ^UInt32 absolute AKey;
+  k16: ^UInt16 absolute AKey;
+  k8: ^UInt8 absolute AKey;
+
+label _10, _8, _6, _4, _2;
+label Case12, Case11, Case10, Case9, Case8, Case7, Case6, Case5, Case4, Case3, Case2, Case1;
+
+begin
+  a := $DEADBEEF + UInt32(ALength) + AInitVal;
+  b := a;
+  c := b;
+
+{$IFDEF ENDIAN_LITTLE}
+  if (u.i and $3) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k32[0];
+      b += k32[1];
+      c += k32[2];
+      mix_abc;
+      ALength -= 12;
+      k32 += 3;
+    end;
+
+    case ALength of
+      12: begin c += k32[2]; b += k32[1]; a += k32[0]; end;
+      11: begin c += k32[2] and $ffffff; b += k32[1]; a += k32[0]; end;
+      10: begin c += k32[2] and $ffff; b += k32[1]; a += k32[0]; end;
+      9 : begin c += k32[2] and $ff; b += k32[1]; a += k32[0]; end;
+      8 : begin b += k32[1]; a += k32[0]; end;
+      7 : begin b += k32[1] and $ffffff; a += k32[0]; end;
+      6 : begin b += k32[1] and $ffff; a += k32[0]; end;
+      5 : begin b += k32[1] and $ff; a += k32[0]; end;
+      4 : begin a += k32[0]; end;
+      3 : begin a += k32[0] and $ffffff; end;
+      2 : begin a += k32[0] and $ffff; end;
+      1 : begin a += k32[0] and $ff; end;
+      0 : Exit(c);              // zero length strings require no mixing
+    end
+  end
+  else
+  if (u.i and $1) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k16[0] + (UInt32(k16[1]) shl 16);
+      b += k16[2] + (UInt32(k16[3]) shl 16);
+      c += k16[4] + (UInt32(k16[5]) shl 16);
+      mix_abc;
+      ALength -= 12;
+      k16 += 6;
+    end;
+
+    case ALength of
+      12:
+        begin
+          c+=k16[4]+((UInt32(k16[5])) shl 16);
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      11:
+        begin
+          c+=(UInt32(k8[10])) shl 16;     //* fall through */
+          goto _10;
+        end;
+      10:
+        begin _10:
+          c+=k16[4];
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      9 :
+        begin
+          c+=k8[8];                      //* fall through */
+          goto _8;
+        end;
+      8 :
+        begin _8:
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      7 :
+        begin
+          b+=(UInt32(k8[6])) shl 16;      //* fall through */
+          goto _6;
+        end;
+      6 :
+        begin _6:
+          b+=k16[2];
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      5 :
+        begin
+          b+=k8[4];                      //* fall through */
+          goto _4;
+        end;
+      4 :
+        begin _4:
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      3 :
+        begin
+          a+=(UInt32(k8[2])) shl 16;      //* fall through */
+          goto _2;
+        end;
+      2 :
+        begin _2:
+          a+=k16[0];
+        end;
+      1 :
+        begin
+          a+=k8[0];
+        end;
+      0 : Exit(c);                     //* zero length requires no mixing */
+    end;
+  end
+  else
+{$ENDIF}
+  begin
+    while ALength > 12 do
+    begin
+      a += k8[0];
+      a += (UInt32(k8[1])) shl 8;
+      a += (UInt32(k8[2])) shl 16;
+      a += (UInt32(k8[3])) shl 24;
+      b += k8[4];
+      b += (UInt32(k8[5])) shl 8;
+      b += (UInt32(k8[6])) shl 16;
+      b += (UInt32(k8[7])) shl 24;
+      c += k8[8];
+      c += (UInt32(k8[9])) shl 8;
+      c += (UInt32(k8[10])) shl 16;
+      c += (UInt32(k8[11])) shl 24;
+      mix_abc;
+      ALength -= 12;
+      k8 += 12;
+    end;
+
+    case ALength of
+      12: goto Case12;
+      11: goto Case11;
+      10: goto Case10;
+      9 : goto Case9;
+      8 : goto Case8;
+      7 : goto Case7;
+      6 : goto Case6;
+      5 : goto Case5;
+      4 : goto Case4;
+      3 : goto Case3;
+      2 : goto Case2;
+      1 : goto Case1;
+      0 : Exit(c);
+    end;
+
+    Case12: c+=(UInt32(k8[11])) shl 24;
+    Case11: c+=(UInt32(k8[10])) shl 16;
+    Case10: c+=(UInt32(k8[9])) shl 8;
+    Case9: c+=k8[8];
+    Case8: b+=(UInt32(k8[7])) shl 24;
+    Case7: b+=(UInt32(k8[6])) shl 16;
+    Case6: b+=(UInt32(k8[5])) shl 8;
+    Case5: b+=k8[4];
+    Case4: a+=(UInt32(k8[3])) shl 24;
+    Case3: a+=(UInt32(k8[2])) shl 16;
+    Case2: a+=(UInt32(k8[1])) shl 8;
+    Case1: a+=k8[0];
+  end;
+
+  final_abc;
+  Result := c;
+end;
+
+(*
+ * hashlittle2: return 2 32-bit hash values
+ *
+ * This is identical to hashlittle(), except it returns two 32-bit hash
+ * values instead of just one.  This is good enough for hash table
+ * lookup with 2^^64 buckets, or if you want a second hash if you're not
+ * happy with the first, or if you want a probably-unique 64-bit ID for
+ * the key.  *pc is better mixed than *pb, so use *pc first.  If you want
+ * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)".
+ *)
+procedure HashLittle2(
+  AKey: Pointer;        //* the key to hash */
+  ALength: SizeInt;    //* length of the key */
+  var APrimaryHashAndInitVal: UInt32;                      //* IN: primary initval, OUT: primary hash */
+  var ASecondaryHashAndInitVal: UInt32);               //* IN: secondary initval, OUT: secondary hash */
+var
+  a,b,c: UInt32;
+  u: record case byte of
+    0: (ptr: Pointer);
+    1: (i: PtrUint);
+  end absolute AKey;
+
+  k32: ^UInt32 absolute AKey;
+  k16: ^UInt16 absolute AKey;
+  k8: ^UInt8 absolute AKey;
+
+label _10, _8, _6, _4, _2;
+label Case12, Case11, Case10, Case9, Case8, Case7, Case6, Case5, Case4, Case3, Case2, Case1;
+
+begin
+  //* Set up the internal state */
+  a := $DEADBEEF + UInt32(ALength) + APrimaryHashAndInitVal;
+  b := a;
+  c := b;
+  c += ASecondaryHashAndInitVal;
+
+{$IFDEF ENDIAN_LITTLE}
+  if (u.i and $3) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k32[0];
+      b += k32[1];
+      c += k32[2];
+      mix_abc;
+      ALength -= 12;
+      k32 += 3;
+    end;
+
+    case ALength of
+      12: begin c += k32[2]; b += k32[1]; a += k32[0]; end;
+      11: begin c += k32[2] and $ffffff; b += k32[1]; a += k32[0]; end;
+      10: begin c += k32[2] and $ffff; b += k32[1]; a += k32[0]; end;
+      9 : begin c += k32[2] and $ff; b += k32[1]; a += k32[0]; end;
+      8 : begin b += k32[1]; a += k32[0]; end;
+      7 : begin b += k32[1] and $ffffff; a += k32[0]; end;
+      6 : begin b += k32[1] and $ffff; a += k32[0]; end;
+      5 : begin b += k32[1] and $ff; a += k32[0]; end;
+      4 : begin a += k32[0]; end;
+      3 : begin a += k32[0] and $ffffff; end;
+      2 : begin a += k32[0] and $ffff; end;
+      1 : begin a += k32[0] and $ff; end;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end
+  end
+  else
+  if (u.i and $1) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k16[0] + (UInt32(k16[1]) shl 16);
+      b += k16[2] + (UInt32(k16[3]) shl 16);
+      c += k16[4] + (UInt32(k16[5]) shl 16);
+      mix_abc;
+      ALength -= 12;
+      k16 += 6;
+    end;
+
+    case ALength of
+      12:
+        begin
+          c+=k16[4]+((UInt32(k16[5])) shl 16);
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      11:
+        begin
+          c+=(UInt32(k8[10])) shl 16;     //* fall through */
+          goto _10;
+        end;
+      10:
+        begin _10:
+          c+=k16[4];
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      9 :
+        begin
+          c+=k8[8];                      //* fall through */
+          goto _8;
+        end;
+      8 :
+        begin _8:
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      7 :
+        begin
+          b+=(UInt32(k8[6])) shl 16;      //* fall through */
+          goto _6;
+        end;
+      6 :
+        begin _6:
+          b+=k16[2];
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      5 :
+        begin
+          b+=k8[4];                      //* fall through */
+          goto _4;
+        end;
+      4 :
+        begin _4:
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      3 :
+        begin
+          a+=(UInt32(k8[2])) shl 16;      //* fall through */
+          goto _2;
+        end;
+      2 :
+        begin _2:
+          a+=k16[0];
+        end;
+      1 :
+        begin
+          a+=k8[0];
+        end;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end;
+  end
+  else
+{$ENDIF}
+  begin
+    while ALength > 12 do
+    begin
+      a += k8[0];
+      a += (UInt32(k8[1])) shl 8;
+      a += (UInt32(k8[2])) shl 16;
+      a += (UInt32(k8[3])) shl 24;
+      b += k8[4];
+      b += (UInt32(k8[5])) shl 8;
+      b += (UInt32(k8[6])) shl 16;
+      b += (UInt32(k8[7])) shl 24;
+      c += k8[8];
+      c += (UInt32(k8[9])) shl 8;
+      c += (UInt32(k8[10])) shl 16;
+      c += (UInt32(k8[11])) shl 24;
+      mix_abc;
+      ALength -= 12;
+      k8 += 12;
+    end;
+
+    case ALength of
+      12: goto Case12;
+      11: goto Case11;
+      10: goto Case10;
+      9 : goto Case9;
+      8 : goto Case8;
+      7 : goto Case7;
+      6 : goto Case6;
+      5 : goto Case5;
+      4 : goto Case4;
+      3 : goto Case3;
+      2 : goto Case2;
+      1 : goto Case1;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end;
+
+    Case12: c+=(UInt32(k8[11])) shl 24;
+    Case11: c+=(UInt32(k8[10])) shl 16;
+    Case10: c+=(UInt32(k8[9])) shl 8;
+    Case9: c+=k8[8];
+    Case8: b+=(UInt32(k8[7])) shl 24;
+    Case7: b+=(UInt32(k8[6])) shl 16;
+    Case6: b+=(UInt32(k8[5])) shl 8;
+    Case5: b+=k8[4];
+    Case4: a+=(UInt32(k8[3])) shl 24;
+    Case3: a+=(UInt32(k8[2])) shl 16;
+    Case2: a+=(UInt32(k8[1])) shl 8;
+    Case1: a+=k8[0];
+  end;
+
+  final_abc;
+  APrimaryHashAndInitVal := c;
+  ASecondaryHashAndInitVal := b;
+end;
+
+procedure DelphiHashLittle2(AKey: Pointer; ALength: SizeInt; var APrimaryHashAndInitVal, ASecondaryHashAndInitVal: UInt32);
+var
+  a,b,c: UInt32;
+  u: record case byte of
+    0: (ptr: Pointer);
+    1: (i: PtrUint);
+  end absolute AKey;
+
+  k32: ^UInt32 absolute AKey;
+  k16: ^UInt16 absolute AKey;
+  k8: ^UInt8 absolute AKey;
+
+label _10, _8, _6, _4, _2;
+label Case12, Case11, Case10, Case9, Case8, Case7, Case6, Case5, Case4, Case3, Case2, Case1;
+
+begin
+  //* Set up the internal state */
+  a := $DEADBEEF + UInt32(ALength shl 2) + APrimaryHashAndInitVal; // delphi version bug? original version don't have "shl 2"
+  b := a;
+  c := b;
+  c += ASecondaryHashAndInitVal;
+
+{$IFDEF ENDIAN_LITTLE}
+  if (u.i and $3) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k32[0];
+      b += k32[1];
+      c += k32[2];
+      mix_abc;
+      ALength -= 12;
+      k32 += 3;
+    end;
+
+    case ALength of
+      12: begin c += k32[2]; b += k32[1]; a += k32[0]; end;
+      11: begin c += k32[2] and $ffffff; b += k32[1]; a += k32[0]; end;
+      10: begin c += k32[2] and $ffff; b += k32[1]; a += k32[0]; end;
+      9 : begin c += k32[2] and $ff; b += k32[1]; a += k32[0]; end;
+      8 : begin b += k32[1]; a += k32[0]; end;
+      7 : begin b += k32[1] and $ffffff; a += k32[0]; end;
+      6 : begin b += k32[1] and $ffff; a += k32[0]; end;
+      5 : begin b += k32[1] and $ff; a += k32[0]; end;
+      4 : begin a += k32[0]; end;
+      3 : begin a += k32[0] and $ffffff; end;
+      2 : begin a += k32[0] and $ffff; end;
+      1 : begin a += k32[0] and $ff; end;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end
+  end
+  else
+  if (u.i and $1) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k16[0] + (UInt32(k16[1]) shl 16);
+      b += k16[2] + (UInt32(k16[3]) shl 16);
+      c += k16[4] + (UInt32(k16[5]) shl 16);
+      mix_abc;
+      ALength -= 12;
+      k16 += 6;
+    end;
+
+    case ALength of
+      12:
+        begin
+          c+=k16[4]+((UInt32(k16[5])) shl 16);
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      11:
+        begin
+          c+=(UInt32(k8[10])) shl 16;     //* fall through */
+          goto _10;
+        end;
+      10:
+        begin _10:
+          c+=k16[4];
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      9 :
+        begin
+          c+=k8[8];                      //* fall through */
+          goto _8;
+        end;
+      8 :
+        begin _8:
+          b+=k16[2]+((UInt32(k16[3])) shl 16);
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      7 :
+        begin
+          b+=(UInt32(k8[6])) shl 16;      //* fall through */
+          goto _6;
+        end;
+      6 :
+        begin _6:
+          b+=k16[2];
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      5 :
+        begin
+          b+=k8[4];                      //* fall through */
+          goto _4;
+        end;
+      4 :
+        begin _4:
+          a+=k16[0]+((UInt32(k16[1])) shl 16);
+        end;
+      3 :
+        begin
+          a+=(UInt32(k8[2])) shl 16;      //* fall through */
+          goto _2;
+        end;
+      2 :
+        begin _2:
+          a+=k16[0];
+        end;
+      1 :
+        begin
+          a+=k8[0];
+        end;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end;
+  end
+  else
+{$ENDIF}
+  begin
+    while ALength > 12 do
+    begin
+      a += k8[0];
+      a += (UInt32(k8[1])) shl 8;
+      a += (UInt32(k8[2])) shl 16;
+      a += (UInt32(k8[3])) shl 24;
+      b += k8[4];
+      b += (UInt32(k8[5])) shl 8;
+      b += (UInt32(k8[6])) shl 16;
+      b += (UInt32(k8[7])) shl 24;
+      c += k8[8];
+      c += (UInt32(k8[9])) shl 8;
+      c += (UInt32(k8[10])) shl 16;
+      c += (UInt32(k8[11])) shl 24;
+      mix_abc;
+      ALength -= 12;
+      k8 += 12;
+    end;
+
+    case ALength of
+      12: goto Case12;
+      11: goto Case11;
+      10: goto Case10;
+      9 : goto Case9;
+      8 : goto Case8;
+      7 : goto Case7;
+      6 : goto Case6;
+      5 : goto Case5;
+      4 : goto Case4;
+      3 : goto Case3;
+      2 : goto Case2;
+      1 : goto Case1;
+      0 :
+        begin
+          APrimaryHashAndInitVal := c;
+          ASecondaryHashAndInitVal := b;
+          Exit;              // zero length strings require no mixing
+        end;
+    end;
+
+    Case12: c+=(UInt32(k8[11])) shl 24;
+    Case11: c+=(UInt32(k8[10])) shl 16;
+    Case10: c+=(UInt32(k8[9])) shl 8;
+    Case9: c+=k8[8];
+    Case8: b+=(UInt32(k8[7])) shl 24;
+    Case7: b+=(UInt32(k8[6])) shl 16;
+    Case6: b+=(UInt32(k8[5])) shl 8;
+    Case5: b+=k8[4];
+    Case4: a+=(UInt32(k8[3])) shl 24;
+    Case3: a+=(UInt32(k8[2])) shl 16;
+    Case2: a+=(UInt32(k8[1])) shl 8;
+    Case1: a+=k8[0];
+  end;
+
+  final_abc;
+  APrimaryHashAndInitVal := c;
+  ASecondaryHashAndInitVal := b;
+end;
+
+function DelphiHashLittle(AKey: Pointer; ALength: SizeInt; AInitVal: UInt32): Int32;
+var
+  a, b, c: UInt32;
+  u: record case byte of
+    0: (ptr: Pointer);
+    1: (i: PtrUint);
+  end absolute AKey;
+
+  k32: ^UInt32 absolute AKey;
+  //k16: ^UInt16 absolute AKey;
+  k8: ^UInt8 absolute AKey;
+
+label Case12, Case11, Case10, Case9, Case8, Case7, Case6, Case5, Case4, Case3, Case2, Case1;
+
+begin
+  a := $DEADBEEF + UInt32(ALength shl 2) + AInitVal; // delphi version bug? original version don't have "shl 2"
+  b := a;
+  c := b;
+
+{.$IFDEF ENDIAN_LITTLE} // Delphi version don't care
+  if (u.i and $3) = 0 then
+  begin
+    while (ALength > 12) do
+    begin
+      a += k32[0];
+      b += k32[1];
+      c += k32[2];
+      mix_abc;
+      ALength -= 12;
+      k32 += 3;
+    end;
+
+    case ALength of
+      12: begin c += k32[2]; b += k32[1]; a += k32[0]; end;
+      11: begin c += k32[2] and $ffffff; b += k32[1]; a += k32[0]; end;
+      10: begin c += k32[2] and $ffff; b += k32[1]; a += k32[0]; end;
+      9 : begin c += k32[2] and $ff; b += k32[1]; a += k32[0]; end;
+      8 : begin b += k32[1]; a += k32[0]; end;
+      7 : begin b += k32[1] and $ffffff; a += k32[0]; end;
+      6 : begin b += k32[1] and $ffff; a += k32[0]; end;
+      5 : begin b += k32[1] and $ff; a += k32[0]; end;
+      4 : begin a += k32[0]; end;
+      3 : begin a += k32[0] and $ffffff; end;
+      2 : begin a += k32[0] and $ffff; end;
+      1 : begin a += k32[0] and $ff; end;
+      0 : Exit(c);              // zero length strings require no mixing
+    end
+  end
+  else
+{.$ENDIF}
+  begin
+    while ALength > 12 do
+    begin
+      a += k8[0];
+      a += (UInt32(k8[1])) shl 8;
+      a += (UInt32(k8[2])) shl 16;
+      a += (UInt32(k8[3])) shl 24;
+      b += k8[4];
+      b += (UInt32(k8[5])) shl 8;
+      b += (UInt32(k8[6])) shl 16;
+      b += (UInt32(k8[7])) shl 24;
+      c += k8[8];
+      c += (UInt32(k8[9])) shl 8;
+      c += (UInt32(k8[10])) shl 16;
+      c += (UInt32(k8[11])) shl 24;
+      mix_abc;
+      ALength -= 12;
+      k8 += 12;
+    end;
+
+    case ALength of
+      12: goto Case12;
+      11: goto Case11;
+      10: goto Case10;
+      9 : goto Case9;
+      8 : goto Case8;
+      7 : goto Case7;
+      6 : goto Case6;
+      5 : goto Case5;
+      4 : goto Case4;
+      3 : goto Case3;
+      2 : goto Case2;
+      1 : goto Case1;
+      0 : Exit(c);
+    end;
+
+    Case12: c+=(UInt32(k8[11])) shl 24;
+    Case11: c+=(UInt32(k8[10])) shl 16;
+    Case10: c+=(UInt32(k8[9])) shl 8;
+    Case9: c+=k8[8];
+    Case8: b+=(UInt32(k8[7])) shl 24;
+    Case7: b+=(UInt32(k8[6])) shl 16;
+    Case6: b+=(UInt32(k8[5])) shl 8;
+    Case5: b+=k8[4];
+    Case4: a+=(UInt32(k8[3])) shl 24;
+    Case3: a+=(UInt32(k8[2])) shl 16;
+    Case2: a+=(UInt32(k8[1])) shl 8;
+    Case1: a+=k8[0];
+  end;
+
+  final_abc;
+  Result := Int32(c);
+end;
+
+end.
+

Units/Utils/generics.helpers.pas

@@ -0,0 +1,144 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.Helpers;
+
+{$MODE DELPHI}{$H+}
+{$MODESWITCH TYPEHELPERS}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  { TValueAnsiStringHelper }
+
+  TValueAnsiStringHelper = record helper for AnsiString
+    function ToLower: AnsiString; inline;
+  end;
+
+  { TValuewideStringHelper }
+
+  TValueWideStringHelper = record helper for WideString
+    function ToLower: WideString; inline;
+  end;
+
+  { TValueUnicodeStringHelper }
+
+  TValueUnicodeStringHelper = record helper for UnicodeString
+    function ToLower: UnicodeString; inline;
+  end;
+
+  { TValueShortStringHelper }
+
+  TValueShortStringHelper = record helper for ShortString
+    function ToLower: ShortString; inline;
+  end;
+
+  { TValueUTF8StringHelper }
+
+  TValueUTF8StringHelper = record helper for UTF8String
+    function ToLower: UTF8String; inline;
+  end;
+
+  { TValueRawByteStringHelper }
+
+  TValueRawByteStringHelper = record helper for RawByteString
+    function ToLower: RawByteString; inline;
+  end;
+
+  { TValueUInt32Helper }
+
+  TValueUInt32Helper = record helper for UInt32
+    class function GetSignMask: UInt32; static; inline;
+    class function GetSizedSignMask(ABits: Byte): UInt32; static; inline;
+    class function GetBitsLength: Byte; static; inline;
+
+    const
+      SIZED_SIGN_MASK: array[1..32] of UInt32 = (
+        $80000000, $C0000000, $E0000000, $F0000000, $F8000000, $FC000000, $FE000000, $FF000000,
+        $FF800000, $FFC00000, $FFE00000, $FFF00000, $FFF80000, $FFFC0000, $FFFE0000, $FFFF0000,
+        $FFFF8000, $FFFFC000, $FFFFE000, $FFFFF000, $FFFFF800, $FFFFFC00, $FFFFFE00, $FFFFFF00,
+        $FFFFFF80, $FFFFFFC0, $FFFFFFE0, $FFFFFFF0, $FFFFFFF8, $FFFFFFFC, $FFFFFFFE, $FFFFFFFF);
+      BITS_LENGTH = 32;
+  end;
+
+implementation
+
+{ TRawDataStringHelper }
+
+function TValueAnsiStringHelper.ToLower: AnsiString;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueWideStringHelper }
+
+function TValueWideStringHelper.ToLower: WideString;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueUnicodeStringHelper }
+
+function TValueUnicodeStringHelper.ToLower: UnicodeString;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueShortStringHelper }
+
+function TValueShortStringHelper.ToLower: ShortString;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueUTF8StringHelper }
+
+function TValueUTF8StringHelper.ToLower: UTF8String;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueRawByteStringHelper }
+
+function TValueRawByteStringHelper.ToLower: RawByteString;
+begin
+  Result := LowerCase(Self);
+end;
+
+{ TValueUInt32Helper }
+
+class function TValueUInt32Helper.GetSignMask: UInt32;
+begin
+  Result := $80000000;
+end;
+
+class function TValueUInt32Helper.GetSizedSignMask(ABits: Byte): UInt32;
+begin
+  Result := SIZED_SIGN_MASK[ABits];
+end;
+
+class function TValueUInt32Helper.GetBitsLength: Byte;
+begin
+  Result := BITS_LENGTH;
+end;
+
+end.
+

Units/Utils/generics.memoryexpanders.pas

@@ -0,0 +1,236 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.MemoryExpanders;
+// Memory expanders
+
+{$mode delphi}
+{$MACRO ON}
+{.$WARN 5024 OFF}
+{.$WARN 4079 OFF}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TProbeSequence = class
+  public
+  end;
+
+  { TLinearProbing }
+
+  TLinearProbing = class(TProbeSequence)
+  public
+    class function Probe(I, Hash: UInt32): UInt32; static; inline;
+
+    const MAX_LOAD_FACTOR = 1;
+    const DEFAULT_LOAD_FACTOR = 0.75;
+  end;
+
+  { TQuadraticProbing }
+
+  TQuadraticProbing = class(TProbeSequence)
+  private
+    class constructor Create;
+  public
+    class var C1: UInt32;
+    class var C2: UInt32;
+
+    class function Probe(I, Hash: UInt32): UInt32; static; inline;
+
+    const MAX_LOAD_FACTOR = 0.5;
+    const DEFAULT_LOAD_FACTOR = 0.5;
+  end;
+
+  { TDoubleHashing }
+
+  TDoubleHashing = class(TProbeSequence)
+  public
+    class function Probe(I, Hash1: UInt32; Hash2: UInt32 = 1): UInt32; static; inline;
+
+    const MAX_LOAD_FACTOR = 1;
+    const DEFAULT_LOAD_FACTOR = 0.85;
+  end;
+
+const
+  // http://stackoverflow.com/questions/757059/position-of-least-significant-bit-that-is-set
+  // MultiplyDeBruijnBitPosition[uint32(((numberInt32 and -numberInt32) * $077CB531)) shr 27]
+  MultiplyDeBruijnBitPosition: array[0..31] of Int32 =
+  (
+    0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
+    31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
+  );
+
+  // http://primes.utm.edu/lists/2small/0bit.html
+  // http://www.math.niu.edu/~rusin/known-math/98/pi_x
+  // http://oeis.org/A014234/
+  PrimaryNumbersJustLessThanPowerOfTwo: array[0..31] of UInt32 =
+  (
+    0, 1, 3, 7, 13, 31, 61, 127, 251, 509, 1021, 2039, 4093, 8191, 16381, 32749, 65521, 131071,
+    262139, 524287, 1048573, 2097143, 4194301, 8388593, 16777213, 33554393, 67108859,
+    134217689, 268435399, 536870909, 1073741789, 2147483647
+  );
+
+  // http://oeis.org/A014210
+  // http://oeis.org/A203074
+  PrimaryNumbersJustBiggerThanPowerOfTwo: array[0..31] of UInt32 = (
+    2,3,5,11,17,37,67,131,257,521,1031,2053,4099,
+    8209,16411,32771,65537,131101,262147,524309,
+    1048583,2097169,4194319,8388617,16777259,33554467,
+    67108879,134217757,268435459,536870923,1073741827,
+    2147483659);
+
+  // Fibonacci numbers
+  FibonacciNumbers: array[0..44] of UInt32 = (
+    {0,1,1,2,3,}0,5,8,13,21,34,55,89,144,233,377,610,987,
+    1597,2584,4181,6765,10946,17711,28657,46368,75025,
+    121393,196418,317811,514229,832040,1346269,
+    2178309,3524578,5702887,9227465,14930352,24157817,
+    39088169, 63245986, 102334155, 165580141, 267914296,
+    433494437, 701408733, 1134903170, 1836311903, 2971215073,
+    {! not fib number - this is memory limit} 4294967295);
+
+  // Largest prime not exceeding Fibonacci(n)
+  // http://oeis.org/A138184/list
+  // http://www.numberempire.com/primenumbers.php
+  PrimaryNumbersJustLessThanFibonacciNumbers: array[0..44] of UInt32 = (
+    {! not correlated to fib number. For empty table} 0,
+    5,7,13,19,31,53,89,139,233,373,607,983,1597,
+    2579,4177,6763,10939,17707,28657,46351,75017,
+    121379,196387,317797,514229,832003,1346249,
+    2178283,3524569,5702867,9227443,14930341,24157811,
+    39088157,63245971,102334123,165580123,267914279,
+    433494437,701408717,1134903127,1836311879,2971215073,
+    {! not correlated to fib number - this is prime memory limit} 4294967291);
+
+  // Smallest prime >= n-th Fibonacci number.
+  // http://oeis.org/A138185
+  PrimaryNumbersJustBiggerThanFibonacciNumbers: array[0..44] of UInt32 = (
+    {! not correlated to fib number. For empty table} 0,
+    5,11,13,23,37,59,89,149,233,379,613,
+    991,1597,2591,4201,6779,10949,17713,28657,46381,
+    75029,121403,196429,317827,514229,832063,1346273,
+    2178313,3524603,5702897,9227479,14930387,24157823,
+    39088193,63245989,102334157,165580147,267914303,
+    433494437,701408753,1134903179,1836311951,2971215073,
+    {! not correlated to fib number - this is prime memory limit} 4294967291);
+
+type
+
+  { TCuckooHashingCfg }
+
+  TCuckooHashingCfg = class
+  public
+    const D = 2;
+    const MAX_LOAD_FACTOR = 0.5;
+
+    class function LoadFactor(M: Integer): Integer; virtual;
+  end;
+
+  TStdCuckooHashingCfg = class(TCuckooHashingCfg)
+  public
+    const MAX_LOOP = 1000;
+  end;
+
+  TDeamortizedCuckooHashingCfg = class(TCuckooHashingCfg)
+  public
+    const L = 5;
+  end;
+
+  TDeamortizedCuckooHashingCfg_D2 = TDeamortizedCuckooHashingCfg;
+
+  { TDeamortizedCuckooHashingCfg_D4 }
+
+  TDeamortizedCuckooHashingCfg_D4 = class(TDeamortizedCuckooHashingCfg)
+  public
+    const D = 4;
+    const L = 20;
+    const MAX_LOAD_FACTOR = 0.9;
+
+    class function LoadFactor(M: Integer): Integer; override;
+  end;
+
+  { TDeamortizedCuckooHashingCfg_D6 }
+
+  TDeamortizedCuckooHashingCfg_D6 = class(TDeamortizedCuckooHashingCfg)
+  public
+    const D = 6;
+    const L = 170;
+    const MAX_LOAD_FACTOR = 0.99;
+
+    class function LoadFactor(M: Integer): Integer; override;
+  end;
+
+  TL5CuckooHashingCfg = class(TCuckooHashingCfg)
+  public
+  end;
+
+implementation
+
+{ TDeamortizedCuckooHashingCfg_D6 }
+
+class function TDeamortizedCuckooHashingCfg_D6.LoadFactor(M: Integer): Integer;
+begin
+  Result:=Pred(Round(MAX_LOAD_FACTOR*M));
+end;
+
+{ TDeamortizedCuckooHashingCfg_D4 }
+
+class function TDeamortizedCuckooHashingCfg_D4.LoadFactor(M: Integer): Integer;
+begin
+  Result:=Pred(Round(MAX_LOAD_FACTOR*M));
+end;
+
+{ TCuckooHashingCfg }
+
+class function TCuckooHashingCfg.LoadFactor(M: Integer): Integer;
+begin
+  Result := Pred(M shr 1);
+end;
+
+{ TLinearProbing }
+
+class function TLinearProbing.Probe(I, Hash: UInt32): UInt32;
+begin
+  Result := (Hash + I)
+end;
+
+{ TQuadraticProbing }
+
+class constructor TQuadraticProbing.Create;
+begin
+  C1 := 1;
+  C2 := 1;
+end;
+
+class function TQuadraticProbing.Probe(I, Hash: UInt32): UInt32;
+begin
+  Result := (Hash + C1 * I {%H-}+ C2 * Sqr(I));
+end;
+
+{ TDoubleHashingNoMod }
+
+class function TDoubleHashing.Probe(I, Hash1: UInt32; Hash2: UInt32): UInt32;
+begin
+  Result := Hash1 + I * Hash2;
+end;
+
+end.
+

Units/Utils/generics.strings.pas

@@ -0,0 +1,34 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Maciej Izak (hnb)
+    member of the Free Sparta development team (http://freesparta.com)
+
+    Copyright(c) 2004-2014 DaThoX
+
+    It contains the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Generics.Strings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+  SArgumentOutOfRange = 'Argument out of range';
+  SDuplicatesNotAllowed = 'Duplicates not allowed in dictionary';
+  SDictionaryKeyDoesNotExist = 'Dictionary key does not exist';
+  SItemNotFound = 'Item not found';
+
+implementation
+
+end.
+