Merge pull request #11 from maciej-izak/master

Fix for tbStatusToolBar and latest Generics.Collections

Units/Forms/UFRMMainForm.lfm

@@ -1,10 +1,10 @@
 object FRMMainForm: TFRMMainForm
-  Left = 168
+  Left = 231
   Height = 600
-  Top = 12
+  Top = 44
   Width = 865
   Caption = 'Pascal Coin Wallet, JSON-RPC Miner & Explorer'
-  ClientHeight = 580
+  ClientHeight = 600
   ClientWidth = 865
   Color = clBtnFace
   Constraints.MinHeight = 600
@@ -45,7 +45,7 @@ object FRMMainForm: TFRMMainForm
   end
   object paSyncPanel: TPanel
     Left = 0
-    Height = 477
+    Height = 505
     Top = 80
     Width = 865
     Align = alClient
@@ -62,7 +62,7 @@ object FRMMainForm: TFRMMainForm
   end
   object paWalletPanel: TPanel
     Left = 0
-    Height = 477
+    Height = 505
     Top = 80
     Width = 865
     Align = alClient
@@ -79,8 +79,8 @@ object FRMMainForm: TFRMMainForm
   end
   object sbStatusBar: TStatusBar
     Left = 0
-    Height = 23
-    Top = 557
+    Height = 15
+    Top = 585
     Width = 865
     Panels = <    
       item
@@ -101,17 +101,21 @@ object FRMMainForm: TFRMMainForm
         Width = 30
       end>
     SimplePanel = False
-    OnDrawPanel = sbStatusBarDrawPanel
   end
   object tbStatusToolBar: TToolBar
+    AnchorSideTop.Control = sbStatusBar
+    AnchorSideTop.Side = asrCenter
+    AnchorSideBottom.Control = sbStatusBar
+    AnchorSideBottom.Side = asrBottom
     Left = 778
-    Height = 16
-    Top = 544
+    Height = 15
+    Top = 585
     Width = 70
     Align = alNone
-    Anchors = [akRight, akBottom]
+    Anchors = [akTop, akRight]
     AutoSize = True
-    ButtonHeight = 16
+    ButtonHeight = 15
+    ButtonWidth = 23
     Caption = 'tbStatusToolBar'
     EdgeBorders = []
     EdgeInner = esNone
@@ -119,7 +123,6 @@ object FRMMainForm: TFRMMainForm
     Images = ilSmallIcons
     List = True
     TabOrder = 0
-    Visible = False
     Wrapable = False
     object tbtnWalletLock: TToolButton
       Left = 1
@@ -131,7 +134,7 @@ object FRMMainForm: TFRMMainForm
       OnClick = tbtnWalletLockClick
     end
     object tbtnConnectivity: TToolButton
-      Left = 24
+      Left = 47
       Hint = 'Network is active. Click to deactivate'
       Top = 0
       Caption = 'Net'
@@ -139,7 +142,7 @@ object FRMMainForm: TFRMMainForm
       OnClick = tbtnConnectivityClick
     end
     object tbtnSync: TToolButton
-      Left = 47
+      Left = 24
       Hint = 'Show &Syncronization'
       Top = 0
       Caption = '&Synchronization'

Units/Forms/UFRMMainForm.pas

@@ -90,10 +90,8 @@ type
     procedure tbtnSyncClick(Sender: TObject);
     procedure tbtnWalletLockClick(Sender:TObject);
     procedure tbtnConnectivityClick(Sender:TObject);
-    procedure sbStatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
     procedure miSeedNodesClick(Sender: TObject);
   private
-    __FLastFooterToolBarDrawRect : TRect;  // Required for FPC bug work-around
     FMode : TFRMMainFormMode;
     FSyncControl : TCTRLSyncronization;
     FWalletControl : TCTRLWallet;
@@ -130,9 +128,22 @@ const
 {%region Form life-cycle }
 
 procedure TFRMMainForm.FormCreate(Sender: TObject);
+
+  procedure AdjustStatusToolBar;
+  var
+    LHeightDiff: Integer;
+  begin
+    LHeightDiff := sbStatusBar.Height - tbStatusToolBar.Height;
+    if LHeightDiff >= 0 then
+      Exit;
+
+    tbStatusToolBar.AnchorSideTop.Side := asrTop;
+    tbStatusToolBar.Anchors := [akRight, akBottom];
+  end;
+
 begin
-  tbStatusToolBar.Parent := sbStatusBar;
-  __FLastFooterToolBarDrawRect := TRect.Empty;
+  AdjustStatusToolBar;
+
   CloseAction := caNone; // Will handle terminate in separate method
   FMode := wmSync;
   FSyncControl := TCTRLSyncronization.Create(self);
@@ -395,18 +406,6 @@ begin
   TUserInterface.ShowSyncDialog;
 end;
 
-procedure TFRMMainForm.sbStatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
-begin
-  if __FLastFooterToolBarDrawRect = Rect then exit; // avoid FPC bug: triggers infinite draw refresh on windows
-  if Panel = sbStatusBar.Panels[3] then
-    with tbStatusToolBar do begin
-      Top := Rect.Top + (Rect.Height - tbStatusToolBar.Height) div 2;
-      Left := Rect.Right - tbStatusToolBar.Width - CT_FOOTER_TOOLBAR_RIGHT_PADDING;
-      Visible := true;
-    end;
-  __FLastFooterToolBarDrawRect := Rect;
-end;
-
 {%endregion}
 
 end.

Units/Utils/generics.defaults.pas

@@ -14,6 +14,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 unit Generics.Defaults;
@@ -857,6 +865,12 @@ type
     class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
   end;
 
+  TmORMotHashFactory = 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)
@@ -922,7 +936,7 @@ type
     class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
   end;
 
-  TDefaultHashFactory = TDelphiQuadrupleHashFactory;
+  TDefaultHashFactory = TmORMotHashFactory;
 
   TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
 
@@ -2782,6 +2796,18 @@ begin
   Result := DelphiHashLittle(AKey, ASize, AInitVal);
 end;
 
