type
  PHashTable = ^THashTable;
  THashTable = record
    Capacity: Cardinal;
    Count: Cardinal;
    Items: array[0..0] of Pointer;
  end;

const
  HASH_SHIFT = 6;
  HASH_EMPTY = Pointer(High(NativeUInt));
  HASH_MINSIZE = 7;

function HashTableGrowThreshold(const ACapacity: NativeUInt): NativeUInt; inline;
var
  LPow2: NativeUInt;
begin
  LPow2 := (ACapacity + 1);
  Result := (LPow2 shr 2) + (LPow2 shr 1);
end;

function HashTableFixBucket(const ABucket: NativeUInt; const ACapacity: NativeUInt): NativeUInt; inline;
begin
  Result := ABucket;
  if (Result = ACapacity) then
    Result := 0;
end;

function HashTableBucketIncrement(const ABucket: NativeUInt; const ACapacity: NativeUInt): NativeUInt; inline;
begin
  Result := HashTableFixBucket(ABucket + 1, ACapacity);
end;

function HashTableBucket(const P: Pointer; const ACapacity: NativeUInt): NativeUInt; inline;
begin
  Result := HashTableFixBucket((NativeUInt(P) shr HASH_SHIFT) and ACapacity, ACapacity);
end;

function HashTableIndex(const AItems: PPointer; const ACapacity: NativeUInt; const P: Pointer;
  const AAddMode: Boolean): NativeUInt;
var
  LValue: Pointer;
  LSourceBucket, LPrevBucket, LBucket: NativeUInt;
begin
  Result := HashTableBucket(P, ACapacity);

  // наиболее благоприятный случай
  LValue := AItems[Result];
  if (LValue = HASH_EMPTY) or (LValue = P) then
    Exit;

  // пропускаем лишние большие бакеты если было переполнение
  // или находим свободное место
  LSourceBucket := Result;
  LBucket := HashTableBucket(LValue, ACapacity);
  if (LBucket > LSourceBucket) then
  repeat
    LPrevBucket := LBucket;

    Result := HashTableBucketIncrement(Result, ACapacity);
    LValue := AItems[Result];
    if (LValue = HASH_EMPTY) then
      Exit;
    LBucket := HashTableBucket(LValue, ACapacity);
  until (LBucket < LPrevBucket);

  // пропускаем лишние малые бакеты если было переполнение
  // или находим свободное место
  if (AAddMode) then
  begin
    repeat
      if (LBucket >= LSourceBucket) then
        Exit;

      Result := HashTableBucketIncrement(Result, ACapacity);
      LValue := AItems[Result];
      if (LValue = HASH_EMPTY) then
        Exit;
      LPrevBucket := LBucket;
      LBucket := HashTableBucket(LValue, ACapacity);
      if (LPrevBucket > LBucket) then
        Break;
    until (False);
  end else
  begin
    repeat
      if (LBucket > LSourceBucket) or (LValue = P) then
        Exit;

      Result := HashTableBucketIncrement(Result, ACapacity);
      LValue := AItems[Result];
      if (LValue = HASH_EMPTY) then
        Exit;
      LPrevBucket := LBucket;
      LBucket := HashTableBucket(LValue, ACapacity);
      if (LPrevBucket > LBucket) then
        Break;
    until (False);
  end;
end;

procedure HashTableInsert(const AItems: PPointer; const ACapacity, AIndex: NativeUInt; const P: Pointer);
var
  LIndex: NativeUInt;
  LValue, LOldValue: Pointer;
begin
  LIndex := AIndex;
  LValue := P;

  repeat
    LOldValue := AItems[LIndex];
    AItems[LIndex] := LValue;
    if (LOldValue = HASH_EMPTY) then
      Exit;

    LValue := LOldValue;
    LIndex := HashTableBucketIncrement(LIndex, ACapacity);
  until (False);
end;

procedure HashTableAdd(var AHashTable: PHashTable; const P: Pointer);
var
  LCapacity: NativeUInt;
begin
  LCapacity := AHashTable.Capacity;
  if (AHashTable.Count = HashTableGrowThreshold(LCapacity)) then
  begin
    LCapacity := (LCapacity + 1) shl 1 - 1;
    HashTableRehash(AHashTable, LCapacity);
  end;

  Inc(AHashTable.Count);
  HashTableInsert(@AHashTable.Items[0], LCapacity,
    HashTableIndex(@AHashTable.Items[0], LCapacity, P, True), P);
end;

function HashTableRemove(var AHashTable: PHashTable; const P: Pointer): Boolean;
var
  LItems: PPointer;
  LCapacity: NativeUInt;
  LIndex, LNextIndex: NativeUInt;
  LValue: Pointer;
begin
  LItems := @AHashTable.Items[0];
  LCapacity := AHashTable.Capacity;
  LIndex := HashTableIndex(LItems, LCapacity, P, False);
  if (LItems[LIndex] <> P) then
    Exit(False);

  Result := False;
  repeat
    LNextIndex := HashTableBucketIncrement(LIndex, LCapacity);
    LValue := LItems[LNextIndex];

    if (LValue = HASH_EMPTY) then
      Break;

    if (LValue = P) then
      Result := True;

    if (LNextIndex = HashTableBucket(LValue, LCapacity)) then
      Break;

    LItems[LIndex] := LValue;
    LIndex := LNextIndex;
  until (False);
  LItems[LIndex] := HASH_EMPTY;

  Dec(AHashTable.Count);
  if (LCapacity <> HASH_MINSIZE) then
  begin
    LCapacity := LCapacity shr 1;
    if (AHashTable.Count = HashTableGrowThreshold(LCapacity)) then
      HashTableRehash(AHashTable, LCapacity);
  end;
end;

  function HashTableFixBucket(const ABucket: NativeUInt; const ACapacity: NativeUInt): NativeUInt; inline;
begin
  Result := ABucket;
  if (Result = ACapacity) then
    Result := 0;
end;

function HashTableBucketIncrement(const ABucket: NativeUInt; const ACapacity: NativeUInt): NativeUInt; inline;
begin
  Result := HashTableFixBucket(ABucket + 1, ACapacity);
end;