+{ TmORMotHashFactory }
+
+class function TmORMotHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TmORMotHashFactory>;
+end;
+
+class function TmORMotHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := mORMotHasher(AInitVal, AKey, ASize);
+end;
+
 { TAdler32HashFactory }
 
 class function TAdler32HashFactory.GetHashService: THashServiceClass;
@@ -3255,7 +3281,7 @@ begin
     giEqualityComparer:
       begin
         if AFactory = nil then
-          AFactory := TDelphiHashFactory;
+          AFactory := TDefaultHashFactory;
 
         Exit(
           AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize));

Units/Utils/generics.dictionaries.inc

@@ -16,6 +16,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 { TPair<TKey,TValue> }
@@ -88,16 +96,31 @@ begin
   Create(ACollection, TEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<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>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>); overload;
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+
 destructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Destroy;
 begin
   Clear;
@@ -145,71 +168,30 @@ end;
 
 { TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS> }
 
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.
-  TPointersCollection.Dictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>;
-begin
-  Result := TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>(Pointer(@Self)^);
-end;
-
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.
-  TPointersCollection.{Do}GetEnumerator: TDictionaryPointersEnumerator;
-begin
-  Result := TDictionaryPointersEnumerator(TDictionaryPointersEnumerator.NewInstance);
-  TCustomDictionaryEnumerator<PT, CUSTOM_DICTIONARY_CONSTRAINTS>(Result).Create(Dictionary);
-end;
-
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.
-  TPointersCollection.GetCount: SizeInt;
-begin
-  Result := Dictionary.Count;
-end;
-
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.
-  TPointersCollection.ToArray: TArray<PT>;
-var
-  i: SizeInt;
-  LEnumerator: TDictionaryPointersEnumerator;
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetPtrEnumerator: TEnumerator<PT>;
 begin
-  SetLength(Result, Count);
-
-  try
-    LEnumerator := GetEnumerator;
-
-    i := 0;
-    while LEnumerator.MoveNext do
-    begin
-      Result[i] := LEnumerator.Current;
-      Inc(i);
-    end;
-  finally
-    LEnumerator.Free;
-  end;
+  Result := TDictionaryPointersEnumerator.Create(FDictionary);
 end;
 
-constructor TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
+constructor TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
   ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
 begin
   FDictionary := ADictionary;
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.
   DoGetEnumerator: TDictionaryEnumerator;
 begin
   Result := TDictionaryEnumerator(TDictionaryEnumerator.NewInstance);
   TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>(Result).Create(FDictionary);
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.GetCount: SizeInt;
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetCount: SizeInt;
 begin
   Result := TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>(FDictionary).Count;
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.GetPointers: PPointersCollection;
-begin
-  Result := @FPointers;
-end;
-
-function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, PT, CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<T>;
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<T>;
 begin
   Result := ToArrayImpl(FDictionary.Count);
 end;
@@ -239,6 +221,89 @@ begin
   Result := True;
 end;
 
+{ TOpenAddressingPointersEnumerator<TItem, PDictionaryPair> }
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.DoMoveNext: boolean;
+var
+  LLength: SizeInt;
+begin
+  Inc(FIndex);
+
+  LLength := Length(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 (FItems^[FIndex].Hash and UInt32.GetSignMask) = 0 do
+  begin
+    Inc(FIndex);
+    if FIndex = LLength then
+      Exit(False);
+  end;
+
+  Result := True;
+end;
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.DoGetCurrent: PDictionaryPair;
+begin
+  Result := GetCurrent;
+end;
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.GetCurrent: PDictionaryPair;
+begin
+  Result := @FItems^[FIndex].Pair;
+end;
+
+constructor TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.Create(var AItems);
+begin
+  FIndex := -1;
+  FItems := @AItems;
+end;
+
+{ TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair> }
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.Items: PArray;
+begin
+  Result := PArray(@((@Self)^));
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.GetCount: SizeInt;
+begin
+  Result := PSizeInt(PByte(@((@Self)^))-SizeOf(SizeInt))^;
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.GetEnumerator: TPointersEnumerator;
+begin
+  Result := TPointersEnumerator(TPointersEnumerator.NewInstance);
+  TPointersEnumerator(Result).Create(Items^);
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.ToArray: TArray<PDictionaryPair>;
+{begin
+  Result := ToArrayImpl(FList.Count);
+end;}
+var
+  i: SizeInt;
+  LEnumerator: TPointersEnumerator;
+begin
+  SetLength(Result, GetCount);
+
+  try
+    LEnumerator := GetEnumerator;
+
+    i := 0;
+    while LEnumerator.MoveNext do
+    begin
+      Result[i] := LEnumerator.Current;
+      Inc(i);
+    end;
+  finally
+    LEnumerator.Free;
+  end;
+end;
+
 { TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> }
 
 constructor TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
@@ -304,6 +369,11 @@ begin
   PairNotify(AItem.Pair, cnAdded);
 end;
 
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetPointers: PPointersCollection;
+begin
+  Result := PPointersCollection(@FItems);
+end;
+
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue);
 begin
   DoAdd(AKey, AValue);
@@ -945,6 +1015,11 @@ constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: T
 begin
 end;
 
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt);
 begin
   Create(ACapacity, TExtendedEqualityComparer<TKey>.Default(THashFactory));
@@ -955,6 +1030,11 @@ begin
   Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
   const AComparer: IExtendedEqualityComparer<TKey>);
 begin
@@ -971,13 +1051,23 @@ end;
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
   const AComparer: IExtendedEqualityComparer<TKey>);
 var
-  LItem: TPair<TKey, TValue>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+
 procedure TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
 begin
   inherited;
@@ -1133,6 +1223,126 @@ begin
   Result := True;
 end;
 
+{ TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair> }
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.DoMoveNext: boolean;
+var
+  LLength: SizeInt;
+  LArray: TItemsArray;
+begin
+  Inc(FIndex);
+
+  if (FMainIndex = TCuckooCfg.D) then // queue
+  begin
+    LLength := Length(FQueue.FItems);
+    if FIndex >= LLength then
+      Exit(False);
+
+    while ((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 := 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;
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.DoGetCurrent: PDictionaryPair;
+begin
+  Result := GetCurrent;
+end;
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetCurrent: PDictionaryPair;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := @(FQueue.FItems[FIndex].Pair.Value.Pair)
+  else
+    Result := @((FItems^[FMainIndex])[FIndex].Pair);
+end;
+
+constructor TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.Create(var AItems; AQueue: TQueueDictionary; ACount: SizeInt);
+begin
+  FIndex := -1;
+  if ACount = 0 then
+    FMainIndex := TCuckooCfg.D
+  else
+    FMainIndex := 0;
+  FQueue := AQueue;
+  FItems := @AItems;
+end;
+
+{ TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItem, TQueueDictionary, PDictionaryPair> }
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.Items: PArray;
+begin
+  Result := PArray(@((@Self)^));
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetCount: SizeInt;
+begin
+  Result := SizeInt((@PByte(@((@Self)^))[-SizeOf(SizeInt)])^);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetQueue: TQueueDictionary;
+begin
+  Result := TQueueDictionary((@PByte(@((@Self)^))[SizeOf(TItemsDArray)])^);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetEnumerator: TPointersEnumerator;
+begin
+  Result := TPointersEnumerator(TPointersEnumerator.NewInstance);
+  TPointersEnumerator(Result).Create(Items^, GetQueue, GetCount);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.ToArray: TArray<PDictionaryPair>;
+{begin
+  Result := ToArrayImpl(FList.Count);
+end;}
+var
+  i: SizeInt;
+  LEnumerator: TPointersEnumerator;
+begin
+  SetLength(Result, GetCount);
+
+  try
+    LEnumerator := GetEnumerator;
+
+    i := 0;
+    while LEnumerator.MoveNext do
+    begin
+      Result[i] := LEnumerator.Current;
+      Inc(i);
+    end;
+  finally
+    LEnumerator.Free;
+  end;
+end;
+
 { TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS> }
 
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Rehash(ASizePow2: SizeInt;
@@ -1233,6 +1443,11 @@ constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection:
 begin
 end;
 
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create;
 begin
   Create(0);
@@ -1248,6 +1463,11 @@ begin
   Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACapacity: SizeInt;
   const AComparer: IExtendedEqualityComparer<TKey>);
 begin
@@ -1277,13 +1497,23 @@ end;
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
   const AComparer: IExtendedEqualityComparer<TKey>);
 var
-  LItem: TPair<TKey, TValue>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+
 destructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Destroy;
 begin
   inherited;
@@ -1305,6 +1535,11 @@ begin
   Result := TValueCollection(FValues);
 end;
 
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetPointers: PPointersCollection;
+begin
+  Result := PPointersCollection(@FItems);
+end;
+
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Lookup(constref AKey: TKey;
   var AHashListOrIndex: PUInt32): SizeInt;
 begin

Units/Utils/generics.dictionariesh.inc

@@ -16,6 +16,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 {$WARNINGS OFF}
@@ -44,8 +52,7 @@ type
     PKey = ^TKey;
     PValue = ^TValue;
     THashFactoryClass = THashFactory;
-  public
-    FItemsLength: SizeInt;
+  protected
     FEqualityComparer: IEqualityComparer<TKey>;
     FKeys: TEnumerable<TKey>;
     FValues: TEnumerable<TValue>;
@@ -63,8 +70,6 @@ type
     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
@@ -78,6 +83,8 @@ type
     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;
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>); virtual; overload;
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); virtual; overload;
 
     destructor Destroy; override;
   private
@@ -93,6 +100,10 @@ type
   public
     property OnKeyNotify: TCollectionNotifyEvent<TKey> read FOnKeyNotify write FOnKeyNotify;
     property OnValueNotify: TCollectionNotifyEvent<TValue> read FOnValueNotify write FOnValueNotify;
+  protected // FItemsLength must be declared at the end of TCustomDictionary
+    FItemsLength: SizeInt;
+  public
+    property Count: SizeInt read FItemsLength;
   end;
 
   { TCustomDictionaryEnumerator }
@@ -111,40 +122,51 @@ type
   { TDictionaryEnumerable }
 
   TDictionaryEnumerable<TDictionaryEnumerator: TObject; TDictionaryPointersEnumerator, // ... inherits from TCustomDictionaryEnumerator. workaround...
-    T, PT, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerable<T>)
-  private type
-    PPointersCollection = ^TPointersCollection;
-    TPointersCollection = record
-    private
-      function Dictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>; inline;
-      function GetCount: SizeInt; inline;
-    public
-      function GetEnumerator: TDictionaryPointersEnumerator;
-      function ToArray: TArray<PT>;
-      property Count: SizeInt read GetCount;
-    end;
+    T, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerableWithPointers<T>)
   private
-    FPointers: TPointersCollection;
     FDictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>;
     function GetCount: SizeInt;
-    function GetPointers: PPointersCollection; inline;
+  protected
+    function GetPtrEnumerator: TEnumerator<PT>; override;
+    function DoGetEnumerator: TDictionaryEnumerator; override;
   public
     constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
-    function DoGetEnumerator: TDictionaryEnumerator; override;
     function ToArray: TArray<T>; override; final;
     property Count: SizeInt read GetCount;
-    property Ptr: PPointersCollection read GetPointers;
   end;
 
   // more info : http://en.wikipedia.org/wiki/Open_addressing
 
-  { TDictionaryEnumerable }
+  { TOpenAddressingEnumerator }
 
   TOpenAddressingEnumerator<T, OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
   protected
     function DoMoveNext: Boolean; override;
   end;
 
+  TOpenAddressingPointersEnumerator<TItem, PDictionaryPair> = class abstract(TEnumerator<PDictionaryPair>)
+  private var
+    FItems: ^TArray<TItem>;
+    FIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: PDictionaryPair; override;
+    function GetCurrent: PDictionaryPair; virtual;
+  public
+    constructor Create(var AItems);
+  end;
+
+  TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair> = record
+  private type
+    PArray = ^TArray<TItem>;
+    function Items: PArray; inline;
+    function GetCount: SizeInt; inline;
+  public
+    function GetEnumerator: TPointersEnumerator;
+    function ToArray: TArray<PDictionaryPair>;
+    property Count: SizeInt read GetCount;
+  end;
+
   TOnGetMemoryLayoutKeyPosition = procedure(Sender: TObject; AKeyPos: UInt32) of object;
 
   TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>)
@@ -156,9 +178,13 @@ type
     end;
 
     TItemsArray = array of TItem;
-  private var
-    FItemsThreshold: SizeInt;
+    TPointersEnumerator = class(TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>);
+    TPointersCollection = TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>;
+  public type
+    PPointersCollection = ^TPointersCollection;
+  private var // FItems must be declared as first field 
     FItems: TItemsArray;
+    FItemsThreshold: SizeInt;
 
     procedure Resize(ANewSize: SizeInt);
     procedure PrepareAddingItem;
@@ -196,15 +222,16 @@ type
       end;
 
       // Collections
-      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, PValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
-      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, PKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
     // bug #24283 - workaround related to lack of DoGetEnumerator
     function GetEnumerator: TPairEnumerator; reintroduce;
   private
     function GetKeys: TKeyCollection;
     function GetValues: TValueCollection;
+    function GetPointers: PPointersCollection; inline;
   private
     function GetItem(const AKey: TKey): TValue; inline;
     procedure SetItem(const AKey: TKey; const AValue: TValue); inline;
@@ -241,6 +268,7 @@ type
     property Items[Index: TKey]: TValue read GetItem write SetItem; default;
     property Keys: TKeyCollection read GetKeys;
     property Values: TValueCollection read GetValues;
+    property Ptr: PPointersCollection read GetPointers;
 
     procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
   end;
@@ -320,12 +348,15 @@ type
     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;
+    constructor Create(ACollection: TEnumerableWithPointers<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(ACollection: TEnumerableWithPointers<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;
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
   end;
 
   TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
@@ -343,6 +374,32 @@ type
     constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
   end;
 
+  TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair> = class abstract(TEnumerator<PDictionaryPair>)
+  private var // FItems must be declared as first field and FQueue as second
+    FItems: ^TItemsDArray;
+    FQueue: TQueueDictionary;
+    FIndex: SizeInt;
+    FMainIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: PDictionaryPair; override;
+    function GetCurrent: PDictionaryPair; virtual;
+  public
+    constructor Create(var AItems; AQueue: TQueueDictionary; ACount: SizeInt);
+  end;
+
+  TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair> = record
+  private type
+    PArray = ^TItemsDArray;
+    function Items: PArray; inline;
+    function GetCount: SizeInt; inline;
+    function GetQueue: TQueueDictionary; inline;
+  public
+    function GetEnumerator: TPointersEnumerator;
+    function ToArray: TArray<PDictionaryPair>;
+    property Count: SizeInt read GetCount;
+  end;
+
   // more info :
   // http://arxiv.org/abs/0903.0391
 
@@ -358,7 +415,7 @@ type
     end;
     TValueForQueue = TItem;
 
-    TQueueDictionary = class(TOpenAddressingLP<TKey, TValueForQueue, TDelphiHashFactory, TLinearProbing>)
+    TQueueDictionary = class(TOpenAddressingLP<TKey, TValueForQueue, TDefaultHashFactory, TLinearProbing>)
     private type // for workaround Lazarus bug #25613
       _TItem = record
         Hash: UInt32;
@@ -379,16 +436,20 @@ type
     end;
 
     // cycle-detection mechanism class
-    TCDM = class(TOpenAddressingSH<TKey, TEmptyRecord, TDelphiHashFactory, TLinearProbing>);
+    TCDM = class(TOpenAddressingSH<TKey, TEmptyRecord, TDefaultHashFactory, TLinearProbing>);
     TItemsArray = array of TItem;
     TItemsDArray = array[0..Pred(TCuckooCfg.D)] of TItemsArray;
+    TPointersEnumerator = class(TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>);
+    TPointersCollection = TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>;
+  public type
+    PPointersCollection = ^TPointersCollection;
   private var
+    FItems: TItemsDArray;
     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;
@@ -431,15 +492,16 @@ type
       end;
 
       // Collections
-      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, PValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
-      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, PKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
     // bug #24283 - workaround related to lack of DoGetEnumerator
     function GetEnumerator: TPairEnumerator; reintroduce;
   private
     function GetKeys: TKeyCollection;
     function GetValues: TValueCollection;
+    function GetPointers: PPointersCollection; inline;
   private
     function GetItem(const AKey: TKey): TValue; inline;
     procedure SetItem(const AKey: TKey; const AValue: TValue); overload; inline;
@@ -462,15 +524,18 @@ type
     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;
+    constructor Create(ACollection: TEnumerableWithPointers<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(ACollection: TEnumerableWithPointers<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;
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
     destructor Destroy; override;
 
     procedure Add(constref APair: TPair<TKey, TValue>); override; overload;
@@ -488,6 +553,7 @@ type
     property Items[Index: TKey]: TValue read GetItem write SetItem; default;
     property Keys: TKeyCollection read GetKeys;
     property Values: TValueCollection read GetValues;
+    property Ptr: PPointersCollection read GetPointers;
 
     property QueueCount: SizeInt read GetQueueCount;
     procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
@@ -531,17 +597,17 @@ type
 
   // useful generics overloads
   TOpenAddressingLP<TKey, TValue, THashFactory> = class(TOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
-  TOpenAddressingLP<TKey, TValue>  = class(TOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+  TOpenAddressingLP<TKey, TValue>  = class(TOpenAddressingLP<TKey, TValue, TDefaultHashFactory, TLinearProbing>);
 
   TObjectOpenAddressingLP<TKey, TValue, THashFactory> = class(TObjectOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
-  TObjectOpenAddressingLP<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+  TObjectOpenAddressingLP<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue, TDefaultHashFactory, 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>);
+  TOpenAddressingLPT<TKey, TValue> = class(TOpenAddressingSH<TKey, TValue, TDefaultHashFactory, TLinearProbing>);
 
   TOpenAddressingQP<TKey, TValue, THashFactory> = class(TOpenAddressingQP<TKey, TValue, THashFactory, TQuadraticProbing>);
-  TOpenAddressingQP<TKey, TValue> = class(TOpenAddressingQP<TKey, TValue, TDelphiHashFactory, TQuadraticProbing>);
+  TOpenAddressingQP<TKey, TValue> = class(TOpenAddressingQP<TKey, TValue, TDefaultHashFactory, TQuadraticProbing>);
 
   TOpenAddressingDH<TKey, TValue, THashFactory> = class(TOpenAddressingDH<TKey, TValue, THashFactory, TDoubleHashing>);
   TOpenAddressingDH<TKey, TValue> = class(TOpenAddressingDH<TKey, TValue, TDelphiDoubleHashFactory, TDoubleHashing>);

Units/Utils/generics.hashes.pas

@@ -14,6 +14,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library.
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 unit Generics.Hashes;
@@ -64,6 +72,14 @@ function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
 // 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;
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+
+type
+  THasher = function(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+
+var
+  crc32c: THasher;
+  mORMotHasher: THasher;
 
 implementation
 
@@ -911,5 +927,657 @@ begin
   Result := Int32(c);
 end;
 
+{$ifdef CPU64}
+  {$define PUREPASCAL}
+  {$ifdef CPUX64}
+    {$define CPUINTEL}
+    {$ASMMODE INTEL}
+  {$endif CPUX64}
+{$else}
+  {$ifdef CPUX86}
+    {$define CPUINTEL}
+    {$ASMMODE INTEL}
+  {$else CPUX86}
+  {$define PUREPASCAL}
+  {$endif}
+{$endif CPU64}
+
+{$ifdef CPUARM} // circumvent FPC issue on ARM
+function ToByte(value: cardinal): cardinal; inline;
+begin
+  result := value and $ff;
+end;
+{$else}
+type ToByte = byte;
+{$endif}
+
+{$ifdef CPUINTEL} // use optimized x86/x64 asm versions for xxHash32
+
+{$ifdef CPUX86}
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+asm
+        xchg    edx, ecx
+        push    ebp
+        push    edi
+        lea     ebp, [ecx+edx]
+        push    esi
+        push    ebx
+        sub     esp, 8
+        cmp     edx, 15
+        mov     ebx, eax
+        mov     dword ptr [esp], edx
+        lea     eax, [ebx+165667B1H]
+        jbe     @2
+        lea     eax, [ebp-10H]
+        lea     edi, [ebx+24234428H]
+        lea     esi, [ebx-7A143589H]
+        mov     dword ptr [esp+4H], ebp
+        mov     edx, eax
+        lea     eax, [ebx+61C8864FH]
+        mov     ebp, edx
+@1:     mov     edx, dword ptr [ecx]
+        imul    edx, edx, -2048144777
+        add     edi, edx
+        rol     edi, 13
+        imul    edi, edi, -1640531535
+        mov     edx, dword ptr [ecx+4]
+        imul    edx, edx, -2048144777
+        add     esi, edx
+        rol     esi, 13
+        imul    esi, esi, -1640531535
+        mov     edx, dword ptr [ecx+8]
+        imul    edx, edx, -2048144777
+        add     ebx, edx
+        rol     ebx, 13
+        imul    ebx, ebx, -1640531535
+        mov     edx, dword ptr [ecx+12]
+        lea     ecx, [ecx+16]
+        imul    edx, edx, -2048144777
+        add     eax, edx
+        rol     eax, 13
+        imul    eax, eax, -1640531535
+        cmp     ebp, ecx
+        jnc     @1
+        rol     edi, 1
+        rol     esi, 7
+        rol     ebx, 12
+        add     esi, edi
+        mov     ebp, dword ptr [esp+4H]
+        ror     eax, 14
+        add     ebx, esi
+        add     eax, ebx
+@2:     lea     esi, [ecx+4H]
+        add     eax, dword ptr [esp]
+        cmp     ebp, esi
+        jc      @4
+        mov     ebx, esi
+        nop
+@3:     imul    edx, dword ptr [ebx-4H], -1028477379
+        add     ebx, 4
+        add     eax, edx
+        ror     eax, 15
+        imul    eax, eax, 668265263
+        cmp     ebp, ebx
+        jnc     @3
+        lea     edx, [ebp-4H]
+        sub     edx, ecx
+        mov     ecx, edx
+        and     ecx, 0FFFFFFFCH
+        add     ecx, esi
+@4:     cmp     ebp, ecx
+        jbe     @6
+@5:     movzx   edx, byte ptr [ecx]
+        add     ecx, 1
+        imul    edx, edx, 374761393
+        add     eax, edx
+        rol     eax, 11
+        imul    eax, eax, -1640531535
+        cmp     ebp, ecx
+        jnz     @5
+        nop
+@6:     mov     edx, eax
+        add     esp, 8
+        shr     edx, 15
+        xor     eax, edx
+        imul    eax, eax, -2048144777
+        pop     ebx
+        pop     esi
+        mov     edx, eax
+        shr     edx, 13
+        xor     eax, edx
+        imul    eax, eax, -1028477379
+        pop     edi
+        pop     ebp
+        mov     edx, eax
+        shr     edx, 16
+        xor     eax, edx
+end;
+{$endif CPUX86}
+
+{$ifdef CPUX64}
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+asm
+        {$ifdef LINUX} // crc=rdi P=rsi len=rdx
+        mov     r8, rdi
+        mov     rcx, rsi
+        {$else} // crc=r8 P=rcx len=rdx
+        mov     r10, r8
+        mov     r8, rcx
+        mov     rcx, rdx
+        mov     rdx, r10
+        push    rsi   // Win64 expects those registers to be preserved
+        push    rdi
+        {$endif}
+        // P=r8 len=rcx crc=rdx
+        push    rbx
+        lea     r10, [rcx+rdx]
+        cmp     rdx, 15
+        lea     eax, [r8+165667B1H]
+        jbe     @2
+        lea     rsi, [r10-10H]
+        lea     ebx, [r8+24234428H]
+        lea     edi, [r8-7A143589H]
+        lea     eax, [r8+61C8864FH]
+@1:     imul    r9d, dword ptr [rcx], -2048144777
+        add     rcx, 16
+        imul    r11d, dword ptr [rcx-0CH], -2048144777
+        add     ebx, r9d
+        lea     r9d, [r11+rdi]
+        rol     ebx, 13
+        rol     r9d, 13
+        imul    ebx, ebx, -1640531535
+        imul    edi, r9d, -1640531535
+        imul    r9d, dword ptr [rcx-8H], -2048144777
+        add     r8d, r9d
+        imul    r9d, dword ptr [rcx-4H], -2048144777
+        rol     r8d, 13
+        imul    r8d, r8d, -1640531535
+        add     eax, r9d
+        rol     eax, 13
+        imul    eax, eax, -1640531535
+        cmp     rsi, rcx
+        jnc     @1
+        rol     edi, 7
+        rol     ebx, 1
+        rol     r8d, 12
+        mov     r9d, edi
+        ror     eax, 14
+        add     r9d, ebx
+        add     r8d, r9d
+        add     eax, r8d
+@2:     lea     r9, [rcx+4H]
+        add     eax, edx
+        cmp     r10, r9
+        jc      @4
+        mov     r8, r9
+@3:     imul    edx, dword ptr [r8-4H], -1028477379
+        add     r8, 4
+        add     eax, edx
+        ror     eax, 15
+        imul    eax, eax, 668265263
+        cmp     r10, r8
+        jnc     @3
+        lea     rdx, [r10-4H]
+        sub     rdx, rcx
+        mov     rcx, rdx
+        and     rcx, 0FFFFFFFFFFFFFFFCH
+        add     rcx, r9
+@4:     cmp     r10, rcx
+        jbe     @6
+@5:     movzx   edx, byte ptr [rcx]
+        add     rcx, 1
+        imul    edx, edx, 374761393
+        add     eax, edx
+        rol     eax, 11
+        imul    eax, eax, -1640531535
+        cmp     r10, rcx
+        jnz     @5
+@6:     mov     edx, eax
+        shr     edx, 15
+        xor     eax, edx
+        imul    eax, eax, -2048144777
+        mov     edx, eax
+        shr     edx, 13
+        xor     eax, edx
+        imul    eax, eax, -1028477379
+        mov     edx, eax
+        shr     edx, 16
+        xor     eax, edx
+        pop     rbx
+        {$ifndef LINUX}
+        pop     rdi
+        pop     rsi
+        {$endif}
+end;
+{$endif CPUX64}
+
+{$else not CPUINTEL}
+const
+  PRIME32_1 = 2654435761;
+  PRIME32_2 = 2246822519;
+  PRIME32_3 = 3266489917;
+  PRIME32_4 = 668265263;
+  PRIME32_5 = 374761393;
+
+// RolDWord is an intrinsic function under FPC :)
+function Rol13(value: cardinal): cardinal; inline;
+begin
+  result := RolDWord(value, 13);
+end;
+
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+var c1, c2, c3, c4: cardinal;
+    PLimit, PEnd: PAnsiChar;
+begin
+  PEnd := P + len;
+  if len >= 16 then begin
+    PLimit := PEnd - 16;
+    c3 := crc;
+    c2 := c3 + PRIME32_2;
+    c1 := c2 + PRIME32_1;
+    c4 := c3 - PRIME32_1;
+    repeat
+      c1 := PRIME32_1 * Rol13(c1 + PRIME32_2 * PCardinal(P)^);
+      c2 := PRIME32_1 * Rol13(c2 + PRIME32_2 * PCardinal(P+4)^);
+      c3 := PRIME32_1 * Rol13(c3 + PRIME32_2 * PCardinal(P+8)^);
+      c4 := PRIME32_1 * Rol13(c4 + PRIME32_2 * PCardinal(P+12)^);
+      inc(P, 16);
+    until not (P <= PLimit);
+    result := RolDWord(c1, 1) + RolDWord(c2, 7) + RolDWord(c3, 12) + RolDWord(c4, 18);
+  end else
+    result := crc + PRIME32_5;
+  inc(result, len);
+  while P <= PEnd - 4 do begin
+    inc(result, PCardinal(P)^ * PRIME32_3);
+    result := RolDWord(result, 17) * PRIME32_4;
+    inc(P, 4);
+  end;
+  while P < PEnd do begin
+    inc(result, PByte(P)^ * PRIME32_5);
+    result := RolDWord(result, 11) * PRIME32_1;
+    inc(P);
+  end;
+  result := result xor (result shr 15);
+  result := result * PRIME32_2;
+  result := result xor (result shr 13);
+  result := result * PRIME32_3;
+  result := result xor (result shr 16);
+end;
+{$endif CPUINTEL}
+
+{$ifdef CPUINTEL}
+
+type
+ TRegisters = record
+   eax,ebx,ecx,edx: cardinal;
+ end;
+
+{$ifdef CPU64}
+procedure GetCPUID(Param: Cardinal; var Registers: TRegisters); nostackframe; assembler;
+asm
+        {$ifdef win64}
+        mov     eax, ecx
+        mov     r9, rdx
+        {$else}
+        mov     eax, edi
+        mov     r9, rsi
+        {$endif win64}
+        mov     r10, rbx // preserve rbx
+        xor     ebx, ebx
+        xor     ecx, ecx
+        xor     edx, edx
+        cpuid
+        mov     TRegisters(r9).&eax, eax
+        mov     TRegisters(r9).&ebx, ebx
+        mov     TRegisters(r9).&ecx, ecx
+        mov     TRegisters(r9).&edx, edx
+        mov     rbx, r10
+end;
+
+function crc32csse42(crc: cardinal; buf: Pointer; len: cardinal): cardinal; nostackframe; assembler;
+asm // ecx=crc, rdx=buf, r8=len (Linux: edi,rsi,rdx)
+        {$ifdef win64}
+        mov     eax, ecx
+        {$else}
+        mov     eax, edi
+        mov     r8, rdx
+        mov     rdx, rsi
+        {$endif win64}
+        not     eax
+        test    rdx, rdx
+        jz      @0
+        test    r8, r8
+        jz      @0
+@7:     test    dl, 7
+        jz      @8 // align to 8 bytes boundary
+        crc32   eax, byte ptr[rdx]
+        inc     rdx
+        dec     r8
+        jz      @0
+        test    dl, 7
+        jnz     @7
+@8:     mov     rcx, r8
+        shr     r8, 3
+        jz      @2
+@1:
+        crc32   rax, qword [rdx] // hash 8 bytes per loop
+        dec     r8
+        lea     rdx, [rdx + 8]
+        jnz     @1
+@2:     and     ecx, 7
+        jz      @0
+        cmp     ecx, 4
+        jb      @4
+        crc32   eax, dword ptr[rdx]
+        sub     ecx, 4
+        lea     rdx, [rdx + 4]
+        jz      @0
+@4:     crc32   eax, byte ptr[rdx]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[rdx + 1]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[rdx + 2]
+@0:     not     eax
+end;
+{$endif CPU64}
+
+{$ifdef CPUX86}
+procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
+asm
+        push    esi
+        push    edi
+        mov     esi, edx
+        mov     edi, eax
+        pushfd
+        pop     eax
+        mov     edx, eax
+        xor     eax, $200000
+        push    eax
+        popfd
+        pushfd
+        pop     eax
+        xor     eax, edx
+        jz      @nocpuid
+        push    ebx
+        mov     eax, edi
+        xor     ecx, ecx
+        cpuid
+        mov     TRegisters(esi).&eax, eax
+        mov     TRegisters(esi).&ebx, ebx
+        mov     TRegisters(esi).&ecx, ecx
+        mov     TRegisters(esi).&edx, edx
+        pop     ebx
+@nocpuid:
+        pop     edi
+        pop     esi
+end;
+
+function crc32csse42(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+asm // eax=crc, edx=buf, ecx=len
+        not     eax
+        test    ecx, ecx
+        jz      @0
+        test    edx, edx
+        jz      @0
+@3:     test    edx, 3
+        jz      @8 // align to 4 bytes boundary
+        crc32   eax, byte ptr[edx]
+        inc     edx
+        dec     ecx
+        jz      @0
+        test    edx, 3
+        jnz     @3
+@8:     push    ecx
+        shr     ecx, 3
+        jz      @2
+@1:
+        crc32   eax, dword ptr[edx]
+        crc32   eax, dword ptr[edx + 4]
+        dec     ecx
+        lea     edx, [edx + 8]
+        jnz     @1
+@2:     pop     ecx
+        and     ecx, 7
+        jz      @0
+        cmp     ecx, 4
+        jb      @4
+        crc32   eax, dword ptr[edx]
+        sub     ecx, 4
+        lea     edx, [edx + 4]
+        jz      @0
+@4:
+        crc32   eax, byte ptr[edx]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[edx + 1]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[edx + 2]
+@0:     not     eax
+end;
+{$endif CPUX86}
+
+type
+  /// the potential features, retrieved from an Intel CPU
+  // - see https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
+  TIntelCpuFeature =
+   ( { in EDX }
+   cfFPU, cfVME, cfDE, cfPSE, cfTSC, cfMSR, cfPAE, cfMCE,
+   cfCX8, cfAPIC, cf_d10, cfSEP, cfMTRR, cfPGE, cfMCA, cfCMOV,
+   cfPAT, cfPSE36, cfPSN, cfCLFSH, cf_d20, cfDS, cfACPI, cfMMX,
+   cfFXSR, cfSSE, cfSSE2, cfSS, cfHTT, cfTM, cfIA64, cfPBE,
+   { in ECX }
+   cfSSE3, cfCLMUL, cfDS64, cfMON, cfDSCPL, cfVMX, cfSMX, cfEST,
+   cfTM2, cfSSSE3, cfCID, cfSDBG, cfFMA, cfCX16, cfXTPR, cfPDCM,
+   cf_c16, cfPCID, cfDCA, cfSSE41, cfSSE42, cfX2A, cfMOVBE, cfPOPCNT,
+   cfTSC2, cfAESNI, cfXS, cfOSXS, cfAVX, cfF16C, cfRAND, cfHYP,
+   { extended features in EBX, ECX }
+   cfFSGS, cf_b01, cfSGX, cfBMI1, cfHLE, cfAVX2, cf_b06, cfSMEP,
+   cfBMI2, cfERMS, cfINVPCID, cfRTM, cfPQM, cf_b13, cfMPX, cfPQE,
+   cfAVX512F, cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT, cfCLFLUSH,
+   cfCLWB, cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD, cfSHA, cfAVX512BW, cfAVX512VL,
+   cfPREFW1, cfAVX512VBMI, cfUMIP, cfPKU, cfOSPKE, cf_c05, cf_c06, cf_c07,
+   cf_c08, cf_c09, cf_c10, cf_c11, cf_c12, cf_c13, cfAVX512VPC, cf_c15,
+   cf_cc16, cf_c17, cf_c18, cf_c19, cf_c20, cf_c21, cfRDPID, cf_c23,
+   cf_c24, cf_c25, cf_c26, cf_c27, cf_c28, cf_c29, cfSGXLC, cf_c31,
+   cf_d0, cf_d1, cfAVX512NNI, cfAVX512MAS, cf_d4, cf_d5, cf_d6, cf_d7);
+
+  /// all features, as retrieved from an Intel CPU
+  TIntelCpuFeatures = set of TIntelCpuFeature;
+
+var
+  /// the available CPU features, as recognized at program startup
+  CpuFeatures: TIntelCpuFeatures;
+
+procedure TestIntelCpuFeatures;
+var regs: TRegisters;
+begin
+  regs.edx := 0;
+  regs.ecx := 0;
+  GetCPUID(1,regs);
+  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
+  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
+  GetCPUID(7,regs);
+  PIntegerArray(@CpuFeatures)^[2] := regs.ebx;
+  PIntegerArray(@CpuFeatures)^[3] := regs.ecx;
+  PByte(@PIntegerArray(@CpuFeatures)^[4])^ := regs.edx;
+//  assert(sizeof(CpuFeatures)=4*4+1);
+  {$ifdef Darwin}
+  {$ifdef CPU64}
+  // SSE42 asm does not (yet) work on Darwin x64 ...
+  Exclude(CpuFeatures, cfSSE42);
+  {$endif}
+  {$endif}
+end;
+{$endif CPUINTEL}
+
+var
+  crc32ctab: array[0..{$ifdef PUREPASCAL}3{$else}7{$endif},byte] of cardinal;
+
+function crc32cfast(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+{$ifdef PUREPASCAL}
+begin
+  result := not crc;
+  if (buf<>nil) and (len>0) then begin
+    repeat
+      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
+        break;
+      result := crc32ctab[0,ToByte(result xor cardinal(buf^))] xor (result shr 8);
+      dec(len);
+      inc(buf);
+    until len=0;
+    while len>=4 do begin
+      result := result xor PCardinal(buf)^;
+      inc(buf,4);
+      result := crc32ctab[3,ToByte(result)] xor
+                crc32ctab[2,ToByte(result shr 8)] xor
+                crc32ctab[1,ToByte(result shr 16)] xor
+                crc32ctab[0,result shr 24];
+      dec(len,4);
+    end;
+    while len>0 do begin
+      result := crc32ctab[0,ToByte(result xor cardinal(buf^))] xor (result shr 8);
+      dec(len);
+      inc(buf);
+    end;
+  end;
+  result := not result;
+end;
+{$else}
+// adapted from fast Aleksandr Sharahov version
+asm
+        test    edx, edx
+        jz      @ret
+        neg     ecx
+        jz      @ret
+        not     eax
+        push    ebx
+@head:  test    dl, 3
+        jz      @aligned
+        movzx   ebx, byte[edx]
+        inc     edx
+        xor     bl, al
+        shr     eax, 8
+        xor     eax, dword ptr[ebx * 4 + crc32ctab]
+        inc     ecx
+        jnz     @head
+        pop     ebx
+        not     eax
+        ret
+@ret:   rep     ret
+@aligned:
+        sub     edx, ecx
+        add     ecx, 8
+        jg      @bodydone
+        push    esi
+        push    edi
+        mov     edi, edx
+        mov     edx, eax
+@bodyloop:
+        mov     ebx, [edi + ecx - 4]
+        xor     edx, [edi + ecx - 8]
+        movzx   esi, bl
+        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
+        movzx   esi, bh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
+        shr     ebx, 16
+        movzx   esi, bl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
+        movzx   esi, bh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
+        movzx   esi, dl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
+        movzx   esi, dh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
+        shr     edx, 16
+        movzx   esi, dl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
+        movzx   esi, dh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
+        add     ecx, 8
+        jg      @done
+        mov     ebx, [edi + ecx - 4]
+        xor     eax, [edi + ecx - 8]
+        movzx   esi, bl
+        mov     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
+        movzx   esi, bh
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
+        shr     ebx, 16
+        movzx   esi, bl
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
+        movzx   esi, bh
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
+        movzx   esi, al
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
+        movzx   esi, ah
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
+        shr     eax, 16
+        movzx   esi, al
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
+        movzx   esi, ah
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
+        add     ecx, 8
+        jle     @bodyloop
+        mov     eax, edx
+@done:  mov     edx, edi
+        pop     edi
+        pop     esi
+@bodydone:
+        sub     ecx, 8
+        jl      @tail
+        pop     ebx
+        not     eax
+        ret
+@tail:  movzx   ebx, byte[edx + ecx]
+        xor     bl, al
+        shr     eax, 8
+        xor     eax, dword ptr[ebx * 4 + crc32ctab]
+        inc     ecx
+        jnz     @tail
+        pop     ebx
+        not     eax
+end;
+{$endif PUREPASCAL}
+
+procedure InitializeCrc32ctab;
+var
+  i, n: integer;
+  crc: cardinal;
+begin
+  // initialize tables for crc32cfast() and SymmetricEncrypt/FillRandom
+  for i := 0 to 255 do begin
+    crc := i;
+    for n := 1 to 8 do
+      if (crc and 1)<>0 then // polynom is not the same as with zlib's crc32()
+        crc := (crc shr 1) xor $82f63b78 else
+        crc := crc shr 1;
+    crc32ctab[0,i] := crc;
+  end;
+  for i := 0 to 255 do begin
+    crc := crc32ctab[0,i];
+    for n := 1 to high(crc32ctab) do begin
+      crc := (crc shr 8) xor crc32ctab[0,ToByte(crc)];
+      crc32ctab[n,i] := crc;
+    end;
+  end;
+end;
+
+begin
+  {$ifdef CPUINTEL}
+  TestIntelCpuFeatures;
+  if cfSSE42 in CpuFeatures then
+  begin
+    crc32c := @crc32csse42;
+    mORMotHasher := @crc32csse42;
+  end
+  else
+  {$endif CPUINTEL}
+  begin
+    InitializeCrc32ctab;
+    crc32c := @crc32cfast;
+    mORMotHasher := @xxHash32;
+  end;
 end.
 

Units/Utils/generics.strings.pas

@@ -25,6 +25,8 @@ interface
 resourcestring
   SArgumentOutOfRange = 'Argument out of range';
   SDuplicatesNotAllowed = 'Duplicates not allowed in dictionary';
+  SCollectionInconsistency = 'Collection inconsistency';
+  SCollectionDuplicate = 'Collection does not allow duplicates';
   SDictionaryKeyDoesNotExist = 'Dictionary key does not exist';
   SItemNotFound = 'Item not found';